7000 REM ********************************************************************* 7005 REM ------------------------- ROUTINES.BAS ------------------------------ 7010 REM 7015 REM updates - 08/15/90 7020 REM 10/16/90 added DATE and TIME 7025 REM added function keys to EDIT FIELD 7030 REM moved lines 6000-8000 to 16000 and up 7035 REM 11/23/90 added ENTER DOLLAR AMOUNT 7040 REM 12/27/90 added BAR GRAPH 7045 REM 12/29/90 added LARGE CHARACTER MESSAGES 7050 REM 01/02/91 added display window option to POINT & SHOOT MENU 7055 REM added ESCAPE to DELAY OR KEY 7060 REM 07/29/91 added inital item highlighted to POINT & SHOOT MENU 7065 REM 08/07/91 added WIN=2 to POINT & SHOOT MENU 7070 REM 11/04/91 removed WIN=0,1 and made TYP=0,1,2,3 instead 7075 REM on POINT & SHOOT MENU 7080 REM 01/03/92 moved MENUS, LARGE CHAR, BAR GRAPH, FILE SELECTION 7085 REM added TALL file selection 7090 REM 01/16/92 EDIT FIELD now re-prints edited string upon exit 7095 REM 05/18/92 changed entry/exit options to DATE and TIME 7100 REM 05/22/92 added preset colors to CHANGE COLORS 7105 REM added correct ESCAPE to POINT & SHOOT MENU 7110 REM 05/26/92 allow decimal point on numeric only EDIT STRING 7115 REM 05/28/92 fixed column calc on CENTER MESSAGE AND FIELD EDIT 7120 REM added TYP=3 (Y or N only) to EDIT FIELD 7125 REM changed FILE SELECT at 20000 to specify extension 7130 REM 10/29/92 removed leftover WIN variable from POINT AND SHOOT 7135 REM 12/28/92 added MULTIPLE SELECTION ON/OFF MENU 7140 REM 01/18/93 added SHADOW to all routines 7145 REM improved SELECT COLORS routines 7150 REM TYP changed to DISPTYPE and INPTYPE in some routines 7155 REM CENTER MESSAGE AND FIELD now has 4 display options 7160 REM ENTER TIME changed from 12500 to 13000 7165 REM ENTER DOLLAR AMOUNT now uses EDKEYS same as others 7170 REM ENTER DATE and ENTER TIME now uses EDKEYS 7175 REM POINT & SHOOT MENU highlighted ITEM now data colors 7180 REM added ROUTINTS.BAS to this file 7185 REM corrected 0 vs. 1 status in MULTIPLE SELECTION MENU 7190 REM 02/15/93 eliminated CENTER DOLLAR AMOUNT routine 7195 REM eliminated "DATE" and "TIME" from date and time routines 7200 REM changed MESSAGE AND FIELD to field/date/time/dollar and 7205 REM moved from 9500 to 11000, moved MESSAGE from 9700 to 9500 7210 REM moved 11000, 11100, 11200, 11500 (key and delay) to 19000's 7215 REM added LEFT and RIGHT exits to DATE and TIME 7220 REM added another MODE to DATE and TIME 7225 REM better exit for FILE SELECTION at 20000 7230 REM 03/19/93 fixed file selection at 20000 7235 REM 10/26/93 added default colors, MESSAGE & FLD/DAT/TIM/$ edit 7240 REM fixed exits to DATE and TIME 7245 REM 01/11/94 fixed SELECT FILE NAME OF SPECIFIED EXT for DOS 6.x 7250 REM 7255 REM ----------------- BASIC ROUTINES FOR THE IBM PC --------------------- 7260 REM 7265 REM THIS IS A GROUP OF BASIC LANGUAGE SUBROUTINES WRITTEN 7270 REM FOR THE IBM PC AND COMPATIBLES. THESE SUBROUTINES WILL 7275 REM HELP THE BASIC PROGRAMMER SAVE TIME, WRITE MORE USER- 7280 REM FRIENDLY PROGRAMS, AND CREATE BETTER LOOKING DISPLAYS. 7285 REM 7290 REM THEY WERE DEVELOPED WITH THE SIMPLEST SYSTEM IN MIND, 7295 REM THAT IS, THEY USE FEW GRAPHICS OR SPECIAL COMMANDS, SO 7300 REM THEY WILL WORK ON A SYSTEM WITH A MONOCHROME MONITOR 7305 REM AS WELL AS MORE ADVANCED SYSTEMS. HOWEVER, WHEN USED 7310 REM WITH SYSTEMS THAT HAVE COLOR CAPABILITY, COLORS CAN 7315 REM BE SPECIFIED TO PRODUCE COLOR DISPLAYS. 7320 REM 7325 REM THESE SUBROUTINES ARE SUPPLIED WITH LINE NUMBERS AND 7330 REM WILL WORK WITH BASIC INTERPRETERS (LIKE BASICA.COM 7335 REM AND GWBASIC.EXE) AS WELL AS BASIC COMPILERS (LIKE 7340 REM QUICKBASIC AND TURBOBASIC). BOTH EXPERIENCED AND 7345 REM BEGINNING PROGRAMMERS WILL FIND USEFUL SUBROUTINES 7350 REM AND TECHNIQUES IN THIS SOURCE CODE. 7355 REM 7360 REM IN AN EFFORT TO MAKE THIS PACKAGE AS USEFUL AS POSSIBLE, 7365 REM IMPROVEMENTS TO THE EXISTING SUBROUTINES ARE OFTEN MADE 7370 REM AND NEW SUBROUTINES ARE ADDED. EVERY EFFORT IS MADE TO 7375 REM RETAIN COMPATIBILITY WITH THE PREVIOUS VERSIONS. WE 7380 REM WOULD ALSO LIKE TO SOLICIT YOUR SUGGESTIONS ON WAYS TO 7385 REM IMPROVE AND EXPAND THIS PACKAGE. PLEASE FEEL FREE TO 7390 REM CONTACT US AT THE ADDRESS LISTED ABOVE. 7395 REM 7400 REM NOTICE: 7405 REM 7410 REM ROUTINES.BAS IS NEITHER PUBLIC DOMAIN SOFTWARE NOR `SHAREWARE'. 7415 REM IT IS PROVIDED AS A SOURCE CODE PROGRAMMING TOOL TO A SINGLE 7420 REM USER SOLELY FOR INCLUSION IN PROGRAMS WRITTEN BY AND DISTRIBUTED 7425 REM BY THE USER. DUPLICATION OF THIS SOFTWARE BY ANY MEANS IS LIMITED 7430 REM TO THIS INCLUSION AND TO COPIES MADE FOR BACKUP PURPOSES. 7435 REM 7440 REM WARNING - DISCLAIMER 7445 REM 7450 REM THIS SOFTWARE IS PROVIDE "AS IS" WITHOUT WARRANTY OF ANY KIND. 7455 REM THE ENTIRE RISK AS TO THE RESULT AND PERFORMANCE OF THIS SOFTWARE 7460 REM AS WELL AS ITS FITNESS FOR A PARTICULAR USE IS ASSUMED BY THE USER. 7465 REM NEITHER THE AUTHOR, NOR ANY PUBLISHER OR DISTRIBUTOR SHALL HAVE 7470 REM ANY LIABILITY FOR, NOR RESPONSIBILITY TO ANY PERSON OR ENTITY 7475 REM WITH RESPECT TO LOSS OR DAMAGE CAUSED OR ALLEGED TO BE CAUSED 7480 REM DIRECTLY OR INDIRECTLY BY THE SOFTWARE OR INFORMATION CONTAINED 7485 REM IN THIS PACKAGE. 7490 REM 7495 REM ------------------------- ROUTINES.BAS ------------------------------ 7500 REM ----------------- BASIC ROUTINES FOR THE IBM PC --------------------- 7503 REM written by GARY PEEK 3201 HIGHGATE ST. CHARLES, MO 63301 7505 REM ---------- COPYRIGHT (c) 1989, 1990, 1991, 1992, 1993 --------------- 7510 REM 7515 REM 7520 REM ROUTINES.BAS - QUICK REFERENCE 7525 REM 7530 REM 7535 REM 8000 display and select colors for ROUTINES 7540 REM 7545 REM 9000 outline the screen 7550 REM 9200 erase line 7555 REM 7560 REM 9500 display message at row and column 7565 REM 7570 REM 10000 edit a field at row and column 7575 REM 11000 message and field/date/time/dollar amount 7580 REM 7585 REM 12000 enter or change date 7590 REM 13000 enter or change time 7595 REM 7600 REM 15000 enter dollar amount 7605 REM 7610 REM 19000 wait for any key hit 7615 REM 19100 delay in seconds 7620 REM 19200 delay in seconds or key hit 7625 REM 19500 wait for a function key hit 7630 REM 7635 REM 20000 display and select file names (vertically) 7640 REM 21000 display and select file names (wide) 7645 REM 7650 REM 30000 point and shoot style menu 7655 REM 32000 multiple selection on/off menu 7660 REM 7665 REM 38000 full screen menu with work & prompt areas 7670 REM 38500 erase menu work area 7675 REM 38600 erase menu prompt area 7680 REM 7685 REM 50000 display a bar graph 7690 REM 51000 draw 1 bar for bar graph 7695 REM 7700 REM 60000 create messages with large characters 7705 REM 61000 display messages with large characters 7710 REM 7715 REM The following require the assembly language interface 7720 REM 7725 REM 62000 GET MONITOR TYPE 7730 REM 7735 REM The following provide access to mouse function calls 7740 REM 7745 REM 63000 hardware reset and status 7750 REM 63100 show cursor 7755 REM 63200 hide cursor 7760 REM 63300 get button status and mouse position 7765 REM 63400 set cursor position 7770 REM 63500 get button press info 7775 REM 63600 get button release info 7780 REM 63700 set cursor limits 7785 REM 63800 set graphics cursor 7790 REM 64000 set text cursor 7795 REM 64100 read motion counters 7800 REM 64600 set sensitivity and double speed 7805 REM 64900 get driver version, type, IRQ 7810 REM 7815 REM 65000 set up and call assembly language subroutine 7820 REM 65250 load assembly language subroutine 7825 REM 7830 REM ********************************************************************* 7835 REM ------------------- DISPLAY AND SELECT COLORS ----------------------- 7840 REM 7845 REM This routine will let you select 4 sets of colors to be used in some 7850 REM of the other routines for text, data, field, and shadow areas. If 7855 REM these color variables are not specified with this routine or are 7860 REM not specified elsewhere, the routines that use color will default 7865 REM to WHITE on BLACK for text, HIGH-INTENSITY WHITE on BLACK for data, 7870 REM BLACK on WHITE for fields, and GREY on BLACK for shadows. This will 7875 REM insure that the screen will display something that can be seen. 7880 REM 7885 REM TEXTFORE and TEXTBACK are text foreground and background colors 7890 REM These are the normal display colors 7895 REM DATAFORE and DATABACK are data foreground and background colors 7900 REM These are for data or other special things to highlight 7905 REM FIELDFORE and FIELDBACK are field foreground and background colors 7910 REM These are for fields used in editing or selecting data 7915 REM SHADOWFORE and SHADOWBACK are shadow foreground and background colors 7920 REM These are for the optional box and shadow colors 7925 REM 7930 REM enter with - 7935 REM TEXTFORE, TEXTBACK, DATAFORE, DATABACK, 7940 REM FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK - 7945 REM colors optionally specified for COLOR statements 7950 REM optional- 7955 REM BOX=0,1,2,3 - type of outline around screen and example menu/box 7960 REM 0 = no box, 1 = 1 line box, 2 = 2 line box, 3 = solid box 7965 REM (BOX should be set the same as the other routines that use BOX 7970 REM in order to best see what the colors will look like.) 7975 REM exit with - 7980 REM TEXTFORE, TEXTBACK, DATAFORE, DATABACK, 7985 REM FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK - 7990 REM BOX=0 (to maintain BOX as optional) 7995 REM 8000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 8000 8005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 8010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 8015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 8020 DIM COLOUR$(15):RESTORE 8585:REM POINT TO COLOR STRINGS 8025 FOR A%=0 TO 15:READ A$:COLOUR$(A%)=A$:NEXT A% 8030 COLORSET=0:DIM COLOURSET(30,8):RESTORE 8600:REM POINT TO COLOR SETS 8035 FOR A%=0 TO 24:FOR B%=1 TO 8:READ C%:COLOURSET(A%,B%)=C%:NEXT B%:NEXT A% 8040 REM ----- 8045 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A% 8050 LOCATE ,,0:COLOR TEXTFORE,TEXTBACK:CLS 8055 IF BOX=0 THEN TP=0:BT=0:LS=0:RS=0:MS=0:MM=0:UL=0:LL=0:UR=0:LR=0:DN=0:RT=0 8060 IF BOX=1 THEN TP=196:BT=196:LS=195:RS=180:MS=179:MM=196:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195 8065 IF BOX=2 THEN TP=205:BT=205:LS=204:RS=185:MS=186:MM=205:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204 8070 IF BOX=3 THEN TP=223:BT=220:LS=219:RS=219:MS=219:MM=220:UL=219:LL=219:UR=219:LR=219 8075 ROW=1:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP)); 8080 ROW=25:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT)); 8085 COL=1:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW% 8090 COL=80:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW% 8095 LOCATE 1,1:PRINT CHR$(UL);:LOCATE 1,80:PRINT CHR$(UR); 8100 LOCATE 25,1:PRINT CHR$(LL);:LOCATE 25,80:PRINT CHR$(LR); 8105 REM ----- 8110 MSG$=" CHANGE DISPLAY COLORS " 8115 ROW=4:COL=41-INT((LEN(MSG$)/2)):LOCATE ROW,COL:PRINT MSG$; 8120 LOCATE 22,3 8125 PRINT "F1=Text Color, F2=Text Background, F3=Highlite Color, F4=Highlite Background"; 8130 LOCATE 23,3 8135 PRINT " F5=Field Color, F6=Field Background, F7=Shadow Color, F8=Shadow Background "; 8140 LOCATE 24,3 8145 PRINT " F9=Preset Color Combinations, F10 or Enter=Exit "; 8150 REM ----- 8155 MAXITEM=4:MAXLEN=20 8160 ROW=11-INT((MAXITEM/2)) 8165 COL=39-INT((MAXLEN/2)) 8170 LOCATE ROW,COL:COLOR TEXTFORE,TEXTBACK 8175 PRINT CHR$(UL)+STRING$(MAXLEN+2,TP)+CHR$(UR); 8180 LOCATE ROW+1,COL:PRINT CHR$(MS)+" "; 8185 COLOR DATAFORE,DATABACK:PRINT "HIGHLITE/DATA colors"; 8190 COLOR TEXTFORE,TEXTBACK:PRINT " "+CHR$(MS); 8195 LOCATE ROW+2,COL:COLOR TEXTFORE,TEXTBACK 8200 PRINT CHR$(LS)+STRING$(MAXLEN+2,MM)+CHR$(RS); 8205 LOCATE ROW+3,COL 8210 PRINT CHR$(MS)+" NORMAL TEXT colors "+CHR$(MS); 8215 LOCATE ROW+4,COL 8220 PRINT CHR$(MS)+" NORMAL TEXT colors "+CHR$(MS); 8225 LOCATE ROW+5,COL 8230 PRINT CHR$(MS)+" NORMAL TEXT colors "+CHR$(MS); 8235 LOCATE ROW+6,COL:PRINT CHR$(MS)+" "; 8240 COLOR FIELDFORE,FIELDBACK:PRINT "FIELD/EDITING colors"; 8245 COLOR TEXTFORE,TEXTBACK:PRINT " "+CHR$(MS); 8250 LOCATE ROW+7,COL 8255 PRINT CHR$(LL)+STRING$(MAXLEN+2,BT)+CHR$(LR); 8260 IF BOX=0 THEN 8350 8265 COLOR SHADOWFORE,SHADOWBACK 8270 LOCATE ROW+9,COL+8:PRINT " SHADOW colors ";: 8275 IF BOX=1 OR BOX=2 THEN 8310 8280 LOCATE ROW+8,COL+1:PRINT STRING$(MAXLEN+4,CHR$(TP)); 8285 FOR DROW%=ROW+7 TO ROW+1 STEP -1 8290 LOCATE DROW%,COL+MAXLEN+4:PRINT CHR$(MS); 8295 NEXT DROW% 8300 LOCATE ROW,COL+MAXLEN+4:PRINT CHR$(BT); 8305 GOTO 8350 8310 LOCATE ROW+7,COL+2:PRINT CHR$(DN);:LOCATE ROW+8,COL+2:PRINT CHR$(LL); 8315 LOCATE ROW+8,COL+3:PRINT STRING$(MAXLEN+2,CHR$(BT)); 8320 LOCATE ROW+8,COL+MAXLEN+5:PRINT CHR$(LR); 8325 FOR DROW%=ROW+6 TO ROW+1 STEP -1 8330 LOCATE DROW%+1,COL+MAXLEN+5:PRINT CHR$(MS); 8335 NEXT DROW% 8340 LOCATE ROW+1,COL+MAXLEN+3:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 8345 REM ----- 8350 IN$=INKEY$:IF IN$="" THEN 8350 8355 IF IN$=CHR$(0)+CHR$(59) THEN 8460 8360 IF IN$=CHR$(0)+CHR$(60) THEN 8475 8365 IF IN$=CHR$(0)+CHR$(61) THEN 8490 8370 IF IN$=CHR$(0)+CHR$(62) THEN 8505 8375 IF IN$=CHR$(0)+CHR$(63) THEN 8520 8380 IF IN$=CHR$(0)+CHR$(64) THEN 8535 8385 IF IN$=CHR$(0)+CHR$(65) THEN 8550 8390 IF IN$=CHR$(0)+CHR$(66) THEN 8565 8395 IF IN$=CHR$(0)+CHR$(67) THEN 8425 8400 IF IN$=CHR$(0)+CHR$(68) OR IN$=CHR$(13) THEN 8410 8405 BEEP:GOTO 8350 8410 COLOR TEXTFORE,TEXTBACK:BOX=0 8415 ERASE COLOUR$:ERASE COLOURSET:RETURN 8420 REM ----- 8425 CSET=CSET+1:IF CSET>24 THEN CSET=0 8430 TEXTFORE=COLOURSET(CSET,1):TEXTBACK=COLOURSET(CSET,2) 8435 DATAFORE=COLOURSET(CSET,3):DATABACK=COLOURSET(CSET,4) 8440 FIELDFORE=COLOURSET(CSET,5):FIELDBACK=COLOURSET(CSET,6) 8445 SHADOWFORE=COLOURSET(CSET,7):SHADOWBACK=COLOURSET(CSET,8) 8450 IF BOX=1 OR BOX=2 THEN SHADOWFORE=TEXTFORE:SHADOWBACK=TEXTBACK 8455 GOTO 8050 8460 TEXTFORE=TEXTFORE+1:IF TEXTFORE>15 THEN TEXTFORE=0 8465 IF TEXTFORE=TEXTBACK THEN 8460 8470 GOTO 8050 8475 TEXTBACK=TEXTBACK+1:IF TEXTBACK>7 THEN TEXTBACK=0 8480 IF TEXTFORE=TEXTBACK THEN 8475 8485 GOTO 8050 8490 DATAFORE=DATAFORE+1:IF DATAFORE>15 THEN DATAFORE=0 8495 IF DATAFORE=DATABACK THEN 8490 8500 GOTO 8155 8505 DATABACK=DATABACK+1:IF DATABACK>7 THEN DATABACK=0 8510 IF DATAFORE=DATABACK THEN 8505 8515 GOTO 8155 8520 FIELDFORE=FIELDFORE+1:IF FIELDFORE>15 THEN FIELDFORE=0 8525 IF FIELDFORE=FIELDBACK THEN 8520 8530 GOTO 8155 8535 FIELDBACK=FIELDBACK+1:IF FIELDBACK>7 THEN FIELDBACK=0 8540 IF FIELDFORE=FIELDBACK THEN 8535 8545 GOTO 8155 8550 SHADOWFORE=SHADOWFORE+1:IF SHADOWFORE>15 THEN SHADOWFORE=0 8555 IF SHADOWFORE=SHADOWBACK THEN 8550 8560 GOTO 8155 8565 SHADOWBACK=SHADOWBACK+1:IF SHADOWBACK>7 THEN SHADOWBACK=0 8570 IF SHADOWFORE=SHADOWBACK THEN 8565 8575 GOTO 8155 8580 REM ------ 8585 DATA "BLACK","BLUE","GREEN","CYAN","RED","MAGENTA","BROWN","WHITE" 8590 DATA "GREY","LIGHT BLUE","LIGHT GREEN","LIGHT CYAN","LIGHT RED" 8595 DATA "LIGHT MAGENTA","YELLOW","HIGH-INTENSITY WHITE" 8600 DATA 7,0,15,0,0,7,8,0 8605 DATA 7,1,15,1,15,4,0,1 8610 DATA 10,1,11,1,15,2,0,1 8615 DATA 11,1,14,1,15,4,0,1 8620 DATA 12,1,11,1,15,0,0,1 8625 DATA 15,1,12,1,15,5,5,1 8630 DATA 0,3,15,3,15,0,8,3 8635 DATA 1,3,15,3,15,0,0,3 8640 DATA 1,3,15,4,15,1,0,3 8645 DATA 10,3,14,5,14,5,5,3 8650 DATA 14,3,1,3,14,0,0,3 8655 DATA 15,3,0,3,14,0,0,3 8660 DATA 0,4,14,4,15,4,14,4 8665 DATA 15,4,14,4,14,0,14,4 8670 DATA 15,5,15,0,11,1,1,5 8675 DATA 15,5,15,1,14,0,13,5 8680 DATA 0,2,11,2,15,4,4,2 8685 DATA 0,2,11,2,15,0,15,2 8690 DATA 0,6,14,6,15,0,14,6 8695 DATA 7,0,8,0,0,3,8,0 8700 DATA 8,0,12,0,7,4,4,0 8705 DATA 10,0,11,0,1,3,2,0 8710 DATA 11,0,12,0,1,3,1,0 8715 DATA 14,0,14,6,15,6,6,0 8720 DATA 14,0,5,0,1,3,5,0 8725 REM 8935 REM ********************************************************************* 8940 REM --------------------- OUTLINE THE SCREEN ---------------------------- 8945 REM 8950 REM This subroutines allows you to outline the screen with your 8955 REM choice of 4 types of boxes. Boxes 1, 2, and 3 are the same 8960 REM types of boxes used in other subroutines. 8965 REM 8970 REM enter with - BOX = 0,1,2,3 - type of box to outline the screen with 8975 REM 0=squares, 1=1 line box, 2=2 line box, 3=solid box 8980 REM optional - TEXTFORE,TEXTBACK 8985 REM colors optionally specified for COLOR statements 8990 REM exit with - BOX=0 (to maintain BOX as optional for other routines) 8995 REM 9000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 9000 9005 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A% 9010 LOCATE ,,0:COLOR TEXTFORE,TEXTBACK:CLS 9015 IF BOX=0 THEN TP=254:BT=254:MS=254:UL=254:LL=254:UR=254:LR=254 9020 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217 9025 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188 9030 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 9035 ROW=1:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP)); 9040 ROW=25:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT)); 9045 COL=1:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW% 9050 COL=80:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW% 9055 LOCATE 1,1:PRINT CHR$(UL);:LOCATE 1,80:PRINT CHR$(UR); 9060 LOCATE 25,1:PRINT CHR$(LL);:LOCATE 25,80:PRINT CHR$(LR); 9065 BOX=0:RETURN 9070 REM 9075 REM 9145 REM ********************************************************************* 9150 REM ------------------------- ERASE LINE -------------------------------- 9155 REM 9160 REM This subroutine will erase the line of your choice from col. 2 to 79 9165 REM 9170 REM 9175 REM enter with - ROW=line to erase 9180 REM optional - TEXTFORE,TEXTBACK 9185 REM colors optionally specified for COLOR statements 9190 REM 9195 REM 9200 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 9200 9205 COLOR TEXTFORE,TEXTBACK 9210 LOCATE ROW,2,0:PRINT SPACE$(78); 9215 RETURN 9220 REM 9405 REM ********************************************************************* 9410 REM ------------------------- DISPLAY MESSAGE --------------------------- 9415 REM 9420 REM This subroutine allows you to display a message at a specified 9425 REM row and column or at the center of a specified row, and optionally 9430 REM draw a box with a shadow around it. 9435 REM 9440 REM enter with - MSG$="message", to display 9445 REM ROW and COL=row and column on which to display "message" 9450 REM (if COL=0 then message is centered) 9455 REM optional- BOX=0,1,2,3 - type of box to draw around MSG$ 9460 REM 0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid 9465 REM optional- SHADOW=0,1 - type of shadow to include with box 9470 REM 0 = no shadow, 1 = shadow 9475 REM optional - TEXTFORE, TEXTBACK, DATAFORE, DATABACK, 9480 REM FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK 9485 REM colors optionally specified for COLOR statements 9490 REM exit with - BOX=0, SHADOW=0 (to maintain them as optional for later) 9495 REM 9500 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 9500 9505 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 9510 IF COL=0 THEN COL=41-INT((LEN(MSG$)/2)) :REM 9300 9515 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,COL,0:PRINT MSG$;:L=LEN(MSG$) 9520 IF BOX=0 THEN 9630 9525 LOCATE ROW,COL-1:PRINT " ";:LOCATE ROW,COL+LEN(MSG$):PRINT " "; 9530 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195 9535 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204 9540 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 9545 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS); 9550 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+L+1:PRINT CHR$(UR); 9555 LOCATE ROW,COL+L+1:PRINT CHR$(MS);:LOCATE ROW+1,COL+L+1:PRINT CHR$(LR); 9560 LOCATE ROW-1,COL-1:PRINT STRING$(L+2,CHR$(TP)); 9565 LOCATE ROW+1,COL-1:PRINT STRING$(L+2,CHR$(BT)); 9570 IF SHADOW=0 THEN 9630 9575 COLOR SHADOWFORE,SHADOWBACK 9580 IF BOX<>1 AND BOX<>2 THEN 9615 9585 LOCATE ROW+1,COL:PRINT CHR$(DN);:LOCATE ROW+2,COL:PRINT CHR$(LL); 9590 LOCATE ROW+2,COL+1:PRINT STRING$(L+2,CHR$(BT)); 9595 LOCATE ROW+2,COL+L+3:PRINT CHR$(LR);:LOCATE ROW+1,COL+L+3:PRINT CHR$(MS); 9600 LOCATE ROW,COL+L+1:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 9605 COLOR TEXTFORE,TEXTBACK:LOCATE ROW+1,COL+L+2:PRINT " "; 9610 GOTO 9630 9615 LOCATE ROW+2,COL-1:PRINT STRING$(L+4,CHR$(TP)); 9620 LOCATE ROW+1,COL+L+2:PRINT CHR$(MS);:LOCATE ROW,COL+L+2:PRINT CHR$(MS); 9625 LOCATE ROW-1,COL+L+2:PRINT CHR$(BT); 9630 BOX=0:SHADOW=0:COLOR TEXTFORE,TEXTBACK 9635 RETURN 9640 REM 9820 REM ********************************************************************* 9825 REM ---------------- EDIT A FIELD AT ROW AND COLUMN --------------------- 9830 REM 9835 REM This subroutine allows you to edit or enter a string. The editing 9840 REM keys perform the same functions as BASIC in the screen editing mode. 9845 REM 9850 REM enter with - ROW and COL=row and column at which to edit the string 9855 REM LNG=maximum length of string allowed (up to 74) 9860 REM (if LNG=0 then this routine just waits for any key hit) 9865 REM TEMP$="string" to edit 9870 REM optional - EDCOL=0, place cursor at beginning of string 9875 REM 1, place cursor at end of string 9880 REM optional - EDKEYS=0,1,2 - what keys allow you to exit the routine 9885 REM 0 = only ENTER or ESCAPE 9890 REM 1 = include PGUP, PGDN, UP, DOWN, LEFT, RIGHT ARROWS 9895 REM 2 = include F1-F10 9900 REM optional - INPTYPE=0,1,2,3 - type of input desired 9905 REM 0 = normal ALPHANUMERIC 9910 REM 1 = ALPHANUMERIC with lower case changed to upper case 9915 REM 2 = NUMERIC only allowed 9920 REM 3 = Y or N only (or y or n changed to upper case) 9925 REM optional - BOX=0,1,2,3 - type of box to draw around TEMP$ 9930 REM 0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid 9935 REM optional- SHADOW=0,1 - type of shadow to include with box 9940 REM 0 = no shadow, 1 = shadow 9945 REM optional - TEXTFORE, TEXTBACK, DATAFORE, DATABACK 9950 REM FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK 9955 REM colors optionally specified for color statements 9960 REM exit with - TEMP$="string" edited or entered 9965 REM BOX=0,INPTYPE=0,EDKEYS=0,EDCOL=0 (to maintain as optional) 9970 REM EXIT$=key hit that exited routine- 9975 REM (EXIT$="ENTER" if field was completely filled) 9980 REM "LEFT" if LEFT ARROW when at left side of field 9985 REM "RIGHT" if RIGHT ARROW when at right side of field 9990 REM "UP","DOWN","PGUP","PGDN","F1"-"F10","ENTER","ESC" 9995 REM 10000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 10000 10005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 10010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 10015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 10020 IF LNG=0 THEN LOCATE ,,0:GOTO 10215:REM WAIT FOR KEY ONLY 10025 LOCATE ,,0:INS=0:EXIT$="":TEMP$=LEFT$(TEMP$,LNG) 10030 IF EDCOL=0 THEN EDCOL=COL:GOTO 10040 10035 IF LEN(TEMP$)=LNG THEN EDCOL=COL+LEN(TEMP$)-1 ELSE EDCOL=COL+LEN(TEMP$) 10040 IF BOX=0 THEN 10170 10045 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195 10050 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204 10055 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 10060 COLOR TEXTFORE,TEXTBACK 10065 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS); 10070 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+LNG+1:PRINT CHR$(UR); 10075 LOCATE ROW,COL+LNG+1:PRINT CHR$(MS); 10080 LOCATE ROW+1,COL+LNG+1:PRINT CHR$(LR); 10085 LOCATE ROW-1,COL-1:PRINT STRING$(LNG+2,CHR$(TP)); 10090 LOCATE ROW+1,COL-1:PRINT STRING$(LNG+2,CHR$(BT)); 10095 IF SHADOW=0 THEN 10165 10100 COLOR SHADOWFORE,SHADOWBACK 10105 IF BOX<>1 AND BOX<>2 THEN 10145 10110 LOCATE ROW+1,COL:PRINT CHR$(DN);:LOCATE ROW+2,COL:PRINT CHR$(LL); 10115 LOCATE ROW+2,COL+1:PRINT STRING$(LNG+2,CHR$(BT)); 10120 LOCATE ROW+2,COL+LNG+3:PRINT CHR$(LR); 10125 LOCATE ROW+1,COL+LNG+3:PRINT CHR$(MS); 10130 LOCATE ROW,COL+LNG+1:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 10135 COLOR TEXTFORE,TEXTBACK:LOCATE ROW+1,COL+LNG+2:PRINT " "; 10140 GOTO 10165 10145 LOCATE ROW+2,COL-1:PRINT STRING$(LNG+4,CHR$(TP)); 10150 LOCATE ROW+1,COL+LNG+2:PRINT CHR$(MS); 10155 LOCATE ROW,COL+LNG+2:PRINT CHR$(MS); 10160 LOCATE ROW-1,COL+LNG+2:PRINT CHR$(BT); 10165 LOCATE ROW,COL-1:PRINT " ";:LOCATE ROW,COL+LNG:PRINT " "; 10170 BOX=0:SHADOW=0 10175 LOCATE ROW,COL,0:COLOR FIELDFORE,FIELDBACK:PRINT TEMP$; 10180 LOCATE ROW,COL+LEN(TEMP$):PRINT SPACE$(LNG-LEN(TEMP$)); 10185 L=LEN(TEMP$) 10190 AAAA$=MID$(TEMP$,EDCOL-COL+1,1) :REM -------------- 10195 IF INS THEN LOCATE ROW,EDCOL:COLOR DATAFORE,DATABACK :REM editing | 10200 IF INS THEN PRINT AAAA$;:COLOR FIELDFORE,FIELDBACK :REM keys | 10205 LOCATE ROW,EDCOL :REM available | 10210 LOCATE,,1 :REM | 10215 IN$=INKEY$:IF IN$="" THEN 10215 :REM WAIT FOR KEY | 10220 IF LNG=0 THEN 10745 :REM ------------ | 10225 IF INPTYPE=3 THEN 10235 :REM | 10230 IF IN$=CHR$(13) THEN EXIT$="ENTER":GOTO 10710 :REM ENTER | 10235 IF IN$=CHR$(27) THEN EXIT$="ESC":GOTO 10710 :REM ESCAPE | 10240 IF IN$=CHR$(8) THEN 10520 :REM BACKSPACE | 10245 IF IN$=CHR$(0)+CHR$(71) THEN 10565 :REM HOME | 10250 IF IN$=CHR$(0)+CHR$(119) THEN 10575 :REM CONTROL HOME | 10255 IF IN$=CHR$(0)+CHR$(75) THEN 10585 :REM LEFT ARROW | 10260 IF IN$=CHR$(0)+CHR$(77) THEN 10605 :REM RIGHT ARROW | 10265 IF IN$=CHR$(0)+CHR$(79) THEN 10645 :REM END | 10270 IF IN$=CHR$(0)+CHR$(117) THEN 10665 :REM CONTROL END | 10275 IF IN$=CHR$(0)+CHR$(82) THEN 10675 :REM INSERT | 10280 IF IN$=CHR$(0)+CHR$(83) THEN 10685 :REM DELETE | 10285 IF EDKEYS=0 THEN 10375 :REM skip these - | 10290 IF IN$=CHR$(0)+CHR$(72) THEN EXIT$="UP":GOTO 10710 :REM UP ARROW | 10295 IF IN$=CHR$(0)+CHR$(80) THEN EXIT$="DOWN":GOTO 10710 :REM DOWN ARROW | 10300 IF IN$=CHR$(0)+CHR$(73) THEN EXIT$="PGUP":GOTO 10710 :REM PAGE UP | 10305 IF IN$=CHR$(0)+CHR$(81) THEN EXIT$="PGDN":GOTO 10710 :REM PAGE DOWN | 10310 REM :REM HOME | 10315 REM :REM END | 10320 IF EDKEYS=1 THEN 10375 :REM skip these - | 10325 IF IN$=CHR$(0)+CHR$(59) THEN EXIT$="F1":GOTO 10710 :REM F1 | 10330 IF IN$=CHR$(0)+CHR$(60) THEN EXIT$="F2":GOTO 10710 :REM F2 | 10335 IF IN$=CHR$(0)+CHR$(61) THEN EXIT$="F3":GOTO 10710 :REM F3 | 10340 IF IN$=CHR$(0)+CHR$(62) THEN EXIT$="F4":GOTO 10710 :REM F4 | 10345 IF IN$=CHR$(0)+CHR$(63) THEN EXIT$="F5":GOTO 10710 :REM F5 | 10350 IF IN$=CHR$(0)+CHR$(64) THEN EXIT$="F6":GOTO 10710 :REM F6 | 10355 IF IN$=CHR$(0)+CHR$(65) THEN EXIT$="F7":GOTO 10710 :REM F7 | 10360 IF IN$=CHR$(0)+CHR$(66) THEN EXIT$="F8":GOTO 10710 :REM F8 | 10365 IF IN$=CHR$(0)+CHR$(67) THEN EXIT$="F9":GOTO 10710 :REM F9 | 10370 IF IN$=CHR$(0)+CHR$(68) THEN EXIT$="F10":GOTO 10710 :REM F10 | 10375 IF INPTYPE=0 OR INPTYPE=1 OR INPTYPE=3 THEN 10395 :REM -------------- 10380 REM ----- allow only numbers or decimal point 10385 IF ASC(IN$)<46 OR ASC(IN$)>57 OR ASC(IN$)=47 THEN GOSUB 10760:GOTO 10210 10390 REM ----- allow only legitimate alphanumeric 10395 IF ASC(IN$)<32 OR ASC(IN$)>126 THEN GOSUB 10760:GOTO 10210 10400 REM ----- change to all upper case 10405 IF INPTYPE=0 OR INPTYPE=2 THEN 10435 10410 IF ASC(IN$)>=97 AND ASC(IN$)<=122 THEN IN$=CHR$(ASC(IN$)-32) 10415 REM ----- Yes or No only ----- 10420 IF INPTYPE<>3 THEN 10435 10425 IF IN$<>"Y" AND IN$<>"N" THEN GOSUB 10760:GOTO 10210 10430 REM ----- good character 10435 L=EDCOL-COL:IF INS THEN 10480 10440 REM ----- add char. if at end of string 10445 IF EDCOL=COL+LEN(TEMP$) THEN TEMP$=TEMP$+IN$:GOTO 10495 10450 REM ----- add char. in middle if not in insert mode 10455 TEMP$=LEFT$(TEMP$,L)+IN$+RIGHT$(TEMP$,LEN(TEMP$)-1-L) 10460 REM ----- exit if overwriting last character 10465 IF EDCOL=COL+LNG-1 AND LEN(TEMP$)=LNG THEN EXIT$="ENTER":GOTO 10710 10470 GOTO 10495 10475 REM ----- in insert mode, check for full field 10480 IF LEN(TEMP$)=LNG THEN GOSUB 10760:GOTO 10175 :REM full field 10485 TEMP$=LEFT$(TEMP$,L)+IN$+RIGHT$(TEMP$,LEN(TEMP$)-L) :REM not full 10490 REM ----- move cursor right if applicable 10495 IF EDCOLCOL THEN EDCOL=EDCOL-1:GOTO 10175 10590 IF EDKEYS=0 THEN GOSUB 10760:GOTO 10175 :REM error if left col 10595 EXIT$="LEFT":GOTO 10710 :REM or exit 10600 REM ----- RIGHT ARROW ----- 10605 INS=0:IF EDCOLCOL+LNG THEN EDCOL=COL+LNG:GOTO 10025 10660 REM ----- CONTROL END ----- 10665 INS=0:TEMP$=LEFT$(TEMP$,EDCOL-COL):GOTO 10175 10670 REM ----- INSERT ----- 10675 IF INS THEN INS=0:GOTO 10175 ELSE INS=-1:GOTO 10175 10680 REM ----- DELETE ----- 10685 INS=0:L=EDCOL-COL 10690 REM:IF EDCOL=COL+LNG-1 THEN GOSUB 10515:GOTO 10025:REM needed? 10695 IF EDCOL>=COL+LEN(TEMP$) THEN GOSUB 10760:GOTO 10175 10700 TEMP$=LEFT$(TEMP$,L)+RIGHT$(TEMP$,LEN(TEMP$)-L-1):GOTO 10175 10705 REM ----- COMMON EXIT ----- 10710 BLANK$=CHR$(255):REM remove blanks at end 10715 IF RIGHT$(TEMP$,1)=BLANK$ THEN TEMP$=LEFT$(TEMP$,LEN(TEMP$)-1):GOTO 10715 10720 FOR A%=1 TO LEN(TEMP$):REM change blanks in middle to spaces 10725 IF MID$(TEMP$,A%,1)=CHR$(255) THEN MID$(TEMP$,A%,1)=" " 10730 NEXT A% 10735 LOCATE ROW,COL,0:COLOR TEXTFORE,TEXTBACK 10740 PRINT TEMP$+SPACE$(LNG-LEN(TEMP$)); 10745 BOX=0:INPTYPE=0:EDKEYS=0:EDCOL=0:RETURN 10750 REM 10755 REM ----- BEEP IF ERROR ----- 10760 BEEP:RETURN 10765 REM 10770 REM 10810 REM ********************************************************************* 10815 REM ------------- MESSAGE AND FIELD/DATE/TIME/DOLLAR AMOUNT ------------- 10820 REM 10825 REM This subroutine allows you to combine a message along with a field 10830 REM entry or edit, date or time entry, or dollar amount entry, while 10835 REM making adjustments for optional centering and boxes. 10840 REM 10845 REM enter with - MSG$="message" to display and, 10850 REM everything required or optionally required with the 10855 REM EDIT A FIELD AT ROW AND COLUMN routine, or 10860 REM ENTER DATE routine, or ENTER TIME routine, or 10865 REM ENTER DOLLAR AMOUNT routine 10870 REM (except COL when centering is selected.) 10875 REM optional- BOX=0,1,2,3 - type of box to draw around MSG$ 10880 REM 0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid 10885 REM optional- SHADOW=0,1 - type of shadow to include with box 10890 REM 0 = no shadow, 1 = shadow 10895 REM optional - FLDTYPE = 0, 1, 2 or 3 - type of field/entry 10900 REM 0 = enter or edit field 10905 REM 1 = date 10910 REM 2 = time 10915 REM 3 = dollar amount 10920 REM optional - ORTYPE = 0, 1, 2 or 3 - type of message/field orientation 10925 REM 0 = side by side and centered in ROW (COL not required) 10930 REM 1 = side by side at ROW and COL 10935 REM 2 = field below message and centered in ROW (COL not required) 10940 REM 3 = field below message at ROW and COL 10945 REM (if a box is specified the field will be 2 rows below 10950 REM the message, otherwise it will be 1 row below) 10955 REM optional - DISPTYPE=0 or 1 - type of display desired 10960 REM 0 = normal message 10965 REM 1 = message with screen restored 10970 REM exit with - everything returned with 10975 REM FIELD, DATE, TIME, or DOLLAR AMOUNT routine, 10980 REM BOX=0, SHADOW=0, ORTYPE=0, FLDTYPE=0, DISPTYPE=0 10985 REM (to maintain as optional) 10990 REM 10995 REM :REM 11000 11000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 11005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 11010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 11015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 11020 REM 11025 IF FLDTYPE=1 OR FLDTYPE=2 THEN LNG=8 :REM DATE OR TIME 11030 IF ORTYPE=0 OR ORTYPE=1 THEN MAXLEN=LEN(MSG$)+1+LNG:GOTO 11040 :REM SxS 11035 IF LEN(MSG$)>LNG THEN MAXLEN=LEN(MSG$) ELSE MAXLEN=LNG :REM TxB 11040 IF ORTYPE=0 OR ORTYPE=2 THEN COL=41-(INT(MAXLEN/2)) :REM CENTERED 11045 REM 11050 IF BOX<>0 THEN 11075 11055 STARTCOL=COL-1:ENDCOL=COL+MAXLEN :REM BOX=0 11060 IF ORTYPE=0 OR ORTYPE=1 THEN STARTROW=ROW:ENDROW=ROW :REM SxS 11065 IF ORTYPE=2 OR ORTYPE=3 THEN STARTROW=ROW:ENDROW=ROW+1 :REM TxB 11070 GOTO 11100 11075 STARTCOL=COL-2:ENDCOL=COL+MAXLEN+2 :REM BOX<>0 11080 IF ORTYPE=0 OR ORTYPE=1 THEN STARTROW=ROW-1:ENDROW=ROW+1 :REM SxS 11085 IF ORTYPE=2 OR ORTYPE=3 THEN STARTROW=ROW-1:ENDROW=ROW+3 :REM TxB 11090 REM 11095 REM ----- SAVE SCREEN IF REQUIRED 11100 IF DISPTYPE<>1 THEN 11180 11105 SHADOFF=0 11110 IF SHADOW<>0 AND BOX=3 THEN SHADOFF=1 11115 IF SHADOW<>0 AND (BOX=1 OR BOX=2) THEN SHADOFF=2 11120 DIM MSGSSCHR(ENDROW-STARTROW+1+SHADOFF,ENDCOL-STARTCOL+1+SHADOFF) 11125 DIM MSGSSCOLOR(ENDROW-STARTROW+1+SHADOFF,ENDCOL-STARTCOL+1+SHADOFF,2) 11130 R=1:C=1 11135 FOR SR%=STARTROW TO ENDROW+SHADOFF 11140 FOR SC%=STARTCOL TO ENDCOL+SHADOFF 11145 MSGSSCHR(R,C)=SCREEN(SR%,SC%,0) 11150 A=SCREEN(SR%,SC%,1):MSGSSCOLOR(R,C,1)=(A AND 15) 11155 IF (A AND 128)=128 THEN MSGSSCOLOR(R,C,1)=MSGSSCOLOR(R,C,1)+16 11160 MSGSSCOLOR(R,C,2)=(A AND 112)/16 11165 C=C+1:NEXT SC% 11170 R=R+1:C=1:NEXT SR% 11175 REM ----- 11180 IF BOX=0 THEN 11360 11185 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:LF=195:RT=180 11190 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:LF=204:RT=185 11195 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219:DN=219:LF=219:RT=219 11200 COLOR TEXTFORE,TEXTBACK :REM BOX 11205 LOCATE ROW-1,COL-2:PRINT CHR$(UL)+STRING$(MAXLEN+2,CHR$(TP))+CHR$(UR); 11210 LOCATE ROW,COL-2:PRINT CHR$(MS)+SPACE$(MAXLEN+2)+CHR$(MS); 11215 LOCATE ROW+1,COL-2:PRINT CHR$(LL)+STRING$(MAXLEN+2,CHR$(BT))+CHR$(LR); 11220 IF ORTYPE=0 OR ORTYPE=1 THEN 11245 11225 LOCATE ROW+1,COL-2:PRINT CHR$(LF); :REM LOWER BOX 11230 LOCATE ROW+1,COL+MAXLEN+1:PRINT CHR$(RT); 11235 LOCATE ROW+2,COL-2:PRINT CHR$(MS)+SPACE$(MAXLEN+2)+CHR$(MS); 11240 LOCATE ROW+3,COL-2:PRINT CHR$(LL)+STRING$(MAXLEN+2,CHR$(BT))+CHR$(LR); 11245 IF SHADOW=0 THEN 11360 11250 COLOR SHADOWFORE,SHADOWBACK :REM SHADOW 11255 IF ORTYPE=0 OR ORTYPE=1 THEN ROWOFF=0 ELSE ROWOFF=2 11260 IF BOX<>1 AND BOX<>2 THEN 11330 11265 LOCATE ROW+1+ROWOFF,COL:PRINT CHR$(DN); :REM BOX 1,2 SHADOW 11270 LOCATE ROW+2+ROWOFF,COL:PRINT CHR$(LL); 11275 LOCATE ROW+2+ROWOFF,COL+1:PRINT STRING$(MAXLEN+2,CHR$(BT)); 11280 LOCATE ROW+2+ROWOFF,COL+MAXLEN+3:PRINT CHR$(LR); 11285 FOR DROW=ROW+1 TO ROW+1+ROWOFF 11290 LOCATE DROW,COL+MAXLEN+3:PRINT CHR$(MS); 11295 NEXT DROW 11300 LOCATE ROW,COL+MAXLEN+1:PRINT CHR$(LF);CHR$(TP);CHR$(UR); 11305 COLOR TEXTFORE,TEXTBACK 11310 FOR DROW=ROW+1 TO ROW+1+ROWOFF 11315 LOCATE DROW,COL+MAXLEN+2:PRINT " "; 11320 NEXT DROW 11325 GOTO 11360 11330 LOCATE ROW+2+ROWOFF,COL-1:PRINT STRING$(MAXLEN+4,CHR$(TP));:REM BOX3SHAD 11335 FOR DROW=ROW+1+ROWOFF TO ROW STEP-1 11340 LOCATE DROW,COL+MAXLEN+2:PRINT CHR$(MS); 11345 NEXT DROW 11350 LOCATE ROW-1,COL+MAXLEN+2:PRINT CHR$(BT); 11355 REM ----- 11360 COLOR TEXTFORE,TEXTBACK :REM MESSAGE 11365 IF ORTYPE=2 OR ORTYPE=3 THEN 11385 11370 LOCATE ROW,COL-1:PRINT " "+MSG$+" "+SPACE$(LNG+1); :REM SxS 11375 COL=COL+1+LEN(MSG$):GOTO 11405 11380 REM 11385 LOCATE ROW,COL-1:PRINT " "+MSG$+" "; :REM TxB 11390 IF BOX=0 THEN ROW=ROW+1 ELSE ROW=ROW+2 11395 LOCATE ROW,COL-1:PRINT SPACE$(LNG+2) 11400 REM 11405 BOX=0:SHADOW=0 :REM FIELD 11410 IF FLDTYPE=0 THEN GOSUB 10000:REM edit field SUBROUTINE USED HERE 11415 IF FLDTYPE=1 THEN GOSUB 12000:REM enter date SUBROUTINE USED HERE 11420 IF FLDTYPE=2 THEN GOSUB 13000:REM enter time SUBROUTINE USED HERE 11425 IF FLDTYPE=3 THEN GOSUB 15000:REM enter $ amount SUBROUTINE USED HERE 11430 REM 11435 REM ----- RESTORE SCREEN IF REQUIRED 11440 IF DISPTYPE<>1 THEN 11490 11445 R=1:C=1 11450 FOR SR%=STARTROW TO ENDROW+SHADOFF 11455 FOR SC%=STARTCOL TO ENDCOL+SHADOFF 11460 COLOR MSGSSCOLOR(R,C,1),MSGSSCOLOR(R,C,2) 11465 LOCATE SR%,SC%:PRINT CHR$(MSGSSCHR(R,C)); 11470 C=C+1:NEXT SC% 11475 R=R+1:C=1:NEXT SR% 11480 ERASE MSGSSCHR:ERASE MSGSSCOLOR 11485 REM ----- 11490 BOX=0:SHADOW=0:ORTYPE=0:FLDTYPE=0:DISPTYPE=0 11495 RETURN 11860 REM ******************************************************************** 11865 REM ------------------------- ENTER DATE ------------------------------- 11870 REM 11875 REM This routine lets you to enter the date in the format DD/MM/YY or 11880 REM optionally set the DOS date. 11885 REM 11890 REM enter with - ROW and COL=row and column at which to begin the prompt 11895 REM (COL=35 for centered prompt) 11900 REM MODE=0,1,2 - type of entry 11905 REM 0 = TEMP$ is initial date and entered date 11910 REM 1 = start with current date, TEMP$ = entered date 11915 REM 2 = start with current date, TEMP$ = entered date 11920 REM and DOS date is set 11925 REM optional - TEMP$="MM/DD/YY" - initial date 11930 REM optional - EDKEYS=0,1,2 - what keys allow you to exit the routine 11935 REM 0 = only ENTER or ESCAPE 11940 REM 1 = include PGUP, PGDN, UP, DOWN, LEFT, RIGHT 11945 REM 2 = include F1-F10 11950 REM optional - BOX=0,1,2,3 - type of box to draw around prompt 11955 REM 0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid 11960 REM optional- SHADOW=0,1 - type of shadow to include with box 11965 REM 0 = no shadow, 1 = shadow 11970 REM optional - TEXTFORE, TEXTBACK, DATAFORE, DATABACK 11975 REM FIELDFORE,FIELDBACK, SHADOWFORE, SHADOWBACK 11980 REM colors optionally specified for COLOR statements 11985 REM exit with - TEMP$="DD/MM/YY" (and DOS date set if MODE=2) 11990 REM BOX=0, SHADOW=0, EDKEYS=0, MODE=0 (to maintain as opt.) 11995 REM 12000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 12000 12005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 12010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 12015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 12020 IF BOX=0 THEN 12135 12025 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195 12030 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204 12035 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 12040 COLOR TEXTFORE,TEXTBACK 12045 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS); 12050 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+14:PRINT CHR$(UR); 12055 LOCATE ROW,COL+14:PRINT CHR$(MS); 12060 LOCATE ROW+1,COL+14:PRINT CHR$(LR); 12065 LOCATE ROW-1,COL-1:PRINT STRING$(15,CHR$(TP)); 12070 LOCATE ROW+1,COL-1:PRINT STRING$(15,CHR$(BT)); 12075 IF SHADOW=0 THEN 12135 12080 L=8:COLOR SHADOWFORE,SHADOWBACK 12085 IF BOX<>1 AND BOX<>2 THEN 12120 12090 LOCATE ROW+1,COL:PRINT CHR$(DN);:LOCATE ROW+2,COL:PRINT CHR$(LL); 12095 LOCATE ROW+2,COL+1:PRINT STRING$(L+2,CHR$(BT)); 12100 LOCATE ROW+2,COL+L+3:PRINT CHR$(LR);:LOCATE ROW+1,COL+L+3:PRINT CHR$(MS); 12105 LOCATE ROW,COL+L+1:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 12110 LOCATE ROW+1,COL+L+2:PRINT " "; 12115 GOTO 12135 12120 LOCATE ROW+2,COL-1:PRINT STRING$(L+4,CHR$(TP)); 12125 LOCATE ROW+1,COL+L+2:PRINT CHR$(MS);:LOCATE ROW,COL+L+2:PRINT CHR$(MS); 12130 LOCATE ROW-1,COL+L+2:PRINT CHR$(BT); 12135 BOX=0:SHADOW=0 12140 D1COL=COL:IF MODE=0 THEN D1$=LEFT$(TEMP$,2) ELSE D1$=LEFT$(DATE$,2) 12145 D2COL=COL+3:IF MODE=0 THEN D2$=MID$(TEMP$,4,2) ELSE D2$=MID$(DATE$,4,2) 12150 D3COL=COL+6:IF MODE=0 THEN D3$=MID$(TEMP$,7,2) ELSE D3$=MID$(DATE$,9,2) 12155 TEMPDATE$=D1$+"/"+D2$+"/"+D3$:TEMPCOL=COL:DEDKEYS=EDKEYS 12160 LOCATE ROW,COL:COLOR TEXTFORE,TEXTBACK:PRINT TEMPDATE$; 12165 LOCATE ROW,COL-1:PRINT " ";:LOCATE ROW,COL+8:PRINT " "; 12170 REM ----- 12175 TEMP$=D1$:OLDD1$=D1$:COL=D1COL:LNG=2:INPTYPE=2:EDKEYS=2 12180 GOSUB 10000 :REM SUBROUTINE USED 12185 D1$=TEMP$ 12190 IF EXIT$="ESC" THEN 12485 12195 IF LEFT$(EXIT$,1)="F" AND DEDKEYS>1 THEN 12485 12200 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND DEDKEYS>0 THEN 12485 12205 IF (EXIT$="UP" OR EXIT$="DOWN") AND DEDKEYS>0 THEN 12485 12210 IF VAL(D1$)=0 OR VAL(D1$)>12 THEN GOSUB 12500:GOTO 12175 12215 IF EXIT$="ENTER" AND D1$=OLDD1$ THEN 12455 12220 IF EXIT$="ENTER" AND D1$<>OLDD1$ THEN 12240 12225 IF EXIT$="LEFT" AND DEDKEYS>0 THEN 12455 12230 IF EXIT$="RIGHT" THEN 12240 12235 GOSUB 12500:GOTO 12175 12240 IF RIGHT$(D1$,1)=" " THEN D1$=LEFT$(D1$,1) 12245 IF LEFT$(D1$,1)=" " THEN D1$=RIGHT$(D1$,1) 12250 IF LEN(D1$)<2 THEN D1$="0"+D1$ 12255 LOCATE ROW,D1COL:PRINT D1$; 12260 REM ----- 12265 TEMP$=D2$:OLDD2$=D2$:COL=D2COL:LNG=2:INPTYPE=2:EDKEYS=2 12270 GOSUB 10000 :REM SUBROUTINE USED 12275 D2$=TEMP$ 12280 IF EXIT$="ESC" THEN 12485 12285 IF LEFT$(EXIT$,1)="F" AND DEDKEYS>1 THEN 12485 12290 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND DEDKEYS>0 THEN 12485 12295 IF (EXIT$="UP" OR EXIT$="DOWN") AND DEDKEYS>0 THEN 12485 12300 IF VAL(D2$)=0 THEN GOSUB 12495:GOTO 12265 12305 IF D1$="04" AND VAL(D2$)>30 THEN GOSUB 12500:GOTO 12265 12310 IF D1$="06" AND VAL(D2$)>30 THEN GOSUB 12500:GOTO 12265 12315 IF D1$="09" AND VAL(D2$)>30 THEN GOSUB 12500:GOTO 12265 12320 IF D1$="11" AND VAL(D2$)>30 THEN GOSUB 12500:GOTO 12265 12325 IF EXIT$="RIGHT" THEN 12355 12330 IF VAL(D2$)>31 THEN GOSUB 12500:GOTO 12265 12335 IF EXIT$="ENTER" AND D2$=OLDD2$ THEN 12455 12340 IF EXIT$="ENTER" AND D2$<>OLDD2$ THEN 12355 12345 IF EXIT$="LEFT" THEN EDCOL=1:GOTO 12175 12350 GOSUB 12500:GOTO 12265 12355 IF RIGHT$(D2$,1)=" " THEN D2$=LEFT$(D2$,1) 12360 IF LEFT$(D2$,1)=" " THEN D2$=RIGHT$(D2$,1) 12365 IF LEN(D2$)<2 THEN D2$="0"+D2$ 12370 LOCATE ROW,D2COL:PRINT D2$; 12375 REM ----- 12380 TEMP$=D3$:COL=D3COL:LNG=2:INPTYPE=2:EDKEYS=2 12385 GOSUB 10000 :REM SUBROUTINE USED 12390 D3$=TEMP$ 12395 IF EXIT$="ESC" THEN 12485 12400 IF LEFT$(EXIT$,1)="F" AND DEDKEYS>1 THEN 12485 12405 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND DEDKEYS>0 THEN 12485 12410 IF (EXIT$="UP" OR EXIT$="DOWN") AND DEDKEYS>0 THEN 12485 12415 IF VAL(D3$)<80 OR VAL(D3$)>99 THEN GOSUB 12500:GOTO 12380 12420 IF D1$="02" AND D2$="29" AND VAL(D3$) MOD 4<>0 THEN GOSUB 12500:GOTO 12265 12425 IF EXIT$="ENTER" THEN 12455 12430 IF EXIT$="RIGHT" AND DEDKEYS>0 THEN 12445 12435 IF EXIT$="LEFT" THEN EDCOL=1:GOTO 12265 12440 GOSUB 12500:GOTO 12380 12445 LOCATE ROW,D3COL:PRINT D3$; 12450 REM ----- 12455 IF MODE=2 THEN DATE$=D1$+"-"+D2$+"-"+"19"+D3$ 12460 REM ----- NORMAL EXIT 12465 TEMP$=D1$+"/"+D2$+"/"+D3$ 12470 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,TEMPCOL 12475 PRINT TEMP$;:GOTO 12510 12480 REM ----- ESCAPE EXIT 12485 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,TEMPCOL 12490 PRINT TEMPDATE$;:GOTO 12510 12495 REM ----- BEEP IF ERROR ----- 12500 BEEP:RETURN 12505 REM ----- COMMON EXIT 12510 BOX=0:SHADOW=0:EDKEYS=0:MODE=0:RETURN 12515 REM 12860 REM ******************************************************************** 12865 REM ------------------------- ENTER TIME ------------------------------- 12870 REM 12875 REM This routine lets you enter the time in the format HH:MM:SS or 12880 REM optionally set the DOS time. 12885 REM 12890 REM enter with - ROW and COL=row and column at which to begin the prompt 12895 REM (COL=35 for centered prompt) 12900 REM MODE=0,1,2 - type of entry 12905 REM 0 = TEMP$ is initial time and entered time 12910 REM 1 = start with current time, TEMP$ = entered time 12915 REM 2 = start with current time, TEMP$ = entered time 12920 REM and DOS time is set 12925 REM optional - TEMP$="HH:MM:SS" - initial time 12930 REM optional - EDKEYS=0,1,2 - what keys allow you to exit the routine 12935 REM 0 = only ENTER or ESCAPE 12940 REM 1 = include PGUP, PGDN, UP, DOWN, LEFT, RIGHT 12945 REM 2 = include F1-F10 12950 REM optional - BOX=0,1,2,3 - type of box to draw around prompt 12955 REM 0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid 12960 REM optional- SHADOW=0,1 - type of shadow to include with box 12965 REM 0 = no shadow, 1 = shadow 12970 REM optional - TEXTFORE, TEXTBACK, DATAFORE, DATABACK 12975 REM FIELDFORE, FIELDBACK, SHADOEFORE, SHADOWBACK 12980 REM colors optionally specified for COLOR statements 12985 REM exit with - TEMP$="HH:MM:SS" and DOS time set if MODE=1 12990 REM BOX=0, SHADOW=0, EDKEYS=0 (to maintain as optional) 12995 REM 13000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 13000 13005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 13010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 13015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 13020 IF BOX=0 THEN 13135 13025 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195 13030 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204 13035 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 13040 COLOR TEXTFORE,TEXTBACK 13045 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS); 13050 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+14:PRINT CHR$(UR); 13055 LOCATE ROW,COL+14:PRINT CHR$(MS); 13060 LOCATE ROW+1,COL+14:PRINT CHR$(LR); 13065 LOCATE ROW-1,COL-1:PRINT STRING$(15,CHR$(TP)); 13070 LOCATE ROW+1,COL-1:PRINT STRING$(15,CHR$(BT)); 13075 IF SHADOW=0 THEN 13135 13080 L=8:COLOR SHADOWFORE,SHADOWBACK 13085 IF BOX<>1 AND BOX<>2 THEN 13120 13090 LOCATE ROW+1,COL:PRINT CHR$(DN);:LOCATE ROW+2,COL:PRINT CHR$(LL); 13095 LOCATE ROW+2,COL+1:PRINT STRING$(L+2,CHR$(BT)); 13100 LOCATE ROW+2,COL+L+3:PRINT CHR$(LR);:LOCATE ROW+1,COL+L+3:PRINT CHR$(MS); 13105 LOCATE ROW,COL+L+1:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 13110 LOCATE ROW+1,COL+L+2:PRINT " "; 13115 GOTO 13135 13120 LOCATE ROW+2,COL-1:PRINT STRING$(L+4,CHR$(TP)); 13125 LOCATE ROW+1,COL+L+2:PRINT CHR$(MS);:LOCATE ROW,COL+L+2:PRINT CHR$(MS); 13130 LOCATE ROW-1,COL+L+2:PRINT CHR$(BT); 13135 BOX=0:SHADOW=0 13140 T1COL=COL:IF MODE=0 THEN T1$=LEFT$(TEMP$,2) ELSE T1$=LEFT$(TIME$,2) 13145 T2COL=COL+3:IF MODE=0 THEN T2$=MID$(TEMP$,4,2) ELSE T2$=MID$(TIME$,4,2) 13150 T3COL=COL+6:IF MODE=0 THEN T3$=MID$(TEMP$,7,2) ELSE T3$=MID$(TIME$,7,2) 13155 TEMPTIME$=T1$+":"+T2$+":"+T3$:TEMPCOL=COL:TEDKEYS=EDKEYS 13160 LOCATE ROW,COL:COLOR TEXTFORE,TEXTBACK:PRINT TEMPTIME$; 13165 LOCATE ROW,COL-1:PRINT " ";:LOCATE ROW,COL+8:PRINT " "; 13170 REM ----- 13175 TEMP$=T1$:OLDT1$=T1$:COL=T1COL:LNG=2:INPTYPE=2:EDKEYS=2 13180 GOSUB 10000 :REM SUBROUTINE USED 13185 T1$=TEMP$ 13190 IF EXIT$="ESC" THEN 13470 13195 IF LEFT$(EXIT$,1)="F" AND TEDKEYS>1 THEN 13470 13200 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND TEDKEYS>0 THEN 13470 13205 IF (EXIT$="UP" OR EXIT$="DOWN") AND TEDKEYS>0 THEN 13470 13210 IF T1$="" OR T1$=" " OR T1$=" " OR VAL(T1$)>23 THEN GOSUB 13485:GOTO 13175 13215 IF EXIT$="ENTER" AND T1$=OLDT1$ THEN 13440 13220 IF EXIT$="ENTER" AND T1$<>OLDT1$ THEN 13240 13225 IF EXIT$="LEFT" AND TEDKEYS>0 THEN 13440 13230 IF EXIT$="RIGHT" THEN 13240 13235 GOSUB 13485:GOTO 13175 13240 IF RIGHT$(T1$,1)=" " THEN T1$=LEFT$(T1$,1) 13245 IF LEFT$(T1$,1)=" " THEN T1$=RIGHT$(T1$,1) 13250 IF LEN(T1$)<2 THEN T1$="0"+T1$ 13255 LOCATE ROW,T1COL:PRINT T1$; 13260 REM ----- 13265 TEMP$=T2$:OLDT2$=T2$:COL=T2COL:LNG=2:INPTYPE=2:EDKEYS=2 13270 GOSUB 10000 :REM SUBROUTINE USED 13275 T2$=TEMP$ 13280 IF EXIT$="ESC" THEN 13470 13285 IF LEFT$(EXIT$,1)="F" AND TEDKEYS>1 THEN 13470 13290 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND TEDKEYS>0 THEN 13470 13295 IF (EXIT$="UP" OR EXIT$="DOWN") AND TEDKEYS>0 THEN 13470 13300 IF T2$="" OR T2$=" " OR T2$=" " OR VAL(T2$)>59 THEN GOSUB 13485:GOTO 13265 13305 IF EXIT$="ENTER" AND T2$=OLDT2$ THEN 13440 13310 IF EXIT$="ENTER" AND T2$<>OLDT2$ THEN 13330 13315 IF EXIT$="RIGHT" THEN 13330 13320 IF EXIT$="LEFT" THEN EDCOL=1:GOTO 13175 13325 GOSUB 13485:GOTO 13265 13330 IF RIGHT$(T2$,1)=" " THEN T2$=LEFT$(T2$,1) 13335 IF LEFT$(T2$,1)=" " THEN T2$=RIGHT$(T2$,1) 13340 IF LEN(T2$)<2 THEN T2$="0"+T2$ 13345 LOCATE ROW,T2COL:PRINT T2$; 13350 REM ----- 13355 TEMP$=T3$:COL=T3COL:LNG=2:INPTYPE=2:EDKEYS=2 13360 GOSUB 10000 :REM SUBROUTINE USED 13365 T3$=TEMP$ 13370 IF EXIT$="ESC" THEN 13470 13375 IF LEFT$(EXIT$,1)="F" AND TEDKEYS>1 THEN 13470 13380 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND TEDKEYS>0 THEN 13470 13385 IF (EXIT$="UP" OR EXIT$="DOWN") AND TEDKEYS>0 THEN 13470 13390 IF T3$="" OR T3$=" " OR T3$=" " OR VAL(T3$)>59 THEN GOSUB 13485:GOTO 13355 13395 IF EXIT$="ENTER" THEN 13440 13400 IF EXIT$="RIGHT" AND TEDKEYS>0 THEN 13415 13405 IF EXIT$="LEFT" THEN EDCOL=1:GOTO 13265 13410 GOSUB 13485:GOTO 13355 13415 IF RIGHT$(T3$,1)=" " THEN T3$=LEFT$(T3$,1) 13420 IF LEFT$(T3$,1)=" " THEN T3$=RIGHT$(T3$,1) 13425 IF LEN(T3$)<2 THEN T3$="0"+T3$ 13430 LOCATE ROW,T3COL:PRINT T3$; 13435 REM ----- 13440 IF MODE=2 THEN TIME$=T1$+":"+T2$+":"+T3$ 13445 REM ----- NORMAL EXIT 13450 TEMP$=T1$+":"+T2$+":"+T3$ 13455 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,TEMPCOL 13460 PRINT TEMP$;:GOTO 13495 13465 REM ----- ESCAPE EXIT 13470 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,TEMPCOL 13475 PRINT TEMPTIME$;:GOTO 13495 13480 REM ----- BEEP IF ERROR ----- 13485 BEEP:RETURN 13490 REM ----- COMMON EXIT 13495 BOX=0:SHADOW=0:EDKEYS=0:RETURN 13500 REM 14850 REM ********************************************************************* 14855 REM ------------- ENTER A DOLLAR AMOUNT AT ROW AND COLUMN --------------- 14860 REM 14865 REM This subroutine allows you to enter a dollar amount field at a 14870 REM specified row and column. It allows you to specify the maximum 14875 REM amount you may enter and allows you to optionally draw a box 14880 REM around the entering area. The numbers shift into the field from 14885 REM right to left and can be shifted back out with the BACKSPACE key. 14890 REM Hitting ESCAPE once clears the field and hitting ESCAPE again 14895 REM exits the routine. Hitting ENTER completes the entry. 14900 REM 14905 REM enter with - ROW and COL=row and column at which to enter the field 14910 REM LNG=maximum length of the amount (8=99999.99) 14915 REM optional - BOX=0,1,2,3 - type of box to draw around the area 14920 REM 0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid 14925 REM optional- SHADOW=0,1 - type of shadow to include with box 14930 REM 0 = no shadow, 1 = shadow 14935 REM optional - TEXTFORE, TEXTBACK, DATAFORE, DATABACK 14940 REM FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK 14945 REM colors optionally specified for COLOR statements 14950 REM optional - EDKEYS=0,1 - what keys allow you to exit the routine 14955 REM 0 = only ENTER or ESCAPE 14960 REM 1 = include PGUP, PGDN, UP, DOWN, LEFT, RIGHT 14965 REM 2 = include F1-F10 14970 REM exit with - TEMP$="dollars" entered 14975 REM BOX=0,SHADOW=0,EDKEYS=0 (to maintain these as optional) 14980 REM EXIT$=key hit that exited routine (ENTER or ESC) 14985 REM 14990 REM 14995 REM 15000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 15000 15005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 15010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 15015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 15020 TTTT$="":EXIT$="" 15025 IF BOX=0 THEN 15155 15030 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195 15035 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204 15040 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 15045 COLOR TEXTFORE,TEXTBACK 15050 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS); 15055 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+LNG+1:PRINT CHR$(UR); 15060 LOCATE ROW,COL+LNG+1:PRINT CHR$(MS); 15065 LOCATE ROW+1,COL+LNG+1:PRINT CHR$(LR); 15070 LOCATE ROW-1,COL-1:PRINT STRING$(LNG+2,CHR$(TP)); 15075 LOCATE ROW+1,COL-1:PRINT STRING$(LNG+2,CHR$(BT)); 15080 IF SHADOW=0 THEN 15155 15085 COLOR SHADOWFORE,SHADOWBACK 15090 IF BOX<>1 AND BOX<>2 THEN 15130 15095 LOCATE ROW+1,COL:PRINT CHR$(DN);:LOCATE ROW+2,COL:PRINT CHR$(LL); 15100 LOCATE ROW+2,COL+1:PRINT STRING$(LNG+2,CHR$(BT)); 15105 LOCATE ROW+2,COL+LNG+3:PRINT CHR$(LR); 15110 LOCATE ROW+1,COL+LNG+3:PRINT CHR$(MS); 15115 LOCATE ROW,COL+LNG+1:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 15120 COLOR TEXTFORE,TEXTBACK:LOCATE ROW+1,COL+LNG+2:PRINT " "; 15125 GOTO 15155 15130 LOCATE ROW+2,COL-1:PRINT STRING$(LNG+4,CHR$(TP)); 15135 LOCATE ROW+1,COL+LNG+2:PRINT CHR$(MS); 15140 LOCATE ROW,COL+LNG+2:PRINT CHR$(MS); 15145 LOCATE ROW-1,COL+LNG+2:PRINT CHR$(BT); 15150 REM ----- 15155 IF LEN(TTTT$)=0 THEN TEMP$="0.00":GOTO 15175 15160 IF LEN(TTTT$)=1 THEN TEMP$="0.0"+TTTT$:GOTO 15175 15165 IF LEN(TTTT$)=2 THEN TEMP$="0."+TTTT$:GOTO 15175 15170 TEMP$=LEFT$(TTTT$,LEN(TTTT$)-2)+"."+RIGHT$(TTTT$,2) 15175 COLOR FIELDFORE,FIELDBACK:LOCATE ROW,COL 15180 PRINT STRING$(LNG-LEN(TEMP$)," ")+TEMP$;:COLOR TEXTFORE,TEXTBACK 15185 LOCATE ROW,COL-1:PRINT " ";:LOCATE ROW,COL+LNG:PRINT " "; 15190 IN$=INKEY$:IF IN$="" THEN 15190 :REM -------------- 15195 IF IN$=CHR$(27) THEN 15360 :REM ESCAPE | 15200 ESCFLAG=0 :REM clear flag | 15205 IF IN$=CHR$(13) THEN EXIT$="ENTER":GOTO 15375 :REM ENTER | 15210 IF IN$=CHR$(8) THEN 15340 :REM BACKSPACE | 15215 IF EDKEYS=0 THEN 15305 :REM skip these - | 15220 IF IN$=CHR$(0)+CHR$(75) THEN EXIT$="LEFT":GOTO 15375 :REM LEFT ARROW | 15225 IF IN$=CHR$(0)+CHR$(77) THEN EXIT$="RIGHT":GOTO 15375:REM RIGHT ARROW | 15230 IF IN$=CHR$(0)+CHR$(72) THEN EXIT$="UP":GOTO 15375 :REM UP ARROW | 15235 IF IN$=CHR$(0)+CHR$(80) THEN EXIT$="DOWN":GOTO 15375 :REM DOWN ARROW | 15240 IF IN$=CHR$(0)+CHR$(73) THEN EXIT$="PGUP":GOTO 15375 :REM PAGE UP | 15245 IF IN$=CHR$(0)+CHR$(81) THEN EXIT$="PGDN":GOTO 15375 :REM PAGE DOWN | 15250 IF EDKEYS=1 THEN 15305 :REM skip these - | 15255 IF IN$=CHR$(0)+CHR$(59) THEN EXIT$="F1":GOTO 15375 :REM F1 | 15260 IF IN$=CHR$(0)+CHR$(60) THEN EXIT$="F2":GOTO 15375 :REM F2 | 15265 IF IN$=CHR$(0)+CHR$(61) THEN EXIT$="F3":GOTO 15375 :REM F3 | 15270 IF IN$=CHR$(0)+CHR$(62) THEN EXIT$="F4":GOTO 15375 :REM F4 | 15275 IF IN$=CHR$(0)+CHR$(63) THEN EXIT$="F5":GOTO 15375 :REM F5 | 15280 IF IN$=CHR$(0)+CHR$(64) THEN EXIT$="F6":GOTO 15375 :REM F6 | 15285 IF IN$=CHR$(0)+CHR$(65) THEN EXIT$="F7":GOTO 15375 :REM F7 | 15290 IF IN$=CHR$(0)+CHR$(66) THEN EXIT$="F8":GOTO 15375 :REM F8 | 15295 IF IN$=CHR$(0)+CHR$(67) THEN EXIT$="F9":GOTO 15375 :REM F9 | 15300 IF IN$=CHR$(0)+CHR$(68) THEN EXIT$="F10":GOTO 15375 :REM F10 | 15305 :REM -------------- 15310 REM ----- allow only numbers 15315 IF ASC(IN$)<48 OR ASC(IN$)>57 THEN GOSUB 15400:GOTO 15190 15320 IF LEN(TTTT$)>=LNG-1 THEN GOSUB 15400:GOTO 15190 15325 TTTT$=TTTT$+IN$:GOTO 15155 15330 REM ----- BACKSPACE ----- 15335 REM ----- error if blank 15340 IF LEN(TTTT$)=0 THEN GOSUB 15400:GOTO 15190 15345 REM ----- good backspace 15350 TTTT$=LEFT$(TTTT$,LEN(TTTT$)-1):GOTO 15155 15355 REM ----- ESCAPE ----- 15360 IF ESCFLAG THEN EXIT$="ESC":GOTO 15375 15365 ESCFLAG=-1:TTTT$="":GOTO 15155 15370 REM ----- COMMON EXIT ----- 15375 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,COL 15380 PRINT STRING$(LNG-LEN(TEMP$)," ")+TEMP$; 15385 BOX=0:EDKEYS=0:ESCFLAG=0:RETURN 15390 REM 15395 REM ----- BEEP IF ERROR ----- 15400 BEEP:RETURN 15405 REM 15410 REM 15415 REM 18980 REM ******************************************************************** 18985 REM --------------------- wait for any key ----------------------------- 18990 REM nothing needed on entry 18995 REM 19000 LOCATE ,,0 :REM 19000 19005 IN$=INKEY$:IF IN$="" THEN 19005 19010 RETURN 19015 REM 19020 REM 19025 REM 19080 REM ******************************************************************** 19085 REM -------------------------- DELAY ----------------------------------- 19090 REM enter with DELAY=seconds to delay 19095 REM 19100 LOCATE ,,0:T=TIMER :REM 19100 19105 IF TIMER"" THEN ESCAPE=-1:GOTO 19215 19210 IF TIMER FILES.TMP":SHELL SHEL$ 20030 ON ERROR GOTO 20080 20035 OPEN "FILES.TMP" FOR INPUT AS 1 20040 IF LOF(1)=0 THEN CLOSE #1:GOTO 20050 20045 GOTO 20100 20050 PRINT:PRINT "SORT utility not in DOS path" 20055 SHEL$="DIR *."+EXT$+" > FILES.TMP":SHELL SHEL$ 20060 ON ERROR GOTO 20080 20065 OPEN "FILES.TMP" FOR INPUT AS 1 20070 IF LOF(1)=0 THEN CLOSE #1:GOTO 20085 20075 GOTO 20100 20080 RESUME 20085 20085 DOSERROR$="DISK":NUMFILES=0:FILE$="" 20090 ON ERROR GOTO 0:GOTO 20645 20095 REM ----- 20100 ON ERROR GOTO 0 20105 DOSERROR$="NONE" 20110 DIM FILENAME$(1000):NUMFILES=0 20115 IF EOF(1) THEN 20160 20120 INPUT #1,FILE$ 20125 IF MID$(FILE$,9,1)<>" " OR LEFT$(FILE$,1)="." THEN 20115 20130 IF VAL(MID$(FILE$,14,13))=0 THEN 20115 20135 FILENAME$(NUMFILES+1)=LEFT$(FILE$,8) 20140 NUMFILES=NUMFILES+1 20145 IF NUMFILES>1000 THEN 20160 20150 GOTO 20115 20155 REM ----- 20160 CLOSE 1:KILL "FILES.TMP" 20165 IF NUMFILES=0 THEN FILE$="":GOTO 20645 20170 ON ERROR GOTO 0 20175 COL=35 20180 REM ----- OUTLINE THE AREA 20185 COLOR TEXTFORE,TEXTBACK:CLS 20190 IF BOX=0 THEN 20340 20195 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195 20200 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204 20205 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 20210 ROW=3:LOCATE ROW,1+COL:PRINT STRING$(10,CHR$(TP)); 20215 ROW=23:LOCATE ROW,1+COL:PRINT STRING$(10,CHR$(BT)); 20220 DCOL=COL:FOR ROW%=4 TO 22:LOCATE ROW%,DCOL:PRINT CHR$(MS);:NEXT ROW% 20225 DCOL=COL+11:FOR ROW%=4 TO 22:LOCATE ROW%,DCOL:PRINT CHR$(MS);:NEXT ROW% 20230 LOCATE 3,COL:PRINT CHR$(UL);:LOCATE 3,COL+11:PRINT CHR$(UR); 20235 LOCATE 23,COL:PRINT CHR$(LL);:LOCATE 23,COL+11:PRINT CHR$(LR); 20240 IF SHADOW=0 THEN 20340 20245 ROW=4:L=8:COLOR SHADOWFORE,SHADOWBACK 20250 IF BOX<>1 AND BOX<>2 THEN 20315 20255 LOCATE ROW+19,COL+2:PRINT CHR$(DN);:LOCATE ROW+20,COL+2:PRINT CHR$(LL); 20260 LOCATE ROW+20,COL+3:PRINT STRING$(L+2,CHR$(BT)); 20265 LOCATE ROW+20,COL+L+5:PRINT CHR$(LR); 20270 FOR DROW%=ROW+19 TO ROW+1 STEP -1 20275 LOCATE DROW%,COL+L+5:PRINT CHR$(MS); 20280 NEXT DROW% 20285 LOCATE ROW,COL+L+3:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 20290 COLOR TEXTFORE,TEXTBACK 20295 FOR DROW%=ROW+1 TO ROW+19 20300 LOCATE DROW%,COL+L+4:PRINT " "; 20305 NEXT DROW% 20310 GOTO 20340 20315 LOCATE ROW+20,COL+1:PRINT STRING$(L+4,CHR$(TP)); 20320 FOR DROW%=ROW+19 TO ROW STEP -1 20325 LOCATE DROW%,COL+L+4:PRINT CHR$(MS); 20330 NEXT DROW% 20335 LOCATE ROW-1,COL+L+4:PRINT CHR$(BT); 20340 REM 20345 REM ----- DISPLAY MESSAGE 20350 ROW=1:MCOL=41-INT((LEN(MSG$)/2)) 20355 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,MCOL:PRINT MSG$; 20360 ROW=25:MSG$="Use "+CHR$(24)+" and "+CHR$(25)+" to Move, " 20365 MSG$=MSG$+"PgUp and PgDn for More Files, ENTER to Select" 20370 MCOL=41-INT((LEN(MSG$)/2)) 20375 LOCATE ROW,MCOL:PRINT MSG$; 20380 REM ----- 20385 CURROW=1:OLDROW=CURROW 20390 MAXROW=19:IF NUMFILES<19 THEN MAXROW=NUMFILES 20395 SRTROW=1 20400 REM ----- DISPLAY FILE NAMES 20405 COLOR DATAFORE,DATABACK 20410 FOR DROW%=1 TO MAXROW 20415 LOCATE DROW%+3,COL+2 20420 PRINT FILENAME$(DROW%-1+SRTROW); 20425 NEXT DROW% 20430 REM ----- MOVE THROUGH FILE NAMES AND SELECT ONE 20435 ESCAPE=0:LOCATE ,,0 20440 LOCATE CURROW+3,COL+2 20445 COLOR FIELDFORE,FIELDBACK 20450 PRINT FILENAME$(CURROW-1+SRTROW); 20455 COLOR DATAFORE,DATABACK 20460 LOCATE CURROW+3,COL+2 20465 IN$=INKEY$:IF IN$="" THEN 20465 20470 IF IN$=CHR$(13) THEN 20625 20475 IF IN$=CHR$(27) THEN ESCAPE=-1:FILE$="":GOTO 20645 20480 IF IN$=CHR$(0)+CHR$(72) THEN 20510:REM UP 20485 IF IN$=CHR$(0)+CHR$(80) THEN 20525:REM DOWN 20490 IF IN$=CHR$(0)+CHR$(73) THEN 20540:REM PAGE UP 20495 IF IN$=CHR$(0)+CHR$(81) THEN 20555:REM PAGE DOWN 20500 GOTO 20575 20505 REM ----- 20510 IF CURROW>1 THEN OLDROW=CURROW:CURROW=CURROW-1:GOTO 20585 20515 IF SRTROW>1 THEN SRTROW=SRTROW-1:GOTO 20405 20520 GOTO 20575 20525 IF CURROWMAXROW AND SRTROW<=NUMFILES-19 THEN SRTROW=SRTROW+1:GOTO 20405 20535 GOTO 20575 20540 IF SRTROW>18 THEN SRTROW=SRTROW-18:GOTO 20405 20545 IF SRTROW<>1 THEN SRTROW=1:GOTO 20405 20550 GOTO 20575 20555 IF SRTROW+18<=NUMFILES-19 THEN SRTROW=SRTROW+18:GOTO 20405 20560 IF SRTROW<=NUMFILES-19 THEN SRTROW=NUMFILES-18:GOTO 20405 20565 GOTO 20575 20570 REM ----- BEEP ON ERROR WOULD GO HERE 20575 BEEP:GOTO 20465 20580 REM ----- HIGHLIGHT NEW FILE 20585 LOCATE OLDROW+3,COL+2 20590 COLOR DATAFORE,DATABACK 20595 PRINT FILENAME$(OLDROW-1+SRTROW); 20600 LOCATE CURROW+3,COL+2 20605 COLOR FIELDFORE,FIELDBACK 20610 PRINT FILENAME$(CURROW-1+SRTROW); 20615 GOTO 20465 20620 REM ----- FILE WAS SELECTED 20625 FILE$=FILENAME$(CURROW-1+SRTROW) 20630 REM ----- REMOVE TRAILING SPACES 20635 IF RIGHT$(FILE$,1)=" " THEN FILE$=LEFT$(FILE$,LEN(FILE$)-1):GOTO 20635 20640 REM ----- 20645 ERASE FILENAME$ 20650 COLOR TEXTFORE,TEXTBACK:BOX=0:SHADOW=0:RETURN 20655 REM 20900 REM ******************************************************************** 20905 REM --------- SELECT FROM FILE NAMES OF A SPECIFIED EXTENSION ---------- 20910 REM Move among names with arrow keys and select file with ENTER key, or 20915 REM exit with ESCAPE key. Message on row 2, files begin on row 4. Number 20920 REM of files is limited to 133. DOS must have COMMAND.COM in path. 20925 REM 20930 REM enter with - 20935 REM MSG$="message", to display 20940 REM EXT$="ext", extension of files desired 20945 REM optional- 20950 REM TEXTFORE,TEXTBACK,DATAFORE,DATABACK,FIELDFORE,FIELDBACK - 20955 REM colors optionally specified for COLOR statements 20960 REM BOX=0,1,2,3 - type of box around message and field 20965 REM 0 = no box, 1 = 1 line box, 2 = 2 line box, 3 = solid box 20970 REM exit with - 20975 REM FILE$="filename", the filename without extension 20980 REM ESCAPE TRUE (=-1) if ESCAPE key hit 20985 REM NUMFILES=number of files found of the specified extension 20990 REM BOX=0 (to maintain BOX as optional for other routines) 20995 REM 21000 DIM FILENAME1$(256,7) :REM 21000 21005 SHEL$="DIR *."+EXT$+" > FILES.TMP" 21010 LOCATE ,,0:COLOR TEXTFORE,TEXTBACK:CLS 21015 SHELL SHEL$:REM DOS MUST HAVE COMMAND.COM IN THE PATH 21020 OPEN "FILES.TMP" FOR INPUT AS 1 21025 NUMFILES=0:FROW=1:FCOL=1:MAXROW=1:MAXCOL=1 21030 IF EOF(1) THEN 21100 21035 INPUT #1,FILE$ 21040 EXTPOS=INSTR(FILE$," "+EXT$)-1 21045 IF EXTPOS<1 OR LEN(FILE$)=0 THEN 21095 21050 FILE$=LEFT$(FILE$,EXTPOS) 21055 SPCPOS=INSTR(FILE$," ")-1 21060 IF SPCPOS<1 OR LEN(FILE$)=0 THEN 21070 21065 FILE$=LEFT$(FILE$,SPCPOS) 21070 FILENAME1$(FROW,FCOL)=FILE$ 21075 NUMFILES=NUMFILES+1 21080 FCOL=FCOL+1 21085 IF FCOL=8 THEN FCOL=1:FROW=FROW+1 :REM NUMBER OF COLUMNS+1 21090 IF FCOL>MAXCOL THEN MAXCOL=FCOL 21095 GOTO 21030 21100 MAXROW=FROW:IF MAXROW=1 THEN MAXCOL=MAXCOL-1 21105 CLOSE 1:KILL "FILES.TMP" 21110 IF NUMFILES=0 THEN FILE$="":GOTO 21445 21115 REM ----- 21120 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 21125 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 21130 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 21135 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 21140 REM ----- OUTLINE THE AREA 21145 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A% 21150 LOCATE ,,0:COLOR TEXTFORE,TEXTBACK:CLS 21155 IF BOX=0 THEN 21205 21160 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217 21165 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188 21170 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 21175 ROW=1:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP)); 21180 ROW=25:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT)); 21185 COL=1:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW% 21190 COL=80:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW% 21195 LOCATE 1,1:PRINT CHR$(UL);:LOCATE 1,80:PRINT CHR$(UR); 21200 LOCATE 25,1:PRINT CHR$(LL);:LOCATE 25,80:PRINT CHR$(LR); 21205 BOX=0 21210 REM ----- DISPLAY MESSAGE 21215 ROW=2 21220 COL=41-INT((LEN(MSG$)/2)) 21225 LOCATE ROW,COL:PRINT MSG$; 21230 REM ----- DISPLAY FILE NAMES 21235 FILEROW=4:COLOR DATAFORE,DATABACK:REM set colors for DATA 21240 FOR DROW%=1 TO FROW 21245 FOR DCOL%=1 TO MAXCOL 21250 LOCATE DROW%-1+FILEROW,((DCOL%-1)*11)+4 :REM COLUMN SPACING 21255 PRINT FILENAME1$(DROW%,DCOL%) 21260 NEXT DCOL% 21265 NEXT DROW% 21270 REM ----- MOVE THROUGH FILE NAMES AND SELECT ONE 21275 ESCAPE=0:LOCATE ,,0:FROW=1:FCOL=1:OLDFROW=FROW:OLDFCOL=FCOL 21280 LOCATE FROW-1+FILEROW,FCOL+3 :REM COLUMN SPACING 21285 COLOR FIELDFORE,FIELDBACK:REM set colors for FIELD 21290 PRINT FILENAME1$(FROW,FCOL) 21295 COLOR DATAFORE,DATABACK:REM set colors for DATA 21300 LOCATE FROW-1+FILEROW,FCOL+4 21305 IN$=INKEY$:IF IN$="" THEN 21305 21310 IF IN$=CHR$(13) THEN 21440 21315 IF IN$=CHR$(27) THEN ESCAPE=-1:FILE$="":GOTO 21445 21320 IF IN$=CHR$(0)+CHR$(75) THEN 21355:REM LEFT 21325 IF IN$=CHR$(0)+CHR$(77) THEN 21365:REM RIGHT 21330 IF IN$=CHR$(0)+CHR$(72) THEN 21375:REM UP 21335 IF IN$=CHR$(0)+CHR$(80) THEN 21385:REM DOWN 21340 REM ----- BEEP ON ERROR 21345 BEEP:GOTO 21305 21350 REM 21355 IF FCOL>1 THEN OLDFROW=FROW:OLDFCOL=FCOL:FCOL=FCOL-1 21360 GOTO 21395 21365 IF FCOL1 THEN OLDFROW=FROW:OLDFCOL=FCOL:FROW=FROW-1 21380 GOTO 21395 21385 IF FROW"" THEN 21405 21400 FROW=OLDFROW:FCOL=OLDFCOL 21405 LOCATE OLDFROW-1+FILEROW,((OLDFCOL-1)*11)+4 :REM COLUMN SPACING 21410 PRINT FILENAME1$(OLDFROW,OLDFCOL) 21415 LOCATE FROW-1+FILEROW,((FCOL-1)*11)+4 :REM COLUMN SPACING 21420 COLOR FIELDFORE,FIELDBACK:REM set colors for FIELD 21425 PRINT FILENAME1$(FROW,FCOL) 21430 COLOR DATAFORE,DATABACK:REM set colors for DATA 21435 GOTO 21305 21440 FILE$=FILENAME1$(FROW,FCOL) 21445 ERASE FILENAME1$ 21450 COLOR TEXTFORE,TEXTBACK:RETURN 21455 REM 21460 REM 29780 REM ******************************************************************** 29785 REM ---------------------- POINT AND SHOOT MENU ------------------------ 29790 REM ----------------------- (or display window) ------------------------ 29795 REM 29800 REM Sets up menu and selects from up to 9 items. Moves among the items 29805 REM with the arrow keys and selects with ENTER or ESCAPE keys, numbers 29810 REM 1-9, F1-F9, and optionally PAGE UP, PAGE DOWN, LEFT, RIGHT, F10. 29815 REM Displays message at top and optional box and shadow around the menu. 29820 REM Item names must be in order and none may be skipped. The ROW and COL 29825 REM must allow all of menu to be displayed on the screen. Menu can be 29830 REM optionally displayed as a pull-down menu, meaning that when item is 29835 REM selected, parts of the screen that were written over are restored. 29840 REM 29845 REM With the display window option set, the menu becomes only a display 29850 REM of text and does not wait for any keyboard entry. 29855 REM 29860 REM enter with ITEM$(1)="ITEM 1 message",(up to 76 chars.),ITEM$(2), etc. 29865 REM (array must be DIMinsioned before using this routine) 29870 REM MSG$="menu message or name", (up to 76 characters) 29875 REM ROW, COL=upper left corner of menu 29880 REM optional - TEXTFORE, TEXTBACK, DATAFORE, DATABACK 29885 REM FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK 29890 REM colors optionally specified for COLOR statements 29895 REM BOX=0,1,2,3 - type of outline around menu 29900 REM 0 = no box, 1 = 1 line box, 2 = 2 line box, 3 = solid box 29905 REM optional- SHADOW=0,1 - type of shadow to include with box 29910 REM 0 = no shadow, 1 = shadow 29915 REM optional - EDKEYS=0,1 - what keys allow you to exit the routine 29920 REM 0 = only ENTER or ESCAPE 29925 REM 1 = include PGUP, PGDN, LEFT and RIGHT ARROWS, F10 29930 REM ITEM = 1 to number of items, default item selected 29935 REM optional - DISPTYPE=0,1,2,3 - type of menu/display desired 29940 REM 0 = normal menu 29945 REM 1 = pull-down menu (screen restored), 29950 REM 2 = display window of text only that looks just like menu 29955 REM 3 = display window with default "ITEM" hi-lighted 29960 REM exit with -ITEM = 1-9, item selected 29965 REM ITEM$ = ITEM$(1)-ITEM$(9), depending on item selected 29970 REM ESCAPE=-1 (TRUE) if ESCAPE key hit 29975 REM (for compatibility with old versions) 29980 REM EXIT$=key hit that exited routine- 29985 REM "ENTER","ESC","PGUP","PGDN","LEFT","RIGHT","F10" 29990 REM BOX, SHADOW, DISPTYPE, EDKEYS=0 (to maintain as optional) 29995 REM 30000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 30000 30005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 30010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 30015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 30020 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A% 30025 NUMITEMS=0:EXIT$="":ESCAPE=0 30030 FOR A%=1 TO 9:IF ITEM$(A%)="" THEN 30040 30035 NUMITEMS=NUMITEMS+1:NEXT A% 30040 IF NUMITEMS+ROW+3>25 THEN ROW=25-3-NUMITEMS 30045 REM -------------- FIND MAX LNG AND PAD SHORTER ONES --------------- 30050 MAXLEN=LEN(MSG$) 30055 FOR MLOOP%=1 TO NUMITEMS 30060 IF LEN(ITEM$(MLOOP%))>MAXLEN THEN MAXLEN=LEN(ITEM$(MLOOP%)) 30065 NEXT MLOOP% 30070 IF LEN(MSG$)80 THEN COL=80-3-MAXLEN 30095 REM --------------- SAVE SCREEN IF PULL DOWN MENU ---------------- 30100 IF DISPTYPE<>1 THEN 30170 30105 IF SHADOW<>0 THEN SHAD=2 ELSE SHAD=0 30110 DIM PSSSCHR(NUMITEMS+4+SHAD,MAXLEN+4+SHAD) 30115 DIM PSSSCOLOR(NUMITEMS+4+SHAD,MAXLEN+4+SHAD,2) 30120 R=1:C=1 30125 FOR SR%=ROW TO ROW+NUMITEMS+3+SHAD 30130 FOR SC%=COL TO COL+MAXLEN+3+SHAD 30135 PSSSCHR(R,C)=SCREEN(SR%,SC%,0) 30140 A=SCREEN(SR%,SC%,1):PSSSCOLOR(R,C,1)=(A AND 15) 30145 IF (A AND 128)=128 THEN PSSSCOLOR(R,C,1)=PSSSCOLOR(R,C,1)+16 30150 PSSSCOLOR(R,C,2)=(A AND 112)/16 30155 C=C+1:NEXT SC% 30160 R=R+1:C=1:NEXT SR% 30165 REM ---------------------- DISPLAY MENU ----------------------------- 30170 LOCATE ,,0 30175 IF BOX=0 THEN TP=0:BT=0:LS=0:RS=0:MS=0:MM=0:UL=0:LL=0:UR=0:LR=0 30180 IF BOX=1 THEN TP=196:BT=196:LS=195:RS=180:MS=179:MM=196:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195 30185 IF BOX=2 THEN TP=205:BT=205:LS=204:RS=185:MS=186:MM=205:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204 30190 IF BOX=3 THEN TP=223:BT=220:LS=219:RS=219:MS=219:MM=220:UL=219:LL=219:UR=219:LR=219 30195 IROW=ROW:ICOL=COL 30200 LOCATE IROW,ICOL:COLOR TEXTFORE,TEXTBACK 30205 PRINT CHR$(UL)+STRING$(MAXLEN+2,TP)+CHR$(UR); 30210 LOCATE IROW+1,ICOL:PRINT CHR$(MS)+" "; 30215 COLOR DATAFORE,DATABACK:PRINT MSG$; 30220 COLOR TEXTFORE,TEXTBACK:PRINT " "+CHR$(MS); 30225 LOCATE IROW+2,ICOL:COLOR TEXTFORE,TEXTBACK 30230 PRINT CHR$(LS)+STRING$(MAXLEN+2,MM)+CHR$(RS); 30235 FOR PLOOP%=1 TO NUMITEMS 30240 LOCATE IROW+2+PLOOP%,ICOL 30245 PRINT CHR$(MS)+" "+ITEM$(PLOOP%)+" "+CHR$(MS); 30250 NEXT PLOOP% 30255 LOCATE IROW+3+NUMITEMS,ICOL 30260 PRINT CHR$(LL)+STRING$(MAXLEN+2,BT)+CHR$(LR); 30265 REM 30270 IF SHADOW=0 THEN 30375 30275 COLOR SHADOWFORE,SHADOWBACK 30280 IF BOX<>1 AND BOX<>2 THEN 30350 30285 LOCATE ROW+3+NUMITEMS,COL+2:PRINT CHR$(DN); 30290 LOCATE ROW+4+NUMITEMS,COL+2:PRINT CHR$(LL); 30295 LOCATE ROW+4+NUMITEMS,COL+3:PRINT STRING$(MAXLEN+2,CHR$(BT)); 30300 LOCATE ROW+4+NUMITEMS,COL+MAXLEN+5:PRINT CHR$(LR); 30305 FOR DROW%=ROW+3+NUMITEMS TO ROW+2 STEP -1 30310 LOCATE DROW%,COL+MAXLEN+5:PRINT CHR$(MS); 30315 NEXT DROW% 30320 LOCATE ROW+1,COL+MAXLEN+3:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 30325 COLOR TEXTFORE,TEXTBACK 30330 FOR DROW%=ROW+2 TO ROW+3+NUMITEMS 30335 LOCATE DROW%,COL+MAXLEN+4:PRINT " "; 30340 NEXT DROW% 30345 GOTO 30375 30350 LOCATE ROW+4+NUMITEMS,COL+1:PRINT STRING$(MAXLEN+4,CHR$(TP)); 30355 FOR DROW%=ROW+3+NUMITEMS TO ROW+1 STEP -1 30360 LOCATE DROW%,COL+MAXLEN+4:PRINT CHR$(MS); 30365 NEXT DROW% 30370 LOCATE ROW,COL+MAXLEN+4:PRINT CHR$(BT); 30375 REM 30380 REM ---------- DO NOT WAIT FOR ENTRY IF DISPLAY WINDOW ONLY ---------- 30385 IF DISPTYPE=2 THEN 30545:REM DISPLAY WINDOW 30390 IF DISPTYPE=3 THEN IROW=ITEM:ICOL=ICOL+2:GOTO 30535:REM WIND. WITH HILITE 30395 REM ------------- MOVE THROUGH MENU ITEMS AND SELECT ONE -------------- 30400 IROW=1:IF ITEM>=1 AND ITEM<=NUMITEMS THEN IROW=ITEM 30405 ESCAPE=0:OLDIROW=IROW:ICOL=COL+2 30410 LOCATE OLDIROW+ROW+2,ICOL:COLOR TEXTFORE,TEXTBACK:PRINT ITEM$(OLDIROW); 30415 LOCATE IROW+ROW+2,ICOL:COLOR FIELDFORE,FIELDBACK:PRINT ITEM$(IROW); 30420 IN$=INKEY$:IF IN$="" THEN 30420 30425 IF IN$=CHR$(27) THEN EXIT$="ESC":ESCAPE=-1:GOTO 30525 30430 IF IN$=CHR$(13) THEN EXIT$="ENTER":GOTO 30525 30435 IF EDKEYS=0 THEN 30465 30440 IF IN$=CHR$(0)+CHR$(75) THEN EXIT$="LEFT":GOTO 30525 30445 IF IN$=CHR$(0)+CHR$(77) THEN EXIT$="RIGHT":GOTO 30525 30450 IF IN$=CHR$(0)+CHR$(73) THEN EXIT$="PGUP":GOTO 30525 30455 IF IN$=CHR$(0)+CHR$(81) THEN EXIT$="PGDN":GOTO 30525 30460 IF IN$=CHR$(0)+CHR$(68) THEN EXIT$="F10":GOTO 30525 30465 IF LEN(IN$)=1 THEN 30475 30470 V=ASC(RIGHT$(IN$,1))-58:GOTO 30480:REM FUNCTION KEY 30475 V=VAL(IN$) 30480 IF V>=1 AND V<=9 AND V<=NUMITEMS THEN OLDIROW=IROW:IROW=V:GOTO 30525 30485 IF IN$=CHR$(0)+CHR$(72) THEN 30500:REM UP 30490 IF IN$=CHR$(0)+CHR$(80) THEN 30510:REM DOWN 30495 BEEP:GOTO 30420 30500 OLDIROW=IROW:IF IROW>1 THEN IROW=IROW-1:GOTO 30410 30505 IROW=NUMITEMS:GOTO 30410 30510 OLDIROW=IROW:IF IROW1 THEN 30595 30550 R=1:C=1 30555 FOR SR%=ROW TO ROW+NUMITEMS+3+SHAD 30560 FOR SC%=COL TO COL+MAXLEN+3+SHAD 30565 COLOR PSSSCOLOR(R,C,1),PSSSCOLOR(R,C,2) 30570 LOCATE SR%,SC%:PRINT CHR$(PSSSCHR(R,C)); 30575 C=C+1:NEXT SC% 30580 R=R+1:C=1:NEXT SR% 30585 ERASE PSSSCHR:ERASE PSSSCOLOR 30590 REM ------------------------------------------------------- 30595 FOR A%=1 TO 9:ITEM$(A%)="":NEXT A% 30600 COLOR TEXTFORE,TEXTBACK 30605 BOX=0:SHADOW=0:DISPTYPE=0:EDKEYS=0 30610 RETURN 30615 REM 31800 REM ******************************************************************** 31805 REM -------------------- MULTIPLE SELECTION MENU ----------------------- 31810 REM 31815 REM Sets up menu and selects from up to 21 items. Moves among the items 31820 REM with the arrow keys and selects item as on or off with SPACE BAR. 31825 REM Exit routine with ENTER or ESCAPE keys, and optionally PAGE UP, 31830 REM PAGE DOWN, LEFT, RIGHT, F10. Optionally draws a box around the menu. 31835 REM Item names must be in order and none may be skipped. The ROW and COL 31840 REM must allow all of menu to be displayed on the screen. Menu can be 31845 REM optionally displayed as a pull-down menu, meaning that when item is 31850 REM selected, parts of the screen that were written over are restored. 31855 REM 31860 REM enter with ITEM$(1)="ITEM 1 message",(up to 76 chars.),ITEM$(2), etc. 31865 REM (array must be DIMinsioned before using this routine) 31870 REM MSG$="menu message or name", (up to 76 characters) 31875 REM ROW, COL=upper left corner of menu 31880 REM optional - ITEMSTATUS(1)= 0 or 1, ITEMSTATUS(2)=0 or 1, etc. 31885 REM (array must be DIMinsioned before using this routine) 31890 REM optional - TEXTFORE, TEXTBACK, DATAFORE, DATABACK 31895 REM FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK 31900 REM colors optionally specified for COLOR statements 31905 REM optional - BOX=0,1,2,3 - type of outline around menu 31910 REM 0 = no box, 1 = 1 line box, 2 = 2 line box, 3 = solid box 31915 REM optional - SHADOW=0,1 - type of shadow to include with box 31920 REM 0 = no shadow, 1 = shadow 31925 REM optional - EDKEYS=0,1 - what keys allow you to exit the routine 31930 REM 0 = only ENTER or ESCAPE 31935 REM 1 = include PGUP, PGDN, LEFT and RIGHT ARROWS, F10 31940 REM optional - DISPTYPE=0,1 - type of menu/display desired 31945 REM 0 = normal menu 31950 REM 1 = pull-down menu (screen restored), 31955 REM optional - STATUSTYPE = 0,1,2 - type of selection desired 31960 REM 0 = ON or OFF, 1 = YES or NO, 2=dot to indicate selected 31965 REM exit with -ITEMSTATUS(1)-ITEMSTATUS(21)= 1 or 0, selected or not 31970 REM ESCAPE=-1 (TRUE) if ESCAPE key hit 31975 REM (for compatibility with old versions) 31980 REM EXIT$=key hit that exited routine- 31985 REM "ENTER","ESC","PGUP","PGDN","LEFT","RIGHT","F10" 31990 REM BOX, SHADOW, DISPTYPE, STATUSTYPE, EDKEYS=0 (to maintain as optional) 31995 REM 32000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 32000 32005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 32010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 32015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 32020 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A% 32025 NUMITEMS=0:EXIT$="":ESCAPE=0 32030 ON ERROR GOTO 32050 32035 FOR A%=1 TO 21:IF ITEM$(A%)="" THEN 32055 32040 NUMITEMS=NUMITEMS+1:NEXT A% 32045 GOTO 32060 32050 RESUME 32055 32055 ON ERROR GOTO 0 32060 IF NUMITEMS+ROW+3>25 THEN ROW=25-3-NUMITEMS 32065 REM -------------- FIND MAX LNG AND PAD SHORTER ONES --------------- 32070 MAXLEN=LEN(MSG$) 32075 FOR MLOOP%=1 TO NUMITEMS 32080 IF LEN(ITEM$(MLOOP%))>MAXLEN THEN MAXLEN=LEN(ITEM$(MLOOP%)) 32085 NEXT MLOOP% 32090 IF LEN(MSG$)80 THEN COL=80-3-MAXLEN 32115 REM --------------- SAVE SCREEN IF PULL DOWN MENU ---------------- 32120 IF DISPTYPE<>1 THEN 32190 32125 IF SHADOW<>0 THEN SHAD=2 ELSE SHAD=0 32130 DIM MSSSCHR(NUMITEMS+4+SHAD,MAXLEN+9+SHAD) 32135 DIM MSSSCOLOR(NUMITEMS+4+SHAD,MAXLEN+9+SHAD,2) 32140 R=1:C=1 32145 FOR SR%=ROW TO ROW+NUMITEMS+3+SHAD 32150 FOR SC%=COL TO COL+MAXLEN+8+SHAD 32155 MSSSCHR(R,C)=SCREEN(SR%,SC%,0) 32160 A=SCREEN(SR%,SC%,1):MSSSCOLOR(R,C,1)=(A AND 15) 32165 IF (A AND 128)=128 THEN MSSSCOLOR(R,C,1)=MSSSCOLOR(R,C,1)+16 32170 MSSSCOLOR(R,C,2)=(A AND 112)/16 32175 C=C+1:NEXT SC% 32180 R=R+1:C=1:NEXT SR% 32185 REM ---------------------- DISPLAY MENU ----------------------------- 32190 LOCATE ,,0 32195 IF BOX=0 THEN TP=0:BT=0:LS=0:RS=0:MS=0:MM=0:UL=0:LL=0:UR=0:LR=0 32200 IF BOX=1 THEN TP=196:BT=196:LS=195:RS=180:MS=179:MM=196:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195 32205 IF BOX=2 THEN TP=205:BT=205:LS=204:RS=185:MS=186:MM=205:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204 32210 IF BOX=3 THEN TP=223:BT=220:LS=219:RS=219:MS=219:MM=220:UL=219:LL=219:UR=219:LR=219 32215 IROW=ROW:ICOL=COL 32220 LOCATE IROW,ICOL:COLOR TEXTFORE,TEXTBACK 32225 PRINT CHR$(UL)+STRING$(MAXLEN+7,TP)+CHR$(UR); 32230 LOCATE IROW+1,ICOL:PRINT CHR$(MS)+" "; 32235 COLOR DATAFORE,DATABACK:PRINT MSG$; 32240 COLOR TEXTFORE,TEXTBACK:PRINT " "+CHR$(MS); 32245 LOCATE IROW+2,ICOL:COLOR TEXTFORE,TEXTBACK 32250 PRINT CHR$(LS)+STRING$(MAXLEN+7,MM)+CHR$(RS); 32255 FOR PLOOP=1 TO NUMITEMS 32260 LOCATE IROW+2+PLOOP,ICOL 32265 PRINT CHR$(MS)+" "+ITEM$(PLOOP)+" "; 32270 SROW=PLOOP:GOSUB 32640:REM PRINT SELECT MESSAGE 32275 PRINT " "+CHR$(MS); 32280 NEXT PLOOP 32285 LOCATE IROW+3+NUMITEMS,ICOL 32290 PRINT CHR$(LL)+STRING$(MAXLEN+7,BT)+CHR$(LR); 32295 IF SHADOW=0 THEN 32395 32300 COLOR SHADOWFORE,SHADOWBACK 32305 IF BOX<>1 AND BOX<>2 THEN 32370 32310 LOCATE ROW+3+NUMITEMS,COL+2:PRINT CHR$(DN); 32315 LOCATE ROW+4+NUMITEMS,COL+2:PRINT CHR$(LL); 32320 LOCATE ROW+4+NUMITEMS,COL+3:PRINT STRING$(MAXLEN+8,CHR$(BT)); 32325 LOCATE ROW+4+NUMITEMS,COL+MAXLEN+10:PRINT CHR$(LR); 32330 FOR DROW%=ROW+3+NUMITEMS TO ROW+2 STEP -1 32335 LOCATE DROW%,COL+MAXLEN+10:PRINT CHR$(MS); 32340 NEXT DROW% 32345 LOCATE ROW+1,COL+MAXLEN+8:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 32350 FOR DROW%=ROW+2 TO ROW+3+NUMITEMS 32355 LOCATE DROW%,COL+MAXLEN+9:PRINT " "; 32360 NEXT DROW% 32365 GOTO 32395 32370 LOCATE ROW+4+NUMITEMS,COL+1:PRINT STRING$(MAXLEN+9,CHR$(TP)); 32375 FOR DROW%=ROW+3+NUMITEMS TO ROW+1 STEP -1 32380 LOCATE DROW%,COL+MAXLEN+9:PRINT CHR$(MS); 32385 NEXT DROW% 32390 LOCATE ROW,COL+MAXLEN+9:PRINT CHR$(BT); 32395 REM 32400 REM ------------- MOVE THROUGH MENU ITEMS AND SELECT STATUS ------------ 32405 IROW=1:ESCAPE=0:OLDIROW=IROW:ICOL=COL+2 32410 LOCATE OLDIROW+ROW+2,ICOL:COLOR TEXTFORE,TEXTBACK:PRINT ITEM$(OLDIROW); 32415 LOCATE OLDIROW+ROW+2,ICOL+MAXLEN+2:SROW=OLDIROW:GOSUB 32640:REM SELECT MESSAGE 32420 LOCATE IROW+ROW+2,ICOL:COLOR FIELDFORE,FIELDBACK:PRINT ITEM$(IROW); 32425 LOCATE IROW+ROW+2,ICOL+MAXLEN+2:SROW=IROW:GOSUB 32640:REM SELECT MESSAGE 32430 IN$=INKEY$:IF IN$="" THEN 32430 32435 IF IN$=CHR$(27) THEN EXIT$="ESC":ESCAPE=-1:GOTO 32550 32440 IF IN$=CHR$(13) THEN EXIT$="ENTER":GOTO 32550 32445 IF EDKEYS=0 THEN 32475 32450 IF IN$=CHR$(0)+CHR$(75) THEN EXIT$="LEFT":GOTO 32520 32455 IF IN$=CHR$(0)+CHR$(77) THEN EXIT$="RIGHT":GOTO 32520 32460 IF IN$=CHR$(0)+CHR$(73) THEN EXIT$="PGUP":GOTO 32520 32465 IF IN$=CHR$(0)+CHR$(81) THEN EXIT$="PGDN":GOTO 32520 32470 IF IN$=CHR$(0)+CHR$(68) THEN EXIT$="F10":GOTO 32520 32475 IF IN$=CHR$(0)+CHR$(72) THEN 32495:REM UP 32480 IF IN$=CHR$(0)+CHR$(80) THEN 32505:REM DOWN 32485 IF IN$=" " THEN 32520 32490 BEEP:GOTO 32430 32495 OLDIROW=IROW:IF IROW>1 THEN IROW=IROW-1:GOTO 32410 32500 IROW=NUMITEMS:GOTO 32410 32505 OLDIROW=IROW:IF IROW1 THEN 32600 32555 R=1:C=1 32560 FOR SR%=ROW TO ROW+NUMITEMS+3+SHAD 32565 FOR SC%=COL TO COL+MAXLEN+8+SHAD 32570 COLOR MSSSCOLOR(R,C,1),MSSSCOLOR(R,C,2) 32575 LOCATE SR%,SC%:PRINT CHR$(MSSSCHR(R,C)); 32580 C=C+1:NEXT SC% 32585 R=R+1:C=1:NEXT SR% 32590 ERASE MSSSCHR:ERASE MSSSCOLOR 32595 REM --------------------------- EXIT --------------------------------- 32600 ON ERROR GOTO 32610 32605 FOR A%=1 TO 21:ITEM$(A%)="":NEXT A%:GOTO 32620 32610 RESUME 32615 32615 ON ERROR GOTO 0 32620 COLOR TEXTFORE,TEXTBACK 32625 BOX=0:SHADOW=0:DISPTYPE=0:STATUSTYPE=0:EDKEYS=0 32630 RETURN 32635 REM -------------------- PRINT SELECT MESSAGE ------------------------ 32640 IF STATUSTYPE=0 AND ITEMSTATUS(SROW)=0 THEN PRINT "OFF"; 32645 IF STATUSTYPE=0 AND ITEMSTATUS(SROW)=1 THEN PRINT "ON "; 32650 IF STATUSTYPE=1 AND ITEMSTATUS(SROW)=0 THEN PRINT "NO "; 32655 IF STATUSTYPE=1 AND ITEMSTATUS(SROW)=1 THEN PRINT "YES"; 32660 IF STATUSTYPE=2 AND ITEMSTATUS(SROW)=0 THEN PRINT "[ ]"; 32665 IF STATUSTYPE=2 AND ITEMSTATUS(SROW)=1 THEN PRINT "["+CHR$(254)+"]"; 32670 RETURN 37880 REM ******************************************************************** 37885 REM ------------------------------ MENU -------------------------------- 37890 REM ------- OUTLINE A WORK AREA AND PROMPT AREA AND DISPLAY A MENU ----- 37895 REM ------------ SELECT FROM ITEMS ON MENU WITH F1-F10 KEYS ------------ 37900 REM 37905 REM This subroutine allows you to set up a menu and select from items on 37910 REM the menu with the function keys. It sets up a "work" area and a 37915 REM "prompt" area, both which can be erased individually with their 37920 REM own respective routines. Any function key that does not have a 37925 REM message specified for it will not be allowed as a possible key to 37930 REM be hit. 37935 REM 37940 REM enter with - F1MSG$="F1 message", TO DISPLAY (UP TO 23 CHARACTERS) 37945 REM F2MSG$,F10MSG$, etc. 37950 REM note: unused messages must be set to null or "" 37955 REM MSG$="program or menu name", (up to 37 characters) 37960 REM MENUBOX = 0,1,2,3 - type of box outline 37965 REM 0=no box, 1=1 line box, 2=2 line box, 3=solid box 37970 REM optional - TEXTFORE,TEXTBACK,DATAFORE,DATABACK,FIELDFORE,FIELDBACK 37975 REM colors optionally specified for COLOR statements 37980 REM exit with - FUNCT = 1-10, depending on key hit 37985 REM MENUBOX still set for erase prompt area routine 37990 REM ESCAPE=-1 (TRUE) if ESCAPE key hit 37995 REM 38000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 38000 38005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 38010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 38015 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A% 38020 COLOR TEXTFORE,TEXTBACK:CLS:LOCATE ,,0 38025 IF MENUBOX=0 THEN 38140 38030 IF MENUBOX=1 THEN TP=196:BT=196:SS=179:UL=218:LL=192:UR=191:LR=217 38035 IF MENUBOX=1 THEN MM=196:ML=195:MR=180:MT=194:MB=193:VT=194:VB=193 38040 IF MENUBOX=2 THEN TP=205:BT=205:SS=186:UL=201:LL=200:UR=187:LR=188 38045 IF MENUBOX=2 THEN MM=205:ML=204:MR=185:MT=203:MB=202:VT=203:VB=202 38050 IF MENUBOX=3 THEN TP=223:BT=220:SS=219:UL=219:LL=219:UR=219:LR=219 38055 IF MENUBOX=3 THEN MM=219:ML=219:MR=219:MT=223:MB=220:VT=219:VB=219 38060 ROW=1:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP)); 38065 ROW=3:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT)); 38070 ROW=19:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP)); 38075 ROW=25:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT)); 38080 COL=1:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(SS);:NEXT ROW% 38085 COL=80:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(SS);:NEXT ROW% 38090 LOCATE 1,1:PRINT CHR$(UL);:LOCATE 1,80:PRINT CHR$(UR); 38095 LOCATE 25,1:PRINT CHR$(LL);:LOCATE 25,80:PRINT CHR$(LR); 38100 LOCATE 1,19:PRINT CHR$(VT);:LOCATE 2,19:PRINT CHR$(SS); 38105 LOCATE 3,19:PRINT CHR$(VB); 38110 LOCATE 1,64:PRINT CHR$(VT);:LOCATE 2,64:PRINT CHR$(SS); 38115 LOCATE 3,64:PRINT CHR$(VB); 38120 LOCATE 3,1:PRINT CHR$(ML);:LOCATE 3,80:PRINT CHR$(MR); 38125 LOCATE 19,1:PRINT CHR$(ML);:LOCATE 19,80:PRINT CHR$(MR); 38130 COL=59:FOR ROW=20 TO 24:LOCATE ROW,COL:PRINT CHR$(SS);:NEXT 38135 LOCATE 19,59:PRINT CHR$(VT);:LOCATE 25,59:PRINT CHR$(VB); 38140 REM 38145 ROW=2:COL=42-INT((LEN(MSG$)/2)):REM display message at top 38150 COLOR DATAFORE,DATABACK:LOCATE ROW,COL 38155 PRINT MSG$;:COLOR TEXTFORE,TEXTBACK 38160 MSG$="SELECT MENU ITEM":ROW=20:COL=62:LOCATE ROW,COL:PRINT MSG$; 38165 MSG$="WITH FUNCTION KEYS ":ROW=21:COL=61:LOCATE ROW,COL:PRINT MSG$; 38170 MSG$="(F1-F10)":ROW=22:COL=66 38175 COLOR DATAFORE,DATABACK:REM set colors for DATA 38180 LOCATE ROW,COL:PRINT MSG$; 38185 COLOR TEXTFORE,TEXTBACK:REM set colors for TEXT 38190 MSG$="(ESC)ape to EXIT":ROW=24:COL=62:LOCATE ROW,COL:PRINT MSG$; 38195 MSG$="F1-"+F1MSG$:ROW=20:COL=3:LOCATE ROW,COL:PRINT MSG$; 38200 MSG$="F2-"+F2MSG$:ROW=20:COL=31:LOCATE ROW,COL:PRINT MSG$; 38205 MSG$="F3-"+F3MSG$:ROW=21:COL=3:LOCATE ROW,COL:PRINT MSG$; 38210 MSG$="F4-"+F4MSG$:ROW=21:COL=31:LOCATE ROW,COL:PRINT MSG$; 38215 MSG$="F5-"+F5MSG$:ROW=22:COL=3:LOCATE ROW,COL:PRINT MSG$; 38220 MSG$="F6-"+F6MSG$:ROW=22:COL=31:LOCATE ROW,COL:PRINT MSG$; 38225 MSG$="F7-"+F7MSG$:ROW=23:COL=3:LOCATE ROW,COL:PRINT MSG$; 38230 MSG$="F8-"+F8MSG$:ROW=23:COL=31:LOCATE ROW,COL:PRINT MSG$; 38235 MSG$="F9-"+F9MSG$:ROW=24:COL=3:LOCATE ROW,COL:PRINT MSG$; 38240 MSG$="F10-"+F10MSG$:ROW=24:COL=30:LOCATE ROW,COL:PRINT MSG$; 38245 REM 38250 COLOR DATAFORE,DATABACK:REM set colors for FIELD 38255 IF F1MSG$<>"" THEN MSG$="F1":ROW=20:COL=3:LOCATE ROW,COL:PRINT MSG$; 38260 IF F2MSG$<>"" THEN MSG$="F2":ROW=20:COL=31:LOCATE ROW,COL:PRINT MSG$; 38265 IF F3MSG$<>"" THEN MSG$="F3":ROW=21:COL=3:LOCATE ROW,COL:PRINT MSG$; 38270 IF F4MSG$<>"" THEN MSG$="F4":ROW=21:COL=31:LOCATE ROW,COL:PRINT MSG$; 38275 IF F5MSG$<>"" THEN MSG$="F5":ROW=22:COL=3:LOCATE ROW,COL:PRINT MSG$; 38280 IF F6MSG$<>"" THEN MSG$="F6":ROW=22:COL=31:LOCATE ROW,COL:PRINT MSG$; 38285 IF F7MSG$<>"" THEN MSG$="F7":ROW=23:COL=3:LOCATE ROW,COL:PRINT MSG$; 38290 IF F8MSG$<>"" THEN MSG$="F8":ROW=23:COL=31:LOCATE ROW,COL:PRINT MSG$; 38295 IF F9MSG$<>"" THEN MSG$="F9":ROW=24:COL=3:LOCATE ROW,COL:PRINT MSG$; 38300 IF F10MSG$<>"" THEN MSG$="F10":ROW=24:COL=30:LOCATE ROW,COL:PRINT MSG$; 38305 COLOR TEXTFORE,TEXTBACK:REM restore colors to TEXT 38310 REM 38315 REM ------- get a function key while displaying date and time ----- 38320 REM 38325 ESCAPE=0:LOCATE ,,0 38330 IN$=INKEY$:IF IN$<>"" THEN 38345 38335 LOCATE 2,3:PRINT "DATE "+DATE$; 38340 LOCATE 2,66:PRINT "TIME "+TIME$;:GOTO 38330 38345 IF F1MSG$<>"" AND IN$=CHR$(0)+CHR$(59) THEN FUNCT=1:GOTO 38405 38350 IF F2MSG$<>"" AND IN$=CHR$(0)+CHR$(60) THEN FUNCT=2:GOTO 38405 38355 IF F3MSG$<>"" AND IN$=CHR$(0)+CHR$(61) THEN FUNCT=3:GOTO 38405 38360 IF F4MSG$<>"" AND IN$=CHR$(0)+CHR$(62) THEN FUNCT=4:GOTO 38405 38365 IF F5MSG$<>"" AND IN$=CHR$(0)+CHR$(63) THEN FUNCT=5:GOTO 38405 38370 IF F6MSG$<>"" AND IN$=CHR$(0)+CHR$(64) THEN FUNCT=6:GOTO 38405 38375 IF F7MSG$<>"" AND IN$=CHR$(0)+CHR$(65) THEN FUNCT=7:GOTO 38405 38380 IF F8MSG$<>"" AND IN$=CHR$(0)+CHR$(66) THEN FUNCT=8:GOTO 38405 38385 IF F9MSG$<>"" AND IN$=CHR$(0)+CHR$(67) THEN FUNCT=9:GOTO 38405 38390 IF F10MSG$<>"" AND IN$=CHR$(0)+CHR$(68) THEN FUNCT=10:GOTO 38405 38395 IF IN$=CHR$(27) THEN ESCAPE=-1:GOTO 38405 38400 BEEP:GOTO 38330 38405 LOCATE 2,3:PRINT " "; 38410 LOCATE 2,66:PRINT " "; 38415 RETURN 38420 REM 38425 REM 38465 REM ******************************************************************** 38470 REM ----------------------- ERASE WORK AREA ---------------------------- 38475 REM nothing needed on entry 38480 REM 38485 REM This subroutine allows you to erase only the "work" area 38490 REM set up in the menu subroutine. 38495 REM 38500 COLOR TEXTFORE,TEXTBACK:LOCATE ,,0 :REM 38500 38505 FOR ROW%=4 TO 18:LOCATE ROW%,2:PRINT SPACE$(78);:NEXT ROW% 38510 RETURN 38515 REM 38565 REM ******************************************************************** 38570 REM ---------------------- ERASE PROMPT AREA --------------------------- 38575 REM nothing needed on entry 38580 REM 38585 REM This subroutine allows you to erase only the "prompt" area 38590 REM set up in the menu subroutine. 38595 REM 38600 COLOR TEXTFORE,TEXTBACK:LOCATE ,,0 :REM 38600 38605 FOR ROW%=20 TO 24:LOCATE ROW%,2:PRINT SPACE$(78);:NEXT ROW% 38610 IF MENUBOX=0 THEN 38630 38615 IF MENUBOX=1 THEN MT=196:MB=196 38620 IF MENUBOX=2 THEN MT=205:MB=205 38625 IF MENUBOX=3 THEN MT=223:MB=220 38630 LOCATE 19,59:PRINT CHR$(MT);:LOCATE 25,59:PRINT CHR$(MB); 38635 RETURN 38640 REM 38645 REM 49795 REM ******************************************************************** 49800 REM --------------------- DISPLAY A BAR GRAPH -------------------------- 49805 REM 49810 REM This subroutine displays a bar graph of up to 78 bars representing 49815 REM values from 0 to 42. The position of the bar graph can be adjusted 49820 REM by selecting where the first bar begins and by the number of spaces 49825 REM (whose length depends on the spacing between bars). Horizontal 49830 REM reference lines can be added along with scale markings for the lines. 49835 REM A vertical scale message can be centered at the left of the graph 49840 REM and a horizontal scale message can be centered at the bottom of the 49845 REM graph area (which also determines the message's maximum length). 49850 REM 49855 REM Bar graphs that have at least one space between bars are drawn with 49860 REM the standard "TEXT" colors and those that have adjacent bars alter- 49865 REM nate between "TEXT" and "DATA" colors for easy viewing of the bars. 49870 REM 49875 REM 49880 REM 49885 REM enter with - BARVALUE(1) through BARVALUE(x), array of bar values 49890 REM value=0 to 42 (greater than 42 will be truncated) 49895 REM (array must be DIMinsioned before using this routine) 49900 REM NUMBARS=number of bars to display 49905 REM BARCOL=1 to 78, leftmost column where bars begin 49910 REM BARSPACE=number of spaces between bars 49915 REM optional - BARID$(1) through BARID$(x), array of identifiers 49920 REM (array must be DIMinsioned before using this routine) 49925 REM optional - VERTMSG$="vertical scale message", up to 23 characters 49930 REM optional - HORIZMSG$="horizontal scale message", length adjusted 49935 REM optional - REFLINE=0,1 0=no grid, 1=horizontal grid 49940 REM optional - REFLINE$(1) through REFLINE$(11), 49945 REM array of vertical scale messages used if REFLINE=1 49950 REM (array must be DIMinsioned before using this routine) 49955 REM optional- BOX=0,1,2,3 - type of box to draw around whole screen 49960 REM 0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid 49965 REM optional - TEXTFORE,TEXTBACK,DATAFORE,DATABACK,FIELDFORE,FIELDBACK 49970 REM colors optionally specified for COLOR statements 49975 REM exit with - BOX=0, REFLINE=0 (to maintain as optional) 49980 REM 49985 REM 49990 REM 49995 REM 50000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 50000 50005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 50010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 50015 COLOR TEXTFORE,TEXTBACK 50020 CLS:LOCATE ,,0 50025 IF BOX=0 THEN 50075 50030 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217 50035 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188 50040 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 50045 ROW=1:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP)); 50050 ROW=25:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT)); 50055 COL=1:FOR ROW=2 TO 24:LOCATE ROW,COL:PRINT CHR$(MS);:NEXT 50060 COL=80:FOR ROW=2 TO 24:LOCATE ROW,COL:PRINT CHR$(MS);:NEXT 50065 LOCATE 1,1:PRINT CHR$(UL);:LOCATE 1,80:PRINT CHR$(UR); 50070 LOCATE 25,1:PRINT CHR$(LL);:LOCATE 25,80:PRINT CHR$(LR); 50075 BOX=0 50080 IF BARCOL=0 THEN BARCOL=3 50085 IF NUMBARS=0 THEN NUMBARS=1 50090 FIRSTCOL=BARCOL 50095 REM ----- FIND LAST COLUMN IN WHICH A BAR WILL BE DRAWN ----- 50100 LASTCOL=FIRSTCOL+(NUMBARS*(BARSPACE+1))-BARSPACE-1 50105 IF LASTCOL>78 THEN LASTCOL=LASTCOL-BARSPACE-1:GOTO 50105 50110 REM 50115 REM ----- D0 VERTICAL SCALE MESSAGES AND LINES IF SELECTED ----- 50120 IF REFLINE=0 THEN 50235 50125 REM ---------- PRINT MESSAGES ---------- 50130 FOR BARLOOP=1 TO 11 50135 LOCATE 23-(BARLOOP*2)+1,FIRSTCOL 50140 PRINT REFLINE$(BARLOOP); 50145 NEXT BARLOOP 50150 REM ----- FIND MAXIMUM LENGTH OF SCALE MESSAGES ----- 50155 MAXLEN=0 50160 FOR BARLOOP=1 TO 11 50165 L=LEN(REFLINE$(BARLOOP)) 50170 IF L>MAXLEN THEN MAXLEN=L 50175 NEXT BARLOOP 50180 REM ----- ADJUST COLUMNS FOR SCALE MESSAGES ----- 50185 FIRSTCOL=FIRSTCOL+MAXLEN+1:IF FIRSTCOL>78 THEN FIRSTCOL=78 50190 LASTCOL=LASTCOL+MAXLEN+1 50195 IF LASTCOL>78 THEN LASTCOL=LASTCOL-BARSPACE-1:GOTO 50195 50200 REM ---------- DRAW REFERENCE LINES ---------- 50205 COLOR DATAFORE,DATABACK 50210 FOR ROW=2 TO 22 50215 LOCATE ROW,FIRSTCOL 50220 PRINT STRING$(LASTCOL-FIRSTCOL+1,95):REM underscore 50225 NEXT ROW 50230 REM ---------- DRAW BARS ---------- 50235 BARCOL=FIRSTCOL 50240 FOR BARLOOP=1 TO NUMBARS 50245 BARVALUE=BARVALUE(BARLOOP) 50250 BARID$=BARID$(BARLOOP) 50255 IF BARSPACE<>0 THEN 50270 50260 IF BARLOOP MOD 2=1 THEN 50270 50265 BARFORE=DATAFORE:BARBACK=DATABACK:GOTO 50275 50270 BARFORE=TEXTFORE:BARBACK=DATABACK 50275 GOSUB 51000 :REM SUBROUTINE USED HERE 50280 BARCOL=BARCOL+BARSPACE+1 50285 IF BARCOL>78 THEN 50300 50290 NEXT BARLOOP 50295 REM ----- 50300 COLOR DATAFORE,DATABACK 50305 REM ----- PRINT VERTICAL SCALE MESSAGE ----- 50310 IF LEN(VERTMSG$)>23 THEN VERTMSG$=LEFT$(VERTMSG$,23) 50315 ROW=13-INT(LEN(VERTMSG$)/2) 50320 FOR BARLOOP=1 TO LEN(VERTMSG$) 50325 LOCATE ROW,3 50330 PRINT MID$(VERTMSG$,BARLOOP,1); 50335 ROW=ROW+1 50340 NEXT BARLOOP 50345 REM ----- PRINT HORIZONTAL SCALE MESSAGE ----- 50350 BARWIDTH=LASTCOL-FIRSTCOL+1 50355 IF LEN(HORIZMSG$)>BARWIDTH THEN HORIZMSG$=LEFT$(HORIZMSG$,BARWIDTH) 50360 COL=FIRSTCOL+INT(BARWIDTH/2)-INT(LEN(HORIZMSG$)/2)-1 50365 LOCATE 24,COL:PRINT HORIZMSG$; 50370 REM ----- 50375 COLOR TEXTFORE,TEXTBACK 50380 BOX=0:REFLINE=0 50385 RETURN 50390 REM 50925 REM ********************************************************************* 50930 REM ---------------- DRAW 1 BAR FOR USE IN A BAR GRAPH ------------------ 50935 REM 50940 REM This subroutine allows you to draw a single bar representing a 50945 REM value from 0 to 42. The base of the bar will start at the column 50950 REM of your choice and be draw upward from row 22. Row 23 will be 50955 REM where the ID is displayed, centered on the column. 50960 REM 50965 REM enter with - BARVALUE=0 to 42 (greater than 42 will be truncated) 50970 REM BARID$="bar ID", identification at bottom of bar 50975 REM BARCOL=column in which to draw bar 50980 REM optional - BARFORE,BARBACK 50985 REM colors optionally specified for COLOR statements 50990 REM 50995 REM 51000 IF BARFORE=0 AND BARBACK=0 THEN BARFORE=7 :REM 51000 51005 COLOR BARFORE,BARBACK 51010 COL=BARCOL-INT((LEN(BARID$)-.5)/2):IF COL<1 THEN COL=1 51015 LOCATE 23,COL:PRINT BARID$; 51020 ROW=22 51025 IF BARVALUE>42 THEN BARVALUE=42 51030 IF BARCOL>80 THEN 51060 51035 FOR A=1 TO (INT(BARVALUE/2)) 51040 LOCATE ROW,BARCOL:PRINT CHR$(219); 51045 ROW=ROW-1 51050 NEXT A 51055 IF (BARVALUE MOD 2)=1 THEN LOCATE ROW,BARCOL:PRINT CHR$(220); 51060 RETURN 51065 REM 59850 REM ******************************************************************** 59855 REM -------------------- CREATE LARGE CHARACTERS ----------------------- 59860 REM 59865 REM This routine is the first part of a 2 routine process that allows 59870 REM you create and then display messages with characters that are 4 59875 REM times the regular size. The screen can display up to 5 lines of 10 59880 REM characters each of this size. The process is divided into 2 routines 59885 REM so that messages with the large characters can be formed with the 59890 REM first routine during initialization of a program, when time is less 59895 REM of a concern, and then the messages can be displayed multiple times 59900 REM throughout the program without having to take the time to re-form 59905 REM the characters. If more than 5 large messages are needed and it is 59910 REM necessary to call this routine again, only those messages ( MSG$(1) 59915 REM to MSG$(5) ) that contain something will be formed and the others 59920 REM will be left alone. Since the process of forming large characters is 59925 REM time consuming, optional initialization messages can be displayed 59930 REM in the middle of the screen during the formation process. The screen 59935 REM is then restored after the formation process. 59940 REM 59945 REM enter with - BIGMSG$(1),BIGMSG$(2),BIGMSG$(3),BIGMSG$(4),BIGMSG$(5), 59950 REM array of messages to create, up to 10 characters each 59955 REM (Array must be DIMinsioned before calling this routine) 59960 REM optional - INITMSG=0,1 0=no messages, 1=messages 59965 REM exit with - BIG$(1) to BIG$(20) array filled with info needed to 59970 REM display large characters with the following routine. 59975 REM (Array must be DIMinsioned before calling this routine) 59980 REM BIGMSG$(1) to BIGMSG$(5) all ="" (NUL) to keep these 59985 REM messages optional if routine is used again. 59990 REM INITMSG=0 (to retain as optional for next time) 59995 REM 60000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 60000 60005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 60010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 60015 REM ----- SAVE SCREEN WHERE INIT MESSAGES ARE DISPLAYED ----- 60020 IF INITMSG=0 THEN 60070 60025 DIM BIGSSCHR(23):DIM BIGSSCOLOR(23,2) 60030 C=1:FOR COL=29 TO 51 60035 BIGSSCHR(C)=SCREEN(10,COL) 60040 A=SCREEN(10,COL,1):BIGSSCOLOR(C,1)=(A AND 15) 60045 IF (A AND 128)=128 THEN BIGSSCOLOR(C,1)=BIGSSCOLOR(C,1)+16 60050 BIGSSCOLOR(C,2)=(A AND 112)/16 60055 C=C+1:NEXT COL 60060 LOCATE 10,29,0:COLOR FIELDFORE,FIELDBACK:PRINT " INITIALIZING ... "; 60065 REM ------------------------------------------------------------------- 60070 RESTORE 60400 :REM POINT TO CHARACTER FONTS 60075 DIM FONT(96,8) 60080 FOR A=0 TO 95 60085 FOR B=0 TO 7 60090 READ F:FONT(A,B)=F 60095 NEXT B 60100 NEXT A 60105 REM ----- FORM CHARACTERS AND MESSAGES ----- 60110 FOR MSGLOOP=1 TO 5 60115 MSG$=BIGMSG$(MSGLOOP) 60120 IF MSG$="" THEN 60235 60125 REM --------------------------------------------- 60130 IF INITMSG=0 THEN 60150 60135 LOCATE 10,29,0:COLOR FIELDFORE,FIELDBACK 60140 PRINT " FORMING MESSAGE";STR$(MSGLOOP);" ..."; 60145 REM --------------------------------------------- 60150 IF LEN(MSG$)>10 THEN MSG$=LEFT$(MSG$,10) 60155 FOR CHARLOOP=1 TO LEN(MSG$) 60160 CHAR$=MID$(MSG$,CHARLOOP,1):CHARNUM=ASC(CHAR$)-32 60165 FOR BIGROW=0 TO 6 STEP 2 60170 MASK=128 :REM (for mask=128 to 1 step /2) 60175 F=FONT(CHARNUM,BIGROW) 60180 IF (F AND MASK)=MASK THEN UPPER=-1 ELSE UPPER=0 60185 F=FONT(CHARNUM,BIGROW+1) 60190 IF (F AND MASK)=MASK THEN LOWER=-1 ELSE LOWER=0 60195 IF UPPER AND LOWER THEN PIX=219:GOTO 60215 60200 IF UPPER AND NOT LOWER THEN PIX=223:GOTO 60215 60205 IF NOT UPPER AND LOWER THEN PIX=220:GOTO 60215 60210 IF NOT UPPER AND NOT LOWER THEN PIX=32 60215 B=(BIGROW/2)+1+((MSGLOOP-1)*4):BIG$(B)=BIG$(B)+CHR$(PIX) 60220 MASK=MASK/2:IF MASK<> .5 THEN 60175 :REM (next mask) (of 8) 60225 NEXT BIGROW :REM (of 4) 60230 NEXT CHARLOOP :REM (of up to 10) 60235 NEXT MSGLOOP :REM (of up to 5) 60240 BIGMSG$(1)="":BIGMSG$(2)="":BIGMSG$(3)="":BIGMSG$(4)="":BIGMSG$(5)="" 60245 ERASE FONT 60250 REM ----- RESTORE SCREEN ----- 60255 IF INITMSG=0 THEN 60285 60260 C=1:FOR COL=29 TO 51 60265 COLOR BIGSSCOLOR(C,1),BIGSSCOLOR(C,2) 60270 LOCATE 10,COL:PRINT CHR$(BIGSSCHR(C)); 60275 C=C+1:NEXT COL 60280 ERASE BIGSSCHR:ERASE BIGSSCOLOR 60285 RETURN 60290 REM 60295 REM 60300 REM 60365 REM ------------------------- CHARACTER FONTS -------------------------- 60370 REM 60375 REM These are the character fonts used by the large character routine. 60380 REM They start at 32 decimal or 20 hexidecimal which is a "space" and 60385 REM go to 127 decimal or 7F hexidecimal. They include the alphanumeric 60390 REM characters, punctuation, and some other characters. 60395 REM 60400 DATA &H00,&H00,&H00,&H00,&H00,&H00,&H00,&H0 60405 DATA &H30,&H78,&H78,&H30,&H30,&H00,&H30,&H0 60410 DATA &H6C,&H6C,&H6C,&H00,&H00,&H00,&H00,&H0 60415 DATA &H6C,&H6C,&HFE,&H6C,&HFE,&H6C,&H6C,&H0 60420 DATA &H30,&H7C,&HC0,&H78,&H0C,&HF8,&H30,&H0 60425 DATA &H00,&HC6,&HCC,&H18,&H30,&H66,&HC6,&H0 60430 DATA &H38,&H6C,&H38,&H76,&HDC,&HCC,&H76,&H0 60435 DATA &H60,&H60,&HC0,&H00,&H00,&H00,&H00,&H0 60440 DATA &H18,&H30,&H60,&H60,&H60,&H30,&H18,&H0 60445 DATA &H60,&H30,&H18,&H18,&H18,&H30,&H60,&H0 60450 DATA &H00,&H66,&H3C,&HFF,&H3C,&H66,&H00,&H0 60455 DATA &H00,&H30,&H30,&HFC,&H30,&H30,&H00,&H0 60460 DATA &H00,&H00,&H00,&H00,&H00,&H30,&H30,&H60 60465 DATA &H00,&H00,&H00,&HFC,&H00,&H00,&H00,&H0 60470 DATA &H00,&H00,&H00,&H00,&H00,&H30,&H30,&H0 60475 DATA &H06,&H0C,&H18,&H30,&H60,&HC0,&H80,&H0 60480 DATA &H7C,&HC6,&HCE,&HDE,&HF6,&HE6,&H7C,&H0 60485 DATA &H30,&H70,&H30,&H30,&H30,&H30,&HFC,&H0 60490 DATA &H78,&HCC,&H0C,&H38,&H60,&HCC,&HFC,&H0 60495 DATA &H78,&HCC,&H0C,&H38,&H0C,&HCC,&H78,&H0 60500 DATA &H1C,&H3C,&H6C,&HCC,&HFE,&H0C,&H1E,&H0 60505 DATA &HFC,&HC0,&HF8,&H0C,&H0C,&HCC,&H78,&H0 60510 DATA &H38,&H60,&HC0,&HF8,&HCC,&HCC,&H78,&H0 60515 DATA &HFC,&HCC,&H0C,&H18,&H30,&H30,&H30,&H0 60520 DATA &H78,&HCC,&HCC,&H78,&HCC,&HCC,&H78,&H0 60525 DATA &H78,&HCC,&HCC,&H7C,&H0C,&H18,&H70,&H0 60530 DATA &H00,&H30,&H30,&H00,&H00,&H30,&H30,&H0 60535 DATA &H00,&H30,&H30,&H00,&H00,&H30,&H30,&H60 60540 DATA &H18,&H30,&H60,&HC0,&H60,&H30,&H18,&H0 60545 DATA &H00,&H00,&HFC,&H00,&H00,&HFC,&H00,&H0 60550 DATA &H60,&H30,&H18,&H0C,&H18,&H30,&H60,&H0 60555 DATA &H78,&HCC,&H0C,&H18,&H30,&H00,&H30,&H0 60560 DATA &H7C,&HC6,&HDE,&HDE,&HDE,&HC0,&H78,&H0 60565 DATA &H30,&H78,&HCC,&HCC,&HFC,&HCC,&HCC,&H0 60570 DATA &HFC,&H66,&H66,&H7C,&H66,&H66,&HFC,&H0 60575 DATA &H3C,&H66,&HC0,&HC0,&HC0,&H66,&H3C,&H0 60580 DATA &HF8,&H6C,&H66,&H66,&H66,&H6C,&HF8,&H0 60585 DATA &HFE,&H62,&H68,&H78,&H68,&H62,&HFE,&H0 60590 DATA &HFE,&H62,&H68,&H78,&H68,&H60,&HF0,&H0 60595 DATA &H3C,&H66,&HC0,&HC0,&HCE,&H66,&H3E,&H0 60600 DATA &HCC,&HCC,&HCC,&HFC,&HCC,&HCC,&HCC,&H0 60605 DATA &H78,&H30,&H30,&H30,&H30,&H30,&H78,&H0 60610 DATA &H1E,&H0C,&H0C,&H0C,&HCC,&HCC,&H78,&H0 60615 DATA &HE6,&H66,&H6C,&H78,&H6C,&H66,&HE6,&H0 60620 DATA &HF0,&H60,&H60,&H60,&H62,&H66,&HFE,&H0 60625 DATA &HC6,&HEE,&HFE,&HFE,&HD6,&HC6,&HC6,&H0 60630 DATA &HC6,&HE6,&HF6,&HDE,&HCE,&HC6,&HC6,&H0 60635 DATA &H38,&H6C,&HC6,&HC6,&HC6,&H6C,&H38,&H0 60640 DATA &HFC,&H66,&H66,&H7C,&H60,&H60,&HF0,&H0 60645 DATA &H78,&HCC,&HCC,&HCC,&HDC,&H78,&H1C,&H0 60650 DATA &HFC,&H66,&H66,&H7C,&H6C,&H66,&HE6,&H0 60655 DATA &H78,&HCC,&HE0,&H70,&H1C,&HCC,&H78,&H0 60660 DATA &HFC,&HB4,&H30,&H30,&H30,&H30,&H78,&H0 60665 DATA &HCC,&HCC,&HCC,&HCC,&HCC,&HCC,&HFC,&H0 60670 DATA &HCC,&HCC,&HCC,&HCC,&HCC,&H78,&H48,&H0 60675 DATA &HC6,&HC6,&HC6,&HD6,&HFE,&HEE,&HC6,&H0 60680 DATA &HC6,&HC6,&H6C,&H38,&H38,&H6C,&HC6,&H0 60685 DATA &HCC,&HCC,&HCC,&H78,&H30,&H30,&H78,&H0 60690 DATA &HFE,&HC6,&H8C,&H18,&H32,&H66,&HFE,&H0 60695 DATA &H78,&H60,&H60,&H60,&H60,&H60,&H78,&H0 60700 DATA &HC0,&H60,&H30,&H18,&H0C,&H06,&H02,&H0 60705 DATA &H78,&H18,&H18,&H18,&H18,&H18,&H78,&H0 60710 DATA &H10,&H38,&H6C,&HC6,&H00,&H00,&H00,&H0 60715 DATA &H00,&H00,&H00,&H00,&H00,&H00,&H00,&HFF 60720 DATA &H30,&H30,&H18,&H00,&H00,&H00,&H00,&H0 60725 DATA &H00,&H00,&H78,&H0C,&H7C,&HCC,&H76,&H0 60730 DATA &HE0,&H60,&H60,&H7C,&H66,&H66,&HDC,&H0 60735 DATA &H00,&H00,&H78,&HCC,&HC0,&HCC,&H78,&H0 60740 DATA &H1C,&H0C,&H0C,&H7C,&HCC,&HCC,&H76,&H0 60745 DATA &H00,&H00,&H78,&HCC,&HFC,&HC0,&H78,&H0 60750 DATA &H38,&H6C,&H60,&HF0,&H60,&H60,&HF0,&H0 60755 DATA &H00,&H00,&H76,&HCC,&HCC,&H7C,&HC,&HF8 60760 DATA &HE0,&H60,&H6C,&H76,&H66,&H66,&HE6,&H0 60765 DATA &H30,&H00,&H70,&H30,&H30,&H30,&H78,&H0 60770 DATA &H0C,&H00,&H0C,&H0C,&H0C,&HCC,&HCC,&H78 60775 DATA &HE0,&H60,&H66,&H6C,&H78,&H6C,&HE6,&H0 60780 DATA &H70,&H30,&H30,&H30,&H30,&H30,&H78,&H0 60785 DATA &H00,&H00,&HCC,&HFE,&HFE,&HD6,&HC6,&H0 60790 DATA &H00,&H00,&HF8,&HCC,&HCC,&HCC,&HCC,&H0 60795 DATA &H00,&H00,&H78,&HCC,&HCC,&HCC,&H78,&H0 60800 DATA &H00,&H00,&HDC,&H66,&H66,&H7C,&H60,&HF0 60805 DATA &H00,&H00,&H76,&HCC,&HCC,&H7C,&H0C,&H1E 60810 DATA &H00,&H00,&HDC,&H76,&H66,&H60,&HF0,&H0 60815 DATA &H00,&H00,&H7C,&HC0,&H78,&H0C,&HF8,&H0 60820 DATA &H10,&H30,&H7C,&H30,&H30,&H34,&H18,&H0 60825 DATA &H00,&H00,&HCC,&HCC,&HCC,&HCC,&H76,&H0 60830 DATA &H00,&H00,&HCC,&HCC,&HCC,&H78,&H30,&H0 60835 DATA &H00,&H00,&HC6,&HD6,&HFE,&HFE,&H6C,&H0 60840 DATA &H00,&H00,&HC6,&H6C,&H38,&H6C,&HC6,&H0 60845 DATA &H00,&H00,&HCC,&HCC,&HCC,&H7C,&H0C,&HF8 60850 DATA &H00,&H00,&HFC,&H98,&H30,&H64,&HFC,&H0 60855 DATA &H1C,&H30,&H30,&HE0,&H30,&H30,&H1C,&H0 60860 DATA &H18,&H18,&H18,&H00,&H18,&H18,&H18,&H0 60865 DATA &HE0,&H30,&H30,&H1C,&H30,&H30,&HE0,&H0 60870 DATA &H76,&HDC,&H00,&H00,&H00,&H00,&H00,&H0 60875 DATA &H00,&H10,&H38,&H6C,&HC6,&HC6,&HFE,&H0 60880 REM 60890 REM 60930 REM ******************************************************************** 60935 REM -------------- DISPLAY MESSAGES WITH LARGE CHARACTERS -------------- 60940 REM 60945 REM This routine is the second part of the 2 routine process that 60950 REM allows you create and then display messages with large characters. 60955 REM 60960 REM 60965 REM enter with - BIGMSG=1 to 5, which message to display 60970 REM ROW and COL=row and column at which to start displaying 60975 REM the upper left corner of the message 60980 REM optional - TEXTFORE,TEXTBACK,DATAFORE,DATABACK,FIELDFORE,FIELDBACK 60985 REM colors optionally specified for COLOR statements 60990 REM 60995 REM 61000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 61000 61005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 61010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 61015 LOCATE ROW,COL:PRINT BIG$((BIGMSG-1)*4+1); 61020 LOCATE ROW+1,COL:PRINT BIG$((BIGMSG-1)*4+2); 61025 LOCATE ROW+2,COL:PRINT BIG$((BIGMSG-1)*4+3); 61030 LOCATE ROW+3,COL:PRINT BIG$((BIGMSG-1)*4+4); 61035 RETURN 61040 REM 61960 REM ******************************************************************** 61970 REM 61975 REM This routine finds the type of video monitor hardware installed. 61980 REM It requires that the assembly language interface be installed. 61985 REM 61990 REM exit with - MONITOR$="MONO","HERC","CGA","EGA",or"VGA", monitor used 61995 REM 62000 DEF SEG=0:STATUS=PEEK(&H463):DEF SEG 62005 IF STATUS<>&HB4 THEN 62040 62010 STATUS=(INP(&H3BA) AND &H80) 62015 FOR DELAYLOOP=1 TO 30000 62020 IF (INP(&H3BA) AND &H80)<>STATUS THEN MONITOR$="HERC":RETURN 62025 NEXT DELAYLOOP 62030 MONITOR$="MONO":RETURN 62035 REM ----- 62040 REGAX%=&H1A00 62045 INTERRUPT%=&H10:GOSUB 65000:REM CALL ASM 62050 IF (REGAX% AND &HFF)=&H1A THEN MONITOR$="VGA":RETURN 62055 REM ----- 62060 REGAX%=&H1200:REGBX%=&H10 62065 INTERRUPT%=&H10:GOSUB 65000:REM CALL ASM 62070 IF (REGBX% AND &HFF)=&H10 THEN MONITOR$="CGA":RETURN 62075 REM ----- 62080 MONITOR$="EGA":RETURN 62085 REM 62110 REM ******************************************************************** 62115 REM ------------------------- MOUSE ROUTINES --------------------------- 62120 REM 62125 REM The following routines provide access to some mouse function calls. 62130 REM They require that the assembly language interface be installed. 62135 REM 62140 REM 62145 REM 62150 REM 62155 REM 63000 hardware reset and status 62160 REM 63100 show cursor 62165 REM 63200 hide cursor 62170 REM 63300 get button status and mouse position 62175 REM 63400 set cursor position 62180 REM 63500 get button press info 62185 REM 63600 get button release info 62190 REM 63700 set cursor limits 62195 REM 63800 set graphics cursor 62200 REM 62205 REM 64000 set text cursor 62210 REM 64100 read motion counters 62215 REM 64200 62220 REM 64300 62225 REM 64400 62230 REM 64500 62235 REM 64600 set sensitivity and double speed 62240 REM 64700 62245 REM 64800 62250 REM 64900 get driver version, type, IRQ 62255 REM 62260 REM 62265 REM 62270 REM ******************************************************************** 62275 REM ------------------- MOUSE - RESET AND STATUS ----------------------- 62280 REM 62285 REM exit with - STATUS = -1 if mouse found and reset, otherwise 0 62290 REM BUTTONS = number of buttons 62295 REM 63000 REGAX%=0:REGBX%=0:REGCX%=0:REGDX%=0 63005 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM 63010 STATUS=REGAX%:BUTTONS=REGBX% 63015 RETURN 63020 REM 63085 REM ******************************************************************** 63090 REM ------------------- MOUSE - SHOW CURSOR ---------------------------- 63095 REM 63100 REGAX%=1:INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM 63105 RETURN 63110 REM 63185 REM ******************************************************************** 63190 REM ------------------- MOUSE - HIDE CURSOR ---------------------------- 63195 REM 63200 REGAX%=2:INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM 63205 RETURN 63210 REM 63270 REM ******************************************************************** 63275 REM ---------- MOUSE - GET CURSOR POSITION AND BUTTON STATUS ----------- 63280 REM 63285 REM exit with - X and Y = cursor coordinates 63290 REM LEFT, RIGHT, or BOTH = true for buttons pressed 63295 REM 63300 REGAX%=3 63305 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM 63310 X=REGCX%:Y=REGDX% 63315 REM ----- 63320 LEFT=0:RIGHT=0:BOTH=0 63325 IF (REGBX% AND 7)=0 THEN RETURN 63330 T=TIMER 63335 IF TIMER32767 THEN BINVALUE=BINVALUE-65536! 63845 MOUSECURSOR%(CURSLOOP%)=BINVALUE 63850 NEXT CURSLOOP% 63855 REM 63860 REGAX%=9:REM SET GRAPHICS CURSOR 63865 REGBX%=8:REM HORIZONTAL HOT SPOT 63870 REGCX%=7:REM VERTICAL HOT SPOT 63875 REGDX%=VARPTR(MOUSECURSOR%(1)) :REM VERSION 6.25 AND LATER 63880 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM 63885 RETURN 63890 REM 63895 REM ----- SCREEN MASK 63900 DATA "1111111111111111" 63901 DATA "1111111000111111" 63902 DATA "1111111010111111" 63903 DATA "1111111010111111" 63904 DATA "1111111010111111" 63905 DATA "1111111010111111" 63906 DATA "1000000111000000" 63907 DATA "1011111111111110" 63908 DATA "1000000111000000" 63909 DATA "1111111010111111" 63910 DATA "1111111010111111" 63911 DATA "1111111010111111" 63912 DATA "1111111010111111" 63913 DATA "1111111000111111" 63914 DATA "1111111111111111" 63915 DATA "1111111111111111" 63916 REM ----- CURSOR MASK 63917 DATA "0000000000000000" 63918 DATA "0000000111000000" 63919 DATA "0000000101000000" 63920 DATA "0000000101000000" 63921 DATA "0000000101000000" 63922 DATA "0000000101000000" 63923 DATA "0111111000111111" 63924 DATA "0100000000000001" 63925 DATA "0111111000111111" 63926 DATA "0000000101000000" 63927 DATA "0000000101000000" 63928 DATA "0000000101000000" 63929 DATA "0000000101000000" 63930 DATA "0000000111000000" 63931 DATA "0000000000000000" 63932 DATA "0000000000000000" 63933 REM 63935 REM 63985 REM ******************************************************************** 63990 REM ------------------- MOUSE - SET SOFTWARE TEXT CURSOR --------------- 63995 REM 64000 REGAX%=10:REM SET TEXT CURSOR 64005 REGBX%=0:REM SOFTWARE TEXT CURSOR 64010 REGCX%=&H77FF :REM TRY &HFFFF 64015 REGDX%=&H7700 64020 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM 64025 RETURN 64030 REM 64035 REM 64075 REM ******************************************************************** 64080 REM ------------------- MOUSE - READ MOTION COUNTERS ------------------- 64085 REM 64090 REM exit with - XMICKEY, YMICKEY, mickey counts since last called 64095 REM 64100 REGAX%=11 64105 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM 64110 XMICKEY=REGCX%:YMICKEY=REGDX% 64115 RETURN 64120 REM 64125 REM 64565 REM ******************************************************************** 64570 REM ------------------- MOUSE - SET SENSITIVITY ------------------------ 64575 REM 64580 REM enter with - XSENS, YSENS = 1 to 100, horiz. and vert. sensitivity 64585 REM THRESHOLD = 0 to 100, threshold for double speed 64590 REM 64595 REM 64600 REGAX%=26:REGBX%=XSENS:REGCX%=YSENS:REGDX%=THRESHOLD 64605 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM 64610 RETURN 64615 REM 64620 REM 64865 REM ******************************************************************** 64870 REM ------------------- MOUSE - GET VERSION, TYPE, IRQ ----------------- 64875 REM 64880 REM exit with - VERSION = mouse driver version number 64885 REM MOUSETYPE = type of mouse 64890 REM IRQ = interrupt request 64895 REM 64900 REGAX%=36 64905 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM 64910 VERSION=VAL(HEX$(INT(REGBX%/256))+"."+HEX$(REGBX% MOD 256)) 64915 MOUSETYPE=INT(REGCX%/256):IRQ=REGCX% MOD 256 64920 RETURN 64925 REM 64930 REM ******************************************************************** 64935 REM ----------- SET UP AND CALL ASSEMBLY LANGUAGE SUBROUTINE ----------- 64940 REM 64945 REM This routine sets up and calls a previously loaded general purpose 64950 REM assembly language subroutine to access DOS and other interrupts. 64955 REM Knowledge of how to call these interrupts is required. Interrupts 64960 REM that use only registers AX,BX,CX,DX are the only ones supported. 64965 REM 64970 REM enter with - REGAX%,REGBX%,REGCX%,REGDX% 64975 REM (registers required for calling the interrupt) 64980 REM INTERRUPT%, the interrupt to call 64985 REM exit with - REGAX%,REGBX%,REGCX%,REGDX% 64990 REM (registers after returning from the interrupt) 64995 REM 65000 DEF SEG=&H4B :REM POINT TO SEGMENT 65005 POKE 33,INTERRUPT% :REM FILL IN THE INTERRUPT TO CALL 65010 POKE 4,INT(REGAX%/256):POKE 3,REGAX% MOD 256 :REM FILL IN THE REGISTERS 65015 POKE 6,INT(REGBX%/256):POKE 5,REGBX% MOD 256 65020 POKE 8,INT(REGCX%/256):POKE 7,REGCX% MOD 256 65025 POKE 10,INT(REGDX%/256):POKE 9,REGDX% MOD 256 65030 ASMSUB=0:CALL ASMSUB :REM USE THIS LINE FOR THE INTERPRETER 65035 REM CALL ABSOLUTE(0) :REM USE THIS LINE FOR THE COMPILER 65040 REGAX=(PEEK(4)*256)+PEEK(3):IF REGAX>32767 THEN REGAX=REGAX-65536! 65045 REGAX%=REGAX 65050 REGBX=(PEEK(6)*256)+PEEK(5):IF REGBX>32767 THEN REGBX=REGBX-65536! 65055 REGBX%=REGBX 65060 REGCX=(PEEK(8)*256)+PEEK(7):IF REGCX>32767 THEN REGCX=REGCX-65536! 65065 REGCX%=REGCX 65070 REGDX=(PEEK(10)*256)+PEEK(9):IF REGDX>32767 THEN REGDX=REGDX-65536! 65075 REGDX%=REGDX 65080 DEF SEG:RETURN :REM RETURN TO BASIC SEGMENT 65085 REM 65090 REM 65095 REM ******************************************************************** 65100 REM ---------------- LOAD ASSEMBLY LANGUAGE SUBROUTINE ----------------- 65105 REM 65110 REM This routine loads the following general purpose assembly language 65115 REM subroutine to access DOS and other interrupts. It is loaded into 65120 REM the area just below the DOS inter-program communication area. 65125 REM 65130 REM ASSUME CS:CODE 65135 REM JMP HERE 65140 REM 65145 REM WORKA DW 0 ;STORAGE FOR REGISTERS- 65150 REM WORKB DW 0 ;BASIC WRITES THESE, 65155 REM WORKC DW 0 ;THEN THE INTERRUPT% HAPPENS, 65160 REM WORKD DW 0 ;THEN BASIC READS THESE 65165 REM 65170 REM HERE: MOV AX,WORKA ;GET PARM 1 FROM BASIC 65175 REM MOV BX,WORKB ;GET PARM 2 FROM BASIC 65180 REM MOV CX,WORKC ;GET PARM 3 FROM BASIC 65185 REM MOV DX,WORKD ;GET PARM 4 FROM BASIC 65190 REM PUSH DS ;MAKE ES THE SAME AS DS 65195 REM POP ES 65200 REM INT 21H ;DOS (or other) INTERRUPT 65205 REM MOV WORKA,AX ;SEND PARM 1 TO BASIC 65210 REM MOV WORKB,BX ;SEND PARM 2 TO BASIC 65215 REM MOV WORKC,CX ;SEND PARM 3 TO BASIC 65220 REM MOV WORKD,DX ;SEND PARM 4 TO BASIC 65225 REM DB 0CBH ;ASSEMBLER REJECTS "RETF" 65230 REM 65235 REM CODE ENDS 65240 REM END 65245 REM 65250 DEF SEG=&H4B:RESTORE 65270 65255 FOR I=0 TO 53:READ B:POKE I,B:NEXT I 65260 DEF SEG:RETURN 65265 REM ----- 65270 DATA &HEB,&H09,&H90 65275 DATA &H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00 :REM REGISTERS AX-DX 65280 DATA &H2E,&HA1,&H03,&H00 65285 DATA &H2E,&H8B,&H1E,&H05,&H00 65290 DATA &H2E,&H8B,&H0E,&H07,&H00 65295 DATA &H2E,&H8B,&H16,&H09,&H00 65300 DATA &H1E,&H07 65305 DATA &HCD,&H21 :REM INTERRUPT% XX 65310 DATA &H2E,&HA3,&H03,&H00 65315 DATA &H2E,&H89,&H1E,&H5,&H0 65320 DATA &H2E,&H89,&H0E,&H07,&H00 65325 DATA &H2E,&H89,&H16,&H09,&H00 65330 DATA &HCB :REM RETF 65335 REM 65340 REM ----------------------- END OF ROUTINES.BAS ------------------------