100 REM ********************************************************************** 110 REM FILE NAME - SCP.BAS 120 REM 130 REM WRITTEN BY - GARY PEEK 140 REM 3201 HIGHGATE 150 REM ST. CHARLES, MO. 63301 160 REM 314 946-5272 170 REM 180 REM LAST UPDATE - change below! 190 REM 200 REM ********************************************************************** 210 KEY OFF:FOR A=1 TO 10:KEY A,"":NEXT 220 ON ERROR GOTO 280 230 OPEN "SCP.CNF" FOR INPUT AS 1 240 INPUT #1,DUMMY$,PORT$,BAUD$,DATABITS$,STOPBITS$,PARITY$,MENU$ 250 CLOSE #1 260 ON ERROR GOTO 0 270 GOTO 320 280 RESUME 290 290 PORT$="COM1":BAUD$="9600":DATABITS$="8":STOPBITS$="1" 300 PARITY$="N":MENU$="WAIT" 310 ON ERROR GOTO 0 320 REM ----- CONSTANTS 330 CAPTURE=0:DISP=0:MENU=-1:NODISP=0:FILE$="SCP.CAP" 340 PROW=7:PCOL=5:BROW=7:BCOL=30:DBROW=7:DBCOL=42 350 SBROW=7:SBCOL=53:PARROW=7:PARCOL=64 360 TEXTFORE=7:TEXTBACK=0:DATAFORE=15:DATABACK=0:FIELDFORE=0:FIELDBACK=7 370 DIM ITEM$(9) 380 DIM SENDHEX$(18):DIM SENDHEX(18) 390 DIM SENDDEC$(12):DIM SENDDEC(12) 400 FOR A=1 TO 18:SENDHEX$(A)="":NEXT A 410 FOR A=1 TO 12:SENDDEC$(A)="":NEXT A 420 REM 430 IF MENU$="NOWAIT" THEN GOTO 5000 490 REM ---------------------- CHANGE PARAMETERS ----------------------------- 1000 VIEW PRINT:CLS:BOX=2:GOSUB 9000 1020 MSG$="SCP - Serial Communication Program 10/12/2000":ROW=3:BOX=0:GOSUB 9300 1030 MSG$="Terminal emulation plus data monitoring and capture":ROW=5:BOX=0:GOSUB 9300 1040 MSG$=CHR$(27)+" and "+CHR$(26)+" Change Parameter ESC Exit Program " 1050 ROW=21:GOSUB 9300 1060 MSG$=CHR$(24)+" and "+CHR$(25)+" Change Setting F10 Communication mode " 1070 ROW=22:GOSUB 9300 1080 MSG$="These parameters will be saved in SCP.CNF when exiting program" 1090 ROW=24:GOSUB 9300 1100 REM 1110 REM -------------------- DISPLAY PARAMETERS 1200 MSG$="Port and Function" 1210 ITEM$(1)="Terminal on COM1" 1220 ITEM$(2)="Terminal on COM2" 1230 ITEM$(3)="Monitor both ports" 1240 IF PORT$="COM1" THEN ITEM=1 1250 IF PORT$="COM2" THEN ITEM=2 1260 IF PORT$="BOTH" THEN ITEM=3 1270 ROW=PROW:COL=PCOL:BOX=2:TYP=3 1280 GOSUB 30000 1290 REM ----- 1300 MSG$="Baud" 1310 ITEM$(1)="110" 1320 ITEM$(2)="150" 1330 ITEM$(3)="300" 1340 ITEM$(4)="600" 1350 ITEM$(5)="1200" 1360 ITEM$(6)="2400" 1370 ITEM$(7)="4800" 1380 ITEM$(8)="9600" 1390 ITEM$(9)="19200" 1400 IF BAUD$="110" THEN ITEM=1 1410 IF BAUD$="150" THEN ITEM=2 1420 IF BAUD$="300" THEN ITEM=3 1430 IF BAUD$="600" THEN ITEM=4 1440 IF BAUD$="1200" THEN ITEM=5 1450 IF BAUD$="2400" THEN ITEM=6 1460 IF BAUD$="4800" THEN ITEM=7 1470 IF BAUD$="9600" THEN ITEM=8 1480 IF BAUD$="19200" THEN ITEM=9 1490 ROW=BROW:COL=BCOL:BOX=2:TYP=3 1500 GOSUB 30000 1510 REM ----- 1520 MSG$="Data" 1530 ITEM$(1)="5" 1540 ITEM$(2)="6" 1550 ITEM$(3)="7" 1560 ITEM$(4)="8" 1570 IF DATABITS$="5" THEN ITEM=1 1580 IF DATABITS$="6" THEN ITEM=2 1590 IF DATABITS$="7" THEN ITEM=3 1600 IF DATABITS$="8" THEN ITEM=4 1610 ROW=DBROW:COL=DBCOL:BOX=2:TYP=3 1620 GOSUB 30000 1630 REM ----- 1640 MSG$="Stop" 1650 ITEM$(1)="1" 1660 ITEM$(2)="2" 1670 IF STOPBITS$="1" THEN ITEM=1 1680 IF STOPBITS$="2" THEN ITEM=2 1690 ROW=SBROW:COL=SBCOL:BOX=2:TYP=3 1700 GOSUB 30000 1710 REM ----- 1720 MSG$="Parity" 1730 ITEM$(1)="None" 1740 ITEM$(2)="Even" 1750 ITEM$(3)="Odd" 1760 ITEM$(4)="Mark (1)" 1770 ITEM$(5)="Space (0)" 1780 IF PARITY$="N" THEN ITEM=1 1790 IF PARITY$="E" THEN ITEM=2 1800 IF PARITY$="O" THEN ITEM=3 1810 IF PARITY$="M" THEN ITEM=4 1820 IF PARITY$="S" THEN ITEM=5 1830 ROW=PARROW:COL=PARCOL:BOX=2:TYP=3 1840 GOSUB 30000 1850 REM 1860 FOR ROW=15 TO 18:LOCATE ROW,45:PRINT CHR$(186);:NEXT ROW 1870 LOCATE 19,45:PRINT CHR$(200)+STRING$(24,CHR$(205))+CHR$(188); 1880 FOR ROW=18 TO 16 STEP-1:LOCATE ROW,70:PRINT CHR$(186);:NEXT ROW 1890 LOCATE 16,50:PRINT " 8 data bits"; 1900 LOCATE 17,50:PRINT " requires that"; 1910 LOCATE 18,50:PRINT "parity be `NONE'"; 1990 REM -------------------- SELECT PARAMETERS 2000 MSG$="Port and Function" 2010 ITEM$(1)="Terminal on COM1" 2020 ITEM$(2)="Terminal on COM2" 2030 ITEM$(3)="Monitor both ports" 2040 IF PORT$="COM1" THEN ITEM=1 2050 IF PORT$="COM2" THEN ITEM=2 2060 IF PORT$="BOTH" THEN ITEM=3 2070 ROW=PROW:COL=PCOL:BOX=2:EDKEYS=1:TYP=0 2080 GOSUB 30000 2090 IF ITEM=1 THEN PORT$="COM1" 2100 IF ITEM=2 THEN PORT$="COM2" 2110 IF ITEM=3 THEN PORT$="BOTH" 2120 IF EXIT$="LEFT" THEN 3200 2130 IF EXIT$="RIGHT" THEN 2200 2140 IF EXIT$="F10" THEN 5000 2150 IF EXIT$="ESC" THEN 4000 2160 GOTO 2000 2170 REM ---------------------------------- 2200 MSG$="Baud" 2210 ITEM$(1)="110" 2220 ITEM$(2)="150" 2230 ITEM$(3)="300" 2240 ITEM$(4)="600" 2250 ITEM$(5)="1200" 2260 ITEM$(6)="2400" 2270 ITEM$(7)="4800" 2280 ITEM$(8)="9600" 2290 ITEM$(9)="19200" 2300 IF BAUD$="110" THEN ITEM=1 2310 IF BAUD$="150" THEN ITEM=2 2320 IF BAUD$="300" THEN ITEM=3 2330 IF BAUD$="600" THEN ITEM=4 2340 IF BAUD$="1200" THEN ITEM=5 2350 IF BAUD$="2400" THEN ITEM=6 2360 IF BAUD$="4800" THEN ITEM=7 2370 IF BAUD$="9600" THEN ITEM=8 2380 IF BAUD$="19200" THEN ITEM=9 2390 ROW=BROW:COL=BCOL:BOX=2:EDKEYS=1:TYP=0 2400 GOSUB 30000 2410 IF ITEM=1 THEN BAUD$="110" 2420 IF ITEM=2 THEN BAUD$="150" 2430 IF ITEM=3 THEN BAUD$="300" 2440 IF ITEM=4 THEN BAUD$="600" 2450 IF ITEM=5 THEN BAUD$="1200" 2460 IF ITEM=6 THEN BAUD$="2400" 2470 IF ITEM=7 THEN BAUD$="4800" 2480 IF ITEM=8 THEN BAUD$="9600" 2490 IF ITEM=9 THEN BAUD$="19200" 2500 IF EXIT$="LEFT" THEN 2000 2510 IF EXIT$="RIGHT" THEN 2600 2520 IF EXIT$="F10" THEN 5000 2530 IF EXIT$="ESC" THEN 4000 2540 GOTO 2200 2550 REM ---------------------------------- 2600 MSG$="Data" 2610 ITEM$(1)="5" 2620 ITEM$(2)="6" 2630 ITEM$(3)="7" 2640 ITEM$(4)="8" 2650 IF DATABITS$="5" THEN ITEM=1 2660 IF DATABITS$="6" THEN ITEM=2 2670 IF DATABITS$="7" THEN ITEM=3 2680 IF DATABITS$="8" THEN ITEM=4 2690 ROW=DBROW:COL=DBCOL:BOX=2:EDKEYS=1:TYP=0 2700 GOSUB 30000 2710 IF ITEM=1 THEN DATABITS$="5" 2720 IF ITEM=2 THEN DATABITS$="6" 2730 IF ITEM=3 THEN DATABITS$="7" 2740 IF ITEM=4 THEN DATABITS$="8" 2750 IF DATABITS$="8" AND PARITY$<>"N" THEN GOSUB 2820 2760 IF EXIT$="LEFT" THEN 2200 2770 IF EXIT$="RIGHT" THEN 3000 2780 IF EXIT$="F10" THEN 5000 2790 IF EXIT$="ESC" THEN 4000 2800 GOTO 2600 2810 REM ----- 2820 MSG$="Parity" 2830 ITEM$(1)="None" 2840 ITEM$(2)="Even" 2850 ITEM$(3)="Odd" 2860 ITEM$(4)="Mark (1)" 2870 ITEM$(5)="Space (0)" 2880 ITEM=1 2890 ROW=PARROW:COL=PARCOL:BOX=2:TYP=3 2900 EX$=EXIT$:GOSUB 30000:EXIT$=EX$ 2910 PARITY$="N":RETURN 2920 REM ------------------------------------ 3000 MSG$="Stop" 3010 ITEM$(1)="1" 3020 ITEM$(2)="2" 3030 IF STOPBITS$="1" THEN ITEM=1 3040 IF STOPBITS$="2" THEN ITEM=2 3050 ROW=SBROW:COL=SBCOL:BOX=2:EDKEYS=1:TYP=0 3060 GOSUB 30000 3070 IF ITEM=1 THEN STOPBITS$="1" 3080 IF ITEM=2 THEN STOPBITS$="2" 3090 IF EXIT$="LEFT" THEN 2600 3100 IF EXIT$="RIGHT" THEN 3200 3110 IF EXIT$="F10" THEN 5000 3120 IF EXIT$="ESC" THEN 4000 3130 GOTO 3000 3140 REM -------------------------------------- 3200 MSG$="Parity" 3210 ITEM$(1)="None" 3220 ITEM$(2)="Even" 3230 ITEM$(3)="Odd" 3240 ITEM$(4)="Mark (1)" 3250 ITEM$(5)="Space (0)" 3260 IF PARITY$="N" THEN ITEM=1 3270 IF PARITY$="E" THEN ITEM=2 3280 IF PARITY$="O" THEN ITEM=3 3290 IF PARITY$="M" THEN ITEM=4 3300 IF PARITY$="S" THEN ITEM=5 3310 ROW=PARROW:COL=PARCOL:BOX=2:EDKEYS=1:TYP=0 3320 GOSUB 30000 3330 IF ITEM=1 THEN PARITY$="N" 3340 IF ITEM=2 THEN PARITY$="E" 3350 IF ITEM=3 THEN PARITY$="O" 3360 IF ITEM=4 THEN PARITY$="M" 3370 IF ITEM=5 THEN PARITY$="S" 3380 IF PARITY$<>"N" AND DATABITS$="8" THEN GOSUB 3450 3390 IF EXIT$="LEFT" THEN 3000 3400 IF EXIT$="RIGHT" THEN 2000 3410 IF EXIT$="F10" THEN 5000 3420 IF EXIT$="ESC" THEN 4000 3430 GOTO 3200 3440 REM ----- 3450 MSG$="Data" 3460 ITEM$(1)="5" 3470 ITEM$(2)="6" 3480 ITEM$(3)="7" 3490 ITEM$(4)="8" 3500 ITEM=3 3510 ROW=DBROW:COL=DBCOL:BOX=2:TYP=3 3520 EX$=EXIT$:GOSUB 30000:EXIT$=EX$ 3530 DATABITS$="7":RETURN 4000 OPEN "SCP.CNF" FOR OUTPUT AS 1 4010 PRINT #1,"THIS CONFIGURATION FILE IS WRITTEN WHEN EXITING SCP.EXE" 4020 PRINT #1,PORT$;",";BAUD$;",";DATABITS$;",";STOPBITS$;",";PARITY$;",";MENU$ 4030 CLOSE #1 4040 COLOR 7,0:CLS 4050 END 4990 REM --------------------- COMMUNICATION MODE ---------------------------- 5000 IF PORT$="BOTH" THEN 5200 5010 REM ----- 5100 CLOSE 5110 COMM$=PORT$+":"+BAUD$+","+PARITY$+","+DATABITS$+","+STOPBITS$+",CS,DS,CD" 5120 ON ERROR GOTO 7500 5130 OPEN COMM$ AS #1 5140 ON ERROR GOTO 0 5150 GOTO 5500 5160 REM ----- 5200 CLOSE 5210 PORT$="COM1" 5220 COMM$=PORT$+":"+BAUD$+","+PARITY$+","+DATABITS$+","+STOPBITS$+",CS,DS,CD" 5230 ON ERROR GOTO 7500 5240 OPEN COMM$ AS #1 5250 ON ERROR GOTO 0 5260 PORT$="COM2" 5270 COMM$=PORT$+":"+BAUD$+","+PARITY$+","+DATABITS$+","+STOPBITS$+",CS,DS,CD" 5280 ON ERROR GOTO 7500 5290 OPEN COMM$ AS #2 5300 ON ERROR GOTO 0 5310 REM --- 5320 PORT$="BOTH" 5490 REM ------------- 5500 CLS 5510 VIEW PRINT 5520 IF NOT MENU THEN 5600 5530 COLOR 0,7:LOCATE 25,1 5540 GOSUB 8800:REM STATUS LINE MENU 5550 VIEW PRINT 1 TO 24 5560 REM ----- 5600 COLOR 7,0:LOCATE 1,1 5610 PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»" 5620 PRINT "º The following keys can be used at any time during communication: º" 5630 PRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹" 5640 PRINT "º In Dumb Terminal or Monitor mode: Only in Dumb Terminal mode: º" 5650 PRINT "º F1 Display as ASCII Text ALT F1 Send ASCII Text º" 5660 PRINT "º F2 Display as Hex ASCII Codes ALT F2 Send Hex Values º" 5670 PRINT "º F3 Display as Decimal ASCII Codes ALT F3 Send Decimal Values º" 5680 PRINT "º F4 Bit 7 on Receive Used/Ignored º" 5690 PRINT "º F5 Name Capture File as SCP.CAP º" 5700 PRINT "º F6 Name Capture File as [Timer].SCP º" 5710 PRINT "º F7 Begin File Capture º" 5720 PRINT "º F8 End File Capture Only in Monitor mode: º" 5730 PRINT "º F9 Display This Menu/Toggle Menu Bar ALT F9 Decrease loop delay º" 5740 PRINT "º F10 Exit to Parameter Menu ALT F10 Increase loop delay º" 5750 PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ" 5760 PRINT 5770 COLOR 0,7 5780 IF PORT$="COM1" OR PORT$="COM2" THEN PRINT " Now in dumb terminal mode on "+PORT$+" " 5790 IF PORT$="BOTH" THEN PRINT " Now monitoring COM1 and COM2 " 5800 COLOR 7,0::PRINT:LOCATE ,,1 5900 ON ERROR GOTO 7000 5910 REM ------------- 6000 IF EOF(1) THEN 6200 6005 IF LOF(1)>32000 THEN NODISP=-1 ELSE NODISP=0 6010 IF PORT$="BOTH" THEN PRINT:PRINT "[COM1] "; 6020 IF CAPTURE=0 THEN 6040 6030 IF PORT$="BOTH" THEN PRINT #3,"":PRINT #3,"[COM1] "; 6040 A$=INPUT$(1,#1) 6050 IF STRIP THEN A=ASC(A$):A=(A AND &H7F):A$=CHR$(A) 6060 IF A$=CHR$(8) AND DISP=0 THEN A$=CHR$(29)+" "+CHR$(29) 6070 IF A$=CHR$(10) AND DISP=0 THEN 6110 6075 IF NODISP THEN 6110 6080 IF DISP=0 THEN PRINT A$; 6090 IF DISP=1 THEN PRINT ASC(A$); 6100 IF DISP=2 THEN PRINT STRING$(2-LEN(HEX$(ASC(A$))),"0");HEX$(ASC(A$));" "; 6110 IF CAPTURE=0 THEN 6145 6120 IF DISP=0 THEN PRINT #3,A$; 6130 IF DISP=1 THEN PRINT #3,ASC(A$); 6140 IF DISP=2 THEN PRINT #3,STRING$(2-LEN(HEX$(ASC(A$))),"0");HEX$(ASC(A$));" "; 6145 T=TIMER 6147 IF TIMER"BOTH" THEN 6500 6210 REM ----- 6300 IF EOF(2) THEN 6500 6310 PRINT:PRINT "[COM2] "; 6320 IF CAPTURE=0 THEN 6340 6330 PRINT #3,"":PRINT #3,"[COM2] "; 6340 A$=INPUT$(1,#2) 6350 IF STRIP THEN A=ASC(A$):A=(A AND &H7F):A$=CHR$(A) 6360 IF A$=CHR$(8) AND DISP=0 THEN A$=CHR$(29)+" "+CHR$(29) 6370 IF A$=CHR$(10) AND DISP=0 THEN 6410 6380 IF DISP=0 THEN PRINT A$; 6390 IF DISP=1 THEN PRINT ASC(A$); 6400 IF DISP=2 THEN PRINT STRING$(2-LEN(HEX$(ASC(A$))),"0");HEX$(ASC(A$));" "; 6410 IF CAPTURE=0 THEN 6445 6420 IF DISP=0 THEN PRINT #3,A$; 6430 IF DISP=1 THEN PRINT #3,ASC(A$); 6440 IF DISP=2 THEN PRINT #3,STRING$(2-LEN(HEX$(ASC(A$))),"0");HEX$(ASC(A$));" "; 6445 T=TIMER 6447 IF TIMERCHR$(0)+CHR$(62) THEN 6570 6550 IF STRIP=0 THEN STRIP=-1:PRINT:PRINT "IGNORING BIT 7-":GOTO 6000 6560 IF STRIP THEN STRIP=0:PRINT:PRINT "USING BIT 7-":GOTO 6000 6570 IF B$<>CHR$(0)+CHR$(63) THEN 6600 6580 FILE$="SCP.CAP":FILEFLAG=0 6590 PRINT:PRINT "Capture File Name=SCP.CAP":GOTO 6000 6600 IF B$<>CHR$(0)+CHR$(64) THEN 6630:REM NAME CAPTURE FILE AS TIMER 6610 PRINT:PRINT "Capture File Name=[# seconds since midnight].CAP" 6620 FILEFLAG=-1::GOTO 6000 6630 IF B$<>CHR$(0)+CHR$(65) THEN 6680:REM OPEN CAPTURE FILE 6640 CAPTURE=1:CLOSE #3:OPEN FILE$ FOR OUTPUT AS #3 6650 IF NOT FILEFLAG THEN FILE$="SCP.CAP":GOTO 6670 6660 T$=STR$(INT(TIMER)):FILE$=RIGHT$(T$,LEN(T$)-1)+".CAP" 6670 PRINT:PRINT "Beginning File Capture - Writing to ";FILE$:GOTO 6000 6680 IF B$<>CHR$(0)+CHR$(66) THEN 6710:REM CLOSE CAPTURE FILE 6690 IF CAPTURE=0 THEN PRINT:PRINT "File Capture Not Active":GOTO 6000 6700 CAPTURE=0:CLOSE #3:PRINT:PRINT "Ending File Capture":GOTO 6000 6710 IF B$<>CHR$(0)+CHR$(67) THEN 6730:REM RE-DISPLAY MENU 6720 IF MENU THEN MENU=0:GOTO 5500 ELSE MENU=-1:GOTO 5500 6730 IF B$=CHR$(0)+CHR$(68) THEN CLOSE:CAPTURE=0:ON ERROR GOTO 0:GOTO 1000:REM EXIT 6735 IF B$=CHR$(0)+CHR$(104) AND PORT$<>"BOTH" THEN GOSUB 8000:GOTO 6000 6740 IF B$=CHR$(0)+CHR$(105) AND PORT$<>"BOTH" THEN GOSUB 8200:GOTO 6000 6745 IF B$=CHR$(0)+CHR$(106) AND PORT$<>"BOTH" THEN GOSUB 8500:GOTO 6000 6750 IF B$<>CHR$(0)+CHR$(112) OR PORT$<>"BOTH" THEN 6760 6755 DLY=DLY-0.0001:IF DLY<0 THEN DLY=0 6757 PRINT:PRINT "LOOP DELAY IS ";:PRINT USING ".####";DLY; 6758 PRINT " SECONDS":GOTO 6000 6760 IF B$<>CHR$(0)+CHR$(113) OR PORT$<>"BOTH" THEN 6770 6765 DLY=DLY+0.0001:PRINT:PRINT "LOOP DELAY IS ";:PRINT USING ".####";DLY; 6767 PRINT " SECONDS":GOTO 6000 6770 IF PORT$<>"BOTH" THEN PRINT #1,B$; 6780 GOTO 6000 6990 REM ------- ERRORS DURING COMMUNICATION ------- 7000 IF ERR=57 THEN RESUME 7030:REM DEVICE I/O 7010 IF ERR=69 THEN RESUME 7060:REM COMMUNICATION BUFFER OVERFLOW 7020 PRINT:PRINT "ERROR";ERR;" on line ";ERL:PRINT:SOUND 500,10:END 7030 ON ERROR GOTO 0 7040 PRINT:PRINT "overrun, framing, parity, or break error":PRINT 7050 SOUND 2000,.2:GOTO 5900 7060 ON ERROR GOTO 0 7070 PRINT:PRINT "receive buffer has overflowed - data will be missing":PRINT 7080 SOUND 2000,.2:GOTO 5900 7490 REM ------- ERRORS OPENING COM PORT ------- 7500 IF ERR=24 OR ERR=68 THEN RESUME 7520:REM DEVICE TIMEOUT, DEVICE UNAVAILABLE 7510 CLS:PRINT "ERROR";ERR;" on line ";ERL:PRINT:SOUND 500,10:END 7520 ON ERROR GOTO 0 7530 SOUND 500,10 7540 LOCATE 15,5:PRINT PORT$+" is not responding" 7550 T=TIMER 7560 IF TIMER=65 AND HD<=70 THEN 8330 8320 IF HD>=48 AND HD<=57 THEN 8330 8325 GOTO 8235 8330 SENDHEX(I)=VAL("&H"+HEXDIG$)*16 8335 HEXDIG$=RIGHT$(SENDHEX$(I),1):HD=ASC(HEXDIG$) 8345 IF HD>=65 AND HD<=70 THEN 8360 8350 IF HD>=48 AND HD<=57 THEN 8360 8355 GOTO 8235 8360 SENDHEX(I)=SENDHEX(I)+VAL("&H"+HEXDIG$) 8365 REM ----- 8370 IF EXIT$<>"LEFT" THEN 8385 8375 I=I-1:IF I=0 THEN I=1 8380 GOTO 8235 8385 IF EXIT$<>"RIGHT" THEN 8400 8390 I=I+1:IF I=19 THEN I=18 8395 GOTO 8235 8400 IF EXIT$<>"ENTER" THEN 8235 8405 REM ----- 8410 COLOR 7,0:LOCATE 25,1:PRINT SPACE$(79); 8415 IF NOT MENU THEN 8435 8420 COLOR 0,7:LOCATE 25,1 8425 GOSUB 8800:REM STATUS LINE MENU 8430 VIEW PRINT 1 TO 24 8435 COLOR 7,0 8440 LOCATE SAVEROW,SAVECOL,1 8445 IF EXIT$="ESC" THEN RETURN 8450 REM ----- 8455 FOR SENDLOOP=1 TO 18 8460 IF SENDHEX$(SENDLOOP)<>"" THEN PRINT #1,CHR$(SENDHEX(SENDLOOP)); 8465 NEXT SENDLOOP 8470 RETURN 8490 REM ---------- DECIMAL ---------- 8500 SAVEROW=CSRLIN:SAVECOL=POS(0) 8505 VIEW PRINT 8510 LOCATE 25,1:PRINT SPACE$(79); 8515 LOCATE 25,1:PRINT "Enter decimal values to send: "; 8520 FOR I=1 TO 12:LOCATE 25,28+(I*4):PRINT SENDDEC$(I);:NEXT I 8525 I=1 8530 REM ----- 8535 TEMP$=SENDDEC$(I) 8540 ROW=25:COL=28+(I*4):LNG=3:EDKEYS=1:GOSUB 10000 8545 IF EXIT$="PGUP" OR EXIT$="PGDN" OR EXIT$="UP" OR EXIT$="DN" THEN 8535 8550 IF EXIT$="ESC" THEN 8660 8555 SENDDEC$(I)=TEMP$ 8560 REM ----- 8565 IF SENDDEC$(I)=" " THEN SENDDEC$(I)="" 8566 IF SENDDEC$(I)=" " THEN SENDDEC$(I)="" 8567 IF SENDDEC$(I)=" " THEN SENDDEC$(I)="" 8568 IF LEFT$(SENDDEC$(I),2)=" " THEN SENDDEC$(I)="00"+RIGHT$(SENDDEC$(I),1) 8569 IF LEFT$(SENDDEC$(I),1)=" " THEN SENDDEC$(I)="0"+RIGHT$(SENDDEC$(I),2) 8570 IF RIGHT$(SENDDEC$(I),2)=" " THEN SENDDEC$(I)="00"+LEFT$(SENDDEC$(I),1) 8571 IF RIGHT$(SENDDEC$(I),1)=" " THEN SENDDEC$(I)="0"+LEFT$(SENDDEC$(I),2) 8572 IF MID$(SENDDEC$(I),2,1)=" " THEN SENDDEC$(I)="0"+LEFT$(SENDDEC$(I),1)+RIGHT$(SENDDEC$(I),1) 8573 IF LEN(SENDDEC$(I))=1 THEN SENDDEC$(I)="00"+SENDDEC$(I) 8574 IF LEN(SENDDEC$(I))=2 THEN SENDDEC$(I)="0"+SENDDEC$(I) 8575 IF SENDDEC$(I)="" THEN 8620 8580 LOCATE 25,28+(I*4):PRINT SENDDEC$(I); 8585 REM ----- 8590 IF ASC(LEFT$(SENDDEC$(I),1))<48 OR ASC(LEFT$(SENDDEC$(I),1))>57 THEN 8535 8592 IF ASC(RIGHT$(SENDDEC$(I),1))<48 OR ASC(RIGHT$(SENDDEC$(I),1))>57 THEN 8535 8594 IF ASC(MID$(SENDDEC$(I),2,1))<48 OR ASC(MID$(SENDDEC$(I),2,1))>57 THEN 8535 8605 SENDDEC(I)=VAL(SENDDEC$(I)) 8610 IF SENDDEC(I)<0 OR SENDDEC(I)>255 THEN 8535 8615 REM ----- 8620 IF EXIT$<>"LEFT" THEN 8635 8625 I=I-1:IF I=0 THEN I=1 8630 GOTO 8535 8635 IF EXIT$<>"RIGHT" THEN 8650 8640 I=I+1:IF I=13 THEN I=12 8645 GOTO 8535 8650 IF EXIT$<>"ENTER" THEN 8535 8655 REM ----- 8660 COLOR 7,0:LOCATE 25,1:PRINT SPACE$(79); 8665 IF NOT MENU THEN 8685 8670 COLOR 0,7:LOCATE 25,1 8675 GOSUB 8800:REM STATUS LINE MENU 8680 VIEW PRINT 1 TO 24 8685 COLOR 7,0 8690 LOCATE SAVEROW,SAVECOL,1 8695 IF EXIT$="ESC" THEN RETURN 8700 REM ----- 8705 FOR SENDLOOP=1 TO 12 8710 IF SENDDEC$(SENDLOOP)<>"" THEN PRINT #1,CHR$(SENDDEC(SENDLOOP)); 8715 NEXT SENDLOOP 8720 RETURN 8790 REM --------------------- MISC SUBROUTINES ------------------------------ 8800 PRINT " F1=Asc F2=Hex F3=Dec F4=Bit7 F5=SCP F6=[Timer] F7=Cap F8=End F9=Menu F10=Exit "; 8810 RETURN 8945 REM ********************************************************************* 8950 REM --------------------- OUTLINE THE SCREEN ---------------------------- 8955 REM 8960 REM This subroutines allows you to outline the screen with your 8965 REM choice of 4 types of boxes. Boxes 1,2, and 3 are the same 8970 REM types of boxes used in other subroutines. 8975 REM 8980 REM enter with - BOX = 0,1,2,3 - type of box to outline the screen with 8985 REM 0=squares, 1=1 line box, 2=2 line box, 3=solid box 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 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 9010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 9015 KEY OFF:COLOR TEXTFORE,TEXTBACK:CLS:LOCATE ,,0 9020 IF BOX=0 THEN TP=254:BT=254:MS=254:UL=254:LL=254:UR=254:LR=254 9025 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217 9030 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188 9035 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 9040 ROW=1:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP)); 9045 ROW=25:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT)); 9050 COL=1:FOR ROW=2 TO 24:LOCATE ROW,COL:PRINT CHR$(MS);:NEXT 9055 COL=80:FOR ROW=2 TO 24:LOCATE ROW,COL:PRINT CHR$(MS);:NEXT 9060 LOCATE 1,1:PRINT CHR$(UL);:LOCATE 1,80:PRINT CHR$(UR); 9065 LOCATE 25,1:PRINT CHR$(LL);:LOCATE 25,80:PRINT CHR$(LR); 9070 BOX=0:RETURN 9075 REM 9080 REM 9235 REM ********************************************************************* 9240 REM ------------------- CENTER A MESSAGE IN ROW ------------------------- 9245 REM 9250 REM This subroutine allows you to center a message in a particular row 9255 REM and automatically makes adjustments to the column for centering. 9260 REM 9265 REM 9270 REM enter with - MSG$="message", to display (up to 74 characters) 9275 REM ROW=ROW (on which to display message) 9280 REM optional - BOX=0,1,2,3 - type of box to draw around MSG$ 9285 REM 0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid 9290 REM exit with - BOX=0 (to maintain BOX as optional for other routines) 9295 REM 9300 COL=41-INT((LEN(MSG$)/2)) :REM 9300 9305 GOSUB 9700:REM display message at row,col :REM SUBROUTINE USED HERE 9310 RETURN 9315 REM 9620 REM ********************************************************************* 9625 REM ---------------- DISPLAY MESSAGE AT ROW AND COLUMN ------------------ 9630 REM 9635 REM This subroutine allows you to display a message at a specified 9640 REM row and column and optionally draw a box around it. If drawing 9645 REM the box would mean trying to print to an illegal row or column, 9650 REM the box is not drawn. 9655 REM 9660 REM enter with - MSG$="message", to display (up to 74 characters) 9665 REM ROW and COL=row and column on which to display "message" 9670 REM optional- BOX=0,1,2,3 - type of box to draw around MSG$ 9675 REM 0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid 9680 REM optional - TEXTFORE,TEXTBACK,DATAFORE,DATABACK,FIELDFORE,FIELDBACK 9685 REM colors optionally specified for COLOR statements 9690 REM exit with - BOX=0 (to maintain BOX as optional for other routines) 9695 REM 9700 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 9700 9705 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 9710 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 9715 COLOR TEXTFORE,TEXTBACK 9720 LOCATE ROW,COL,0:PRINT MSG$;:L=LEN(MSG$) 9725 IF ROW<2 OR ROW>24 THEN 9790 9730 IF COL<3 OR LEN(MSG$)>74 THEN 9790 9735 IF BOX=0 THEN 9790 9740 LOCATE ROW,COL-1:PRINT " "; 9745 LOCATE ROW,COL+LEN(MSG$):PRINT " "; 9750 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217 9755 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188 9760 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 9765 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS); 9770 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+L+1:PRINT CHR$(UR); 9775 LOCATE ROW,COL+L+1:PRINT CHR$(MS);:LOCATE ROW+1,COL+L+1:PRINT CHR$(LR); 9780 LOCATE ROW-1,COL-1:PRINT STRING$(L+2,CHR$(TP)); 9785 LOCATE ROW+1,COL-1:PRINT STRING$(L+2,CHR$(BT)); 9790 BOX=0:RETURN 9795 REM 9800 REM 9805 REM 9810 REM 9815 REM 9820 REM ************************** modified ********************************* 9825 REM ---------------- EDIT A FIELD AT ROW AND COLUMN --------------------- 9830 REM 9835 REM This subroutine allows you to edit or enter a string of up to 74 9840 REM characters at a specified row and column. It allows you to specify 9845 REM the maximum length of the string and allows you to optionally draw 9850 REM a box around the editing area. The editing keys perform about the 9855 REM same functions as when using BASIC in the screen editing mode. 9860 REM 9865 REM enter with - ROW and COL=row and column at which to edit the string 9870 REM LNG=maximum length of string allowed (up to 74) 9875 REM TEMP$="string" to edit 9880 REM optional - EDCOL=0,1 9885 REM 0 = begin editing at beginning of string 9890 REM else begin editing at end of string 9895 REM optional - EDKEYS=0,1,2 - what keys allow you to exit the routine 9900 REM 0 = only ENTER or ESCAPE 9905 REM 1 = include PGUP, PGDN, UP, DOWN, LEFT, RIGHT ARROWS 9910 REM 2 = include F1-F10 9915 REM optional - TYP=0,1,2,3 - type of input desired 9920 REM 0 = normal ALPHANUMERIC 9925 REM 1 = ALPHANUMERIC with lower case changed to upper case 9930 REM 2 = NUMERIC only allowed 9935 REM 3 = Y or N only (or y or n changed to upper case) 9940 REM optional - BOX=0,1,2,3 - type of box to draw around MSG$ 9945 REM 0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid 9950 REM optional - TEXTFORE,TEXTBACK,DATAFORE,DATABACK,FIELDFORE,FIELDBACK 9955 REM colors optionally specified for COLOR statements 9960 REM exit with - TEMP$="string" edited or entered 9965 REM BOX=0,TYP=0,EDKEYS=0,EDCOL=0 (to maintain these as opt.) 9970 REM EXIT$=key hit that exited routine- 9975 REM !!! modified !!! (EXIT$="RIGHT" 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 LNG=0 THEN LNG=1 10020 INS=0:EXIT$="":TEMP$=LEFT$(TEMP$,LNG) 10025 IF EDCOL=0 THEN EDCOL=COL:GOTO 10035 10030 IF LEN(TEMP$)=LNG THEN EDCOL=COL+LEN(TEMP$)-1 ELSE EDCOL=COL+LEN(TEMP$) 10035 LOCATE ROW,COL,1:COLOR FIELDFORE,FIELDBACK:PRINT TEMP$; 10040 LOCATE ROW,COL+LEN(TEMP$):PRINT SPACE$(LNG-LEN(TEMP$)); 10045 L=LEN(TEMP$) 10050 IF ROW<2 OR ROW>24 THEN 10115 10055 IF COL<3 OR LNG>74 THEN 10115 10060 IF BOX=0 THEN 10115 10065 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217 10070 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188 10075 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 10080 COLOR TEXTFORE,TEXTBACK 10085 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS); 10090 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+LNG+1:PRINT CHR$(UR); 10095 LOCATE ROW,COL+LNG+1:PRINT CHR$(MS); 10100 LOCATE ROW+1,COL+LNG+1:PRINT CHR$(LR); 10105 LOCATE ROW-1,COL-1:PRINT STRING$(LNG+2,CHR$(TP)); 10110 LOCATE ROW+1,COL-1:PRINT STRING$(LNG+2,CHR$(BT)); 10115 BOX=0 10120 AAAA$=MID$(TEMP$,EDCOL-COL+1,1) :REM -------------- 10125 IF INS THEN LOCATE ROW,EDCOL:COLOR DATAFORE,DATABACK :REM editing | 10130 IF INS THEN PRINT AAAA$;:COLOR FIELDFORE,FIELDBACK :REM keys | 10135 LOCATE ROW,EDCOL :REM available | 10140 IN$=INKEY$:IF IN$="" THEN 10140 :REM -------------- 10145 IF IN$=CHR$(13) THEN EXIT$="ENTER":GOTO 10625 :REM ENTER | 10150 IF IN$=CHR$(27) THEN EXIT$="ESC":GOTO 10625 :REM ESCAPE | 10155 IF IN$=CHR$(8) THEN 10435 :REM BACKSPACE | 10160 IF IN$=CHR$(0)+CHR$(71) THEN 10480 :REM HOME | 10165 IF IN$=CHR$(0)+CHR$(119) THEN 10490 :REM CONTROL HOME | 10170 IF IN$=CHR$(0)+CHR$(75) THEN 10500 :REM LEFT ARROW | 10175 IF IN$=CHR$(0)+CHR$(77) THEN 10520 :REM RIGHT ARROW | 10180 IF IN$=CHR$(0)+CHR$(79) THEN 10560 :REM END | 10185 IF IN$=CHR$(0)+CHR$(117) THEN 10580 :REM CONTROL END | 10190 IF IN$=CHR$(0)+CHR$(82) THEN 10590 :REM INSERT | 10195 IF IN$=CHR$(0)+CHR$(83) THEN 10600 :REM DELETE | 10200 IF EDKEYS=0 THEN 10290 :REM skip these - | 10205 IF IN$=CHR$(0)+CHR$(72) THEN EXIT$="UP":GOTO 10625 :REM UP ARROW | 10210 IF IN$=CHR$(0)+CHR$(80) THEN EXIT$="DOWN":GOTO 10625 :REM DOWN ARROW | 10215 IF IN$=CHR$(0)+CHR$(73) THEN EXIT$="PGUP":GOTO 10625 :REM PAGE UP | 10220 IF IN$=CHR$(0)+CHR$(81) THEN EXIT$="PGDN":GOTO 10625 :REM PAGE DOWN | 10225 REM :REM HOME | 10230 REM :REM END | 10235 IF EDKEYS=1 THEN 10290 :REM skip these - | 10240 IF IN$=CHR$(0)+CHR$(59) THEN EXIT$="F1":GOTO 10625 :REM F1 | 10245 IF IN$=CHR$(0)+CHR$(60) THEN EXIT$="F2":GOTO 10625 :REM F2 | 10250 IF IN$=CHR$(0)+CHR$(61) THEN EXIT$="F3":GOTO 10625 :REM F3 | 10255 IF IN$=CHR$(0)+CHR$(62) THEN EXIT$="F4":GOTO 10625 :REM F4 | 10260 IF IN$=CHR$(0)+CHR$(63) THEN EXIT$="F5":GOTO 10625 :REM F5 | 10265 IF IN$=CHR$(0)+CHR$(64) THEN EXIT$="F6":GOTO 10625 :REM F6 | 10270 IF IN$=CHR$(0)+CHR$(65) THEN EXIT$="F7":GOTO 10625 :REM F7 | 10275 IF IN$=CHR$(0)+CHR$(66) THEN EXIT$="F8":GOTO 10625 :REM F8 | 10280 IF IN$=CHR$(0)+CHR$(67) THEN EXIT$="F9":GOTO 10625 :REM F9 | 10285 IF IN$=CHR$(0)+CHR$(68) THEN EXIT$="F10":GOTO 10625 :REM F10 | 10290 IF TYP=0 OR TYP=1 OR TYP=3 THEN 10310 :REM -------------- 10295 REM ----- allow only numbers or decimal point 10300 IF ASC(IN$)<46 OR ASC(IN$)>57 OR ASC(IN$)=47 THEN GOSUB 10675:GOTO 10140 10305 REM ----- allow only legitimate alphanumeric 10310 IF ASC(IN$)<32 OR ASC(IN$)>126 THEN GOSUB 10675:GOTO 10140 10315 REM ----- change to all upper case 10320 IF TYP=0 OR TYP=2 THEN 10350 10325 IF ASC(IN$)>=97 AND ASC(IN$)<=122 THEN IN$=CHR$(ASC(IN$)-32) 10330 REM ----- Yes or No only ----- 10335 IF TYP<>3 THEN 10350 10340 IF IN$<>"Y" AND IN$<>"N" THEN GOSUB 10675:GOTO 10140 10345 REM ----- good character 10350 L=EDCOL-COL:IF INS THEN 10395 10355 REM ----- add char. if at end of string 10360 IF EDCOL=COL+LEN(TEMP$) THEN TEMP$=TEMP$+IN$:GOTO 10410 10365 REM ----- add char. in middle if not in insert mode 10370 TEMP$=LEFT$(TEMP$,L)+IN$+RIGHT$(TEMP$,LEN(TEMP$)-1-L) 10375 REM ----- exit if overwriting last character 10380 IF EDCOL=COL+LNG-1 AND LEN(TEMP$)=LNG THEN EXIT$="RIGHT":GOTO 10625 10385 GOTO 10410 10390 REM ----- in insert mode, check for full field 10395 IF LEN(TEMP$)=LNG THEN GOSUB 10675:GOTO 10035 :REM full field 10400 TEMP$=LEFT$(TEMP$,L)+IN$+RIGHT$(TEMP$,LEN(TEMP$)-L) :REM not full 10405 REM ----- move cursor right if applicable 10410 IF EDCOLCOL THEN EDCOL=EDCOL-1:GOTO 10035 10505 IF EDKEYS=0 THEN GOSUB 10675:GOTO 10035 :REM error if left col 10510 EXIT$="LEFT":GOTO 10625 :REM or exit 10515 REM ----- RIGHT ARROW ----- 10520 INS=0:IF EDCOLCOL+LNG THEN EDCOL=COL+LNG:GOTO 10025 10575 REM ----- CONTROL END ----- 10580 INS=0:TEMP$=LEFT$(TEMP$,EDCOL-COL):GOTO 10035 10585 REM ----- INSERT ----- 10590 IF INS THEN INS=0:GOTO 10035 ELSE INS=-1:GOTO 10035 10595 REM ----- DELETE ----- 10600 INS=0:L=EDCOL-COL 10605 REM:IF EDCOL=COL+LNG-1 THEN GOSUB 10515:GOTO 10025:REM needed? 10610 IF EDCOL>=COL+LEN(TEMP$) THEN GOSUB 10675:GOTO 10035 10615 TEMP$=LEFT$(TEMP$,L)+RIGHT$(TEMP$,LEN(TEMP$)-L-1):GOTO 10035 10620 REM ----- COMMON EXIT ----- 10625 BLANK$=CHR$(255):REM remove blanks at end 10630 IF RIGHT$(TEMP$,1)=BLANK$ THEN TEMP$=LEFT$(TEMP$,LEN(TEMP$)-1):GOTO 10630 10635 FOR BLANKLOOP=1 TO LEN(TEMP$):REM change blanks in middle to spaces 10640 IF MID$(TEMP$,BLANKLOOP,1)=CHR$(255) THEN MID$(TEMP$,BLANKLOOP,1)=" " 10645 NEXT BLANKLOOP 10650 LOCATE ROW,COL,0:COLOR TEXTFORE,TEXTBACK 10655 PRINT TEMP$+SPACE$(LNG-LEN(TEMP$)); 10660 BOX=0:TYP=0:EDKEYS=0:EDCOL=0:RETURN 10665 REM 10670 REM ----- BEEP IF ERROR ----- 10675 RETURN 10680 REM 10685 REM 29800 REM ******************** pull down stuff removed *********************** 29805 REM ---------------------- POINT AND SHOOT MENU ------------------------ 29810 REM ----------------------- (or display window) ------------------------ 29815 REM 29820 REM Sets up menu and selects from up to 9 items. Moves among the items 29825 REM with the arrow keys and selects with ENTER or ESCAPE keys, numbers 29830 REM 1-9, F1-F9, and optionally PAGE UP, PAGE DOWN, LEFT, RIGHT, F10. 29835 REM Displays message at top and optionally, a box around the menu. 29840 REM Item names must be in order and none may be skipped. The ROW and COL 29845 REM must allow all of menu to be displayed on the screen. Menu can be 29850 REM optionally displayed as a pull-down menu, meaning that when item is 29855 REM selected, parts of the screen that were written over are restored. 29860 REM 29865 REM With the display window option set, the menu becomes only a display 29870 REM of text and does not wait for any keyboard entry. 29875 REM 29880 REM enter with ITEM$(1)="ITEM 1 message",(up to 76 chars.),ITEM$(2), etc. 29882 REM (array must be DIMinsioned before using this routine) 29885 REM MSG$="menu message or name", (up to 76 characters) 29890 REM ROW, COL=upper left corner of menu 29895 REM optional - TEXTFORE,TEXTBACK,DATAFORE,DATABACK,FIELDFORE,FIELDBACK 29900 REM colors optionally specified for COLOR statements 29905 REM BOX=0,1,2,3 - type of outline around menu 29910 REM 0 = no box, 1 = 1 line box, 2 = 2 line box, 3 = solid box 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 TYP=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 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=0, TYP=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 KEY OFF:FOR A=1 TO 10:KEY A,"":NEXT 30020 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 MENULOOP=1 TO NUMITEMS 30060 IF LEN(ITEM$(MENULOOP))>MAXLEN THEN MAXLEN=LEN(ITEM$(MENULOOP)) 30065 NEXT MENULOOP 30070 IF LEN(MSG$)80 THEN COL=80-3-MAXLEN 30155 REM ---------------------- DISPLAY MENU ----------------------------- 30160 LOCATE ,,0 30165 IF BOX=0 THEN TP=0:BT=0:LS=0:RS=0:MS=0:MM=0:UL=0:LL=0:UR=0:LR=0 30170 IF BOX=1 THEN TP=196:BT=196:LS=195:RS=180:MS=179:MM=196:UL=218:LL=192:UR=191:LR=217 30175 IF BOX=2 THEN TP=205:BT=205:LS=204:RS=185:MS=186:MM=205:UL=201:LL=200:UR=187:LR=188 30180 IF BOX=3 THEN TP=223:BT=220:LS=219:RS=219:MS=219:MM=220:UL=219:LL=219:UR=219:LR=219 30185 IROW=ROW:ICOL=COL 30190 LOCATE IROW,ICOL:COLOR TEXTFORE,TEXTBACK 30195 PRINT CHR$(UL)+STRING$(MAXLEN+2,TP)+CHR$(UR); 30200 LOCATE IROW+1,ICOL:PRINT CHR$(MS)+" "; 30205 COLOR DATAFORE,DATABACK:PRINT MSG$; 30210 COLOR TEXTFORE,TEXTBACK:PRINT " "+CHR$(MS); 30215 LOCATE IROW+2,ICOL:COLOR TEXTFORE,TEXTBACK 30220 PRINT CHR$(LS)+STRING$(MAXLEN+2,MM)+CHR$(RS); 30225 FOR PRNLOOP=1 TO NUMITEMS 30230 LOCATE IROW+2+PRNLOOP,ICOL 30235 PRINT CHR$(MS)+" "+ITEM$(PRNLOOP)+" "+CHR$(MS); 30240 NEXT PRNLOOP 30245 LOCATE IROW+3+NUMITEMS,ICOL 30250 PRINT CHR$(LL)+STRING$(MAXLEN+2,BT)+CHR$(LR); 30255 REM ---------- DO NOT WAIT FOR ENTRY IF DISPLAY WINDOW ONLY ---------- 30260 IF TYP=2 THEN 30470:REM DISPLAY WINDOW 30265 IF TYP=3 THEN IROW=ITEM:ICOL=ICOL+2:GOTO 30410:REM WINDOW WITH HI-LIGHT 30270 REM ------------- MOVE THROUGH MENU ITEMS AND SELECT ONE -------------- 30275 IROW=1:IF ITEM>=1 AND ITEM<=NUMITEMS THEN IROW=ITEM 30280 ESCAPE=0:OLDIROW=IROW:ICOL=COL+2 30285 LOCATE OLDIROW+ROW+2,ICOL:COLOR TEXTFORE,TEXTBACK:PRINT ITEM$(OLDIROW); 30290 LOCATE IROW+ROW+2,ICOL:COLOR FIELDFORE,FIELDBACK:PRINT ITEM$(IROW); 30295 IN$=INKEY$:IF IN$="" THEN 30295 30300 IF IN$=CHR$(27) THEN EXIT$="ESC":ESCAPE=-1:GOTO 30400 30305 IF IN$=CHR$(13) THEN EXIT$="ENTER":GOTO 30400 30310 IF EDKEYS=0 THEN 30340 30315 IF IN$=CHR$(0)+CHR$(75) THEN EXIT$="LEFT":GOTO 30400 30320 IF IN$=CHR$(0)+CHR$(77) THEN EXIT$="RIGHT":GOTO 30400 30325 IF IN$=CHR$(0)+CHR$(73) THEN EXIT$="PGUP":GOTO 30400 30330 IF IN$=CHR$(0)+CHR$(81) THEN EXIT$="PGDN":GOTO 30400 30335 IF IN$=CHR$(0)+CHR$(68) THEN EXIT$="F10":GOTO 30400 30340 IF LEN(IN$)=1 THEN 30350 30345 V=ASC(RIGHT$(IN$,1))-58:GOTO 30355:REM FUNCTION KEY 30350 V=VAL(IN$) 30355 IF V>=1 AND V<=9 AND V<=NUMITEMS THEN OLDIROW=IROW:IROW=V:GOTO 30400 30360 IF IN$=CHR$(0)+CHR$(72) THEN 30375:REM UP 30365 IF IN$=CHR$(0)+CHR$(80) THEN 30385:REM DOWN 30370 GOTO 30295 30375 OLDIROW=IROW:IF IROW>1 THEN IROW=IROW-1:GOTO 30285 30380 IROW=NUMITEMS:GOTO 30285 30385 OLDIROW=IROW:IF IROW