HAM Radio 1/HamRadio.cdr/misc/pc-hamd1/rttytalk.bas

BASIC Source File | 1984-03-03 | 48KB | 890 lines

50 SCREEN 0,1,0:WIDTH 80:CLS:KEY OFF:LOCATE ,,0
110 CLOSE:DEFINT A-Z:ON ERROR GOTO 9000
115 I=0:P=0:A$="":RC=0:PR=0:LF$="":BS$="":NS=0:DIM S$(3):DIM R$(3):SET=0:PSE=0:XF$="":XN$="":HLT=0:X$="":Y$="":Z$="":B$="":C$="":J=0
120 FLN!=0:CNT!=0
125 DIM ALT$(10):DIM K$(40)
126 FIGS=2:RSWIT=1:RTTY=0
127 DIM ASCII1$(257),ASCII2$(257),BAUDOT$(32,3)
130 FOR I=1 TO 10:KEY I,"":NEXT
135 BS$=CHR$(8):LF$=CHR$(10):CR$=CHR$(13)
140 RCV$="":TRN$="":DIAL$="":STRT$="--":GO$="Ready"
145 DIM KPG$(4):KPG$(1)="Func":KPG$(2)=" Alt":KPG$(3)="Shft":KPG$(4)="Ctrl
150 DIM DS$(3):DIM DR$(3)
155 VL$=CHR$(179):EF$=CHR$(26):BL$=CHR$(7):ENT$=CHR$(17)+CHR$(196)+CHR$(217)
160 XN$=CHR$(17):XF$=CHR$(19):SOH$=CHR$(1):EOT$=CHR$(4):ACK$=CHR$(6):NAK$=CHR$(21):CAN$=CHR$(24)
165 DFIL$="pc-talk.dir":KFIL$="pc-talk.key":FFIL$="pc-talk.def":IFIL$="INITIALIII"
200 ' Get Defaults
210 DFNUM=29:DIM DP$(29):DIM D$(29):DIM DT$(29)
215 CLOSE#1:OPEN FFIL$ FOR INPUT AS #1
220 INPUT#1,Q$:IF Q$<>IFIL$ THEN 245
225 FOR I=1 TO DFNUM:INPUT#1,DP$(I),D$(I):NEXT
235 INPUT#1,Q$:IF Q$<>IFIL$ THEN 245
240 GOSUB 5600:GOTO 300
245 BEEP:PRINT"*** Re-initializing Default File ***":CLOSE#1:KILL FFIL$:GOTO 5400
250 '
300 ' Start-up
305 '
310 B$=" "
315 '
400 '
405 CLOSE#2:OPEN KFIL$ AS #2:FIELD #2,126 AS K$,2 AS L$
410 GET#2,1:IF LEFT$(K$,LEN(IFIL$))<>IFIL$ THEN GOSUB 7425
415 FOR I=1 TO 40:GET#2,I+1:LN=CVI(L$):IF LN=0 THEN 420 ELSE K$(I)=LEFT$(K$,LN)
420 NEXT:CLOSE#2
425 CLOSE#1:OPEN COMM$ AS #1:PRINT#1,MODMINIT$;
428 GOSUB 11000
430 ROW=1:COL=1:GOSUB 2820:LOCATE 1,1,1:PRINT GO$
435 '
500 ' Main Input/Output
505 '
510 '-keyboard
515 IF TR THEN IF TR$="X" THEN 4860 ELSE 4060
520 B$=INKEY$:IF B$="" THEN 560
525 IF LEN(B$)>1 THEN 1500
530 IF B$=BS$ THEN CCNT=CCNT-1:IF ECH THEN GOSUB 2655:IF PR THEN PR$=PR$+B$:GOSUB 800:GOTO 555 ELSE 555 ELSE 555
535 IF MARG<=0 THEN 550
540 IF INSTR(B$,CR$)<>0 THEN CCNT=0:GOTO 550
545 CCNT=CCNT+LEN(B$):IF CCNT>=MARG AND CCNT<MARG+10 THEN BEEP
550 IF ECH THEN PRINT B$;:IF PR THEN PR$=PR$+B$:GOSUB 800
553 IF RTTY THEN GOSUB 7800
555 PRINT#1, B$;
560 IF EOF(1) THEN 515 ELSE 605
600 '-comm port
605 IF LOF(1)<128 THEN PSE=-1:PRINT#1,XF$;
610 IF EOF(1) THEN 710
615 A$=INPUT$(LOC(1),#1):IF NS=0 THEN 635
620 FOR I=1 TO NS
625 P=INSTR(A$,S$(I)):IF P=0 THEN 630 ELSE A$=LEFT$(A$,P-1)+R$(I)+RIGHT$(A$,LEN(A$)-P):GOTO 625
630 NEXT
635 IF RTTY THEN GOSUB 7600
636 IF RC THEN PRINT #2,A$;
640 P=INSTR(A$,LF$):IF P=0 THEN 645 ELSE A$=LEFT$(A$,P-1)+RIGHT$(A$,LEN(A$)-P):GOTO 640
645 P=INSTR(A$,BS$):IF P=0 THEN 655 ELSE FOR I=1 TO LEN(A$):IF MID$(A$,I,1)<>BS$ THEN PRINT MID$(A$,I,1);:GOTO 650 ELSE GOSUB 2650
650 NEXT:GOTO 660
655 FOR I=1 TO LEN(A$):PRINT MID$(A$,I,1);:NEXT
660 IF PR THEN PR$=PR$+A$:GOSUB 800
700 '-check status
705 IF SET THEN 715
710 B$=INKEY$:IF B$<>"" THEN 525
715 IF LOC(1)>0 THEN 605
720 IF PSE THEN PSE=0:PRINT#1,XN$;
725 IF SET THEN ROW=CSRLIN:COL=POS(0):GOTO 1000
730 GOTO 515
800 '-printer buffer
805 P=INSTR(PR$,BS$):IF P=0 THEN 810 ELSE IF LEN(PR$)>1 THEN PR$=LEFT$(PR$,P-2)+RIGHT$(PR$,LEN(PR$)-P):GOTO 805
810 P=INSTR(PR$,CR$):IF P=0 THEN 815 ELSE PRINT#3,LEFT$(PR$,P);:PR$=RIGHT$(PR$,LEN(PR$)-P):GOTO 810
815 IF LEN(PR$)>220 THEN PRINT#3,PR$;:PR$="":RETURN
820 RETURN
825 '
1000 ' Alt-Key Input
1005 '
1010 IF ALTSET THEN LOCATE 25,17 ELSE LOCATE 25,15+LEN(ALT$)
1015 C$=INKEY$:IF C$="" THEN IF EOF(1) THEN 1015 ELSE SET=-1:LOCATE ROW,COL:GOTO 605
1020 IF NOT ALTSET THEN 1035
1025 LOCATE 25,19:IF ASC(C$)>=49 AND ASC(C$)<=57 THEN ALTKY=ASC(C$)-48ELSE IF ASC(C$)=48 THEN ALTKY=10 ELSE BEEP:GOTO 1010
1030 IF ALTSET THEN ALTSET=0:SET=-1:LOCATE 25,1:PRINT STRING$(5,16);" Alt-";ALTKY;CHR$(198);"    ";CHR$(181);:GOTO 1010
1035 IF LEN(ALT$)>=51 THEN ALT$=LEFT$(ALT$,49):LOCATE 25,64:PRINT" ";CHR$(181);:LOCATE 25,66:BEEP:PRINT"(max 50 chrs.)";:GOTO 1010
1040 IF C$=BS$ THEN IF ALT$="" GOTO 1010 ELSE GOSUB 2650:ALT$=LEFT$(ALT$,LEN(ALT$)-1):GOTO 1010
1045 IF C$=CHR$(13) THEN 1070
1050 IF C$>CHR$(31) THEN PRINT C$; ELSE COLOR HI,BG:PRINT CHR$(ASC(C$)+64);:COLOR FG,BG
1055 PRINT"    ";CHR$(181);
1060 IF C$=XCR$ THEN C$=CHR$(13)
1065 ALT$=ALT$+C$:GOTO 1010
1070 IF ALT$<>"" THEN IF ALT$=" " THEN ALT$(ALTKY)="" ELSE ALT$(ALTKY)=ALT$
1075 ALT$="":SET=0:GOTO 1200
1080 '
1200 ' Alt-key Display
1205 '
1210 P=1:FOR I=1 TO 10:LOCATE 25,P:IF I=10 THEN PRINT"0";:COLOR BG,FG:GOTO 1220
1215 PRINT USING "#";I;:COLOR BG,FG
1220 FOR J=1 TO 7:Z$=MID$(ALT$(I),J,1):IF POS(0)=80 THEN 1235
1225 IF J>LEN(ALT$(I)) THEN PRINT" ";:GOTO 1235
1230 IF Z$>=" "THEN PRINT Z$; ELSE IF Z$=CR$ THEN PRINT XCR$; ELSE COLOR HI,FG:PRINT CHR$(ASC(Z$)+64);:COLOR BG,FG
1235 NEXT J:COLOR FG,BG:P=P+8:NEXT I
1240 FOR I=1 TO 10:IF ALT$(I)<>"" THEN EXIT=-1
1245 NEXT:IF EXIT THEN EXIT=0:LOCATE ROW,COL:GOTO 605
1250 LOCATE ROW,COL:GOSUB 2820:GOTO 515
1255 '
1500 ' Extended Codes
1505 '
1510 EX=0:ROW=CSRLIN:COL=POS(0)
1515 IF LEN(B$)=2 THEN EX=ASC(MID$(B$,2,1)) ELSE EX=0
1520 IF EX=75 THEN B$=CHR$(29):GOTO 535 ' cursor left
1525 IF EX=77 THEN B$=CHR$(28):GOTO 535 ' cursor right
1530 IF EX=71 THEN 2000 ' home
1535 IF EX=19 OR EX=81 THEN EX=19:GOTO 3000 ' alt-r or pg-dn
1540 IF EX=47 THEN 3400 ' alt-v
1545 IF EX=20 OR EX=73 THEN EX=20:GOTO 3200 ' alt-t or pg-up
1550 IF EX=25 THEN 5000 ' alt-p
1555 IF EX=32 THEN 6000 ' alt-d
1557 IF EX=36 THEN B$=CHR$(13)+CHR$(10)+"KA9DCA  (STEVE)  "+DATE$+"  "+TIME$+" CST"+CHR$(13)+CHR$(10):GOTO 550  ' alt-j
1560 IF EX=37 THEN 7000 ' alt-k
1565 '-F-keys/Alt-keys
1570 IF EX>=59 AND EX<=68 THEN B$=K$(EX-58):GOTO 535
1575 IF EX>=104 AND EX<=113 THEN B$=K$(EX-93):GOTO 535
1580 IF EX>=84 AND EX<=103 THEN B$=K$(EX-63):GOTO 535
1585 IF EX>=120 AND EX<=129 THEN B$=ALT$(EX-119):GOTO 535
1590 IF EX=131 THEN:BEEP:LOCATE 25,1:PRINT"  set Alt-(1-0):  ";CHR$(181);:ALTSET=-1:GOTO 1000
1595 '-echo/message/print
1600 IF EX=18 THEN BEEP:PRINT:IF ECH=0 THEN ECH=-1:PRINT"===ECHO ON===":GOTO 515 ELSE ECH=0:PRINT"===ECHO OFF===":GOTO 515 'alt-e
1605 IF EX=50 THEN BEEP:PRINT:IF MSG=0 THEN MSG=-1:PRINT"===MESSAGES ON===":GOTO 515 ELSE MSG=0:PRINT"===MESSAGES OFF===":GOTO 515 ' alt-m
1610 IF EX=114 OR EX=132 THEN BEEP:PRINT:IF PR=0 THEN PR=-1:PRINT"===PRINTOUT ON===":CLOSE#3:OPEN PRNTPORT$ AS #3:PRINT#3,PRNTINIT$;:GOTO 515 ELSE PR=0:CLOSE#3:PRINT"===PRINTOUT OFF===":GOSUB 2715:GOTO 515 ' ctrl-prtsc or ctrl-pgup
1615 '-elapsed time/redial/screendump/defaults/exit
1620 IF EX=44 THEN 8200 ' alt-z
1625 IF EX=16 THEN IF DIAL$<>"" THEN 8000 ELSE BEEP:PRINT"(nothing to redial)":PRINT GO$:GOTO 515 ' alt-q
1630 IF EX=31 THEN 3800 ' alt-s
1635 IF EX=33 THEN 5200 ' alt-f
1640 IF EX=45 THEN BEEP:CLS:PRINT"===EXIT TO DOS===":PRINT:PRINT"WARNING!  If you proceed you will terminate the program.":PRINT"Do you want to do this (y/n)?";:Q$=INPUT$(1):GOSUB 2555:IF Q$<>"Y" THEN PRINT:PRINT GO$:GOTO 515 ELSE 8915 ' alt-x
1645 '-logged drive/delete/clearsc/width alarm/menu/break
1650 IF EX=38 THEN BEEP:PRINT:PRINT"===SPECIFY LOGGED DRIVE===":PRINT"Current default for file specs: ";DRIV$:PRINT"New default: ";:QL=2:GOSUB 2500:IF Q$="" THEN PRINT:PRINT GO$:GOTO 515 ELSE DRIV$=LEFT$(Q$,1)+":":PRINT:PRINT GO$:GOTO 515 ' alt-l
1655 IF EX=21 THEN 3900 ' alt-y
1660 IF EX=46 THEN PRINT CHR$(12):GOSUB 2800:GOTO 515 ' alt-c
1665 IF EX=17 THEN BEEP:PRINT"===SPECIFY WIDTH ALARM===":PRINT"Current setting for right margin:";MARG:PRINT"New setting: ";:QL=3:GOSUB 2500:IF Q$="" THEN PRINT:PRINT GO$:GOTO 515 ELSE MARG=VAL(Q$):PRINT:PRINT GO$:GOTO 515 ' alt-w
1670 IF EX=117 THEN OLDVAL=INP(LCR):BRKVAL=OLDVAL OR 64:OUT LCR,BRKVAL:SOUND 32767,3:SOUND 32767,1:OUT LCR,OLDVAL:GOTO 515 ' ctrl-end
1674 IF EX=35 GOTO 2950 ' alt-h
1675 IF EX=15 THEN RESTORE 9999:READ Q$:PRINT Q$:GOTO 515 ' shift-tab 0─
1676 IF EX=48 GOTO 2840 ' Alt-B Baud Rate Generator
1677 IF EX=30 THEN OUT &H2FC,(INP(&H2FC) XOR &H2):GOTO 515  ' alt-a T/R Switch
1678 IF EX=22 THEN RTTY=NOT RTTY:IF RTTY THEN PRINT "RTTY ON":GOTO 515 ELSE PRINT "RTTY OFF":GOTO 515    ' alt-u
1679 IF EX=49 THEN FIGS=5-FIGS:PRINT "FIGS=";FIGS:GOTO 515 ' (49 IS ALT-N)
1680 IF EX=24 GOTO 1700 ' alt-o switch rswit between 1 and figs
1681 '
1682 '-more Extended Codes can go here (see p.G-6 IBM BASIC manual)
1683 '
1685 GOTO 515 'DON'T remove this line! (failsafe to return to terminal)
1690 '
1700 IF RSWIT=1 THEN RSWIT=FIGS: GOTO 515
1705 RSWIT=1: GOTO 515
2000 ' Command Summary
2005 '
2010 LOCATE 1,39:PRINT CHR$(213)+STRING$(38,205)+CHR$(184)
2015 LOCATE 2,39:PRINT VL$;"  ===PC-TALK III  COMMAND SUMMARY===  ";VL$
2020 LOCATE 3,39:PRINT CHR$(195)+STRING$(38,196)+CHR$(180)
2025 RESTORE 2050:LOCATE 4,39:READ B$:PRINT VL$;" ";CAN$;B$;SPACE$(36-LEN(B$));VL$
2030 FOR I=5 TO 23:LOCATE I,39:READ B$:PRINT VL$;B$;SPACE$(38-LEN(B$));VL$:NEXT
2035 LOCATE 24,39:PRINT CHR$(192)+STRING$(38,205)+CHR$(217);
2040 LOCATE ROW,COL:GOTO 515
2045 '
2050 DATA"PrtSc =  print screen contents
2055 DATA" ^PrtSc =  contin. printout (or ^PgUp)
2060 DATA"  Alt-R =  Receive a file  (or PgDn)
2065 DATA"  Alt-T =  Transmit a file  (or PgUp)
2070 DATA" transmit: pacing '=p'  binary '=b'
2075 DATA"tran/recv: XMODEM '=x'
2080 DATA"  Alt-V =  View file   Alt-Y = delete
2085 DATA"  Alt-D =  Dialing directory
2090 DATA"  Alt-Q =  redial last number
2095 DATA"  Alt-K =  set/clear Func keys
2100 DATA"  Alt-=    set/clear temp Alt keys
2105 DATA" Alt-E = Echo toggle  Alt-M = Message
2110 DATA" Alt-S = Screendump   Alt-C = Clearsc
2115 DATA"  Alt-P =  communications Parameters
2120 DATA"  Alt-F =  set program deFaults
2125 DATA"  Alt-L =  change Logged drive
2130 DATA"  Alt-W =  set margin Width alarm
2135 DATA"  Alt-Z =  elapsed time/current call
2140 DATA"  Alt-X =  eXit to DOS
2145 DATA"Ctrl-End = send sustained Break signal
2150 '
2450 '
2455 '
2500 '-return Q$ w/ max len QL
2505 Q$="":IF QL=0 THEN QL=255
2510 QI$=INKEY$:IF QI$="" THEN 2510
2515 IF QI$=CHR$(13) THEN RETURN
2520 IF QI$<>CHR$(8) THEN 2530 ELSE IF Q$="" THEN BEEP:GOTO 2510
2525 IF QI$=CHR$(8) THEN GOSUB 2650:Q$=LEFT$(Q$,LEN(Q$)-1):GOTO 2510
2530 IF LEN(Q$)=QL THEN BEEP:GOTO 2510
2535 IF LEN(QI$)=1 THEN 2545 ELSE IF QI$<>CHR$(0)+CHR$(3) THEN BEEP:GOTO 2510 ELSE QI$=CHR$(0)
2545 IF ASC(QI$)>31 OR QI$=CHR$(27) THEN PRINT QI$; ELSE COLOR HI,BG:PRINT CHR$(ASC(QI$)+64);:COLOR FG,BG
2550 IF QI$=XCR$ THEN Q$=Q$+CHR$(13):GOTO 2510 ELSE Q$=Q$+QI$:GOTO 2510
2555 '-convert Q$ to uppercase
2560 FOR J=1 TO LEN(Q$):P=ASC(MID$(Q$,J,1)):IF P<97 OR P>122 THEN 2570
2565 MID$(Q$,J,1)=CHR$(P AND 95)
2570 NEXT:RETURN
2600 '-to/from line 25
2605 MSG$=LEFT$(MSG$,78):ROW=CSRLIN:COL=POS(0):LOCATE 25,1:COLOR HI,BG:PRINT CHR$(16);:COLOR BG,FG:PRINT MSG$+SPACE$(78-LEN(MSG$));:COLOR FG,BG:LOCATE ROW,COL:RETURN
2650 '-destructive backspace
2655 PRINT CHR$(29);" ";CHR$(29);:RETURN
2700 '-reopen files subrout
2705 CLOSE#2:IF RC THEN OPEN RCV$ FOR APPEND AS #2
2710 RETURN
2715 CLOSE#3:IF PR THEN OPEN PRNTPORT$ FOR OUTPUT AS #3
2720 IF TR THEN OPEN TRN$ AS #3 LEN=128:FIELD #3,128 AS X$
2725 RETURN
2800 '-clear menu line
2805 ROW=CSRLIN:COL=POS(0)
2810 EXIT=0:FOR I=1 TO 10:IF ALT$(I)<>"" THEN EXIT=-1:NEXT
2815 IF EXIT THEN EXIT=0:LOCATE ,,1:GOTO 1210
2820 IF MENU=0 THEN 2830
2825 LOCATE 25,1:PRINT" ";:COLOR BG,FG:PRINT"^PrtSc=prnt  Alt- T=tran R=recv V=view D=dial E=echo M=mesg X=exit <Home>=Help";:COLOR FG,BG:LOCATE ROW,COL:RETURN
2830 LOCATE 25,1:PRINT SPACE$(79);:LOCATE ROW,COL,1:RETURN
2835 '
2840 ' Baud Rate Generator       Got here via Alt-B
2841 GOSUB 2900
2842 PRINT "Input data rate between 10 and 10,000 - ";
2844 INPUT "",RATE$
2845 IF RATE$="?" GOTO 2860 ELSE RAT!=VAL(RATE$)
2846 IF RAT!<10 OR RAT!>10000 GOTO 2842
2848 Z$=MKI$((INT(1152000!/RAT!))/10)
2850 OUT LCR,(INP(LCR) OR &H80)
2852 OUT DLLSB,CVI(LEFT$(Z$,1)+CHR$(0))
2854 OUT DLMSB,CVI(RIGHT$(Z$,1)+CHR$(0))
2856 OUT LCR,(INP(LCR) AND &H7F)
2857 GOSUB 2800
2858 GOTO 515
2860 OUT LCR,(INP(LCR) OR &H80)
2861 R1=INP(DLLSB)
2862 R2=INP(DLMSB)
2866 OUT LCR,(INP(LCR) AND &H7F)
2868 RAT!=115200!/(R1+256*R2)
2870 PRINT "Baud rate=",RAT!:GOTO 2857
2900 LCR=&H2FB
2905 DLLSB=&H2F8
2910 DLMSB=&H2F9
2915 IF COMMPORT$="COM2:" THEN RETURN
2920 IF COMMPORT$<>"COM1:" THEN PRINT "Comm port. name is invalid":GOTO 515
2925 LCR=LCR OR &O100
2930 DLLSB=DLLSB OR &H100
2935 DLMSB=DLMSB OR &H100
2940 RETURN
2950 IF COMMPORT$="COM1:" THEN COMMPORT$="COM2:":GOTO 2960
2955 IF COMMPORT$="COM2:" THEN COMMPORT$="COM1:"
2960 PRINT "Commucication port name is ";COMMPORT$
2965 GOTO 515
3000 ' Receive File
3005 '
3010 IF RC THEN RC=0:RC$="":BEEP:PRINT:PRINT"===RECEIPT OF FILE ";RCV$;" TERMINATED===":PRINT:GOSUB 2700:GOSUB 2800:IF MSG THEN PRINT#1,BL$;CR$;"===FILE RECEIVED===":GOTO 515 ELSE 515
3015 RC$="":BEEP:PRINT:PRINT"===RECEIVE A FILE===":GOTO 3500
3020 IF RC$="X" THEN CLOSE#2:KILL RCV$:OPEN RCV$ AS #2 LEN=128:FIELD #2,128 AS X$:GOTO 3030
3025 IF MSG THEN PRINT#1,BL$;CR$;"===READY TO RECEIVE===
3030 MSG$=" Receiving "+RCVX$+"  (ALT-R to Terminate)":GOSUB 2600
3035 RC=-1:IF RC$="X" THEN 4500 ELSE 605
3040 '
3200 ' Transmit File
3205 '
3210 IF TR THEN TR=0:TR$="":MSG1$="===TRANSMISSION OF FILE ":MSG2$=" TERMINATED===":BEEP:PRINT:PRINT MSG1$;TRN$;MSG2$:GOSUB 2715:GOSUB 2800:IF MSG THEN PRINT#1,CR$;MSG1$;MSG2$,BL$:GOTO 515 ELSE 515
3215 IF TR THEN TR=0:TR$="":MSG1$="===END OF FILE":MSG2$="===":BEEP:PRINT:PRINT MSG1$;" ";TRN$;MSG2$:GOSUB 2715:GOSUB 2800:IF MSG THEN PRINT#1,"65529 '";MSG1$;MSG2$;BL$:GOTO 515 ELSE 515
3220 TR$="":BEEP:PRINT:PRINT"===TRANSMIT A FILE===":GOTO 3500
3225 CLOSE#3:OPEN TRN$ AS #3 LEN=128:FIELD #3,128 AS X$
3230 MSG$=" Transmitting "+TRNX$+" (ALT-T to terminate)":IF TR$="X" THEN MSG$=MSG$+"  # of blocks:" ELSE IF TR$="P" THEN MSG$=MSG$+"  percent remain:" ELSE MSG$=MSG$+"   min. remain:"
3235 GOSUB 2600:IF TR$="X" THEN ROW=CSRLIN:COL=POS(0):LOCATE 25,74:CNT!=FIX(LOF(3)/128):FLN!=LOF(3)/128:IF CNT!=FLN! THEN PRINT CNT!;:LOCATE ROW,COL ELSE PRINT CNT!+1;:LOCATE ROW,COL:GOTO 3245
3240 IF MSG THEN PRINT#1,CR$;"0 '===START OF FILE===";BL$
3245 TR=-1:FLN!=LOF(3):IF TR$<>"X" THEN 4000 ELSE 4700
3250 '
3400 ' View File
3405 '
3410 BEEP:PRINT:PRINT"===VIEW A FILE===":GOTO 3500
3415 MSG$=" Viewing "+VEWX$+"  Press <space> to continue  (Alt-V to terminate)":GOSUB 2600:PRINT:PRINT:PRINT
3420 WHILE NOT EOF(3):FOR I=1 TO 20:LINE INPUT#3,X$:J=LEN(X$):IF J<80 THEN PRINT X$ ELSE PRINT X$;:IF J>80 THEN I=I+FIX(J/80)
3421 IF PR THEN LPRINT X$
3425 NEXT
3430 Q$=INKEY$:IF Q$="" THEN 3430 ELSE IF Q$=" " THEN 3420 ELSE IF Q$=CHR$(0)+CHR$(47) THEN 3445 ELSE BEEP:GOTO 3430
3435 WEND
3440 BEEP:PRINT:PRINT"===END OF FILE ";VEW$;" ===":GOTO 3450
3445 BEEP:PRINT:PRINT"===VIEWING OF FILE ";VEW$;" TERMINATED===
3450 GOSUB 2715:GOSUB 2800:GOTO 515
3455 '
3500 ' File Specs
3505 '
3510 EXIT=0:PRINT"   specification:";
3515 Q$=INKEY$:IF Q$="" THEN 3515 ELSE IF Q$=CR$ OR Q$=BS$ THEN FIL$="":PRINT:GOTO 3540
3520 IF LEN(Q$)>1 THEN Q=ASC(MID$(Q$,2,1)):IF Q>=59 AND Q<=68 THEN Q$=K$(Q-58) ELSE IF Q>=104 AND Q<=113 THEN Q$=K$(Q-93) ELSE IF Q>=84 AND Q<=103 THEN Q$=K$(Q-63) ELSE IF Q>=120 AND Q<=129 THEN Q$=ALT$(Q-119) ELSE BEEP:GOTO 3515
3525 IF Q$<>" " THEN PRINT Q$;:QL=128:GOSUB 2510:GOSUB 2555:FIL$=Q$:PRINT:LOCATE,,1:GOTO 3540
3530 IF EX=19 THEN FIL$=RCVX$ ELSE IF EX=20 THEN FIL$=TRNX$ ELSE IF EX=47 THEN FIL$=VEWX$
3535 Q$=FIL$:PRINT Q$;:QL=128:GOSUB 2510:GOSUB 2555:FIL$=Q$:PRINT:LOCATE,,1
3540 IF FIL$="" THEN BEEP:PRINT"===CANCELLED===":GOTO 515
3545 IF LEFT$(FIL$,1)="?" THEN GOSUB 3625:GOTO 3510
3550 P=INSTR(FIL$,":"):IF P=0 THEN FIL$=DRIV$+FIL$
3555 IF EX=19 THEN RCVX$=FIL$ ELSE IF EX=20 THEN TRNX$=FIL$ ELSE IF EX=47 THEN VEWX$=FIL$
3560 P=INSTR(FIL$,"="):IF P=0 THEN IF EX<>20 OR PC$="" OR EXIT=-1 THEN 3595 ELSE EXIT=-1:Q$=FIL$+PC$:LOCATE CSRLIN-1,18:BEEP:GOTO 3525
3565 Q$=RIGHT$(FIL$,LEN(FIL$)-P):FIL$=LEFT$(FIL$,P-1)
3570 IF Q$="B" THEN TR$="B"
3575 IF Q$="X" THEN IF EX=19 THEN RC$="X" ELSE IF EX=20 THEN TR$="X
3580 IF LEFT$(Q$,1)="P" THEN TR$="P":PROMPT$=RIGHT$(Q$,LEN(Q$)-1):DEL!=VAL(PROMPT$)
3585 IF TR$="B" OR TR$="X" OR RC$="X" THEN IF DTA$<>"8" THEN BEEP:PRINT"*** You must communicate at 8 DATA BITS for binary or XMODEM ***":GOTO 5015
3590 IF TR$="X" OR RC$="X" THEN IF NS<>0 THEN BEEP:PRINT"*** Stripping disabled for XMODEM ***":NS=0
3595 IF EX=19 THEN CLOSE#2:OPEN FIL$ FOR APPEND AS #2 ELSE CLOSE#3:OPEN FIL$ FOR INPUT AS #3
3600 PRINT STRING$(18+LEN(FIL$),61):IF EX=19 THEN RCV$=FIL$:GOTO 3020
3605 IF EX=20 THEN TRN$=FIL$:GOTO 3225
3610 IF EX=47 THEN VEW$=FIL$:GOTO 3415
3615 IF EX=21 THEN 3915
3620 '-file directory subrout
3625 IF LEN(FIL$)=1 THEN FIL$=DRIV$+"*.*":GOTO 3640 ELSE FIL$=RIGHT$(FIL$,LEN(FIL$)-1):IF LEFT$(FIL$,1)=" " THEN FIL$=RIGHT$(FIL$,LEN(FIL$)-1)
3630 P=INSTR(FIL$,":"):IF P=0 THEN FIL$=DRIV$+FIL$
3635 IF LEN(FIL$)=P THEN FIL$=FIL$+"*.*
3640 PRINT:FILES FIL$:PRINT
3645 RETURN
3650 '
3800 ' Screendump
3805 '
3810 SOUND 440,2:CLOSE#2:OPEN DUMP$ FOR APPEND AS #2:MSG$=" Appending to "+DUMP$+" at "+TIME$:GOSUB 2600
3815 FOR I=1 TO 24:Y$="":FOR J=1 TO 79:X=SCREEN(I,J):Y$=Y$+CHR$(X):NEXT J:PRINT#2,Y$:NEXT I:PRINT#2,STRING$(79,45);CR$;LF$;"*** PC-TALK III SCREENDUMP - ";DATE$;" at ";TIME$;" ***";CR$;LF$;STRING$(79,61):CLOSE#2
3820 SOUND 660,2:BEEP:GOSUB 2705:GOSUB 2800:LOCATE ROW,COL:GOTO 515
3825 '
3900 ' Delete File
3905 '
3910 BEEP:PRINT:PRINT"===DELETE A FILE===":GOTO 3500
3915 PRINT"***The first 5 lines are:":FOR I=1 TO 5:IF NOT EOF(3) THEN LINE INPUT#3,X$:PRINT X$
3920 NEXT:PRINT"***ARE YOU SURE (y/n)?";:Q$=INPUT$(1):PRINT Q$:GOSUB 2555:IF Q$="Y" THEN CLOSE#3:KILL FIL$:BEEP:PRINT" (deleted)":GOTO 3930
3925 PRINT" (not deleted)":PRINT GO$:GOTO 515
3930 PRINT GO$:GOTO 515
3935 '
4000 ' Transmit
4005 '
4010 IF TR$="B" THEN PRINT"(sending file as binary...)
4015 RATE!=VAL(BAU$)*6:CNT!=0:ROW=CSRLIN:COL=POS(0):GOTO 4060
4020 LOCATE 25,74:IF TR$<>"P" THEN PRINT USING"###.#";(FLN!-(CNT!*128))/RATE!; ELSE PRINT USING".##";(FLN!-CNT!*128)/FLN!;
4025 GET#3,CNT!:Y$=X$:LOCATE ROW,COL
4030 IF TR$="P" THEN GOSUB 4400:IF NOT ABORT THEN 4050 ELSE ABORT=0:GOTO 1500
4035 PRINT#1,Y$;:IF TR$="B" THEN 4050
4040 P=INSTR(1,Y$,LF$):IF P=0 THEN 4045 ELSE Y$=LEFT$(Y$,P-1)+RIGHT$(Y$,LEN(Y$)-P):GOTO 4040
4045 FOR I=1 TO 128:PRINT MID$(Y$,I,1);:NEXT
4050 ROW=CSRLIN:COL=POS(0):GOSUB 4070:B$=INKEY$:IF B$="" THEN 4060
4055 IF LEN(B$)>1 THEN 1500
4060 CNT!=CNT!+1:IF CNT!*128<FLN! THEN 4020 ELSE GET#3,CNT!:Y$=X$:GOTO 4200
4065 '-xon/xoff subrout
4070 IF EOF(1) THEN 4085 ELSE A$=INPUT$(LOC(1),#1)
4075 P=INSTR(1,A$,XF$):IF P<>0 THEN HLT=-1:COLOR HI,BG:PRINT"<<XOFF>>";:COLOR FG,BG
4080 IF HLT THEN P=INSTR(1,A$,XN$):IF P=0 THEN 4085 ELSE HLT=0:RETURN
4085 IF HLT THEN Q$=INKEY$:IF Q$<>"" THEN IF LEN(Q$)<>2 THEN 4070 ELSE IF ASC(RIGHT$(Q$,1))=24 THEN HLT=0:RETURN ELSE 4070 ELSE 4070
4090 RETURN
4200 '-transmit last block
4205 I=0:CNT!=(CNT!-1)*128
4210 I=I+1:CNT!=CNT!+1:IF I>255 THEN 4230 ELSE Z$=MID$(Y$,I,1)
4215 IF TR$="B" THEN IF CNT!<=FLN! THEN 4235 ELSE 4230
4220 IF Z$<>EF$ THEN 4235 ELSE 4230
4225 IF CNT!<=FLN! THEN 4235
4230 IF EOF(1) THEN 3215 ELSE DMMY$=INPUT$(LOC(1),#1):GOTO 4230
4235 IF TR$="P" THEN IF Z$=LF$ THEN 4210
4240 PRINT#1,Z$;:IF TR$="P" THEN IF Z$=CR$ THEN PRINT Z$;:GOSUB 4425:GOTO 4210
4245 IF TR$="B" OR Z$=LF$ THEN 4210
4250 PRINT Z$;:GOTO 4210
4400 '-line pacing subrout
4405 FOR I=1 TO LEN(Y$):Z$=MID$(Y$,I,1):IF Z$=LF$ THEN 4415 ELSE IF Z$<>CR$ THEN PRINT#1,Z$;:PRINT Z$;:GOTO 4415 ELSE PRINT #1," "+CR$;:PRINT CR$;:B$="":GOSUB 4420
4410 IF ABORT THEN RETURN
4415 NEXT:RETURN
4420 IF LEN(B$)>1 THEN ABORT=-1:RETURN
4425 IF (INP(LSR) AND 96)<>96 THEN 4425
4430 IF DEL!>0 THEN SOUND 32767,18*DEL!:SOUND 32767,1:RETURN
4435 Z$="":WHILE NOT EOF(1):Z$=Z$+INPUT$(LOC(1),#1):WEND:PRINT Z$;:IF Z$="" THEN Z$=CHR$(0) ELSE IF LEN(Z$)>128 THEN Z$=""
4440 P=INSTR(Z$,PROMPT$):B$=INKEY$:IF P<>0 OR B$=" " THEN RETURN ELSE 4420
4445 '
4500 ' Receive w/ XMODEM
4505 '
4510 PRINT"===RECEIVE FILE WITH XMODEM===":PRINT
4515 Y$="":BLK=1:SEC=1:CK=0:ECNT=0
4520 PRINT"***Holding for Start...":GOSUB 4975:PRINT#1,NAK$;
4525 GOSUB 4925:IF ABORT THEN 4645 ELSE 4535
4530 GOSUB 4905:IF Z$="" THEN 4545
4535 Y$=Y$+Z$:IF LEN(Y$)<=131 THEN 4530
4540 '-check block
4545 IF LEN(Y$)=132 THEN LSET X$=MID$(Y$,4,128):N=132:GOTO 4580
4550 IF LEN(Y$)=131 THEN LSET X$=MID$(Y$,3,128):N=131:GOTO 4580
4555 IF LEN(Y$)>132 THEN PRINT"**Long  Block in #";BLK:GOTO 4615
4560 IF Y$=EOT$ THEN 4635
4565 IF Y$=CAN$ THEN 4640
4570 IF Y$="" THEN PRINT"***Timeout":GOSUB 4975:PRINT #1,NAK$:GOTO 4525
4575 PRINT"**Short Block in #";BLK:GOTO 4615
4580 IF (ASC(MID$(Y$,1,1)) AND ASC(MID$(Y$,2,1)) AND ASC(MID$(Y$,3,1)))<>0 THEN PRINT"**Error in SOH":Y$="":PRINT #1,NAK$:GOTO 4525
4585 IF ASC(MID$(Y$,2,1))=SEC-1 THEN PRINT"**Requesting Next Block":PRINT#1,ACK$:GOTO 4520
4590 IF SEC<>ASC(MID$(Y$,2,1)) THEN PRINT"**Block # Error in #";BLK:GOTO 4615
4595 IF (SEC XOR 255)<>ASC(MID$(Y$,3,1)) THEN PRINT"**Complement Error in #";BLK:GOTO 4615
4600 FOR I=1 TO 128:CK=CK+ASC(MID$(X$,I,1)):NEXT
4605 IF (CK AND 255)=(ASC(MID$(Y$,N,1))) THEN 4620
4610 PRINT"**Checksum Error in #";BLK:
4615 PRINT#1,NAK$;:ECNT=ECNT+1:IF ECNT<12 THEN 4625 ELSE 4645
4620 LOCATE CSRLIN-1,1:PRINT"Received Block #";BLK;:SEC=255 AND (SEC+1):PUT#2,BLK:BLK=BLK+1:PRINT#1,ACK$;:PRINT"- verified":ECNT=0
4625 Y$="":CK=0:GOSUB 4965:IF ABORT THEN 4645 ELSE 4530
4630 '-terminate
4635 PRINT"***End of File - verified":PRINT#1,ACK$;:GOTO 3010
4640 PRINT"***Cancelled by Transmitter":GOTO 3010
4645 PRINT"***Cancelled by Receiver":PRINT#1,CAN$;:GOSUB 4975:GOTO 3010
4650 '
4700 'Transmit with XMODEM
4705 '
4710 PRINT"===TRANSMIT FILE WITH XMODEM===":PRINT
4715 SEC=0:BLK=0:CNT!=0:ECNT=0:EOT=0:ETT=0:GOSUB 4815
4720 PRINT"***Holding for Start...":GOSUB 4975:ABORT=0:SECZ=0:GOSUB 4985
4725 WHILE NOT EOF(1):Z$=INPUT$(1,#1)
4730 IF Z$=NAK$ THEN 4800
4735 IF Z$=CAN$ THEN 4855
4740 WEND:GOSUB 4965:IF ABORT THEN 4860
4745 GOSUB 4990:IF NOT TENSEC THEN 4725 ELSE GOSUB 4995:GOTO 4725
4750 '-hold for ACK
4755 ABORT=0:SECZ=0:GOSUB 4985
4760 WHILE NOT EOF(1):Z$=INPUT$(LOC(1),#1)
4765 IF Z$=ACK$ THEN ECNT=0:PRINT "- verified ":IF NOT EOT THEN 4800 ELSE IF NOT ETT THEN 4845 ELSE 4850
4770 IF Z$=NAK$ THEN ECNT=ECNT+1:IF ECNT>12 THEN 4860 ELSE IF NOT EOT THEN 4805 ELSE 4845
4775 IF Z$=CAN$ THEN 4855
4780 WEND:GOSUB 4965:IF ABORT THEN 4860
4785 GOSUB 4990:IF NOT TENSEC THEN 4760
4790 GOSUB 4995:IF NOT ABORT THEN IF NOT EOT THEN 4805 ELSE 4845 ELSE 4860
4800 A$=Y$:LOCATE CSRLIN-1,1:PRINT"Sending Block #";BLK;:PRINT#1,A$;:IF CNT!<FLN! THEN GOSUB 4815:GOTO 4755 ELSE EOT=-1:GOTO 4755
4805 ECNT=ECNT+1:IF ECNT>12 THEN 4860 ELSE PRINT:PRINT"***Re-sending block...";:PRINT#1,A$;:GOTO 4755
4810 '-build block
4815 BLK=BLK+1:CNT!=CNT!+128:GET#3,BLK:Y$=X$:IF CNT!<=FLN! THEN 4825
4820 Y$=MID$(Y$,1,128-(CNT!-FLN!))+STRING$(CNT!-FLN!,CHR$(0))
4825 CK=0:FOR I=1 TO LEN(Y$):CK=CK+ASC(MID$(Y$,I,1)):NEXT:CK=(CK AND 255)
4830 IF CK>256 THEN CK=CK-256:GOTO 4830
4835 SEC=(255 AND BLK):Y$=SOH$+CHR$(SEC)+CHR$(SEC XOR 255)+Y$+CHR$(CK):RETURN
4840 '-terminate
4845 PRINT#1,EOT$;:PRINT"***Sending End Marker ";:ETT =-1:GOTO 4755
4850 CLOSE #3:GOTO 3215
4855 PRINT:PRINT"***Cancelled by Receiver":CLOSE#3:GOTO 3210
4860 PRINT:PRINT"***Cancelled by Transmitter":CLOSE#3:PRINT#1,CAN$;:GOTO 3210
4865 '
4900 ' XMODEM subroutines
4905 Z$="":ZA=0
4910 IF NOT EOF(1) THEN Z$=INPUT$(LOC(1),#1):RETURN ELSE SOUND 32767,1:ZA=ZA+1
4915 IF ZA>72 THEN RETURN ELSE 4910
4920 '-hold for SOH
4925 ABORT=0:SECZ=0:GOSUB 4985
4930 GOSUB 4905:GOSUB 4965:IF ABORT THEN RETURN
4935 IF LEFT$(Z$,1)=SOH$ THEN RETURN
4940 IF LEFT$(Z$,1)=EOT$ THEN RETURN
4945 IF LEFT$(Z$,1)=CAN$ THEN RETURN
4950 GOSUB 4975:PRINT#1,NAK$;
4955 GOSUB 4990:IF NOT TENSEC THEN 4955 ELSE GOSUB 4995:GOTO 4930
4960 '-test for abort
4965 B$=INKEY$:IF LEN(B$)<2 THEN RETURN ELSE Q$=MID$(B$,2,1):IF Q$=CHR$(19) OR Q$=CHR$(20) THEN ABORT=-1:RETURN ELSE RETURN
4970 '-purge buffer
4975 WHILE NOT EOF(1):Z$=INPUT$(LOC(1),#1):WEND:RETURN
4980 '-set/check delay
4985 SECX=60*VAL(MID$(TIME$,4,2))+VAL(MID$(TIME$,7,2)):RETURN
4990 TENSEC=0:SECY=60*VAL(MID$(TIME$,4,2))+VAL(MID$(TIME$,7,2)):IF SECY-SECX<10 THEN RETURN ELSE TENSEC=-1:RETURN
4995 IF SECZ<9 THEN GOSUB 4985:SECZ=SECZ+1:RETURN ELSE ABORT=-1:RETURN
4996 '
5000 ' Comm Params
5005 '
5010 BEEP:CLS:PRINT:PRINT"===COMMUNICATIONS PARAMETERS===
5015 PRINT:PRINT"Present parameters: ";:GOSUB 5100:PRINT"Options:
5020 PRINT"   1 -  300,E,7,1  (text)      2 -  300,N,8,1  (binary)
5025 PRINT"   3 - 1200,E,7,1  (text)      4 - 1200,N,8,1  (binary)
5030 PRINT SPACE$(15);"F - reset params to defaults
5035 PRINT SPACE$(15);"X - exit to terminal
5040 PRINT"Choose: ";
5045 Q$=INPUT$(1):GOSUB 2555
5050 IF Q$="X" THEN PRINT Q$:PRINT:PRINT"(present parameters still in effect)":GOTO 5095
5055 IF Q$="F" THEN PRINT Q$:GOSUB 5815:PRINT:PRINT"Parameters reset to:";:GOSUB 5100:GOTO 5095
5060 Q=VAL(Q$):IF Q<1 OR Q>4 THEN BEEP:GOTO 5045 ELSE PRINT Q
5065 BAU$="300":PAR$="E":DTA$="7":STP$="1
5070 IF Q=2 THEN PAR$="N":DTA$="8
5075 IF Q=3 THEN BAU$="1200
5080 IF Q=4 THEN BAU$="1200":PAR$="N":DTA$="8
5085 LOCATE ,,1:COMM$=COMMPORT$+BAU$+","+PAR$+","+DTA$+","+STP$+COMMINIT$:CLOSE#1:OPEN COMM$ AS #1
5090 PRINT:PRINT"New parameters are: ";:GOSUB 5100
5095 PRINT GO$:GOSUB 2800:GOTO 515
5100 COLOR BG,FG:PRINT MID$(COMM$,6,10);:COLOR FG,BG:PRINT:PRINT
5105 PRINT"Echo-";:IF ECH=-1 THEN PRINT"Y"; ELSE PRINT"N";
5110 PRINT" Mesg-";:IF MSG=-1 THEN PRINT"Y"; ELSE PRINT"N";
5115 PRINT" Strip-";:IF NS=0 THEN PRINT"N"; ELSE PRINT USING"#";NS;
5120 PRINT" Pace-";:IF PC$="" THEN PRINT"N" ELSE PRINT PC$
5125 IF NS=0 THEN PRINT:RETURN ELSE FOR I=1 TO NS:PRINT"Strip #";:PRINT USING"#";I;:PRINT" - /";:PRINT USING"###";ASC(S$(I));:PRINT"/";:IF R$(I)="" THEN PRINT"000"; ELSE PRINT USING"###";ASC(R$(I));
5130 PRINT"/":NEXT:PRINT:RETURN
5135 '
5200 ' New Defaults
5205 '
5210 CLS:BEEP:PRINT"===SET NEW DEFAULTS===":PRINT:COLOR BG,FG:PRINT" Present program defaults:";SPACE$(53);:COLOR FG,BG:EXIT=0
5215 FOR I=1 TO DFNUM:J=I+4:P=1:IF I>15 THEN J=I-11:P=32
5220 LOCATE J,P,0:PRINT DP$(I);:LOCATE J,P+16:IF D$(I)>=" " THEN PRINT D$(I); ELSE IF D$(I)="" THEN PRINT "''"; ELSE IF D$(I)=CHR$(0) THEN PRINT "0"; ELSE COLOR HI,BG:PRINT CHR$(ASC(D$(I))+64);:COLOR FG,BG
5225 IF I<15 THEN PRINT SPACE$(12-LEN(D$(I))); ELSE PRINT SPACE$(30-LEN(D$(I)));
5230 NEXT:LOCATE ,,1:IF EXIT THEN 5280 ELSE FOR I=1 TO DFNUM:DT$(I)=D$(I):NEXT
5235 LOCATE 21,1:COLOR BG,FG:PRINT" Enter ";ENT$;" to leave unchanged - <space>";ENT$;" for 'null' value - <ESC>";ENT$;" to quit ":COLOR FG,BG
5240 PRINT"*** Enter new values":ABORT=0:FOR I=1 TO DFNUM:J=I+4:P=1:IF I>15 THEN J=I-11:P=32
5245 IF ABORT THEN 5265
5250 IF D$(I)<>"" THEN LOCATE J,P+17+LEN(D$(I)) ELSE LOCATE J,P+19
5255 IF I>15 THEN QL=16 ELSE QL=4
5260 GOSUB 2500:IF Q$=CHR$(27) THEN GOSUB 2655:GOSUB 2655:ABORT=-1 ELSE IF Q$<>"" THEN DT$(I)=Q$:IF DT$(I)=" " THEN DT$(I)=""
5265 NEXT
5270 GOSUB 5295:PRINT"*** New values ok (y/n)?";:Q$=INPUT$(1):PRINT Q$:GOSUB 2555:IF Q$="N" THEN GOSUB 5295:LOCATE 21,1:PRINT SPACE$(79);:LOCATE 21,1:PRINT"(default routine cancelled)":GOTO 5290 ELSE FOR I=1 TO DFNUM:D$(I)=DT$(I):NEXT
5275 EXIT=-1:GOSUB 5295:PRINT"*** Make these changes permanent (y/n)?";:Q$=INPUT$(1):PRINT Q$+" ...wait";:GOSUB 2555:IF Q$="Y" THEN GOSUB 5440:GOTO 5215 ELSE GOSUB 5600:GOTO 5215
5280 GOSUB 5815:CLOSE#1:OPEN COMM$ AS #1
5285 GOSUB 5295:LOCATE CSRLIN-1,1:PRINT SPACE$(79);:LOCATE CSRLIN,1
5290 COLOR FG,BG,BG:PRINT GO$:GOSUB 2800:GOTO 515
5295 LOCATE 22,1:PRINT SPACE$(79);:LOCATE 22,1:RETURN
5400 '-create default file
5405 RESTORE 5410:FOR I=1 TO DFNUM:READ DP$(I),D$(I):NEXT:GOSUB 5440:GOTO 300
5410 DATA Baud rate,300,Parity,E,Data bits,7,Stop bits,1,Echo,N,Messages,N
5415 DATA"Strip #1",0,Replace #1,0,"Strip #2",0,Replace #2,0,"Strip #3",0,Replace #3,0,Pacing p=,,Logged drive,"B:",Margin width,70
5420 DATA Screendump file,"B:SCRNDUMP.PCT",Redial delay,20,Connect prompt,CONNECT
5425 DATA Line 25 help,Y,Foreground,7,Background,0,High inten.,15
5430 DATA "Print port","LPT1:","Print init.",,"Print width",80
5435 DATA Comm. port,"COM1:",Comm. init.,",CS,DS",Modem init.,,C/R subst.,}
5440 CLOSE#1:OPEN FFIL$ FOR OUTPUT AS #1:WRITE#1,IFIL$:FOR I=1 TO DFNUM:WRITE#1,DP$(I),D$(I):NEXT:WRITE#1,IFIL$:GOSUB 5600:RETURN
5600 '-update values
5605 BAU$=D$(1):PAR$=D$(2):DTA$=D$(3):STP$=D$(4)
5610 I=5:GOSUB 5805:IF D$(5)="Y" THEN DECH=-1 ELSE D$(5)="N":DECH=0
5615 I=6:GOSUB 5805:IF D$(6)="Y" THEN DMSG=-1 ELSE D$(6)="N":DMSG=0
5620 DNS=0:FOR J=1 TO 3:I=2*J+5:GOSUB 5810
5625 DS$(J)=CHR$(VAL(D$(I))):IF DS$(J)<>CHR$(0) THEN DNS=DNS+1 ELSE D$(I)="0"
5630 NEXT:FOR J=1 TO 3:I=2*J+6:GOSUB 5810
5635 DR$(J)=CHR$(VAL(D$(I))):IF DR$(J)=CHR$(0) THEN DR$(J)="":D$(I)="0"
5640 NEXT:IF D$(13)<>"" THEN DPC$="=P"+D$(13) ELSE DPC$=""
5645 D$(14)=LEFT$(D$(14),1)+":":DRIV$=D$(14)
5650 MARG=VAL(D$(15)):DUMP$=D$(16):QDELAY=VAL(D$(17)):CONNECT$=D$(18)
5655 I=19:GOSUB 5805:IF D$(19)="N" THEN MENU=0 ELSE MENU=-1
5660 FG=VAL(D$(20)):BG=VAL(D$(21)):HI=VAL(D$(22))
5665 PRNTPORT$=D$(23):PRNTINIT$=D$(24):WIDTH PRNTPORT$,VAL(D$(25))
5670 I=18:GOSUB 5805:COMMPORT$=D$(26):IF COMMPORT$="COM1:" THEN LSR=&H3FD:LCR=&H3FB ELSE LSR=&H2FD:LCR=&H2FB
5675 COMMINIT$=D$(27):DCOMM$=COMMPORT$+BAU$+","+PAR$+","+DTA$+","+STP$+COMMINIT$:MODMINIT$=D$(28):XCR$=LEFT$(D$(29),1)
5680 GOSUB 5815:RETURN
5800 '-default subrout
5805 Q$=D$(I):GOSUB 2555:D$(I)=Q$:RETURN
5810 IF VAL(D$(I))<0 OR VAL(D$(I))>255 THEN D$(I)="0":RETURN ELSE RETURN
5815 COMM$=DCOMM$:ECH=DECH:MSG=DMSG
5820 NS=DNS:FOR J=1 TO 3:I=2*J+5:S$(J)=DS$(J):R$(J)=DR$(J):NEXT:PC$=DPC$:RETURN
5825 '
6000 ' Dialing Directory
6005 '
6010 BEEP:CLOSE#2:OPEN DFIL$ AS #2:IF DPAGE=0 THEN DPAGE=1
6015 FIELD #2,24 AS N$,36 AS R$,2 AS X$,4 AS B$,1 AS P$,1 AS D$,1 AS S$,1 AS E$,1 AS M$,2 AS T$,26 AS C$,3 AS L$,2 AS G$
6020 GET#2,1:IF LEFT$(N$,LEN(IFIL$))<>IFIL$ THEN I1=1:I2=60:GOSUB 6870
6025 '-write to screen
6030 I1=(DPAGE-1)*15+1:I2=(DPAGE-1)*15+15
6035 CLS:LOCATE 1,1,0:PRINT"===DIALING DIRECTORY "DPAGE"===
6040 GET#2,2:MODM$=RIGHT$(R$,CVI(X$)):LOCATE 1,30:PRINT" Modem dialing command = "MODM$
6045 GET#2,3:SERV1$=RIGHT$(R$,CVI(X$)):LOCATE 2,28:PRINT"Long distance service +# = "LEFT$(SERV1$,24)
6050 GET#2,4:SERV2$=RIGHT$(R$,CVI(X$)):LOCATE 3,50:PRINT"-# = "LEFT$(SERV2$,24)
6055 LOCATE 4,1:COLOR BG,FG:PRINT"   Name"SPACE$(29)"Phone #   Comm Param  Echo Mesg Strip Pace ";:COLOR FG,BG:LOCATE 5,1
6060 FOR I=I1 TO I2:GET#2,I+4
6065 PRINT USING "##";LOC(2)-4;:PRINT"-";N$;"  ";RIGHT$(R$,14);"   ";B$;"-";P$;"-";D$;"-";S$;"    ";E$;"    ";M$;"   ";:IF CVI(T$)=0 THEN PRINT " N "; ELSE PRINT CVI(T$);
6070 PRINT"  ";:IF CVI(G$)=0 THEN PRINT "  N" ELSE PRINT "p="+L$
6075 NEXT
6080 '-initial choice
6085 LOCATE 21,1:PRINT"Dial entry #:             | or...
6090 LOCATE 21,39:PRINT"Enter: R to revise or add to directory
6095 LOCATE 22,46:PRINT"M for manual dialing
6100 LOCATE 23,42:PRINT"F / B to page through directory
6105 LOCATE 24,46:PRINT"X to exit to terminal";
6110 LOCATE 25,27:PRINT"| For long distance service, precede entry # with +/-";
6115 LOCATE 21,14,1:QL=3:GOSUB 2500:GOSUB 2555
6120 IF LEFT$(Q$,1)="+" THEN SERV1=-1:Q$=RIGHT$(Q$,LEN(Q$)-1) ELSE SERV1=0
6125 IF LEFT$(Q$,1)="-" THEN SERV2=-1:Q$=RIGHT$(Q$,LEN(Q$)-1) ELSE SERV2=0
6130 IF Q$="R" THEN 6400
6135 IF Q$="F" THEN IF DPAGE=4 THEN DPAGE=1:GOTO 6030 ELSE DPAGE=DPAGE+1:GOTO 6030
6140 IF Q$="B" THEN IF DPAGE=1 THEN DPAGE=4:GOTO 6030 ELSE DPAGE=DPAGE-1:GOTO 6030
6145 IF Q$="X" THEN CLOSE#2:GOSUB 2700:CLS:LOCATE 1,1,1:PRINT GO$:GOSUB 2800:GOTO 515
6150 IF Q$="M" THEN CLOSE#2:GOSUB 2700:CLS:LOCATE 1,1,1:GOSUB 6305:GOSUB 2800:GOTO 515
6155 IF VAL(Q$)<1 OR VAL(Q$)>60 THEN BEEP:LOCATE 21,14:PRINT SPACE$(LEN(Q$))        :GOTO 6115
6200 '-dial entry
6205 GET#2,VAL(Q$)+4:BAU$=B$:PAR$=P$:DTA$=D$:STP$=S$:IF LEFT$(BAU$,1)=" " THEN BAU$=RIGHT$(BAU$,3)
6210 COMM$=COMMPORT$+BAU$+","+PAR$+","+DTA$+","+STP$+COMMINIT$
6215 CLOSE#1:OPEN COMM$ AS #1
6220 IF E$="Y" THEN ECH=-1 ELSE ECH=0
6225 IF M$="Y" THEN MSG=-1 ELSE MSG=0
6230 NS=CVI(T$):IF NS=0 THEN 6255
6235 FOR I=0 TO NS-1:P=VAL(MID$(C$,I*8+1,3)):IF P>255 THEN P=0
6240 J=VAL(MID$(C$,I*8+5,3)):IF J>255 THEN J=0
6245 S$(I+1)=CHR$(P):IF J=0 THEN R$(I+1)="" ELSE R$(I+1)=CHR$(J)
6250 NEXT
6255 IF CVI(G$)<>0 THEN PC$="=P"+LEFT$(L$,CVI(G$)) ELSE PC$=""
6260 CLS:LOCATE 1,1,1:PRINT"===DIALING ";N$
6265 DIAL$=RIGHT$(R$,CVI(X$))
6270 IF SERV1 THEN DIAL$=SERV1$+DIAL$
6275 IF SERV2 THEN DIAL$=SERV2$+DIAL$
6280 PRINT#1, MODM$+DIAL$:STRT$=TIME$
6285 CLOSE#2:GOSUB 2700:GOSUB 2800:GOTO 515
6300 '-manual dialing
6305 PRINT"===DIAL PHONE #:";:QL=36:GOSUB 2500:R$=Q$:N$="
6310 IF R$="" THEN PRINT"(cancelled)":PRINT GO$:LOCATE,,1:RETURN
6315 IF LEFT$(R$,1)="+" THEN DIAL$=SERV1$+RIGHT$(R$,LEN(R$)-1) ELSE DIAL$=R$
6320 IF LEFT$(R$,1)="-" THEN DIAL$=SERV2$+RIGHT$(R$,LEN(R$)-1)
6325 GOSUB 5815:CLOSE#1:OPEN COMM$ AS #1:PRINT#1,MODM$+DIAL$:STRT$=TIME$:PRINT:LOCATE,,1:RETURN
6400 '-revise
6405 GOSUB 6900:LOCATE 21,1,0:PRINT"Revise/add entry #:       | or...
6410 LOCATE 21,39:PRINT"Enter:  M to change modem command
6415 LOCATE 22,43:PRINT"+ / - to change long distance #s
6420 LOCATE 23,47:PRINT"C to clear directory entries
6425 LOCATE 24,47:PRINT"X to exit to dialing prompt";
6430 LOCATE 21,20,1:QL=2:GOSUB 2500:GOSUB 2555
6435 IF Q$="M" THEN 6830
6440 IF Q$="+" THEN 6835
6445 IF Q$="-" THEN 6840
6450 IF Q$="C" THEN GOSUB 6850:GOTO 6030
6455 IF Q$="X" THEN 6030
6460 IF VAL(Q$)<I1 OR VAL(Q$)>I2 THEN BEEP:LOCATE 21,20:PRINT SPACE$(LEN(Q$)):GOTO 6430
6465 DE$=Q$:GET#2,VAL(DE$)+4:Q=VAL(DE$)-I1+1
6470 '-name & number
6475 GOSUB 6900:LOCATE 22,1:PRINT"Name: ";:QL=24:GOSUB 2500:NI$=Q$
6480 IF NI$="" THEN NI$=N$
6485 LOCATE Q+4,4:PRINT NI$;SPACE$(25-LEN(NI$));:GOSUB 6910
6490 PRINT"Phone number: ";:QL=36:GOSUB 2500:RI$=Q$:XI=LEN(RI$):IF RI$="" THEN RI$=R$:XI=CVI(X$)
6495 LOCATE Q+4,30:IF XI>14 THEN PRINT RIGHT$(RI$,14) ELSE PRINT SPACE$(14-XI)+RIGHT$(RI$,XI)
6500 '-comm params
6505 GOSUB 6910:PRINT"Communications parameters ok (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555
6510 IF Q$="Y" OR Q$="" THEN BI$=B$:PI$=P$:DI$=D$:SI$=S$:GOTO 6555
6515 GOSUB 6910:PRINT"Baud rate: ";:QL=4:GOSUB 2500:BI$=Q$:IF BI$="" THEN BI$=B$
6520 LOCATE Q+4,47:PRINT SPACE$(4-LEN(BI$));BI$;
6525 GOSUB 6910:PRINT"Parity: ";:QL=1:GOSUB 2500:GOSUB 2555:PI$=Q$:IF PI$="" THEN PI$=P$
6530 LOCATE Q+4,52:PRINT PI$;
6535 GOSUB 6910:PRINT"# data bits: ";:QL=1:GOSUB 2500:DI$=Q$:IF DI$="" THEN DI$=D$
6540 LOCATE Q+4,54:PRINT DI$;
6545 GOSUB 6910:PRINT"# stop bits: ";:QL=1:GOSUB 2500:SI$=Q$:IF SI$="" THEN SI$=S$
6550 LOCATE Q+4,56:PRINT SI$;
6555 '-echo & messages
6560 GOSUB 6910:PRINT"Echo on (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555:EI$=Q$:IF EI$="" THEN EI$=E$:GOTO 6570
6565 IF EI$<>"Y" THEN EI$="N
6570 LOCATE Q+4,61:PRINT EI$;
6575 GOSUB 6910:PRINT"Messages on (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555:MI$=Q$:IF MI$="" THEN MI$=M$:GOTO 6585
6580 IF MI$<>"Y" THEN MI$="N
6585 LOCATE Q+4,66:PRINT MI$;
6590 '-strip chars
6595 GOSUB 6910:LOCATE 22,1:PRINT"Strip/convert characters (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555:IF Q$="" THEN TI=CVI(T$):CI$=C$:GOTO 6655
6600 IF Q$="0" OR Q$="N" THEN TI=0:CI$=STRING$(26,47):GOTO 6645
6605 IF Q$<>"Y" THEN BEEP:GOTO 6595
6610 GOSUB 6905:LOCATE 22,1:PRINT"old strip/cnvt string: ";C$
6615 LOCATE 23,1:PRINT"change this (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555:IF Q$<>"Y" THEN TI=CVI(T$):CI$=C$:LOCATE 23,1:PRINT SPACE$(20);:GOTO 6655
6620 LOCATE 24,1:PRINT"(please refer to instructions in the documentation)";:LOCATE 23,1:PRINT"new strip/cnvt string: ";:QL=24:GOSUB 2500:CI$=Q$
6625 CI$=CI$+STRING$(26-LEN(CI$),47)
6630 LOCATE 21,40:PRINT"new string ok (y/n)?";SPACE$(20);:LOCATE 21,61:QL=1:GOSUB 2500:GOSUB 2555:IF Q$="N" THEN LOCATE 23,1:PRINT SPACE$(79):GOTO 6620
6635 P=INSTR(CI$,"//"):IF P=1 THEN TI=0:GOTO 6655
6640 IF P MOD 8<>0 THEN BEEP:GOTO 6610 ELSE TI=P/8
6645 GOSUB 6905:LOCATE Q+4,71:IF TI=0 THEN PRINT "N" ELSE PRINT USING "#";TI
6650 '-pacing
6655 GOSUB 6910:LOCATE 22,1:PRINT"Pacing? p=";:QL=3:GOSUB 2500:LI$=Q$:GI=LEN(LI$)
6660 IF Q$="0" OR Q$="N" OR Q$="n" THEN LI$="N":GI=0:LOCATE Q+4,75:PRINT"  N  ";:GOTO 6800
6665 IF LI$="" THEN LI$=L$:GI=CVI(G$):GOTO 6800
6670 LOCATE Q+4,75:PRINT "p="+LI$+SPACE$(3-GI)
6800 '-write new info
6805 LSET N$=NI$:RSET R$=RI$:LSET X$=MKI$(XI):RSET B$=BI$:LSET P$=PI$:LSET D$=DI$:LSET S$=SI$:LSET E$=EI$:LSET M$=MI$:LSET T$=MKI$(TI):LSET C$=CI$:LSET L$=LI$:LSET G$=MKI$(GI)
6810 GOSUB 6905:LOCATE 22,1:PRINT"Is entry #";DE$;" ok (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555:Q1$=Q$
6815 IF Q1$<>"Y" AND Q1$<>"" THEN LOCATE 22,1:PRINT SPACE$(35);:GOTO 6470
6820 PUT#2,VAL(DE$)+4:GOTO 6030
6825 '-modem$ & service$
6830 GOSUB 6900:MSG$="Modem dialing command:":GOSUB 6845:PUT #2,2:GOTO 6030
6835 GOSUB 6900:MSG$="Long distance +#:":GOSUB 6845:PUT #2,3:GOTO 6030
6840 GOSUB 6900:MSG$="Long distance -#:":GOSUB 6845:PUT#2,4:GOTO 6030
6845 LOCATE 21,1:PRINT MSG$;SPACE$(79-LEN(MSG$));:LOCATE 21,LEN(MSG$)+2:QL=36:GOSUB 2500:RI$=Q$:XI=LEN(RI$):RSET R$=RI$:LSET X$=MKI$(XI):RETURN
6850 '-clear directory
6855 GOSUB 6900:LOCATE 21,1:PRINT"Clear directory from entry #:";:QL=2:GOSUB 2500:I1=VAL(Q$):IF I1<1 THEN I1=61
6860 PRINT" ... through entry #:";:QL=2:GOSUB 2500:I2=VAL(Q$):IF I2>60 THEN I2=60
6865 PRINT:PRINT"-- Are you sure (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555:IF Q$<>"Y" THEN 6030
6870 LSET N$=IFIL$:LSET R$="":LSET X$=MKI$(0):LSET B$="":LSET P$="":LSET D$="":LSET S$="":LSET E$="":LSET M$="":LSET T$=MKI$(0):LSET C$="":LSET L$="":LSET G$=MKI$(0):PUT#2,1
6875 IF MODM$="" THEN MODM$="ATDT"
6880 LSET N$="":RSET R$=MODM$:LSET X$=MKI$(LEN(MODM$)):PUT#2,2:RSET R$=SERV1$:LSET X$=MKI$(LEN(SERV1$)):PUT#2,3:RSET R$=SERV2$:LSET X$=MKI$(LEN(SERV2$)):PUT #2,4
6885 LSET N$="------------------------":RSET R$="- --- --- ----":LSET X$=MKI$(14)
6890 RSET B$="300":LSET P$="E":LSET D$="7":LSET S$="1":LSET E$="N":LSET M$="N":LSET T$=MKI$(0):LSET C$=STRING$(26,"/"):LSET L$="":LSET G$=MKI$(0)
6895 FOR I=I1 TO I2:PUT#2,I+4:NEXT:RETURN
6900 '-message area subrout
6905 LOCATE 21,27,0:PRINT SPACE$(52);:FOR I=22 TO 25:LOCATE I,1:PRINT SPACE$(79);:NEXT:LOCATE ,,1:RETURN
6910 LOCATE 22,1,0:PRINT SPACE$(79);:LOCATE 22,1,1:RETURN
6915 '
7000 ' Function Key Directory
7005 '
7010 BEEP:IF KPG=0 THEN KPG=1
7015 LOCATE 1,39,0:PRINT CHR$(213)+STRING$(38,205)+CHR$(184)
7020 LOCATE 2,39:PRINT VL$;"     ===FUNCTION KEY DIRECTORY===     ";VL$
7025 LOCATE 3,39:PRINT VL$;SPACE$(15);:COLOR HI,BG:PRINT KPG$(KPG);:COLOR FG,BG:PRINT" F1-10";SPACE$(13);VL$
7030 LOCATE 4,39:PRINT VL$;:COLOR BG,FG:PRINT"F-   Input String";SPACE$(21);:COLOR FG,BG:PRINT VL$
7035 FOR I=1 TO 10:P=(KPG-1)*10+I
7040 LOCATE I+4,39,0:PRINT VL$;:PRINT USING "##";I;:PRINT" = ";
7045 K=LEN(K$(P)):IF K>33 THEN K=33
7050 FOR J=1 TO K:Q=ASC(MID$(K$(P),J,1)):IF Q>31 THEN PRINT CHR$(Q); ELSE IF Q=13 THEN PRINT XCR$; ELSE COLOR HI,BG:PRINT CHR$(Q+64);:COLOR FG,BG
7055 NEXT J:PRINT SPACE$(33-K)+VL$+"  ";:NEXT I
7060 LOCATE 15,39,1:PRINT CHR$(198)+STRING$(38,205)+CHR$(181)
7100 '-proceed?
7105 GOSUB 7435:LOCATE 16,40,1:PRINT"Press:  R to revise ";KPG$(KPG);"-F assignments
7110 LOCATE 17,44:PRINT"F / B to page through directory
7115 LOCATE 18,48:PRINT"X to exit to terminal
7120 LOCATE 16,46,1:Q$=INPUT$(1):GOSUB 2555
7125 IF Q$="R" THEN 7200
7130 IF Q$="X" THEN CLOSE#2:GOSUB 2700:GOSUB 7435:LOCATE 16,40:LOCATE ROW,COL:PRINT GO$:GOTO 515
7135 IF Q$="F" THEN KPG=KPG+1:IF KPG=5 THEN KPG=1:GOTO 7015 ELSE GOTO 7015
7140 IF Q$="B" THEN KPG=KPG-1:IF KPG=0 THEN KPG=4:GOTO 7015 ELSE GOTO 7015
7145 BEEP:LOCATE 21,76:PRINT SPACE$(LEN(Q$)):GOTO 7120
7200 '-revise
7205 GOSUB 7435:CLOSE#2:OPEN KFIL$ AS #2:FIELD #2, 126 AS K$,2 AS L$
7210 GET#2,1:IF LEFT$(K$,LEN(IFIL$))<>IFIL$ THEN GOSUB 7425
7215 LOCATE 16,40:PRINT"Press Func. key to revise:
7220 LOCATE 18,43:PRINT"or X to exit to terminal
7225 LOCATE 16,66:Q$=INKEY$:IF Q$="" THEN 7225 ELSE IF LEN(Q$)>1 THEN 7240
7230 GOSUB 2555:IF Q$="X" THEN CLOSE#2:GOSUB 2700:GOSUB 7440:LOCATE 16,40:PRINT GO$;:LOCATE ROW,COL:GOTO 515
7235 BEEP:GOTO 7225
7240 Q=ASC(MID$(Q$,2,1))
7245 IF Q>58 AND Q<69 THEN K=(KPG-1)*10+Q-58:Q$=KPG$(KPG)+"-F"+STR$(Q-58):GOTO 7270
7250 IF Q>103 AND Q<114 THEN K=Q-93:Q$=" Alt-F"+STR$(K-10):GOTO 7270
7255 IF Q>83 AND Q<94 THEN K=Q-63:Q$="Shft-F"+STR$(K-20):GOTO 7270
7260 IF Q>93 AND Q<104 THEN K=Q-63:Q$="Ctrl-F"+STR$(K-30):GOTO 7270
7265 BEEP:GOTO 7225
7270 KY=K:GET#2,KY+1
7275 '-new input string
7280 GOSUB 7450:LOCATE 16,1:PRINT"New input string for ";Q$;":":LOCATE 20,1:PRINT STRING$(80,196)
7285 LOCATE 21,1:PRINT"Use ";XCR$;" as substitute for carriage returns
7290 LOCATE 22,8:PRINT ENT$;" to leave key unchanged
7295 LOCATE 23,1:PRINT"<space>";ENT$;" to clear key
7300 LOCATE 17,1:PRINT CHR$(16);:QL=126:GOSUB 2500:KI$=Q$
7305 IF KI$="" THEN KI$=K$
7310 IF KI$=" " THEN KI$="
7315 LI=LEN(KI$)
7400 '-write new info
7405 LSET K$=KI$:LSET L$=MKI$(LI):PUT#2,KY+1
7410 IF Q$="0" THEN K$(10)=KI$:GOSUB 7455:GOTO 7015
7415 K$(KY)=KI$:GOSUB 7455:GOTO 7015
7420 '-create directory
7425 LSET K$=IFIL$:LSET L$="":PUT#2,1
7430 LSET K$="":LSET L$=MKI$(0):FOR I=2 TO 41:PUT#2,I:NEXT:RETURN
7435 '-message area subrout
7440 FOR I=16 TO 18:LOCATE I,39,0:PRINT VL$;SPACE$(38);VL$;"   ";:NEXT
7445 LOCATE 19,39:PRINT CHR$(212);STRING$(38,205);CHR$(190);"   ";:LOCATE ,,1:RETURN
7450 LOCATE 15,1,0:PRINT STRING$(80,205);:GOTO 7460
7455 LOCATE 15,1,0:PRINT SPACE$(80);
7460 FOR I=16 TO 23:LOCATE I,1:PRINT SPACE$(80);:NEXT:LOCATE 24,1:PRINT SPACE$(79);:LOCATE ,,1:RETURN
7465 '
7599 ' receive translator
7600 J=0
7605 FOR I=1 TO LEN(A$)
7610 Z=ASC(MID$(A$,I,1)) AND &H1F
7615 IF Z=27 THEN RSWIT=FIGS:GOTO 7640
7620 IF Z=31 THEN RSWIT=1:GOTO 7640
7627 IF (Z<1) OR (Z>31) GOTO 7640
7630 J=J+1
7635 MID$(A$,J,1)=BAUDOT$(Z,RSWIT)
7640 NEXT I
7642 IF J<>0 THEN A$=LEFT$(A$,J) ELSE A$=""
7650 RETURN
7799 ' transmit translator
7800 BB$=""
7805 FOR I=1 TO LEN(B$)
7810 Z=ASC(MID$(B$,I,1))
7811 IF Z=0 THEN ZZ=0:GOTO 7866
7815 IF FIGS=2 THEN ZZ=ASC(ASCII1$(Z)) ELSE ZZ=ASC(ASCII2$(Z))
7820 IF ZZ=255 GOTO 7868
7825 IF ZZ=>128 GOTO 7850
7830 IF TSWIT=1 GOTO 7866
7835 BB$=BB$+CHR$(31)
7840 TSWIT=1
7845 GOTO 7866
7850 ZZ=ZZ-128
7855 IF TSWIT=FIGS GOTO 7866
7860 BB$=BB$+CHR$(27)
7865 TSWIT=FIGS
7866 BB$=BB$+CHR$(ZZ)
7868 NEXT I
7869 B$=BB$
7870 RETURN
7900 B$=B$+CHR$(13)+"KA9DCA  (STEVE)  "+DATE$+"  "+TIME$+" CST"
8000 ' Redial
8005 '
8010 CLS:MSG$=" Redialing...  *** HIT ANY KEY TO TERMINATE ***  (redial started at "+TIME$+")":GOSUB 2600
8015 SOUND 5000,2:PRINT  "===REDIALING ";N$;" at ";TIME$:PRINT#1,MODM$+DIAL$
8020 IF INKEY$<>"" THEN 8095
8025 SOUND 32767,12000/VAL(BAU$):SOUND 32767,1
8030 IF EOF(1) THEN 8020
8035 Q1$=INPUT$(LOC(1),#1)
8040 SOUND 32767,12000/VAL(BAU$):SOUND 32767,1
8045 IF EOF(1) THEN Q2$="":GOTO 8055
8050 Q2$=INPUT$(LOC(1),#1)
8055 Q$=Q1$+Q2$
8060 FOR I=1 TO LEN(Q$):P=ASC(MID$(Q$,I,1)):J=P AND 127:MID$(Q$,I,1)=CHR$(J):NEXT
8065 PRINT Q$;
8070 IF INSTR(Q$,MODM$)<>0 THEN 8020
8075 IF INSTR(Q$,CONNECT$)=0 THEN GOTO 8100 ELSE STRT$=TIME$
8080 MSG$=" REMOTE COMPUTER ON LINE  *** HIT ANY KEY TO PROCEED ***":GOSUB 2600
8085 IF INKEY$="" THEN SOUND 600,4:SOUND 900,4:GOTO 8085
8090 PRINT:PRINT"===CONNECTED WITH ";N$:GOSUB 2800:GOTO 515
8095 PRINT#1,CR$:CLS:BEEP:PRINT"===REDIAL TERMINATED...back in terminal mode":PRINT GO$:GOSUB 2800:GOTO 515
8100 I=1
8105 SOUND 32767,20:SOUND 32767,1:IF INKEY$<>"" THEN 8095
8110 I=I+1:IF I=QDELAY THEN 8015 ELSE GOTO 8105
8115 '
8200 ' Elapsed Time
8205 '
8210 IF STRT$="--" THEN MLPSD=0:GOTO 8220
8215 MSTRT=VAL(MID$(STRT$,1,2))*60+VAL(MID$(STRT$,4,2)):MSTOP=VAL(MID$(TIME$,1,2))*60+VAL(MID$(TIME$,4,2)):MLPSD=INT(MSTOP-MSTRT):IF MSTRT>MSTOP THEN MLPSD=MLPSD+1440
8220 LOCATE 1,39:PRINT CHR$(213)+STRING$(38,205)+CHR$(184);
8225 LOCATE 2,39:PRINT VL$;"  Elapsed time this call = ";:COLOR HI,BG:PRINT MLPSD;:PRINT" min     ";:LOCATE 2,78:COLOR FG,BG:PRINT VL$;
8230 LOCATE 3,39:PRINT CHR$(192)+STRING$(38,205)+CHR$(217);
8235 LOCATE ROW,COL:GOTO 515
8240 '
8900 ' Error Subrout
8905 '
8910 BEEP:PRINT:PRINT"*** This program requires that you have a serial port."
8915 PRINT:PRINT:PRINT"(returning to DOS)":SOUND 32767,50:SOUND 32767,1:SYSTEM
8920 BEEP:LOCATE 15,1:PRINT"===PLEASE DO NOT BYPASS THE FREEWARE NOTICE===":GOTO 8915
8925 COLOR HI,BG:PRINT MSG$;:COLOR FG,BG:RETURN
8930 IF ERR=52 OR ERR=64 OR ERR=67 THEN MSG$="Not a valid file name.
8935 IF ERR=53 THEN MSG$="File not found.
8940 IF ERR=70 THEN MSG$="Disk is write protected.
8945 IF ERR=71 THEN MSG$="Check disk drive.
8950 IF ERR=72 THEN MSG$="Disk media error.
8955 RETURN
8960 '
9000 ' Error Traps
9005 '
9010 IF ERL=215 THEN RESUME 5405
9015 IF ERL=225 THEN RESUME 245
9020 IF ERL=5665 THEN RESUME 5670
9025 IF ERL=425 THEN RESUME 245
9030 IF ERR=27 THEN BEEP:MGS$="CHECK PRINTER":GOSUB 8925:PR=0:IF ERL=1610 THEN RESUME 515 ELSE RESUME 820
9035 IF ERL=5280 THEN BEEP:GOSUB 5295:PRINT TAB(31)"*** Invalid communications parameters. Try again.";:EXIT=0:RESUME 5215
9040 IF ERL=6215 AND ERR=64 THEN BEEP:LOCATE 20,1:PRINT"*** Invalid parameters for entry #";Q$:RESUME 6400
9045 IF ERL=6245 THEN BEEP:LOCATE 20,1:PRINT"*** Invalid stripping for entry #";Q$:RESUME 6400
9050 IF ERR=24 THEN MSG$="TIMEOUT":GOSUB 8925:IF PR THEN PR=0:MSG$="PRINTOUT OFF":GOSUB 8925:PR=O:CLOSE#3:RESUME 820 ELSE MSG$="CHECK MODEM":GOSUB 8925:RESUME 515
9055 IF ERR=57 THEN MSG$="":GOSUB 8925:IF RC$="X" THEN RESUME 4525 ELSE IF TC$="X" THEN RESUME 4725 ELSE RESUME 515
9060 IF ERR=69 THEN PRINT#1,XF$;:PSE=-1:MSG$="OVERFLOW":GOSUB 8925:IF NOT PR THEN RESUME 515 ELSE MSG$="PRINTOUT OFF":PR=0:CLOSE#3:RESUME 515
9065 IF ERR=15 AND ERL=660 THEN MSG$="OVERFLOW--PRINTOUT OFF":GOSUB 8925:PR=0:CLOSE#3:RESUME 515
9070 IF ERL=3640 THEN BEEP:PRINT"*** File(s) not found. Try again.":RESUME 3645
9075 IF ERR=61 AND RC$="X" THEN BEEP:PRINT"*** DISK IS FULL":RESUME 4645
9080 IF ERR=61 THEN BEEP:PRINT:PRINT"===DISK IS FULL===":IF RC THEN RESUME 3000 ELSE RESUME 3820
9085 IF ERL=3810 THEN LOCATE 1,40:COLOR HI,BG:PRINT"***CAN'T OPEN ";DUMP$;"***";:LOCATE ROW,COL:RESUME 3820
9090 IF ERR=67 AND ERL=3595 THEN PRINT"*** Either too many files, or
9095 IF ERL=3595 THEN MSG$="":GOSUB 8930:BEEP:PRINT"*** ";MSG$;" Try again.":RESUME 3500
9100 IF ERR=67 OR ERR=70 OR ERR=71 THEN BEEP:PRINT"*** Can't read/write file in the default drive.":PRINT"Correct and hit any key to resume..":Q$=INPUT$(1):IF ERL<400 THEN RESUME 215 ELSE CLS:RESUME 400
9105 IF ERR=68 THEN GOTO 8910
9115 IF ERR=62 AND ERL=3420 THEN RESUME 3425
9900 '-if not trapped
9905 CLOSE:BEEP:MSG$=" Sorry, NON-RECOVERABLE ERROR "+STR$(ERR)+" at line"+STR$(ERL):GOSUB 2600:ON ERROR GOTO 0
9999 DATA 830424
11000 RESTORE 11180
11010 FOR I=0 TO 256
11020 ASCII1$(I)=CHR$(255)
11030 ASCII2$(I)=CHR$(255)
11040 NEXT I
11050 FOR I=0 TO 31
11060 READ X,Y,Z
11070 BAUDOT$(I,1)=CHR$(X)
11080 BAUDOT$(I,2)=CHR$(Y)
11090 BAUDOT$(I,3)=CHR$(Z)
11100 ASCII1$(X)=CHR$(I)
11110 ASCII2$(X)=CHR$(I)
11120 IF X<65 OR X>90 GOTO 11150
11130 ASCII1$(X+32)=CHR$(I)
11140 ASCII2$(X+32)=CHR$(I)
11150 ASCII1$(Y)=CHR$(I+128)
11160 ASCII2$(Z)=CHR$(I+128)
11170 NEXT I
11180 DATA 00,00,00
11190 DATA 69,51,51
11200 DATA 10,00,00
11210 DATA 65,45,45
11220 DATA 32,00,00
11230 DATA 83,07,39
11240 DATA 73,56,56
11250 DATA 85,55,55
11260 DATA 13,00,00
11270 DATA 68,36,00
11280 DATA 82,52,52
11290 DATA 74,39,07
11300 DATA 78,44,44
11310 DATA 70,33,33
11320 DATA 67,58,58
11330 DATA 75,40,40
11340 DATA 84,53,53
11350 DATA 90,34,43
11360 DATA 76,41,41
11370 DATA 87,50,50
11380 DATA 72,35,156
11390 DATA 89,54,54
11400 DATA 80,48,48
11410 DATA 81,49,49
11420 DATA 79,57,57
11430 DATA 66,63,63
11440 DATA 71,38,38
11450 DATA 00,00,00
11460 DATA 77,46,46
11470 DATA 88,47,47
11480 DATA 86,59,61
11490 DATA 00,00,00
11500 RETURN