home *** CD-ROM | disk | FTP | other *** search
/ RBBS in a Box Volume 1 #3.1 / RBBSIABOX31.cdr / tcht / talkjrim.bas < prev    next >
BASIC Source File  |  1985-04-23  |  51KB  |  892 lines
  1. 1 ' WARNING!!! DO NOT ALTER, BYPASS OR REMOVE LINES 1-100
  2. 2 '
  3. 3 ' PC-TALK  (ver. III)
  4. 4 '
  5. 5 ' by Andrew Fluegelman
  6. 6 ' The Headlands Press, Inc.
  7. 7 ' P.O. Box 862
  8. 8 ' Tiburon, CA 94920
  9. 9 '
  10. 10 ' ***************************  NOTICE  ***************************
  11. 11 ' *  A limited license is granted to all users of this program,  *
  12. 12 ' *  to make copies of this program and distribute them to other *
  13. 13 ' *  users, on the following conditions:                         *
  14. 14 ' *     1. The notices contained in lines 1 through 100 of the   *
  15. 15 ' *        program are not to be altered, bypassed, or removed.  *
  16. 16 ' *     2. The program is not to be distributed to others in     *
  17. 17 ' *        modified form.                                        *
  18. 18 ' *     3. No fee is to be charged (or any other consideration   *
  19. 19 ' *        received) for copying or distributing the program     *
  20. 20 ' *        without an express written agreement with             *
  21. 21 ' *        The Headlands Press, Inc., Box 862, Tiburon, CA 94920 *
  22. 22 ' *                                                              *
  23. 23 ' *                 Copyright (c) 1983 The Headlands Press, Inc. *
  24. 24 ' ****************************************************************
  25. 25 '
  26. 26 ' NOTE: To see remarks, MERGE "PCTKREM.MRG"
  27. 27 '
  28. 28 ' NOTE:  THIS PROGRAM REQUIRES 128K
  29. 29 '
  30. 30 '
  31. 50 SCREEN 0,1,0:WIDTH 80:CLS:KEY OFF:LOCATE ,,0
  32. 52 PRINT TAB(60)"tm":PRINT TAB(16) STRING$(15,205)" F R E E W A R E "STRING$(15,205)
  33. 54 PRINT:PRINT TAB(28)"User-Supported Software":PRINT:PRINT TAB(7) CHR$(214)STRING$(62,196)CHR$(183)
  34. 56 FOR I=1 TO 11:READ A$:PRINT TAB(7) CHR$(186);A$;SPACE$(62-LEN(A$));CHR$(186):NEXT
  35. 58 PRINT TAB(7) CHR$(211)STRING$(62,196)CHR$(189):PRINT TAB(27)"Copyright (c) 1983 The Headlands Press, Inc.
  36. 60 DATA"    If you are using this program and finding it of value,
  37. 62 DATA"    your contribution ($35 suggested) will be appreciated.
  38. 64 DATA"
  39. 66 DATA"                        === Freeware ===
  40. 68 DATA"                      Post Office Box 862
  41. 70 DATA"                       Tiburon, CA 94920
  42. 72 DATA"
  43. 74 DATA"       You are encouraged to copy and share this program
  44. 76 DATA"  with other users, on the conditions that the program is not
  45. 78 DATA"  distributed in modified form, that no fee or consideration
  46. 80 DATA"  is charged, and that this notice is not bypassed or removed.
  47. 82 '
  48. 100 '
  49. 101  ' MODIFICATIONS MADE TO LINE 8915 ON 3/26/84 TO RESTORE SCREEN TO BLACK AT END OF PROGRAM
  50. 102  '
  51. 110 CLOSE:DEFINT A-Z:OPTION BASE 1:ON ERROR GOTO 9000:GOSUB 64010:PLAY"MF"
  52. 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
  53. 116 SP=0:CLIN$=STRING$(79,32)
  54. 120 FLN!=0:CNT!=0
  55. 125 DIM ALT$(10):DIM K$(40)
  56. 130 FOR I=1 TO 10:KEY I,"":NEXT
  57. 135 BS$=CHR$(8):LF$=CHR$(10):CR$=CHR$(13)
  58. 140 RCV$="":TRN$="":DIAL$="":STRT$="--":GO$="===Proceed ...
  59. 145 DIM KPG$(4):KPG$(1)="Func":KPG$(2)=" Alt":KPG$(3)="Shft":KPG$(4)="Ctrl
  60. 150 DIM DS$(3):DIM DR$(3)
  61. 155 VL$=CHR$(179):EF$=CHR$(26):BL$=CHR$(7):ENT$=CHR$(17)+CHR$(196)+CHR$(217)
  62. 160 XN$=CHR$(17):XF$=CHR$(19):SOH$=CHR$(1):EOT$=CHR$(4):ACK$=CHR$(6):NAK$=CHR$(21):CAN$=CHR$(24)
  63. 165 DFIL$="pc-talk.dir":KFIL$="pc-talk.key":FFIL$="pc-talk.def":IFIL$="INITIALIII"
  64. 200 '
  65. 210 DFNUM=29:DIM DP$(29):DIM D$(29):DIM DT$(29)
  66. 215 CLOSE#1:OPEN FFIL$ FOR INPUT AS #1
  67. 220 INPUT#1,Q$:IF Q$<>IFIL$ THEN 245
  68. 225 FOR I=1 TO DFNUM:INPUT#1,DP$(I),D$(I):NEXT
  69. 230 CK=SCREEN(19,38):IF CK<>99 THEN 8920
  70. 235 INPUT#1,Q$:IF Q$<>IFIL$ THEN 245
  71. 240 GOSUB 5600:GOTO 300
  72. 245 BEEP:PRINT"*** Re-initializing Default File ***":CLOSE#1:KILL FFIL$:GOTO 5400
  73. 250 '
  74. 300 '
  75. 310 LOCATE 25,1:PRINT"Hit any key to continue ...";:I=1:LOCATE ,,0:P=0
  76. 315 B$=INKEY$:SOUND 32767,1:P=P+1:IF B$="" AND P<2000 THEN 315 ELSE B$=" "
  77. 320 COLOR FG,BG,BG:CLS:LOCATE 1,39:COLOR BG,FG:PRINT SPACE$(5);"MAKE SURE THAT YOUR MODEM IS ON"SPACE$(4):COLOR FG,BG:PRINT:RESTORE 355
  78. 325 PRINT TAB(39) CHR$(213);STRING$(38,205);CHR$(184)
  79. 330 FOR I=1 TO 5:READ A$:PRINT TAB(39) VL$;A$;SPACE$(38-LEN(A$));VL$:NEXT
  80. 335 PRINT TAB(39) VL$;STRING$(38,196);VL$
  81. 340 FOR I=1 TO 5:READ A$:PRINT TAB(39) VL$;A$;SPACE$(38-LEN(A$));VL$:NEXT
  82. 345 PRINT TAB(39) CHR$(212);STRING$(38,205);CHR$(190);
  83. 350 '
  84. 355 DATA"      =====   PC-TALK III    =====
  85. 360 DATA"        Revised November 1984
  86. 365 DATA"       Communications Program for
  87. 370 DATA"   The IBM PCjr. with Internal modem
  88. 375 DATA"             FOR DOS 2.1
  89. 377 DATA"
  90. 380 DATA" Press: <Home> for command summary
  91. 385 DATA"        <Alt>-E if you can't see
  92. 390 DATA"               your keyboard input
  93. 391 DATA"        <Ctr>-Home for Split
  94. 392 DATA"              Screen Operation
  95. 400 '
  96. 405 CLOSE#2:OPEN KFIL$ AS #2:FIELD #2,126 AS K$,2 AS L$
  97. 410 GET#2,1:IF LEFT$(K$,LEN(IFIL$))<>IFIL$ THEN GOSUB 7425
  98. 415 FOR I=1 TO 40:GET#2,I+1:LN=CVI(L$):IF LN=0 THEN 420 ELSE K$(I)=LEFT$(K$,LN)
  99. 420 NEXT:CLOSE#2:IF B$="" THEN 8920
  100. 425 GOSUB 64380:CLOSE#1:OPEN COMM$ AS #1:PRINT #1,MODMINIT$+IMFT$+CR$;
  101. 430 ROW=1:COL=1:GOSUB 2820:LOCATE 1,1,1:PRINT GO$
  102. 435 '
  103. 500 '
  104. 510 '
  105. 515 IF TR THEN IF TR$="X" THEN 4860 ELSE 4060
  106. 517 IF TMP$="" AND SP THEN XPOS=1
  107. 520 B$=INKEY$:IF B$="" THEN 560
  108. 525 IF LEN(B$)>1 THEN 1500
  109. 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
  110. 535 IF MARG<=0 THEN 550
  111. 540 IF INSTR(B$,CR$)<>0 THEN CCNT=0:GOTO 550
  112. 545 CCNT=CCNT+LEN(B$):IF CCNT>=MARG AND CCNT<MARG+10 THEN BEEP
  113. 550 IF ECH THEN PRINT B$;:IF PR THEN PR$=PR$+B$:GOSUB 800
  114. 555 IF SP THEN 11000
  115. 558 PRINT#1,B$;
  116. 560 IF EOF(1) THEN 515 ELSE 605
  117. 600 '
  118. 605 IF LOF(1)<128 THEN GOSUB 64030
  119. 610 IF EOF(1) THEN 710
  120. 612 IF SP THEN LOCATE ROW,COL,0
  121. 615 A$=INPUT$(LOC(1),#1):IF NS=0 THEN 635
  122. 620 FOR I=1 TO NS
  123. 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
  124. 630 NEXT
  125. 635 IF RC THEN GOSUB 64200
  126. 640 P=INSTR(A$,LF$):IF P=0 THEN 645 ELSE A$=LEFT$(A$,P-1)+RIGHT$(A$,LEN(A$)-P):GOTO 640
  127. 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
  128. 650 NEXT:GOTO 660
  129. 655 FOR I=1 TO LEN(A$):PRINT MID$(A$,I,1);:NEXT
  130. 660 IF SP THEN ROW=CSRLIN:COL=POS(0):LOCATE 25,XPOS,1
  131. 661 IF PR THEN PR$=PR$+A$:GOSUB 800
  132. 700 '
  133. 705 IF SET THEN 715
  134. 710 B$=INKEY$:IF B$<>"" THEN 525
  135. 715 IF LOC(1)>0 THEN 605
  136. 720 IF PSE THEN GOSUB 64100
  137. 725 IF SET THEN ROW=CSRLIN:COL=POS(0):GOTO 1000
  138. 730 GOTO 515
  139. 800 '
  140. 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
  141. 810 P=INSTR(PR$,CR$):IF P=0 THEN 815 ELSE PRINT#3,LEFT$(PR$,P);:PR$=RIGHT$(PR$,LEN(PR$)-P):GOTO 810
  142. 815 IF LEN(PR$)>220 THEN PRINT#3,PR$;:PR$="":RETURN
  143. 820 RETURN
  144. 825 '
  145. 1000 '
  146. 1010 IF ALTSET THEN LOCATE 25,17 ELSE LOCATE 25,15+LEN(ALT$)
  147. 1015 C$=INKEY$:IF C$="" THEN IF EOF(1) THEN 1015 ELSE SET=-1:LOCATE ROW,COL:GOTO 605
  148. 1020 IF NOT ALTSET THEN 1035
  149. 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
  150. 1030 IF ALTSET THEN ALTSET=0:SET=-1:LOCATE 25,1:PRINT STRING$(5,16);" Alt-";ALTKY;CHR$(198);"    ";CHR$(181);:GOTO 1010
  151. 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
  152. 1040 IF C$=BS$ THEN IF ALT$="" GOTO 1010 ELSE GOSUB 2650:ALT$=LEFT$(ALT$,LEN(ALT$)-1):GOTO 1010
  153. 1045 IF C$=CHR$(13) THEN 1070
  154. 1050 IF C$>CHR$(31) THEN PRINT C$; ELSE COLOR HI,BG:PRINT CHR$(ASC(C$)+64);:COLOR FG,BG
  155. 1055 PRINT"    ";CHR$(181);
  156. 1060 IF C$=XCR$ THEN C$=CHR$(13)
  157. 1065 ALT$=ALT$+C$:GOTO 1010
  158. 1070 IF ALT$<>"" THEN IF ALT$=" " THEN ALT$(ALTKY)="" ELSE ALT$(ALTKY)=ALT$
  159. 1075 ALT$="":SET=0:GOTO 1200
  160. 1080 '
  161. 1200 '
  162. 1210 P=1:FOR I=1 TO 10:LOCATE 25,P:IF I=10 THEN PRINT"0";:COLOR BG,FG:GOTO 1220
  163. 1215 PRINT USING "#";I;:COLOR BG,FG
  164. 1220 FOR J=1 TO 7:Z$=MID$(ALT$(I),J,1):IF POS(0)=80 THEN 1235
  165. 1225 IF J>LEN(ALT$(I)) THEN PRINT" ";:GOTO 1235
  166. 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
  167. 1235 NEXT J:COLOR FG,BG:P=P+8:NEXT I
  168. 1240 FOR I=1 TO 10:IF ALT$(I)<>"" THEN EXIT=-1
  169. 1245 NEXT:IF EXIT THEN EXIT=0:LOCATE ROW,COL:GOTO 605
  170. 1250 LOCATE ROW,COL:GOSUB 2820:GOTO 515
  171. 1255 '
  172. 1500 '
  173. 1510 EX=0:ROW=CSRLIN:COL=POS(0)
  174. 1515 IF LEN(B$)=2 THEN EX=ASC(MID$(B$,2,1)) ELSE EX=0
  175. 1520 IF EX=75 THEN B$=CHR$(29):GOTO 535
  176. 1525 IF EX=77 THEN B$=CHR$(28):GOTO 535
  177. 1530 IF EX=71 THEN 2000
  178. 1535 IF EX=19 OR EX=81 THEN EX=19:GOTO 3000
  179. 1540 IF EX=47 THEN 3400
  180. 1545 IF EX=20 OR EX=73 THEN EX=20:GOTO 3200
  181. 1550 IF EX=25 THEN 5000
  182. 1555 IF EX=32 THEN 6000
  183. 1560 IF EX=36 OR EX=37 THEN 7000
  184. 1565 '
  185. 1570 IF EX>=59 AND EX<=68 THEN B$=K$(EX-58):GOTO 535
  186. 1575 IF EX>=104 AND EX<=113 THEN B$=K$(EX-93):GOTO 535
  187. 1580 IF EX>=84 AND EX<=103 THEN B$=K$(EX-63):GOTO 535
  188. 1585 IF EX>=120 AND EX<=129 THEN B$=ALT$(EX-119):GOTO 535
  189. 1590 IF EX=131 THEN:BEEP:LOCATE 25,1:PRINT"  set Alt-(1-0):  ";CHR$(181);:ALTSET=-1:GOTO 1000
  190. 1595 '
  191. 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
  192. 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
  193. 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
  194. 1615 '
  195. 1620 IF EX=44 THEN 8200
  196. 1625 IF EX=16 THEN IF DIAL$<>"" THEN 8000 ELSE BEEP:PRINT"(nothing to redial)":PRINT GO$:GOTO 515
  197. 1630 IF EX=31 THEN 3800
  198. 1635 IF EX=33 THEN 5200
  199. 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
  200. 1645 '
  201. 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
  202. 1655 IF EX=21 THEN 3900
  203. 1660 IF EX=46 THEN PRINT CHR$(12):GOSUB 2800:GOTO 515
  204. 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
  205. 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
  206. 1675 IF EX=15 THEN RESTORE 9999:READ Q$:PRINT Q$:GOTO 515
  207. 1680 '
  208. 1682 IF EX=119 THEN 10000
  209. 1685 GOTO 515
  210. 1690 '
  211. 2000 '
  212. 2010 LOCATE 1,39:PRINT CHR$(213)+STRING$(38,205)+CHR$(184)
  213. 2015 LOCATE 2,39:PRINT VL$;"  ===PC-TALK III  COMMAND SUMMARY===  ";VL$
  214. 2020 LOCATE 3,39:PRINT CHR$(195)+STRING$(38,196)+CHR$(180)
  215. 2025 RESTORE 2050:LOCATE 4,39:READ B$:PRINT VL$;B$;SPACE$(38-LEN(B$));VL$
  216. 2030 FOR I=5 TO 24:LOCATE I,39:READ B$:PRINT VL$;B$;SPACE$(38-LEN(B$));VL$:NEXT
  217. 2035 LOCATE 24,39:PRINT CHR$(192)+STRING$(38,205)+CHR$(217);
  218. 2040 LOCATE ROW,COL:GOTO 515
  219. 2045 '
  220. 2050 DATA"  PrtSc = print screen contents
  221. 2055 DATA"  ^PgUp = continuous printout
  222. 2060 DATA"  Alt-R =  Receive a file  (or PgDn)
  223. 2063 DATA"         (Display avail. disk space)
  224. 2065 DATA"  Alt-T =  Transmit a file  (or PgUp)
  225. 2070 DATA" transmit: pacing '=p'  binary '=b'
  226. 2075 DATA"tran/recv: XMODEM '=x'
  227. 2080 DATA"  Alt-V =  View file   Alt-Y = delete
  228. 2085 DATA"  Alt-D =  Dialing directory
  229. 2090 DATA"  Alt-Q =  redial last number
  230. 2095 DATA"  Alt-K =  set/clear Func keys (Alt-J)
  231. 2100 DATA"  Alt-=    set/clear temp Alt keys
  232. 2105 DATA" Alt-E = Echo toggle  Alt-M = Message
  233. 2110 DATA" Alt-S = Screendump   Alt-C = Clearsc
  234. 2115 DATA"  Alt-P =  communications Parameters
  235. 2120 DATA"  Alt-F =  set program deFaults
  236. 2125 DATA"  Alt-L =  change Logged drive
  237. 2130 DATA"  Alt-W =  set margin Width alarm
  238. 2135 DATA"  Alt-Z =  elapsed time/current call
  239. 2140 DATA"  Alt-X =  eXit to DOS
  240. 2145 DATA"Ctrl-End = send sustained Break signal
  241. 2150 '
  242. 2500 '
  243. 2505 Q$="":IF QL=0 THEN QL=255
  244. 2510 QI$=INKEY$:IF QI$="" THEN 2510
  245. 2515 IF QI$=CHR$(13) THEN RETURN
  246. 2520 IF QI$<>CHR$(8) THEN 2530 ELSE IF Q$="" THEN BEEP:GOTO 2510
  247. 2525 IF QI$=CHR$(8) THEN GOSUB 2650:Q$=LEFT$(Q$,LEN(Q$)-1):GOTO 2510
  248. 2530 IF LEN(Q$)=QL THEN BEEP:GOTO 2510
  249. 2535 IF LEN(QI$)=1 THEN 2545 ELSE IF QI$<>CHR$(0)+CHR$(3) THEN BEEP:GOTO 2510 ELSE QI$=CHR$(0)
  250. 2545 IF ASC(QI$)>31 OR QI$=CHR$(27) THEN PRINT QI$; ELSE COLOR HI,BG:PRINT CHR$(ASC(QI$)+64);:COLOR FG,BG
  251. 2550 IF QI$=XCR$ THEN Q$=Q$+CHR$(13):GOTO 2510 ELSE Q$=Q$+QI$:GOTO 2510
  252. 2555 '
  253. 2560 FOR J=1 TO LEN(Q$):P=ASC(MID$(Q$,J,1)):IF P<97 OR P>122 THEN 2570
  254. 2565 MID$(Q$,J,1)=CHR$(P AND 95)
  255. 2570 NEXT:RETURN
  256. 2600 '
  257. 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
  258. 2650 '
  259. 2655 PRINT CHR$(29);" ";CHR$(29);:RETURN
  260. 2700 '
  261. 2705 GOSUB 64320:IF RC THEN F2NAME$=RCV$:GOSUB 64360
  262. 2710 GOSUB 64100:RETURN
  263. 2715 CLOSE#3:IF PR THEN OPEN PRNTPORT$ FOR OUTPUT AS #3
  264. 2720 IF TR THEN OPEN TRN$ AS #3 LEN=128:FIELD #3,128 AS X$
  265. 2725 RETURN
  266. 2800 '
  267. 2805 ROW=CSRLIN:COL=POS(0)
  268. 2810 EXIT=0:FOR I=1 TO 10:IF ALT$(I)<>"" THEN EXIT=-1:NEXT
  269. 2815 IF EXIT THEN EXIT=0:LOCATE ,,1:GOTO 1210
  270. 2820 IF MENU=0 THEN 2830
  271. 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
  272. 2830 LOCATE 25,1:PRINT SPACE$(79);:LOCATE ROW,COL:RETURN
  273. 2835 '
  274. 3000 '
  275. 3010 IF RC THEN RC=0:RC$="":BEEP:PRINT:PRINT"===RECEIPT OF FILE ";RCV$;" TERMINATED===":GOSUB 3247:PRINT:GOSUB 2700:GOSUB 2800:IF MSG THEN PRINT#1,BL$;CR$;"===FILE RECEIVED===":GOTO 515 ELSE 515
  276. 3015 RC$="":BEEP:PRINT:PRINT"===RECEIVE A FILE===":DRV$=DRIV$:GOSUB 3110:GOTO 3500
  277. 3020 IF RC$="X" THEN CLOSE#2:KILL RCV$:OPEN RCV$ AS #2 LEN=128:FIELD #2,128 AS X$:GOTO 3030
  278. 3025 IF MSG THEN PRINT#1,BL$;CR$;"===READY TO RECEIVE===
  279. 3030 MSG$=" Receiving "+RCVX$+"  (ALT-R to Terminate)":GOSUB 2600
  280. 3035 RC=-1:IF RC$="X" THEN 4500 ELSE 605
  281. 3040 '
  282. 3107 ' Merge with PC-TALK III; finds disk space with Alt-V
  283. 3108 ' For compiled PC-TALK and DOS 2.0 ONLY!!  Must link with DSK.OBJ
  284. 3109 ' by Jack Wright Nov 1983  /  See DSK.DOC
  285. 3110 A=2:B=0:C!=0:IF DRV$="A:" OR DRV$="a:" THEN A=1
  286. 3115 IF DRV$="C:" OR DRV$="c:" THEN A=3
  287. 3132 NAME DRV$+"1" AS DRV$+"1"  'make sure disk is in drive
  288. 3135 CALL DSK(A,B):C!=(C!+B)*512  ' see p. 110 compiler manual
  289. 3140 PRINT DRV$;" drive avail. space = ";C!
  290. 3145 RETURN
  291. 3200 '
  292. 3210 IF TR THEN TR=0:TR$="":MSG1$="===TRANSMISSION OF FILE ":MSG2$=" TERMINATED===":GOSUB 3247:BEEP:PRINT:PRINT MSG1$;TRN$;MSG2$:GOSUB 2715:GOSUB 2800:IF MSG THEN PRINT#1,CR$;MSG1$;MSG2$,BL$:GOTO 515 ELSE 515
  293. 3215 IF TR THEN TR=0:TR$="":MSG1$="===END OF FILE":MSG2$="===":BEEP:PRINT:GOSUB 3247:PRINT MSG1$;"  ";TRN$;MSG2$:GOSUB 2715:GOSUB 2800: IF MSG THEN PRINT#1,"65529 '";MSG1$;MSG2$;BL$:GOTO 515 ELSE 515
  294. 3220 TR$="":BEEP:PRINT:PRINT"===TRANSMIT A FILE===":GOTO 3500
  295. 3225 CLOSE#3:OPEN TRN$ AS #3 LEN=128:FIELD #3,128 AS X$
  296. 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:"
  297. 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
  298. 3240 IF MSG THEN PRINT#1,CR$;"0 '===START OF FILE===";BL$
  299. 3245 TR=-1:FLN!=LOF(3):IF TR$<>"X" THEN 4000 ELSE 4700
  300. 3247 RETURN
  301. 3248 '
  302. 3250 '
  303. 3400 '
  304. 3405 DRV$=DRIV$:GOSUB 3110
  305. 3410 BEEP:PRINT:PRINT"===VIEW A FILE===":GOTO 3500
  306. 3415 MSG$=" Viewing "+VEWX$+"  Hit <space> to continue  (Alt-V to terminate)":GOSUB 2600:PRINT:PRINT:PRINT
  307. 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)
  308. 3425 NEXT
  309. 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
  310. 3435 WEND
  311. 3440 BEEP:PRINT:PRINT"===END OF FILE ";VEW$;" ===":GOTO 3450
  312. 3445 BEEP:PRINT:PRINT"===VIEWING OF FILE ";VEW$;" TERMINATED===
  313. 3450 GOSUB 2715:GOSUB 2800:GOSUB 64100:GOTO 515
  314. 3455 '
  315. 3500 '
  316. 3505 IF EX=20 THEN COLOR HI,BG:PRINT"NOTE: Modem should be in transparent mode to transmit!":PRINT"(Hit enter to start over)":COLOR FG,BG
  317. 3510 EXIT=0:PRINT"   specification:";
  318. 3515 Q$=INKEY$:IF Q$="" THEN 3515 ELSE IF Q$=CR$ OR Q$=BS$ THEN FIL$="":PRINT:GOTO 3540
  319. 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 BEEP:GOTO 3515
  320. 3525 IF Q$<>" " THEN PRINT Q$;:QL=128:GOSUB 2510:GOSUB 2555:FIL$=Q$:PRINT:LOCATE,,1:GOTO 3540
  321. 3530 IF EX=19 THEN FIL$=RCVX$ ELSE IF EX=20 THEN FIL$=TRNX$ ELSE IF EX=47 THEN FIL$=VEWX$
  322. 3535 Q$=FIL$:PRINT Q$;:QL=128:GOSUB 2510:GOSUB 2555:FIL$=Q$:PRINT:LOCATE,,1
  323. 3540 IF FIL$="" THEN BEEP:PRINT"===CANCELLED===":GOTO 515
  324. 3545 IF LEFT$(FIL$,1)="?" THEN GOSUB 3625:GOTO 3510
  325. 3550 P=INSTR(FIL$,":"):IF P=0 THEN FIL$=DRIV$+FIL$
  326. 3555 IF EX=19 THEN RCVX$=FIL$ ELSE IF EX=20 THEN TRNX$=FIL$ ELSE IF EX=47 THEN VEWX$=FIL$
  327. 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
  328. 3565 Q$=RIGHT$(FIL$,LEN(FIL$)-P):FIL$=LEFT$(FIL$,P-1)
  329. 3570 IF Q$="B" THEN TR$="B"
  330. 3575 IF Q$="X" THEN IF EX=19 THEN RC$="X" ELSE IF EX=20 THEN TR$="X
  331. 3580 IF LEFT$(Q$,1)="P" THEN TR$="P":PROMPT$=RIGHT$(Q$,LEN(Q$)-1):DEL!=VAL(PROMPT$)
  332. 3585 IF TR$="B" OR TR$="X" OR RC$="X" THEN IF DTA$<>"8" THEN BEEP:COLOR HI,BG:PRINT"*** Can not transfer XMODEM with 7 data bits! -- PLEASE ABORT ***":COLOR FG,BG:GOTO 515
  333. 3590 IF TR$="X" OR RC$="X" THEN IF NS<>0 THEN BEEP:PRINT"*** Stripping disabled for XMODEM ***":NS=0
  334. 3595 IF EX=19 THEN GOSUB 64320:F2NAME$=FIL$:GOSUB 64360 ELSE CLOSE #3:OPEN FIL$ FOR INPUT AS #3
  335. 3600 PRINT STRING$(18+LEN(FIL$),61):IF EX=19 THEN RCV$=FIL$:GOTO 3020
  336. 3605 IF EX=20 THEN TRN$=FIL$:GOTO 3225
  337. 3610 IF EX=47 THEN VEW$=FIL$:GOTO 3415
  338. 3615 IF EX=21 THEN 3915
  339. 3620 '
  340. 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)
  341. 3630 P=INSTR(FIL$,":"):IF P=0 THEN FIL$=DRIV$+FIL$
  342. 3635 IF LEN(FIL$)=P THEN FIL$=FIL$+"*.*
  343. 3640 DRV$=LEFT$(FIL$,2):PRINT:GOSUB 3110:FILES FIL$:PRINT
  344. 3645 RETURN
  345. 3650 '
  346. 3800 '
  347. 3810 SOUND 440,2:GOSUB 64320:F2NAME$=DUMP$:GOSUB 64360:MSG$="appending to"+DUMP$+" at"+TIME$:GOSUB 2600
  348. 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 SCREENDUMP - ";DATE$;" at ";TIME$;"===";CR$;LF$;STRING$(79,61):CLOSE#2
  349. 3820 SOUND 660,2:BEEP:GOSUB 2705:GOSUB 2800:GOSUB 64100:LOCATE ROW,COL:GOTO 515
  350. 3825 '
  351. 3900 '
  352. 3910 BEEP:PRINT:PRINT"===DELETE A FILE===":GOTO 3500
  353. 3915 PRINT"***The first 5 lines are:":FOR I=1 TO 5:IF NOT EOF(3) THEN LINE INPUT#3,X$:PRINT X$
  354. 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
  355. 3925 PRINT" (not deleted)":PRINT GO$:GOTO 515
  356. 3930 PRINT GO$:GOTO 515
  357. 3935 '
  358. 4000 '
  359. 4010 IF TR$="B" THEN PRINT"(sending file as binary...)
  360. 4015 RATE!=VAL(BAU$)*6:CNT!=0:ROW=CSRLIN:COL=POS(0):GOTO 4060
  361. 4020 LOCATE 25,74:IF TR$<>"P" THEN PRINT USING"###.#";(FLN!-(CNT!*128))/RATE!; ELSE PRINT USING".##";(FLN!-CNT!*128)/FLN!;
  362. 4025 GET#3,CNT!:Y$=X$:LOCATE ROW,COL
  363. 4030 IF TR$="P" THEN GOSUB 4400:IF NOT ABORT THEN 4050 ELSE ABORT=0:GOTO 1500
  364. 4035 PRINT#1,Y$;:IF TR$="B" THEN 4050
  365. 4040 P=INSTR(1,Y$,LF$):IF P=0 THEN 4045 ELSE Y$=LEFT$(Y$,P-1)+RIGHT$(Y$,LEN(Y$)-P):GOTO 4040
  366. 4045 FOR I=1 TO 128:PRINT MID$(Y$,I,1);:NEXT
  367. 4050 ROW=CSRLIN:COL=POS(0):GOSUB 4070:B$=INKEY$:IF B$="" THEN 4060
  368. 4055 IF LEN(B$)>1 THEN 1500
  369. 4060 CNT!=CNT!+1:IF CNT!*128<FLN! THEN 4020 ELSE GET#3,CNT!:Y$=X$:GOTO 4200
  370. 4065 '
  371. 4070 IF EOF(1) THEN 4085 ELSE A$=INPUT$(LOC(1),#1)
  372. 4075 P=INSTR(1,A$,XF$):IF P<>0 THEN HLT=-1:COLOR HI,BG:PRINT"<<XOFF>>";:COLOR FG,BG
  373. 4080 IF HLT THEN P=INSTR(1,A$,XN$):IF P=0 THEN 4085 ELSE HLT=0:RETURN
  374. 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
  375. 4090 RETURN
  376. 4200 '
  377. 4205 I=0:CNT!=(CNT!-1)*128
  378. 4210 I=I+1:CNT!=CNT!+1:IF I>255 THEN 4230 ELSE Z$=MID$(Y$,I,1)
  379. 4215 IF TR$="B" THEN IF CNT!<=FLN! THEN 4235 ELSE 4230
  380. 4220 IF Z$<>EF$ THEN 4235 ELSE 4230
  381. 4225 IF CNT!<=FLN! THEN 4235
  382. 4230 IF EOF(1) THEN 3215 ELSE DMMY$=INPUT$(LOC(1),#1):GOTO 4230
  383. 4235 IF TR$="P" THEN IF Z$=LF$ THEN 4210
  384. 4240 PRINT#1,Z$;:IF TR$="P" THEN IF Z$=CR$ THEN PRINT Z$;:GOSUB 4425:GOTO 4210
  385. 4245 IF TR$="B" OR Z$=LF$ THEN 4210
  386. 4250 PRINT Z$;:GOTO 4210
  387. 4400 '
  388. 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
  389. 4410 IF ABORT THEN RETURN
  390. 4415 NEXT:RETURN
  391. 4420 IF LEN(B$)>1 THEN ABORT=-1:RETURN
  392. 4425 IF (INP(LSR) AND 96)<>96 THEN 4425
  393. 4430 IF DEL!>0 THEN SOUND 32767,18*DEL!:SOUND 32767,1:RETURN
  394. 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$=""
  395. 4440 P=INSTR(Z$,PROMPT$):B$=INKEY$:IF P<>0 OR B$=" " THEN RETURN ELSE 4420
  396. 4445 '
  397. 4500 '
  398. 4510 PRINT"===RECEIVE FILE WITH XMODEM===":PRINT
  399. 4512 '
  400. 4513 '
  401. 4515 Y$="":BLK=1:SEC=1:CK=0:ECNT=0
  402. 4520 PRINT"***Holding for Start...":GOSUB 4975:PRINT#1,NAK$;
  403. 4525 GOSUB 4925:IF ABORT THEN 4645 ELSE 4535
  404. 4530 GOSUB 4905:IF Z$="" THEN 4545
  405. 4535 Y$=Y$+Z$:IF LEN(Y$)<=131 THEN 4530
  406. 4540 '
  407. 4545 IF LEN(Y$)=132 THEN LSET X$=MID$(Y$,4,128):N=132:GOTO 4580
  408. 4550 IF LEN(Y$)=131 THEN LSET X$=MID$(Y$,3,128):N=131:GOTO 4580
  409. 4555 IF LEN(Y$)>132 THEN PRINT"**Long  Block in #";BLK:GOTO 4615
  410. 4560 IF Y$=EOT$ THEN 4635
  411. 4565 IF Y$=CAN$ THEN 4640
  412. 4570 IF Y$="" THEN PRINT"***Timeout":GOSUB 4975:PRINT #1,NAK$:GOTO 4525
  413. 4575 PRINT"**Short Block in #";BLK:GOTO 4615
  414. 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
  415. 4585 IF ASC(MID$(Y$,2,1))=SEC-1 THEN PRINT"**Requesting Next Block":PRINT#1,ACK$:GOTO 4520
  416. 4590 IF SEC<>ASC(MID$(Y$,2,1)) THEN PRINT"**Block # Error in #";BLK:GOTO 4615
  417. 4595 IF (SEC XOR 255)<>ASC(MID$(Y$,3,1)) THEN PRINT"**Complement Error in #";BLK:GOTO 4615
  418. 4600 FOR I=1 TO 128:CK=CK+ASC(MID$(X$,I,1)):NEXT
  419. 4605 IF (CK AND 255)=(ASC(MID$(Y$,N,1))) THEN 4620
  420. 4610 PRINT"**Checksum Error in #";BLK:
  421. 4615 PRINT#1,NAK$;:ECNT=ECNT+1:IF ECNT<12 THEN 4625 ELSE 4645
  422. 4620 PRINT"Received Block #";BLK;:SEC=255 AND (SEC+1):PUT#2,BLK:BLK=BLK+1:PRINT#1,ACK$;:PRINT"- verified":ECNT=0
  423. 4625 Y$="":CK=0:GOSUB 4965:IF ABORT THEN 4645 ELSE 4530
  424. 4630 '
  425. 4635 PRINT"***End of File - verified":PRINT#1,ACK$;:GOSUB 40000:GOTO 3010
  426. 4640 PRINT"***Cancelled by Transmitter":GOSUB 40000:GOTO 3010
  427. 4645 PRINT"***Cancelled by Receiver":PRINT#1,CAN$;:GOSUB 4975:GOSUB 40000:GOTO 3010
  428. 4650 '
  429. 4700 '
  430. 4710 PRINT"===TRANSMIT FILE WITH XMODEM===":PRINT
  431. 4712 '
  432. 4713 '
  433. 4715 SEC=0:BLK=0:CNT!=0:ECNT=0:EOT=0:ETT=0:GOSUB 4815
  434. 4720 PRINT"***Holding for Start...":GOSUB 4975:ABORT=0:SECZ=0:GOSUB 4985
  435. 4725 WHILE NOT EOF(1):Z$=INPUT$(1,#1)
  436. 4730 IF Z$=NAK$ THEN 4800
  437. 4735 IF Z$=CAN$ THEN 4855
  438. 4740 WEND:GOSUB 4965:IF ABORT THEN 4860
  439. 4745 GOSUB 4990:IF NOT TENSEC THEN 4725 ELSE GOSUB 4995:GOTO 4725
  440. 4750 '
  441. 4755 ABORT=0:SECZ=0:GOSUB 4985
  442. 4760 WHILE NOT EOF(1):Z$=INPUT$(LOC(1),#1)
  443. 4765 IF Z$=ACK$ THEN ECNT=0:PRINT "- verified ":IF NOT EOT THEN 4800 ELSE IF NOT ETT THEN 4845 ELSE 4850
  444. 4770 IF Z$=NAK$ THEN ECNT=ECNT+1:IF ECNT>12 THEN 4860 ELSE IF NOT EOT THEN 4805 ELSE 4845
  445. 4775 IF Z$=CAN$ THEN 4855
  446. 4780 WEND:GOSUB 4965:IF ABORT THEN 4860
  447. 4785 GOSUB 4990:IF NOT TENSEC THEN 4760
  448. 4790 GOSUB 4995:IF NOT ABORT THEN IF NOT EOT THEN 4805 ELSE 4845 ELSE 4860
  449. 4800 A$=Y$:PRINT"Sending Block #";BLK;:PRINT#1,A$;:IF CNT!<FLN! THEN GOSUB 4815:GOTO 4755 ELSE EOT=-1:GOTO 4755
  450. 4805 ECNT=ECNT+1:IF ECNT>12 THEN 4860 ELSE PRINT:PRINT"***Re-sending block...";:PRINT#1,A$;:GOTO 4755
  451. 4810 '
  452. 4815 BLK=BLK+1:CNT!=CNT!+128:GET#3,BLK:Y$=X$:IF CNT!<=FLN! THEN 4825
  453. 4820 Y$=MID$(Y$,1,128-(CNT!-FLN!))+STRING$(CNT!-FLN!,CHR$(0))
  454. 4825 CK=0:FOR I=1 TO LEN(Y$):CK=CK+ASC(MID$(Y$,I,1)):NEXT:CK=(CK AND 255)
  455. 4830 IF CK>256 THEN CK=CK-256:GOTO 4830
  456. 4835 SEC=(255 AND BLK):Y$=SOH$+CHR$(SEC)+CHR$(SEC XOR 255)+Y$+CHR$(CK):RETURN
  457. 4840 '
  458. 4845 PRINT#1,EOT$;:PRINT"***Sending End Marker ";:ETT =-1:GOTO 4755
  459. 4850 CLOSE #3:GOTO 3215
  460. 4855 PRINT:PRINT"***Cancelled by Receiver":CLOSE#3:GOTO 3210
  461. 4860 PRINT:PRINT"***Cancelled by Transmitter":CLOSE#3:PRINT#1,CAN$;:GOTO 3210
  462. 4865 '
  463. 4900 '
  464. 4905 Z$="":ZA=0
  465. 4910 IF NOT EOF(1) THEN Z$=INPUT$(LOC(1),#1):RETURN ELSE SOUND 32767,.2:ZA=ZA+1
  466. 4915 IF ZA>72 THEN RETURN ELSE 4910
  467. 4920 '
  468. 4925 ABORT=0:SECZ=0:GOSUB 4985
  469. 4930 GOSUB 4905:GOSUB 4965:IF ABORT THEN RETURN
  470. 4935 IF LEFT$(Z$,1)=SOH$ THEN RETURN
  471. 4940 IF LEFT$(Z$,1)=EOT$ THEN RETURN
  472. 4945 IF LEFT$(Z$,1)=CAN$ THEN RETURN
  473. 4950 GOSUB 4975:PRINT#1,NAK$;
  474. 4955 GOSUB 4990:IF NOT TENSEC THEN 4955 ELSE GOSUB 4995:GOTO 4930
  475. 4960 '
  476. 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
  477. 4970 '
  478. 4975 WHILE NOT EOF(1):Z$=INPUT$(LOC(1),#1):WEND:RETURN
  479. 4980 '
  480. 4985 SECX=60*VAL(MID$(TIME$,4,2))+VAL(MID$(TIME$,7,2)):RETURN
  481. 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
  482. 4995 IF SECZ<9 THEN GOSUB 4985:SECZ=SECZ+1:RETURN ELSE ABORT=-1:RETURN
  483. 4996 '
  484. 5000 '
  485. 5010 BEEP:CLS:PRINT:PRINT"===COMMUNICATIONS PARAMETERS===
  486. 5015 PRINT:PRINT"Present parameters: ";:GOSUB 5100:PRINT"Options:
  487. 5020 PRINT"   1 -  300,E,7,1  (text)      2 -  300,N,8,1  (binary)
  488. 5025 PRINT"   3 -  300,O,7,1  (text)      4 -  300,S,7,1  (text)"
  489. 5030 PRINT SPACE$(15);"F - reset params to defaults
  490. 5035 PRINT SPACE$(15);"X - exit to terminal
  491. 5040 PRINT"Choose: ":PRINT:COLOR HI,BG:PRINT"NOTICE: Changing parameters will drop an established connection!":COLOR FG,BG:LOCATE 13,9
  492. 5045 Q$=INPUT$(1):GOSUB 2555
  493. 5050 IF Q$="X" THEN PRINT Q$:PRINT:PRINT"(Present parameters still in effect)";STRING$(35,32):GOTO 5095
  494. 5055 IF Q$="F" THEN PRINT Q$:GOSUB 5815:GOSUB 64380:PRINT #1,MODMINIT$+IMFT$+CR$:CLOSE #1:OPEN COMM$ AS #1:PRINT #1,MODMINIT$+IMFT$+CR$:PRINT:PRINT"Parameters reset to:";:GOSUB 5100:GOTO 5095
  495. 5060 Q=VAL(Q$):IF Q<1 OR Q>4 THEN BEEP:GOTO 5045 ELSE PRINT Q
  496. 5065 BAU$="300":PAR$="E":DTA$="7":STP$="1
  497. 5070 IF Q=2 THEN PAR$="N":DTA$="8
  498. 5075 IF Q=3 THEN PAR$="O"
  499. 5080 IF Q=4 THEN PAR$="S"
  500. 5085 LOCATE ,,1:COMM$=COMMPORT$+BAU$+","+PAR$+","+DTA$+","+STP$+COMMINIT$:GOSUB 64380:PRINT #1,MODMINIT$+IMFT$+CR$:CLOSE #1:OPEN COMM$ AS #1:PRINT #1,MODMINIT$+IMFT$+CR$;
  501. 5090 PRINT:PRINT"New parameters are: ";:GOSUB 5100
  502. 5095 PRINT GO$:GOSUB 2800:GOTO 515
  503. 5100 COLOR BG,FG:PRINT MID$(COMM$,6,10);:COLOR FG,BG:PRINT STRING$(35,32):PRINT
  504. 5105 PRINT"Echo-";:IF ECH=-1 THEN PRINT"Y"; ELSE PRINT"N";
  505. 5110 PRINT" Mesg-";:IF MSG=-1 THEN PRINT"Y"; ELSE PRINT"N";
  506. 5115 PRINT" Strip-";:IF NS=0 THEN PRINT"N"; ELSE PRINT USING"#";NS;
  507. 5120 PRINT" Pace-";:IF PC$="" THEN PRINT"N" ELSE PRINT PC$
  508. 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));
  509. 5130 PRINT"/":NEXT:PRINT:RETURN
  510. 5135 '
  511. 5200 '
  512. 5210 CLS:BEEP:PRINT"===SET NEW DEFAULTS===":PRINT:COLOR BG,FG:PRINT" Present program defaults:";SPACE$(53);:COLOR FG,BG:EXIT=0
  513. 5215 FOR I=1 TO DFNUM:J=I+4:P=1:IF I>15 THEN J=I-11:P=32
  514. 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
  515. 5225 IF I<15 THEN PRINT SPACE$(12-LEN(D$(I))); ELSE PRINT SPACE$(30-LEN(D$(I)));
  516. 5230 NEXT:LOCATE ,,1:IF EXIT THEN 5280
  517. 5231 FOR I = 1 TO DFNUM:DT$(I)=D$(I):NEXT
  518. 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
  519. 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
  520. 5245 IF ABORT THEN 5265
  521. 5250 IF D$(I)<>"" THEN LOCATE J,P+17+LEN(D$(I)) ELSE LOCATE J,P+19
  522. 5255 IF I>15 THEN QL=16 ELSE QL=4
  523. 5260 GOSUB 2500:IF Q$=CHR$(27) THEN GOSUB 2655:GOSUB 2655:ABORT=-1 ELSE IF Q$<>"" THEN DT$(I)=Q$:IF DT$=" " THEN DT$(I)=""
  524. 5265 NEXT
  525. 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
  526. 5271 FOR I = 1 TO DFNUM:D$(I)=DT$(I):NEXT
  527. 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
  528. 5280 GOSUB 5815:GOSUB 64380:PRINT #1,MODMINIT$+IMFT$+CR$:CLOSE #1:OPEN COMM$ AS #1:PRINT #1,MODMINIT$+IMFT$+CR$;
  529. 5285 GOSUB 5295:LOCATE CSRLIN-1,1:PRINT SPACE$(79);:LOCATE CSRLIN,1
  530. 5290 COLOR FG,BG,BG:PRINT GO$:GOSUB 2800:GOTO 515
  531. 5295 LOCATE 22,1:PRINT SPACE$(79);:LOCATE 22,1:RETURN
  532. 5400 '
  533. 5405 RESTORE 5410:FOR I=1 TO DFNUM:READ DP$(I),D$(I):NEXT:GOSUB 5440:GOTO 300
  534. 5410 DATA Baud rate,300,Parity,E,Data bits,7,Stop bits,1,Echo,N,Messages,N
  535. 5415 DATA"Strip #1",0,Replace #1,0,"Strip #2",0,Replace #2,0,"Strip #3",0, Replace #3,0,Pacing P=,,Logged Drive,"A:",Margin Width,70
  536. 5420 DATA Screendump File,"A:SCRNDUMP.PCT",Redial Delay,20,Connect Prompt,CONNECTED
  537. 5425 DATA Line 25 help,Y,Foreground,7,Background,0,High inten.,15
  538. 5430 DATA "Print port","LPT1:","Print init.",,"Print width",80
  539. 5435 DATA Comm. port,"COM1:",Comm. init.,",CS,DS",Modem Cmnd.,,C/R subst.,"}"
  540. 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
  541. 5600 '
  542. 5605 BAU$=D$(1):PAR$=D$(2):DTA$=D$(3):STP$=D$(4)
  543. 5610 I=5:GOSUB 5805:IF D$(5)="Y" THEN DECH=-1 ELSE D$(5)="N":DECH=0
  544. 5615 I=6:GOSUB 5805:IF D$(6)="Y" THEN DMSG=-1 ELSE D$(6)="N":DMSG=0
  545. 5620 DNS=0:FOR J=1 TO 3:I=2*J+5:GOSUB 5810
  546. 5625 DS$(J)=CHR$(VAL(D$(I))):IF DS$(J)<>CHR$(0) THEN DNS=DNS+1 ELSE D$(I)="0"
  547. 5630 NEXT:FOR J=1 TO 3:I=2*J+6:GOSUB 5810
  548. 5635 DR$(J)=CHR$(VAL(D$(I))):IF DR$(J)=CHR$(0) THEN DR$(J)="":D$(I)="0"
  549. 5640 NEXT:IF D$(13)<>"" THEN DPC$="=P"+D$(13) ELSE DPC$=""
  550. 5645 D$(14)=LEFT$(D$(14),1)+":":DRIV$=D$(14)
  551. 5650 MARG=VAL(D$(15)):DUMP$=D$(16):QDELAY=VAL(D$(17)):CONNECT$=D$(18)
  552. 5655 I=19:GOSUB 5805:IF D$(19)="N" THEN MENU=0 ELSE MENU=-1
  553. 5660 FG=VAL(D$(20)):BG=VAL(D$(21)):HI=VAL(D$(22))
  554. 5665 PRNTPORT$=D$(23):PRNTINIT$=D$(24):WIDTH PRNTPORT$,VAL(D$(25))
  555. 5670 I=18:GOSUB 5805:COMMPORT$=D$(26):IF COMMPORT$="COM1:" THEN LSR=&H3FD:LCR=&H3FB ELSE LSR=&H2FD:LCR=&H2FB
  556. 5675 COMMINIT$=D$(27):DCOMM$=COMMPORT$+BAU$+","+PAR$+","+DTA$+","+STP$+COMMINIT$:MODMINIT$=D$(28):XCR$=LEFT$(D$(29),1)
  557. 5680 GOSUB 5815:RETURN
  558. 5800 '
  559. 5805 Q$=D$(I):GOSUB 2555:D$(I)=Q$:RETURN
  560. 5810 IF VAL(D$(I))<0 OR VAL(D$(I))>255 THEN D$(I)="0":RETURN ELSE RETURN
  561. 5815 COMM$=DCOMM$:PAR$=D$(2):DTA$=D$(3):STP$=D$(4):ECH=DECH:MSG=DMSG
  562. 5820 NS=DNS:FOR J=1 TO 3:I=2*J+5:S$(J)=DS$(J):R$(J)=DR$(J):NEXT:PC$=DPC$:RETURN
  563. 5825 '
  564. 6000 '
  565. 6010 BEEP:CLOSE#2:OPEN DFIL$ AS #2:IF DPAGE=0 THEN DPAGE=1
  566. 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$
  567. 6020 GET#2,1:IF LEFT$(N$,LEN(IFIL$))<>IFIL$ THEN I1=1:I2=60:GOSUB 6870
  568. 6025 '
  569. 6030 I1=(DPAGE-1)*15+1:I2=(DPAGE-1)*15+15
  570. 6035 CLS:LOCATE 1,1,0:PRINT"===DIALING DIRECTORY "DPAGE"===
  571. 6040 GET#2,2:MODM$=RIGHT$(R$,CVI(X$)):LOCATE 1,30:PRINT" Modem dialing command = "MODM$
  572. 6045 GET#2,3:SERV1$=RIGHT$(R$,CVI(X$)):LOCATE 2,28:PRINT"Long distance service +# = "LEFT$(SERV1$,24)
  573. 6050 GET#2,4:SERV2$=RIGHT$(R$,CVI(X$)):LOCATE 3,50:PRINT"-# = "LEFT$(SERV2$,24)
  574. 6055 LOCATE 4,1:COLOR BG,FG:PRINT"   Name"SPACE$(29)"Phone #   Comm Param  Echo Mesg Strip Pace ";:COLOR FG,BG:LOCATE 5,1
  575. 6060 FOR I=I1 TO I2:GET#2,I+4
  576. 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$);
  577. 6070 PRINT"  ";:IF CVI(G$)=0 THEN PRINT "  N" ELSE PRINT "p="+L$
  578. 6075 NEXT
  579. 6080 '
  580. 6085 LOCATE 21,1:PRINT"Dial entry #:             | or...
  581. 6090 LOCATE 21,39:PRINT"Enter: R to revise or add to directory
  582. 6095 LOCATE 22,46:PRINT"M for manual dialing
  583. 6100 LOCATE 23,42:PRINT"F / B to page through directory
  584. 6105 LOCATE 24,46:PRINT"X to exit to terminal";
  585. 6110 LOCATE 25,27:PRINT"| For long distance service, precede entry # with +/-";
  586. 6115 LOCATE 21,14,1:QL=3:GOSUB 2500:GOSUB 2555
  587. 6120 IF LEFT$(Q$,1)="+" THEN SERV1=-1:Q$=RIGHT$(Q$,LEN(Q$)-1) ELSE SERV1=0
  588. 6125 IF LEFT$(Q$,1)="-" THEN SERV2=-1:Q$=RIGHT$(Q$,LEN(Q$)-1) ELSE SERV2=0
  589. 6130 IF Q$="R" THEN 6400
  590. 6135 IF Q$="F" THEN IF DPAGE=4 THEN DPAGE=1:GOTO 6030 ELSE DPAGE=DPAGE+1:GOTO 6030
  591. 6140 IF Q$="B" THEN IF DPAGE=1 THEN DPAGE=4:GOTO 6030 ELSE DPAGE=DPAGE-1:GOTO 6030
  592. 6145 IF Q$="X" THEN CLOSE#2:GOSUB 2700:CLS:LOCATE 1,1,1:PRINT GO$:GOSUB 2800:GOTO 515
  593. 6150 IF Q$="M" THEN CLOSE#2:GOSUB 2700:CLS:LOCATE 1,1,1:GOSUB 6305:GOSUB 2800:GOTO 515
  594. 6155 IF VAL(Q$)<1 OR VAL(Q$)>60 THEN BEEP:LOCATE 21,14:PRINT SPACE$(LEN(Q$))        :GOTO 6115
  595. 6200 '
  596. 6205 GET#2,VAL(Q$)+4:BAU$=B$:PAR$=P$:DTA$=D$:STP$=S$:IF LEFT$(BAU$,1)=" " THEN BAU$=RIGHT$(BAU$,3)
  597. 6210 COMM$=COMMPORT$+BAU$+","+PAR$+","+DTA$+","+STP$+COMMINIT$
  598. 6215 GOSUB 64380:PRINT #1,MODMINIT$+IMFT$+CR$:CLOSE #1:OPEN COMM$ AS #1:PRINT #1,MODMINIT$+IMFT$+CR$;
  599. 6220 IF E$="Y" THEN ECH=-1 ELSE ECH=0
  600. 6225 IF M$="Y" THEN MSG=-1 ELSE MSG=0
  601. 6230 NS=CVI(T$):IF NS=0 THEN 6255
  602. 6235 FOR I=0 TO NS-1:P=VAL(MID$(C$,I*8+1,3)):IF P>255 THEN P=0
  603. 6240 J=VAL(MID$(C$,I*8+5,3)):IF J>255 THEN J=0
  604. 6245 S$(I+1)=CHR$(P):IF J=0 THEN R$(I+1)="" ELSE R$(I+1)=CHR$(J)
  605. 6250 NEXT
  606. 6255 IF CVI(G$)<>0 THEN PC$="=P"+LEFT$(L$,CVI(G$)) ELSE PC$=""
  607. 6260 CLS:LOCATE 1,1,1:PRINT"===DIALING ";N$
  608. 6265 DIAL$=RIGHT$(R$,CVI(X$))
  609. 6270 IF SERV1 THEN DIAL$=SERV1$+DIAL$
  610. 6275 IF SERV2 THEN DIAL$=SERV2$+DIAL$
  611. 6280 SOUND 32767,15:SOUND 32767,1:PRINT #1,MODM$+DIAL$+CR$;:STRT$=TIME$
  612. 6285 CLOSE#2:GOSUB 2700:GOSUB 2800:GOTO 515
  613. 6300 '
  614. 6305 PRINT"===DIAL PHONE #:";:QL=36:GOSUB 2500:R$=Q$:N$="
  615. 6310 IF R$="" THEN PRINT"(cancelled)":PRINT GO$:LOCATE,,1:RETURN
  616. 6315 IF LEFT$(R$,1)="+" THEN DIAL$=SERV1$+RIGHT$(R$,LEN(R$)-1) ELSE DIAL$=R$
  617. 6320 IF LEFT$(R$,1)="-" THEN DIAL$=SERV2$+RIGHT$(R$,LEN(R$)-1) ELSE DIAL$=R$
  618. 6325 GOSUB 5815:GOSUB 64380:PRINT #1,MODMINIT$+IMFT$+CR$:CLOSE #1:OPEN COMM$ AS #1:PRINT #1,MODMINIT$+IMFT$+CR$;:SOUND 32767,15:SOUND 32767,1:PRINT #1,MODM$+DIAL$+CR$;:STRT$=TIME$:PRINT:LOCATE,,1:RETURN
  619. 6400 '
  620. 6405 GOSUB 6900:LOCATE 21,1,0:PRINT"Revise/add entry #:       | or...
  621. 6410 LOCATE 21,39:PRINT"Enter:  M to change modem command
  622. 6415 LOCATE 22,43:PRINT"+ / - to change long distance #s
  623. 6420 LOCATE 23,47:PRINT"C to clear directory entries
  624. 6425 LOCATE 24,47:PRINT"X to exit to dialing prompt";
  625. 6430 LOCATE 21,20,1:QL=2:GOSUB 2500:GOSUB 2555
  626. 6435 IF Q$="M" THEN 6830
  627. 6440 IF Q$="+" THEN 6835
  628. 6445 IF Q$="-" THEN 6840
  629. 6450 IF Q$="C" THEN GOSUB 6850:GOTO 6030
  630. 6455 IF Q$="X" THEN 6030
  631. 6460 IF VAL(Q$)<I1 OR VAL(Q$)>I2 THEN BEEP:LOCATE 21,20:PRINT SPACE$(LEN(Q$)):GOTO 6430
  632. 6465 DE$=Q$:GET#2,VAL(DE$)+4:Q=VAL(DE$)-I1+1
  633. 6470 '
  634. 6475 GOSUB 6900:LOCATE 22,1:PRINT"Name: ";:QL=24:GOSUB 2500:NI$=Q$
  635. 6480 IF NI$="" THEN NI$=N$
  636. 6485 LOCATE Q+4,4:PRINT NI$;SPACE$(25-LEN(NI$));:GOSUB 6910
  637. 6490 PRINT"Phone number: ";:QL=36:GOSUB 2500:RI$=Q$:XI=LEN(RI$):IF RI$="" THEN RI$=R$:XI=CVI(X$)
  638. 6495 LOCATE Q+4,30:IF XI>14 THEN PRINT RIGHT$(RI$,14) ELSE PRINT SPACE$(14-XI)+RIGHT$(RI$,XI)
  639. 6500 '
  640. 6505 GOSUB 6910:PRINT"Communications parameters ok (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555
  641. 6510 IF Q$="Y" OR Q$="" THEN BI$=B$:PI$=P$:DI$=D$:SI$=S$:GOTO 6555
  642. 6515 GOSUB 6910:PRINT"Baud rate: ";:QL=4:GOSUB 2500:BI$=Q$:IF BI$="" THEN BI$=B$
  643. 6520 LOCATE Q+4,47:PRINT SPACE$(4-LEN(BI$));BI$;
  644. 6525 GOSUB 6910:PRINT"Parity: ";:QL=1:GOSUB 2500:GOSUB 2555:PI$=Q$:IF PI$="" THEN PI$=P$
  645. 6530 LOCATE Q+4,52:PRINT PI$;
  646. 6535 GOSUB 6910:PRINT"# data bits: ";:QL=1:GOSUB 2500:DI$=Q$:IF DI$="" THEN DI$=D$
  647. 6540 LOCATE Q+4,54:PRINT DI$;
  648. 6545 GOSUB 6910:PRINT"# stop bits: ";:QL=1:GOSUB 2500:SI$=Q$:IF SI$="" THEN SI$=S$
  649. 6550 LOCATE Q+4,56:PRINT SI$;
  650. 6555 '
  651. 6560 GOSUB 6910:PRINT"Echo on (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555:EI$=Q$:IF EI$="" THEN EI$=E$:GOTO 6570
  652. 6565 IF EI$<>"Y" THEN EI$="N
  653. 6570 LOCATE Q+4,61:PRINT EI$;
  654. 6575 GOSUB 6910:PRINT"Messages on (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555:MI$=Q$:IF MI$="" THEN MI$=M$:GOTO 6585
  655. 6580 IF MI$<>"Y" THEN MI$="N
  656. 6585 LOCATE Q+4,66:PRINT MI$;
  657. 6590 '
  658. 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
  659. 6600 IF Q$="0" OR Q$="N" THEN TI=0:CI$=STRING$(26,47):GOTO 6645
  660. 6605 IF Q$<>"Y" THEN BEEP:GOTO 6595
  661. 6610 GOSUB 6905:LOCATE 22,1:PRINT"old strip/cnvt string: ";C$
  662. 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
  663. 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$
  664. 6625 CI$=CI$+STRING$(26-LEN(CI$),47)
  665. 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
  666. 6635 P=INSTR(CI$,"//"):IF P=1 THEN TI=0:GOTO 6655
  667. 6640 IF P MOD 8<>0 THEN BEEP:GOTO 6610 ELSE TI=P/8
  668. 6645 GOSUB 6905:LOCATE Q+4,71:IF TI=0 THEN PRINT "N" ELSE PRINT USING "#";TI
  669. 6650 '
  670. 6655 GOSUB 6910:LOCATE 22,1:PRINT"Pacing? p=";:QL=3:GOSUB 2500:LI$=Q$:GI=LEN(LI$)
  671. 6660 IF Q$="0" OR Q$="N" OR Q$="n" THEN LI$="N":GI=0:LOCATE Q+4,75:PRINT"  N  ";:GOTO 6800
  672. 6665 IF LI$="" THEN LI$=L$:GI=CVI(G$):GOTO 6800
  673. 6670 LOCATE Q+4,75:PRINT "p="+LI$+SPACE$(3-GI)
  674. 6800 '
  675. 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)
  676. 6810 GOSUB 6905:LOCATE 22,1:PRINT"Is entry #";DE$;" ok (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555:Q1$=Q$
  677. 6815 IF Q1$<>"Y" AND Q1$<>"" THEN LOCATE 22,1:PRINT SPACE$(35);:GOTO 6470
  678. 6820 PUT#2,VAL(DE$)+4:GOTO 6030
  679. 6825 '
  680. 6830 GOSUB 6900:MSG$="Modem dialing command:":GOSUB 6845:PUT #2,2:GOTO 6030
  681. 6835 GOSUB 6900:MSG$="Long distance +#:":GOSUB 6845:PUT #2,3:GOTO 6030
  682. 6840 GOSUB 6900:MSG$="Long distance -#:":GOSUB 6845:PUT#2,4:GOTO 6030
  683. 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
  684. 6850 '
  685. 6855 GOSUB 6900:LOCATE 21,1:PRINT"Clear directory from entry #:";:QL=2:GOSUB 2500:I1=VAL(Q$):IF I1<1 THEN I1=61
  686. 6860 PRINT" ... through entry #:";:QL=2:GOSUB 2500:I2=VAL(Q$):IF I2>60 THEN I2=60
  687. 6865 PRINT:PRINT"-- Are you sure (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555:IF Q$<>"Y" THEN 6030
  688. 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
  689. 6875 IF MODM$="" THEN MODM$="ATDT"
  690. 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
  691. 6885 LSET N$="------------------------":RSET R$="- --- --- ----":LSET X$=MKI$(14)
  692. 6890 RSET B$="1200":LSET P$="N":LSET D$="8":LSET S$="1":LSET E$="N":LSET M$="N":LSET T$=MKI$(0):LSET C$=STRING$(26,"/"):LSET L$="":LSET G$=MKI$(0)
  693. 6895 FOR I=I1 TO I2:PUT#2,I+4:NEXT:RETURN
  694. 6900 '
  695. 6905 LOCATE 21,27,0:PRINT SPACE$(52);:FOR I=22 TO 25:LOCATE I,1:PRINT SPACE$(79);:NEXT:LOCATE ,,1:RETURN
  696. 6910 LOCATE 22,1,0:PRINT SPACE$(79);:LOCATE 22,1,1:RETURN
  697. 6915 '
  698. 7000 '
  699. 7010 BEEP:IF KPG=0 THEN KPG=1
  700. 7015 LOCATE 1,39,0:PRINT CHR$(213)+STRING$(38,205)+CHR$(184)
  701. 7020 LOCATE 2,39:PRINT VL$;"     ===FUNCTION KEY DIRECTORY===     ";VL$
  702. 7025 LOCATE 3,39:PRINT VL$;SPACE$(15);:COLOR HI,BG:PRINT KPG$(KPG);:COLOR FG,BG:PRINT" F1-10";SPACE$(13);VL$
  703. 7030 LOCATE 4,39:PRINT VL$;:COLOR BG,FG:PRINT"F-   Input String";SPACE$(21);:COLOR FG,BG:PRINT VL$
  704. 7035 FOR I=1 TO 10:P=(KPG-1)*10+I
  705. 7040 LOCATE I+4,39,0:PRINT VL$;:PRINT USING "##";I;:PRINT" = ";
  706. 7045 K=LEN(K$(P)):IF K>33 THEN K=33
  707. 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
  708. 7055 NEXT J:PRINT SPACE$(33-K)+VL$+"  ";:NEXT I
  709. 7060 LOCATE 15,39,1:PRINT CHR$(198)+STRING$(38,205)+CHR$(181)
  710. 7100 '
  711. 7105 GOSUB 7435:LOCATE 16,40,1:PRINT"Press:  R to revise ";KPG$(KPG);"-F assignments
  712. 7110 LOCATE 17,44:PRINT"F / B to page through directory
  713. 7115 LOCATE 18,48:PRINT"X to exit to terminal
  714. 7120 LOCATE 16,46,1:Q$=INPUT$(1):GOSUB 2555
  715. 7125 IF Q$="R" THEN 7200
  716. 7130 IF Q$="X" THEN CLOSE#2:GOSUB 2700:GOSUB 7435:LOCATE 16,40:PRINT GO$;:LOCATE ROW,COL:GOTO 515
  717. 7135 IF Q$="F" THEN KPG=KPG+1:IF KPG=5 THEN KPG=1:GOTO 7015 ELSE GOTO 7015
  718. 7140 IF Q$="B" THEN KPG=KPG-1:IF KPG=0 THEN KPG=4:GOTO 7015 ELSE GOTO 7015
  719. 7145 BEEP:LOCATE 21,76:PRINT SPACE$(LEN(Q$)):GOTO 7120
  720. 7200 '
  721. 7205 GOSUB 7435:CLOSE#2:OPEN KFIL$ AS #2:FIELD #2, 126 AS K$,2 AS L$
  722. 7210 GET#2,1:IF LEFT$(K$,LEN(IFIL$))<>IFIL$ THEN GOSUB 7425
  723. 7215 LOCATE 16,40:PRINT"Press Func. key to revise:
  724. 7220 LOCATE 18,43:PRINT"or X to exit to terminal
  725. 7225 LOCATE 16,66:Q$=INKEY$:IF Q$="" THEN 7225 ELSE IF LEN(Q$)>1 THEN 7240
  726. 7230 GOSUB 2555:IF Q$="X" THEN CLOSE#2:GOSUB 2700:GOSUB 7440:LOCATE 16,40:PRINT GO$;:LOCATE ROW,COL:GOTO 515
  727. 7235 BEEP:GOTO 7225
  728. 7240 Q=ASC(MID$(Q$,2,1))
  729. 7245 IF Q>58 AND Q<69 THEN K=(KPG-1)*10+Q-58:Q$=KPG$(KPG)+"-F"+STR$(Q-58):GOTO 7270
  730. 7250 IF Q>103 AND Q<114 THEN K=Q-93:Q$=" Alt-F"+STR$(K-10):GOTO 7270
  731. 7255 IF Q>83 AND Q<94 THEN K=Q-63:Q$="Shft-F"+STR$(K-20):GOTO 7270
  732. 7260 IF Q>93 AND Q<104 THEN K=Q-63:Q$="Ctrl-F"+STR$(K-30):GOTO 7270
  733. 7265 BEEP:GOTO 7225
  734. 7270 KY=K:GET#2,KY+1
  735. 7275 '
  736. 7280 GOSUB 7450:LOCATE 16,1:PRINT"New input string for ";Q$;":":LOCATE 20,1:PRINT STRING$(80,196)
  737. 7285 LOCATE 21,1:PRINT"Use ";XCR$;" as substitute for carriage returns
  738. 7290 LOCATE 22,8:PRINT ENT$;" to leave key unchanged
  739. 7295 LOCATE 23,1:PRINT"<space>";ENT$;" to clear key
  740. 7300 LOCATE 17,1:PRINT CHR$(16);:QL=126:GOSUB 2500:KI$=Q$
  741. 7305 IF KI$="" THEN KI$=K$
  742. 7310 IF KI$=" " THEN KI$="
  743. 7315 LI=LEN(KI$)
  744. 7400 '
  745. 7405 LSET K$=KI$:LSET L$=MKI$(LI):PUT#2,KY+1
  746. 7410 IF Q$="0" THEN K$(10)=KI$:GOSUB 7455:GOTO 7015
  747. 7415 K$(KY)=KI$:GOSUB 7455:GOTO 7015
  748. 7420 '
  749. 7425 LSET K$=IFIL$:LSET L$="":PUT#2,1
  750. 7430 LSET K$="":LSET L$=MKI$(0):FOR I=2 TO 41:PUT#2,I:NEXT:RETURN
  751. 7435 '
  752. 7440 FOR I=16 TO 18:LOCATE I,39,0:PRINT VL$;SPACE$(38);VL$;"   ";:NEXT
  753. 7445 LOCATE 19,39:PRINT CHR$(212);STRING$(38,205);CHR$(190);"   ";:LOCATE ,,1:RETURN
  754. 7450 LOCATE 15,1,0:PRINT STRING$(80,205);:GOTO 7460
  755. 7455 LOCATE 15,1,0:PRINT SPACE$(80);
  756. 7460 FOR I=16 TO 23:LOCATE I,1:PRINT SPACE$(80);:NEXT:LOCATE 24,1:PRINT SPACE$(79);:LOCATE ,,1:RETURN
  757. 7465 '
  758. 8000 '
  759. 8010 CLS:MSG$=" Redialing...  *** HIT ANY KEY TO TERMINATE ***  (redial started at "+TIME$+")":GOSUB 2600
  760. 8015 SOUND 5000,2:PRINT"===REDIALING ";N$;" at ";TIME$:PRINT #1,MODM$+DIAL$+CR$;
  761. 8020 IF INKEY$<>"" THEN 8095
  762. 8025 SOUND 32767,40:SOUND 32767,1
  763. 8030 IF EOF(1) THEN 8020
  764. 8035 Q1$=INPUT$(LOC(1),#1)
  765. 8040 SOUND 32767,90:SOUND 32767,1
  766. 8045 IF EOF(1) THEN Q2$="":GOTO 8055
  767. 8050 Q2$=INPUT$(LOC(1),#1)
  768. 8055 Q$=Q1$+Q2$
  769. 8060 FOR I=1 TO LEN(Q$):P=ASC(MID$(Q$,I,1)):J=P AND 127:MID$(Q$,I,1)=CHR$(J):NEXT
  770. 8065 PRINT Q$;
  771. 8070 IF INSTR(Q$,RIGHT$(DIAL$,4))<>0 THEN 8020
  772. 8075 IF INSTR(Q$,CONNECT$)=0 THEN GOTO 8100 ELSE STRT$=TIME$
  773. 8080 MSG$=" REMOTE COMPUTER ON LINE  *** HIT ANY KEY TO PROCEED ***":GOSUB 2600
  774. 8085 IF INKEY$="" THEN SOUND 600,4:SOUND 900,4:GOTO 8085
  775. 8090 PRINT:PRINT"===CONNECTED WITH ";N$:GOSUB 2800:GOTO 515
  776. 8095 PRINT#1,CR$:CLS:BEEP:PRINT"===REDIAL TERMINATED...back in terminal mode":PRINT GO$:GOSUB 2800:GOTO 515
  777. 8100 I=1
  778. 8105 SOUND 32767,20:SOUND 32767,1:IF INKEY$<>"" THEN 8095
  779. 8110 I=I+1:IF I=QDELAY THEN 8015 ELSE GOTO 8105
  780. 8115 '
  781. 8200 '
  782. 8210 IF STRT$="--" THEN MLPSD=0:GOTO 8220
  783. 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
  784. 8220 LOCATE 1,39:PRINT CHR$(213)+STRING$(38,205)+CHR$(184);
  785. 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$;
  786. 8230 LOCATE 3,39:PRINT CHR$(192)+STRING$(38,205)+CHR$(217);
  787. 8235 LOCATE ROW,COL:GOTO 515
  788. 8240 '
  789. 8900 '
  790. 8910 BEEP:PRINT:PRINT"*** This program requires that you have a serial port."
  791. 8915 PRINT:PRINT:PRINT"(returning to DOS)":SOUND 32767,50:SOUND 32767,1:SYSTEM
  792. 8920 BEEP:LOCATE 15,1:PRINT"===PLEASE DO NOT BYPASS THE FREEWARE NOTICE===":GOTO 8915
  793. 8925 COLOR HI,BG:PRINT"<<";MSG$;">>";:COLOR FG,BG:RETURN
  794. 8930 IF ERR=52 OR ERR=64 OR ERR=67 THEN MSG$="Not a valid file name.
  795. 8935 IF ERR=53 THEN MSG$="File not found.
  796. 8940 IF ERR=70 THEN MSG$="Disk is write protected.
  797. 8945 IF ERR=71 THEN MSG$="Check disk drive.
  798. 8950 IF ERR=72 THEN MSG$="Disk media error.
  799. 8955 RETURN
  800. 8960 '
  801. 9000 '
  802. 9002 IF ERL=3132 AND ERR=71 THEN PRINT"DISK NOT READY!":RESUME 3145
  803. 9003 IF ERL=3132 THEN RESUME 3135
  804. 9010 IF ERL=215 THEN RESUME 5405
  805. 9015 IF ERL=225 THEN RESUME 245
  806. 9020 IF ERL=5665 THEN RESUME 5670
  807. 9025 IF ERL=425 THEN RESUME 245
  808. 9030 IF ERR=27 THEN BEEP:MGS$="CHECK PRINTER":GOSUB 8925:PR=0:IF ERL=1610 THEN RESUME 515 ELSE RESUME 820
  809. 9035 IF ERL=5280 THEN BEEP:GOSUB 5295:PRINT TAB(31)"*** Invalid Communication Parameter.  TRY AGAIN.";:EXIT=0:RESUME 5215
  810. 9040 IF ERL=6215 AND ERR=64 THEN BEEP:LOCATE 20,1:PRINT"*** Invalid parameters for entry #";Q$:RESUME 6400
  811. 9045 IF ERL=6245 THEN BEEP:LOCATE 20,1:PRINT"*** Invalid stripping for entry #";Q$:RESUME 6400
  812. 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
  813. 9055 IF ERR=57 THEN MSG$="":GOSUB 8925:IF RC$="X" THEN RESUME 4525 ELSE IF TC$="X" THEN RESUME 4725 ELSE RESUME 515
  814. 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
  815. 9065 IF ERR=15 AND ERL=660 THEN MSG$="OVERFLOW--PRINTOUT OFF":GOSUB 8925:PR=0:CLOSE#3:RESUME 515
  816. 9070 IF ERL=3640 THEN BEEP:PRINT"*** File(s) not found. Try again.":RESUME 3645
  817. 9075 IF ERR=61 AND RC$="X" THEN BEEP:PRINT"*** DISK IS FULL":RESUME 4645
  818. 9080 IF ERR=61 THEN BEEP:PRINT:PRINT"===DISK IS FULL===":IF RC THEN RESUME 3000 ELSE RESUME 3820
  819. 9085 IF ERL=3810 THEN LOCATE 1,40:COLOR HI,BG:PRINT"***CAN'T OPEN ";DUMP$;"***";:LOCATE ROW,COL:RESUME 3820
  820. 9090 IF ERR=67 AND ERL=3595 THEN PRINT"*** Either too many files, or
  821. 9095 IF ERL=3595 THEN MSG$="":GOSUB 8930:BEEP:PRINT"*** ";MSG$;" Try again.":RESUME 3500
  822. 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
  823. 9105 IF ERR=68 THEN GOTO 8910
  824. 9115 IF ERR=62 AND ERL=3420 THEN RESUME 3425
  825. 9900 '
  826. 9905 CLOSE:BEEP:MSG$=" Sorry, NON-RECOVERABLE ERROR "+STR$(ERR)+" at line"+STR$(ERL):GOSUB 2600:ON ERROR GOTO 0
  827. 9999 DATA 830424
  828. 10000 IF SP THEN SP=0:TMP$="":LOCATE ROW,COL,1:PRINT:PRINT ELSE 10010
  829. 10001 PRINT"===Split Screen Operation Off":BEEP:PRINT:ROW=CSRLIN:COL=POS(0)
  830. 10002 LOCATE 25,1,0:PRINT CLIN$:LOCATE ROW,COL,1:GOTO 515
  831. 10010 SP=-1:BEEP:PRINT:PRINT"===Split Screen Operation On":ROW=CSRLIN
  832. 10012 COL=POS(0):LOCATE 25,1,1:GOTO 515
  833. 11000 IF B$=CR$ THEN B$=TMP$+B$:TMP$="":LOCATE 25,1,0:PRINT CLIN$;:GOTO 558
  834. 11020 IF B$=CHR$(27) THEN TMP$="":LOCATE 25,1,0:PRINT CLIN$;:XPOS=1 ELSE 11030
  835. 11022 LOCATE 25,XPOS,1:GOTO 560
  836. 11030 IF B$=BS$ AND XPOS>1 THEN TMP$=LEFT$(TMP$,LEN(TMP$)-1) ELSE 11040
  837. 11032 XPOS=XPOS-1:GOSUB 2655:LOCATE 25,XPOS,1:GOTO 560
  838. 11040 IF B$=BS$ AND XPOS = 1 THEN 560
  839. 11050 LOCATE 25,XPOS,1:PRINT B$;:TMP$=TMP$+B$:XPOS = XPOS + 1
  840. 11055 IF XPOS >79 THEN XPOS = 1
  841. 11060 GOTO 560 ' End of PC3SC.MRG.
  842. 40000 RETURN
  843. 40100 IF PAR$="N" AND DTA$="7" THEN NEWPD=2
  844. 40200 IF PAR$="E" AND DTA$="7" THEN NEWPD=26
  845. 40300 IF PAR$="O" AND DTA$="7" THEN NEWPD=10
  846. 40400 IF PAR$="M" AND DTA$="7" THEN NEWPD=42
  847. 40500 IF DTA$="8" THEN NEWPD=3
  848. 40600 OUT LCR,NEWPD
  849. 40700 RETURN
  850. 64000 '
  851. 64010 DIM F2BUF$(5):GOSUB 64150:DPSE=0:RETURN
  852. 64020 '
  853. 64030 IF PSE THEN RETURN
  854. 64040 PRINT #1,XF$;:PSE=-1:RETURN
  855. 64050 DPSE=-1:GOSUB 64030  'Set disk pause, xoff
  856. 64060 GOSUB 64080:IF COFF THEN RETURN ELSE GOTO 64060
  857. 64070 '  Wait for more chars to come in
  858. 64080 COMFRE=LOF(1):SOUND 32767,5:SOUND 32767,1:IF COMFRE<>LOF(1) THEN COFF=0:RETURN ELSE COFF=-1:RETURN
  859. 64090 '
  860. 64100 IF NOT PSE THEN RETURN
  861. 64110 IF NOT EOF(1) THEN RETURN ELSE IF DPSE THEN GOTO 64230
  862. 64120 PSE=0:PRINT #1,XN$;:RETURN
  863. 64130 IF NOT PSE THEN RETURN ELSE GOSUB 64120:RETURN
  864. 64140 '
  865. 64150 F2BUF$(1)="":F2BUF$(2)="":F2BUF$(3)="":F2BUF$(4)="":F2BUF$(5)="":F2BIU=1:F2IO=0:RETURN
  866. 64160 '
  867. 64170 'Routine to up buffer and decide if time to xoff
  868. 64180 F2BIU=F2BIU+1:IF F2BIU<3 THEN RETURN ELSE GOSUB 64030:DPSE=-1:F2IO=-1:RETURN
  869. 64190 'Routines to pack up buffers for writing to file #2
  870. 64200 F2BL=(255-LEN(F2BUF$(F2BIU))):IF F2BL=0 THEN GOSUB 64180:F2BL=255
  871. 64210 IF F2BL>=LEN(A$) THEN F2BUF$(F2BIU)=F2BUF$(F2BIU)+A$:GOTO 64230
  872. 64220 F2BUF$(F2BIU)=F2BUF$(F2BIU)+LEFT$(A$,F2BL):GOSUB 64180:F2BUF$(F2BIU)=MID$(A$,F2BL+1)
  873. 64230 ' check if ok to write to disk
  874. 64240 IF NOT DPSE THEN RETURN
  875. 64250 IF NOT EOF(1) THEN RETURN
  876. 64260 GOSUB 64080:IF NOT COFF THEN RETURN ELSE IF LOC(1) THEN RETURN
  877. 64270 'Write buffers for file #2
  878. 64280 GOSUB 64290:GOSUB 64150:DPSE=0:GOSUB 64100:RETURN
  879. 64290 FOR F2BI=1 TO F2BIU:PRINT #2,F2BUF$(F2BI);:NEXT:RETURN
  880. 64300 'Close #2
  881. 64310 IF (0=LEN(F2BUF$(1))) THEN RETURN ELSE GOSUB 64290:RETURN
  882. 64320 GOSUB 64050:GOSUB 64310:GOSUB 64330:GOTO 64370
  883. 64330 CLOSE #2:F2NAME$="":DPSE=0:RETURN
  884. 64340 'Open file #2
  885. 64350 OPEN F2NAME$ AS #2:GOTO 64370
  886. 64360 OPEN F2NAME$ FOR APPEND AS #2:GOTO 64370
  887. 64370 GOSUB 64150:RETURN
  888. 64380 IF DTA$="8" THEN IMFT$="F 4":RETURN ELSE IF PAR$="E" THEN IMFT$="F 3":RETURN
  889. 64390 IF PAR$="O" THEN IMFT$="F 2":RETURN ELSE IF PAR$="S" THEN IMFT$="F 1":RETURN
  890. 64400 IMFT$="F 0":RETURN
  891. 64410 '  End of PCT-JRIM.FIX
  892.