TAPCOD3.1FD

10 SHELL "CLS"
20 GOSUB 5490:LOCATE 5,33:PRINT"TAPE CODER"
30 LOCATE 9,27:PRINT"TOSHIBA 1FD version 3.00"
40 LOCATE 11,32:PRINT"one-time coder"
50 LOCATE 13,32:PRINT"   May 1988"
60 GOSUB 5590
70 CLEAR:KEY OFF
80 X$="":FOR N=1 TO 10:KEY N,X$:NEXT N
90 DIM ALPH$(100,1),DALPH$(100),SN$(20),RN$(20)
100 :
110 REM **** Main Menu ****
120 M=0:BF=0:ER=-1
130 ON ERROR GOTO 4740
140 WHILE M=0
150   GOSUB 5490:LOCATE 3,35:PRINT"TAPE CODER"
160   LOCATE 5,30:PRINT"Toshiba 1fd Ver.3.00"
170   LOCATE 7,36:PRINT"MAIN MENU"
180   LOCATE 9,24:PRINT"F1  : Load messages from disk"
190   LOCATE 10,24:PRINT"F2  : Save messages onto disk"
200   LOCATE 11,24:PRINT"F3  : Delete messages on disk"
210   LOCATE 13,24:PRINT"F4  : Encipher a message in memory"
220   LOCATE 14,24:PRINT"F5  : Decipher a message in memory"
230   LOCATE 16,24:PRINT"F6  : Type a new message"
240   LOCATE 17,24:PRINT"F7  : Edit/read a message in memory"
250   LOCATE 18,24:PRINT"F8  : Print a file"
260   LOCATE 19,24:PRINT"F9  : Save on/Receive from tape"
270   LOCATE 21,24:PRINT"F10 : Quit"
280   CH$=INKEY$:IF CH$="" THEN 280
290   IF LEN(CH$)=2 THEN CH$=RIGHT$(CH$,1)
300   M=ASC(CH$)-58
310 :
320 REM **** Load a file ****
330   WHILE M=1
340     GOSUB 5490:BEEP:LOCATE 2,3:PRINT"LOAD MESSAGES FROM DISK INTO MEMORY"
350     LOCATE 4,3:PRINT"** Ensure 'MESSAGE' disk is in drive **"
360     LOCATE 21,3:PRINT"Press any key when ready. ESCape to return to Main Menu"
370     CNT$=INKEY$:IF CNT$="" THEN 370
380     IF ASC(CNT$)=27 THEN 110
390     GOSUB 5490:LOCATE 2,3:PRINT"LOAD MESSAGES FROM DISK"
400     ER=0:PRINT:FILES "A:*.*"
410     PRINT:PRINT CHR$(186);" Type in name of message to load"
420     PRINT:PRINT CHR$(186);" or press ENTER to return to Main Menu"
430     PRINT:PRINT CHR$(186);:PRINT" Message name: ":NM$="œ$%":UP=0
440     WHILE NM$<>""
450       V=CSRLIN-UP:LOCATE V-1,15:PRINT SPC(15):LOCATE V-1,15:INPUT": ",NM$
460       IF NM$="" THEN 110
470       ER=1:NAME "A:"+NM$ AS "A:"+NM$
480       L$="COPY A:"+NM$+" E:"
490       SHELL L$
500       UP=2:VD=CSRLIN:LOCATE VD,1:PRINT CHR$(186)
510     WEND
520   WEND
530 :
540 REM **** Save a file ****
550   WHILE M=2
560     GOSUB 5490:BEEP:LOCATE 2,3:PRINT"SAVE MESSAGES IN MEMORY ONTO DISK"
570     LOCATE 4,3:PRINT"** Ensure 'MESSAGE' disk is in drive **"
580     LOCATE 21,3:PRINT"Press any key when ready. ESCape to return to Main Menu"
590     CNT$=INKEY$:IF CNT$="" THEN 590
600     IF ASC(CNT$)=27 THEN 110
610     GOSUB 5490:LOCATE 2,3:PRINT"SAVE MESSAGES IN MEMORY ONTO DISK"
620     ER=2:PRINT:FILES "E:*.*"
630     PRINT:PRINT CHR$(186);" Type in name of message to save"
640     PRINT:PRINT CHR$(186);" or press ENTER to return to Main Menu"
650     PRINT:PRINT CHR$(186);:PRINT" Message name: ":NM$="+?,":UP=0
660     WHILE NM$<>""
670       V=CSRLIN-UP:LOCATE V-1,15:PRINT SPC(15):LOCATE V-1,15:INPUT": ",NM$
680       IF NM$="" THEN 110
690       ER=3:NAME "E:"+NM$ AS "E:"+NM$
700       S$="COPY E:"+NM$+" A:"
710       SHELL S$
720       UP=2:VD=CSRLIN:LOCATE VD,1:PRINT CHR$(186)
730     WEND
740   WEND
750 :
760 REM **** Delete a file ****
770   WHILE M=3
780     GOSUB 5490:BEEP:LOCATE 2,3:PRINT"DELETE MESSAGES ON DISK"
790     LOCATE 4,3:PRINT"** Ensure 'MESSAGE' disk is in drive **"
800     LOCATE 21,3:PRINT"Press any key when ready. ESCape to return to Main Menu"
810     CNT$=INKEY$:IF CNT$="" THEN 810
820     IF ASC(CNT$)=27 THEN 110 ELSE M=3.1
830     WHILE M=3.1
840       GOSUB 5490
850       LOCATE 2,3:PRINT"DELETE MESSAGES ON DISK"
860       ER=4:PRINT:FILES "A:*.*"
870       PRINT:PRINT CHR$(186);" Type in name of message to delete"
880       PRINT:PRINT CHR$(186);" or ENTER to return to Main Menu"
890       PRINT:PRINT CHR$(186);:INPUT " Message name: ",NM$
900       IF NM$="" THEN 110
910      ER=5:NAME "A:"+NM$ AS "A:"+NM$
920      KILL "A:"+NM$
930     WEND
940   WEND
950 :
960 REM **** Encipher ****
970   WHILE M=4
980     GOSUB 5490:BEEP:LOCATE 2,3:PRINT "ENCIPHER A MESSAGE"
990     LOCATE 4,3:PRINT"** Ensure 'DATA' disk is in drive **"
1000     LOCATE 21,3:PRINT"Press any key when ready. ESCape to return to Main Menu"
1010     CNT$=INKEY$:IF CNT$="" THEN 1010
1020     IF ASC(CNT$)=27 THEN 110 ELSE M=4.1
1030     WHILE M=4.1
1040       GOSUB 5490
1050       LOCATE 2,3:PRINT "ENCIPHER A MESSAGE"
1060       PRINT:FILES "E:*"
1070       PRINT:PRINT CHR$(186);" Type in name of message to encipher"
1080       PRINT:PRINT CHR$(186);" or press ENTER to return to Main Menu"
1090       PRINT:PRINT CHR$(186);:INPUT" Message name: ",NM$
1100       IF NM$="" THEN 110
1110       NAME "E:"+NM$ AS "E:"+NM$
1120       CLS:GOSUB 5490:LOCATE 6,3:PRINT"Enciphering. Please wait..."
1130       ER=7:OPEN "I",1,"A:SETNUM":INPUT#1,GETNUM:CLOSE 1
1140       IF GETNUM>99 THEN BF=5:GOTO 4490
1150       LOCATE 18,2:PRINT 99-GETNUM;" sets of numbers left after this message"
1160       OPEN "I",1,"A:SDNO":INPUT#1,DINOS$:CLOSE 1
1170       DNO=VAL(MID$(DINOS$,GETNUM*2+1,2))
1180       OPEN "O",1,"D:ALFA.TMP"
1190       OPEN "R",2,"A:SALFJOIN",200
1200       FIELD#2,200 AS FSA$
1210       GET#2,GETNUM+1
1220       PRINT#1,FSA$:CLOSE
1230       OPEN "O",1,"D:NUMS.TMP"
1240       OPEN "R",2,"A:SNUMJOIN",130
1250       FIELD#2,130 AS FSN$
1260       FOR N=1 TO 20:GET#2,(GETNUM*20)+N:SN$(N)=FSN$:NEXT N
1270       FOR P=1 TO 20:PRINT#1,SN$(P);:NEXT P
1280       CLOSE
1290       OPEN "I",1,"D:ALFABET"
1300       OPEN "I",2,"D:ALFA.TMP"
1310       OPEN "I",3,"D:NUMS.TMP"
1320       FOR BET = 0 TO 99
1330         ALPH$(BET,0)=INPUT$(1,#1)
1340         VL1$=INPUT$(1,#2)
1350         VL2$=INPUT$(1,#2)
1360         ALPH$(BET,1)=VL1$+VL2$
1370       NEXT BET
1380       CLOSE 1:CLOSE 2
1390       OPEN "O",1,"E:"+NM$+".ENC"
1400       OPEN "I",2,"E:"+NM$
1410       DNO$=ALPH$(DNO,0):RANDOMIZE TIMER
1420       AGNO$=CHR$(INT(33+(20*RND)))
1430       FOR N=1 TO 5:PRINT#1,AGNO$;:NEXT N
1440       FOR N=1 TO 4:PRINT#1,CHR$(132);:NEXT N:PRINT#1,DNO$;
1450       LOCATE 18,3:PRINT"Character number:                            "
1460       LENGTH=0:COUNT=0:SLET$="":BM=133
1470       WHILE NOT EOF(2)
1480         AX=ASC(INPUT$(1,#2))
1490         IF AX<32 THEN AX=32
1500         IF AX>131 THEN AX=32
1510         LENGTH=LENGTH+1
1520         LV$=ALPH$(AX-32,1)
1530         RN1$=INPUT$(1,#3)
1540         RN2$=INPUT$(1,#3):COUNT=COUNT+2
1550         IF COUNT MOD 2600=0 THEN CLOSE 3:OPEN "I",3,"D:NUMS.TMP":COUNT=0
1560         CD1=VAL(LEFT$(LV$,1))+VAL(RN1$):IF CD1>9 THEN CD1=CD1-10
1570         CD2=VAL(RIGHT$(LV$,1))+VAL(RN2$):IF CD2>9 THEN CD2=CD2-10
1580         CD=CD2*10+CD1:SLET$=""
1590         IF CD<100 THEN SLET$=ALPH$(CD,0)
1600         IF LENGTH MOD 5=0 THEN SLET$=SLET$+CHR$(BM):BM=BM+1
1610         IF BM=138 THEN BM=133
1620         PRINT#1,SLET$;
1630         LOCATE 18,21:PRINT LENGTH;"   "
1640       WEND
1650       FOR N=1 TO 4:PRINT#1,CHR$(138);:NEXT N
1660       PRINT#1,CHR$(26):CLOSE
1670       ER=8:NAME "A:SETNUM" AS "A:SETNUM"
1680       GOSUB 5490:LOCATE 6,3:PRINT"Enciphering finished. Flushing disk..."
1690       LOCATE 18,3:PRINT"Message length: ";LENGTH;" characters"
1700       OPEN "R",1,"A:SALFJOIN",200
1710       FIELD#1,200 AS DSA$
1720       LSET DSA$=STRING$(200,0):PUT#1,GETNUM+1
1730       CLOSE
1740       OPEN "R",1,"A:SNUMJOIN",130
1750       FIELD#1,130 AS DSN$
1760       FOR N=1 TO 20:LSET DSN$=STRING$(130,0):PUT#1,(GETNUM*20)+N:NEXT N
1770       CLOSE
1780       KILL "D:*.TMP"
1790       GETNUM=GETNUM+1
1800       OPEN "O",1,"A:SETNUM":PRINT#1,GETNUM:CLOSE
1810       GOTO 110
1820     WEND
1830   WEND
1840 :
1850 REM **** Decipher ****
1860   WHILE M=5
1870     GOSUB 5490:BEEP:LOCATE 2,3:PRINT "DECIPHER A MESSAGE"
1880     LOCATE 4,3:PRINT"** Ensure 'DATA' disk is in drive **"
1890     LOCATE 21,3:PRINT"Press any key when ready. ESCape to return to Main Menu"
1900     CNT$=INKEY$:IF CNT$="" THEN 1900
1910     IF ASC(CNT$)=27 THEN 110 ELSE M=5.1
1920     WHILE M=5.1
1930       GOSUB 5490
1940       LOCATE 2,3:PRINT "DECIPHER A MESSAGE"
1950       ER=9:PRINT:FILES "E:*"
1960       PRINT:PRINT CHR$(186);" Type in name of message to decipher"
1970       PRINT:PRINT CHR$(186);" or press ENTER to return to Main Menu"
1980       PRINT:PRINT CHR$(186);:INPUT" Message name: ",NM$
1990       IF NM$="" THEN 110
2000       NAME "E:"+NM$ AS "E:"+NM$
2010       GOSUB 5490:LOCATE 6,3:PRINT"Deciphering. Please wait..."
2020       SC=0:N=0
2030       OPEN "I",1,"E:"+NM$
2040       IP$=INPUT$(1,#1)
2050       IF SC=0 AND ASC(IP$)<>132 THEN 2040
2060       IF ASC(IP$)<32 OR ASC(IP$)>132 THEN 2040
2070       IF ASC(IP$)=132 THEN SC=SC+1:GOTO 2040
2080       IF ASC(IP$)>31 AND ASC(IP$)<132 AND SC>=2 THEN DNO=ASC(IP$)-32
2090       CLOSE
2100       ER=10:OPEN "I",1,"A:RDNO":INPUT#1,DX$:CLOSE
2110       WHILE DNO<>N
2120         N=N+1
2130         IF VAL(MID$(DX$,N*2-1,2))=DNO THEN DNO=N
2140       WEND
2150       OPEN "O",1,"D:DALFA.TMP"
2160       OPEN "R",2,"A:RALFJOIN",100
2170       FIELD#2,100 AS FRA$
2180       GET#2,DNO
2190       PRINT#1,FRA$:CLOSE
2200       OPEN "O",1,"D:DNUMS.TMP"
2210       OPEN "R",2,"A:RNUMJOIN",130
2220       FIELD#2,130 AS FRN$
2230       FOR N=1 TO 20:GET#2,((DNO-1)*20)+N:RN$(N)=FRN$:NEXT N
2240       FOR P=1 TO 20:PRINT#1,RN$(P);:NEXT P
2250       CLOSE
2260       OPEN "I",1,"E:"+NM$
2270       OPEN "I",2,"D:DALFA.TMP"
2280       OPEN "I",3,"D:DNUMS.TMP"
2290       FOR DBET=0 TO 99
2300         LT$=INPUT$(1,#2)
2310         DALPH$(DBET)=LT$
2320       NEXT DBET
2330       CLOSE 2
2340       IF INSTR(NM$,".enc") OR INSTR(NM$,".ENC") THEN NM$=LEFT$(NM$,LEN(NM$)-4)
2350       OPEN "O",2,"E:"+NM$+".DEC"
2360       GOSUB 5490:LOCATE 2,3:PRINT"Message reads:"
2370       SC=0:CH=0:EC=0:R=4:C=3:CT=0:CK=0:BX=1
2380       DIP$=INPUT$(1,#1)
2390       IF SC=0 AND ASC(DIP$)<>132 THEN 2380
2400       IF ASC(DIP$)=132 THEN SC=SC+1:GOTO 2380
2410       WHILE EC<3
2420         IF BX=6 THEN BX=1
2430         IP$=INPUT$(1,#1)
2440         IF ASC(IP$)<32 AND ASC(IP$)>138 THEN 2430
2450         IF ASC(IP$)=138 THEN EC=EC+1:GOTO 2730
2460         D=ASC(IP$)-32
2470         IF D>100 AND D<106 THEN BM=D-100:CK=1
2480         WHILE CK
2490           IF CH=5 AND BM=BX THEN BX=BX+1:CH=0:CK=0:GOTO 2420
2500           IF CH=5 AND BM<>BX THEN BX=BX+1:CH=0
2510           IF BX=6 THEN BX=1
2520           IF CB<5 THEN D=99:GOTO 2550
2530         WEND
2540         IF CH=5 THEN CH=0:BX=BX+1
2550         DNR$=STR$(D):IF D<10 THEN DNR$="0"+DNR$
2560         D2$=MID$(DNR$,2,1):D1$=RIGHT$(DNR$,1)
2570         SUBT1$=INPUT$(1,#3):CT=CT+1
2580         IF VAL(D1$)<VAL(SUBT1$) THEN D1$=STR$(VAL(D1$)+10)
2590         DNUM1$=STR$(VAL(D1$)-VAL(SUBT1$))
2600         SUBT2$=INPUT$(1,#3):CT=CT+1
2610         IF CT MOD 2600=0 THEN CLOSE 3:OPEN "I",3,"D:DNUMS.TMP":COUNT=0
2620         IF VAL(D2$)<VAL(SUBT2$) THEN D2$=STR$(VAL(D2$)+10)
2630         DNUM2$=STR$(VAL(D2$)-VAL(SUBT2$))
2640         DNUM$=DNUM1$+DNUM2$
2650         DNUM=VAL(DNUM$)
2660         PLAIN$=DALPH$(DNUM)
2670         IF CK THEN PLAIN$="?"
2680         LOCATE R,C:PRINT PLAIN$;:PRINT#2,PLAIN$;
2690         C=C+1:CH=CH+1
2700         IF C=79 THEN C=3:R=R+1
2710         IF R=20 THEN R=4
2720         IF CK THEN 2480
2730       WEND
2740       CLOSE
2750       LOCATE 20,1:PRINT CHR$(204):LOCATE 20,2:PRINT BDR$:LOCATE 20,80:PRINT CHR$(185)
2760       LOCATE 21,3:PRINT"This message is in memory. It can be printed out and saved on disk."
2770       LOCATE 22,3:PRINT"Press ESCape to redo or any other key to clear screen and flush disk"
2780       CNT$=INKEY$:IF CNT$="" THEN 2780
2790       IF ASC(CNT$)=27 THEN CLOSE:GOTO 60
2800       ER=10.1:NAME "A:RALFJOIN" AS "A:RALFJOIN"
2810       GOSUB 5490:LOCATE 6,3:PRINT"Flushing disk..."
2820       OPEN "R",1,"A:RALFJOIN",100
2830       FIELD#1,100 AS DRA$
2840       LSET DRA$=STRING$(100,0):PUT#1,DNO
2850       CLOSE
2860       OPEN "R",1,"A:RNUMJOIN",130
2870       FIELD#1,130 AS DRN$
2880       FOR N=1 TO 20:LSET DRN$=STRING$(130,0):PUT#1,((DNO-1)*20)+N:NEXT N
2890       CLOSE
2900       KILL "D:*.TMP"
2910       GOTO 110
2920     WEND
2930   WEND
2940 :
2950 REM **** Type a new message ****
2960   WHILE M=6
2970     GOSUB 5490:BEEP:LOCATE 2,3:PRINT"TYPE A NEW MESSAGE"
2980     LOCATE 4,3:PRINT"** Ensure program disk is in drive **"
2990     LOCATE 20,3:PRINT"Press any key when ready. ESCape to return to Main Menu"
3000     CNT$=INKEY$:IF CNT$="" THEN 3000
3010     IF ASC(CNT$)=27 THEN 110
3020     GOSUB 5490:LOCATE 2,3:PRINT"TYPE A NEW MESSAGE"
3030     LOCATE 4,3:PRINT"Give a name to the message you are about to type"
3040     LOCATE 5,3:PRINT"or press ENTER to return to Main Menu"
3050     LOCATE 7,3:PRINT"The name you give must:"
3060     LOCATE 9,3:PRINT"- only contain alphabet keys"
3070     LOCATE 10,3:PRINT"- not be longer than 8 characters"
3080     LOCATE 11,3:PRINT"- not contain spaces"
3090     LOCATE 12,3:PRINT"- not have an extension"
3100     ER=12:LOCATE 14,3:INPUT "Message name: ",NM$
3110     IF NM$="" THEN 110
3120     IF ASC(LEFT$(NM$,1))>47 AND ASC(LEFT$(NM$,1))<58 THEN BF=4:GOTO 4490
3130     IF INSTR(NM$," ") THEN BF=1:GOTO 4490
3140     IF INSTR(NM$,".") THEN BF=2:GOTO 4490
3150     IF LEN(NM$)>8 THEN BF=3:GOTO 4490
3160     NAME "E:"+NM$ AS "E:"+NM$
3170     M=20
3180   WEND
3190 :
3200 REM **** Edit a message in memory ****
3210   WHILE M=7
3220     GOSUB 5490:BEEP:LOCATE 2,3:PRINT"EDIT/READ A MESSAGE IN MEMORY"
3230     LOCATE 4,3:PRINT"** Ensure program disk is in drive **"
3240     LOCATE 20,3:PRINT"Press any key when ready. ESCape to return to Main Menu"
3250     CNT$=INKEY$:IF CNT$="" THEN 3250
3260     IF ASC(CNT$)=27 THEN 110
3270     GOSUB 5490:LOCATE 2,3:PRINT"EDIT/READ A MESSAGE IN MEMORY"
3280     ER=13:PRINT:FILES "E:*.*"
3290     PRINT:PRINT CHR$(186);" Type in name of message to edit or read"
3300     PRINT:PRINT CHR$(186);" or ENTER to return to Main Menu"
3310     PRINT:PRINT CHR$(186);:INPUT" Message name: ",NM$
3320     IF NM$="" THEN 110
3330     NAME "E:"+NM$ AS "E:"+NM$
3340     M=20
3350   WEND
3360 :
3370 REM **** Message editor ****
3380   WHILE M=20
3390     ER=14:SHELL "EDIT E:"+NM$
3400     M=0
3410   WEND
3420 :
3430 REM **** Print file ****
3440   WHILE M=8
3450     GOSUB 5490:LOCATE 2,3:PRINT"PRINT A FILE"
3460     ER=15:PRINT:FILES "E:*.*"
3470     PRINT:PRINT CHR$(186);" Type in name of file you wish to print"
3480     PRINT:PRINT CHR$(186);" or press ENTER to return to Main Menu"
3490     PRINT:PRINT CHR$(186);:PRINT" Message name: ":NM$="*/A":UP=0
3500     WHILE NM$<>""
3510       V=CSRLIN-UP:LOCATE V-1,15:PRINT SPC(15):LOCATE V-1,15:INPUT": ",NM$
3520       IF NM$="" THEN 110
3530       ER=16:NAME "E:"+NM$ AS "E:"+NM$
3540       LPRINT CHR$(27);CHR$(64);CHR$(15)
3550       P$="TYPE E:"+NM$+" >prn"
3560       SHELL P$
3570       LPRINT CHR$(18);CHR$(12)
3580       UP=2:VD=CSRLIN:LOCATE VD,1:PRINT CHR$(186)
3590     WEND
3600   WEND
3610 :
3620 REM **** Tape ****
3630   WHILE M=9
3640     GOSUB 5490:LOCATE 5,31:PRINT"TAPE RECORDER MENU"
3650     LOCATE 10,29:PRINT"S   : Save on tape"
3660     LOCATE 12,29:PRINT"R   : Receive from tape"
3670     LOCATE 14,29:PRINT"ESC : Return to Main Menu"
3680     ESAU$=INKEY$:IF ESAU$="" THEN 3680
3690     IF ASC(ESAU$)=27 THEN 110
3700     IF ESAU$<>"R" AND ESAU$="r" AND ESAU$<>"S" AND ESAU$="s" THEN 3680
3710     WHILE ESAU$="s" OR ESAU$="S"
3720       GOSUB 5490:LOCATE 2,3:PRINT"SAVE AN ENCIPHERED MESSAGE ON TAPE"
3730       ER=17:PRINT:FILES "E:*.ENC"
3740       PRINT:PRINT CHR$(186);" Type in name of enciphered message to save on tape"
3750       PRINT:PRINT CHR$(186);" or press ENTER to return to Main Menu"
3760       PRINT:PRINT CHR$(186);:INPUT" Message name: ",NM$
3770       IF NM$="" THEN 110
3780       ER=18:NAME "E:"+NM$ AS "E:"+NM$
3790       GOSUB 5490:BEEP:LOCATE 2,3:PRINT"** Ensure modem is on and connected to recorder properly **"
3800       LOCATE 4,3:PRINT"Press PLAY and RECORD on tape recorder"
3810       LOCATE 21,3:PRINT"Press any key when ready. ESCape to return to Main Menu"
3820       CNT$=INKEY$:IF CNT$="" THEN 3820
3830       IF ASC(CNT$)=27 THEN ESAU$="":GOTO 110
3840       GOSUB 5490:LOCATE 6,3:PRINT"Saving to tape..."
3850       LATER=TIMER+5
3860       WHILE TIMER<LATER
3870       WEND
3880       ER=19:OPEN "COM1:300,N,8,1,CS,DS,CD" AS #1
3890       OPEN "I",2,"E:"+NM$
3900       WHILE NOT EOF (2)
3910         TAPNM$=INPUT$(1,#2):PRINT#1,TAPNM$;
3920       WEND
3930       CLOSE:GOTO 110
3940     WEND
3950     WHILE ESAU$="r" OR ESAU$="R"
3960       GOSUB 5490:LOCATE 2,3:PRINT"RECEIVE AN ENCIPHERED MESSAGE FROM TAPE"
3970       LOCATE 4,3:PRINT"Give a name to the message to be received from tape"
3980       LOCATE 5,3:PRINT"or press ENTER to return to Main Menu"
3990       LOCATE 7,3:PRINT"The name you give must:"
4000       LOCATE 9,3:PRINT"- only contain alphabet keys"
4010       LOCATE 10,3:PRINT"- not be longer than 8 characters"
4020       LOCATE 11,3:PRINT"- not contain spaces"
4030       LOCATE 12,3:PRINT"- not have an extension"
4040       LOCATE 14,3:INPUT"Message name: ",NM$
4050       IF NM$="" THEN 110
4060       IF ASC(LEFT$(NM$,1))>47 AND ASC(LEFT$(NM$,1))<58 THEN BF=4:GOTO 4490
4070       IF INSTR(NM$," ") THEN BF=1:GOTO 4490
4080       IF INSTR(NM$,".") THEN BF=2:GOTO 4490
4090       IF LEN(NM$)>8 THEN BF=3:GOTO 4490
4100       GOSUB 5490:BEEP:LOCATE 2,3:PRINT"** Ensure modem is on and connected to recorder properly **"
4110       LOCATE 21,3:PRINT"Press any key when ready. ESCape to return to Main Menu"
4120       CNT$=INKEY$:IF CNT$="" THEN 4120
4130       IF ASC(CNT$)=27 THEN 110
4140       GOSUB 5480:BEEP:LOCATE 2,3:PRINT"Press PLAY on recorder to transfer '";NM$;"'"
4150       ER=20:EC=0:C=3:R=4
4160       OPEN "COM1:300,N,8,1,CS,DS,CD" AS #1
4170       OPEN "O",2,"E:"+NM$
4180       WHILE EC<=3
4190         BIT$=INPUT$(1,#1)
4200         IF ASC(BIT$)=138 THEN EC=EC+1
4210         LOCATE R,C:PRINT BIT$;:PRINT#2,BIT$;:C=C+1
4220         IF C=79 THEN C=3:R=R+1
4230         IF R=20 THEN R=4
4240       WEND
4250       PRINT#2,CHR$(13):CLOSE
4260       LOCATE 20,1:PRINT CHR$(204):LOCATE 20,2:PRINT BDR$:LOCATE 20,80:PRINT CHR$(185)
4270       LOCATE 21,3:PRINT"This message is in memory. It can now be deciphered"
4280       LOCATE 22,3:PRINT"Press ESCape to redo or any other key to clear screen"
4290       CNT$=INKEY$:IF CNT$="" THEN 4290
4300       IF ASC(CNT$)=27 THEN 4140
4310       GOTO 110
4320     WEND
4330   WEND
4340 :
4350 REM **** Quit ****
4360   WHILE M=10
4370     GOSUB 5490:LOCATE 6,23:BEEP:PRINT"** Are you sure you want to quit? **"
4380     LOCATE 8,20:PRINT"Type Y to quit or N to return to Main Menu"
4390     QUIT$=INKEY$:IF QUIT$="" THEN 4390
4400     IF QUIT$<>"Y" AND QUIT$<>"y" THEN 70
4410     GOSUB 5490:LOCATE 2,3:BEEP:PRINT"** Ensure program disk is in drive **"
4420     LOCATE 21,3:PRINT"Press any key to continue"
4430     CNT$=INKEY$:IF CNT$="" THEN 4430
4440     IF QUIT$="y" OR QUIT$="Y" THEN SYSTEM
4450   WEND
4460 :
4470 WEND
4480 :
4490 REM **** Errors ****
4500 GOSUB 5490:FOR N=1 TO 3:BEEP:NEXT N:LOCATE 2,3
4510 IF BF=0 THEN PRINT"** You pressed the wrong key **"
4520 IF BF=1 OR BF=7 THEN PRINT"** No spaces allowed in name **"
4530 IF BF=2 OR BF=8 THEN PRINT"** No extensions allowed in name **"
4540 IF BF=3 OR BF=9 THEN PRINT"** Name too long **"
4550 IF BF=4 OR BF=10 THEN PRINT"** Numbers not allowed in name **"
4560 IF BF=5 THEN PRINT"** All data on this disk has been used. Start a new 'DATA' disk **"
4570 IF BF=6 THEN PRINT"** '";NM$;"' does not exist or may not be edited **"
4580 LOCATE 4,3:PRINT"Try again"
4590 LOCATE 21,3:PRINT"Press a key to continue. ESCape to return to Main Menu"
4600 CNT$=INKEY$:IF CNT$="" THEN 4600
4610 IF ASC(CNT$)=27 THEN GOTO 110
4620 IF BF=0 THEN 110
4630 IF BF=1 THEN 3020
4640 IF BF=2 THEN 3020
4650 IF BF=3 THEN 3020
4660 IF BF=4 THEN 3020
4670 IF BF=5 THEN 110
4680 IF BF=6 THEN 3270
4690 IF BF=7 THEN 3960
4700 IF BF=8 THEN 3960
4710 IF BF=9 THEN 3960
4720 IF BF=10 THEN 3960
4730 :
4740 REM **** Error Messages ****
4750 IF ERR=58 THEN RESUME NEXT
4760 IF ER=12 OR ER=13 AND ERR=53 THEN RESUME NEXT
4770 GOSUB 5490:FOR N=1 TO 3:BEEP:NEXT N:LOCATE 2,3
4780 IF ERR=53 AND ER=0 THEN PRINT"** There are no files on this disk to load **"
4790 IF ERR=71 THEN PRINT"** Disk not in drive or door open **"
4800 IF ERR=53 AND ER=1 THEN PRINT"** There is no file '";NM$;"' to load from this disk **"
4810 IF ERR=53 AND ER=2 THEN PRINT"** There are no files in memory to save **"
4820 IF ERR=53 AND ER=3 THEN PRINT"** There is no file '";NM$;"' in memory to save **"
4830 IF ERR=53 AND ER=4 THEN PRINT"** There are no files on this disk to delete **"
4840 IF ERR=53 AND ER=5 THEN PRINT"** There is no file '";NM$;"' to delete on this disk **"
4850 IF ERR=70 AND ER=5 THEN PRINT"** Disk write-protected **"
4860 IF ERR=53 AND ERL=1060 THEN PRINT"** There is no message in memory to encipher! **"
4870 IF ERR=53 AND ERL=1110 THEN PRINT"** There is no file '";NM$;"' in memory to encipher! **"
4880 IF ERR=53 AND ER=7 THEN PRINT"** Wrong disk. Place 'DATA' disk in drive **"
4890 IF ERR=62 AND ERL=1340 THEN PRINT"** All data on this disk has been used. Start a new 'DATA' disk **"
4900 IF ERR=53 AND ER=8 THEN PRINT"** Wrong disk. Place 'DATA' disk in drive **"
4910 IF ERR=70 AND ER=8 THEN PRINT"** Disk write protected. Switch tab to delete numbers **"
4920 IF ERR=53 AND ER=9 THEN PRINT"** There is no file in memory to decipher! **"
4930 IF ERR=53 AND ERL=2000 THEN PRINT"** There is no file '";NM$;"' in memory to decipher! **"
4940 IF ERR=5 AND ERL=2040 THEN PRINT"** You've tried to decipher an un-enciphered message! **":M=5.1
4950 IF ERR=62 AND ERL=2040 THEN PRINT"** You've tried to decipher an un-enciphered message! **"
4960 IF ERR=9 AND ER=10 THEN PRINT"** Bad data. Can't continue. Print out up to here **"
4970 IF ERR=53 AND ER=10 THEN PRINT"** Wrong disk. Place 'DATA' disk in drive **"
4980 IF ERR=62 AND ER=10 THEN PRINT"** Ending missing. Read in editor or print out **"
4990 IF ERR=53 AND ER=10.1 THEN PRINT"** Wrong disk. Place 'DATA' disk in drive **"
5000 IF ERR=70 AND ER=10.1 THEN PRINT"** Disk write protected. Switch tab to delete numbers **"
5010 IF ERR=53 AND ER=11 THEN PRINT"** Wrong disk. Place 'DATA' disk in drive **"
5020 IF ERR=58 AND ER=12 THEN PRINT"** You've already used '";NM$;"'. Use another name **"
5030 IF ERR=13 AND ER=12 THEN PRINT"** No numbers allowed in name **"
5040 IF ERR=53 AND ER=13 THEN PRINT"** There is no message in memory to edit! **"
5050 IF ERR=53 AND ER=14 THEN PRINT"** Program disk not in drive **"
5060 IF ERR=71 AND ER=14 THEN PRINT"** Program disk not in drive **"
5070 IF ERR=53 AND ER=15 THEN PRINT"** There are no messages in memory to print out **"
5080 IF ERR=53 AND ER=16 THEN PRINT"** There is no message '";NM$;"' to print out **"
5090 IF ERR=25 THEN PRINT"** Printer off or not connected **"
5100 IF ERR=27 THEN PRINT"** Printer off or not connected or out of paper **"
5110 IF ERR=53 AND ER=17 THEN PRINT"** There are no messages in memory to save on tape **"
5120 IF ERR=53 AND ER=18 THEN PRINT"** There is no message '";NM$;"' to save on tape **"
5130 IF ERR=57 AND ER=20 THEN PRINT"** Signal corrupted or volume incorrect **"
5140 LOCATE 4,3:PRINT"Try again"
5150 LOCATE 21,3:PRINT"Press a key to continue. ESCape to return to Main Menu"
5160 CNT$=INKEY$:IF CNT$="" THEN 5160
5170 IF ASC(CNT$)=27 THEN CLOSE:GOTO 70
5180 IF ER=0 THEN RESUME 70                            'load 1
5190 IF ER=1 THEN RESUME 390                           'load 2
5200 IF ER=2 THEN RESUME 70                            'save 1
5210 IF ER=3 THEN RESUME 610                           'save 2
5220 IF ER=4 THEN RESUME 70                            'delete 1
5230 IF ER=5 THEN RESUME 830                           'delete 2
5240 IF ERL=1060 THEN RESUME 70                        'encipher 1
5250 IF ERL=1110 THEN RESUME 1030                      'encipher 2
5260 IF ERL=1340 THEN CLOSE:RESUME 70                  'encipher 4
5270 IF ER=7 THEN RESUME 1120                          'encipher 5
5280 IF ER=8 THEN RESUME 1680                          'encipher 4
5290 IF ER=9 THEN RESUME 70                            'decipher 1
5300 IF ERL=2000 THEN RESUME 1940                      'decipher 2
5310 IF ERL=2040 THEN CLOSE:RESUME 2010                'decipher 3
5320 IF ER=10 AND ERR=9 THEN CLOSE:RESUME 70           'decipher 3
5330 IF ER=10 AND ERR=62 THEN CLOSE:RESUME 70          'decipher 4
5340 IF ER=10 THEN CLOSE:RESUME 2050                   'decipher 5
5350 IF ER=10.1 THEN RESUME 2810                       'decipher 6
5360 IF ER=11 THEN RESUME 2810                         'decipher 7
5370 IF ER=12 THEN RESUME 2960                         'new
5380 IF ER=13 THEN RESUME 3210                         'old
5390 IF ER=14 THEN RESUME 3380                         'edit
5400 IF ER=15 THEN RESUME 70                           'print 1
5410 IF ER=16 THEN RESUME 3440                         'print 2
5420 IF ER=17 THEN RESUME 70                           'tape 1
5430 IF ER=18 THEN RESUME 3710                         'tape 2
5440 IF ER=20 THEN CLOSE:RESUME 4140                   'tape 3
5450 IF ERR=64 THEN RESUME NEXT
5460 IF ER<0 OR ER>20 THEN CLOSE:RESUME 70
5470 CLOSE:GOTO 70
5480 :
5490 REM **** border ****
5500 CLS:LOCATE 1,1:PRINT CHR$(201)
5510 BDR$=STRING$(78,205):LOCATE 1,2:PRINT BDR$
5520 LOCATE 1,80:PRINT CHR$(187)
5530 FOR V=2 TO 22:LOCATE V,1:PRINT CHR$(186):LOCATE V,80:PRINT CHR$(186):NEXT V
5540 LOCATE 23,1:PRINT CHR$(200)
5550 LOCATE 23,2:PRINT BDR$
5560 LOCATE 23,80:PRINT CHR$(188)
5570 RETURN
5580 :
5590 REM **** Create alphabet ****
5600 OPEN "D:ALFABET" FOR OUTPUT AS#1
5610 FOR N=32 TO 131:PRINT#1,CHR$(N);:NEXT N
5620 CLOSE 1
5630 RETURN
5640 :
5650 OPEN "O",1,"A:SETNUM":PRINT#1,"0":CLOSE