home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / rtty / rtty12 / rtty.bas < prev    next >
BASIC Source File  |  1985-12-17  |  42KB  |  734 lines
  1. 10 REM $LINESIZE:132
  2. 20 '********************************************************************
  3. 30 '
  4. 40 ' RTTY PROGRAM FOR THE IBM PERSONAL COMPUTER
  5. 50 '
  6. 60 ' VERSION 1.2E
  7. 70 '
  8. 80 ' LAST CHANGED DECEMBER 14, 1985
  9. 90 '
  10. 100 ' BY   GLENN E. WELMAN  -  KF4NB   (FORMERLY WB0OWT)
  11. 110 '      3301 PASTERN CT.
  12. 120 '      LEXINGTON, KY 40513
  13. 130 '
  14. 140 '  (C) COPYRIGHT WELMAN SOFTWARE 1983, 1984
  15. 150 '********************************************************************
  16. 160 '
  17. 170 '  FEEL FREE TO GIVE COPIES OF THIS PROGRAM TO YOUR FRIENDS.
  18. 180 '
  19. 190 '  PLEASE, DON'T SELL OR BARTER THE PROGRAM TO OTHERS.
  20. 200 '
  21. 210 '  IF YOU FIND BUGS IN THE PROGRAM, FEEL FREE TO
  22. 220 '  CORRESPOND DIRECTLY WITH ME. (SASE REQUESTED)
  23. 230 '
  24. 240 '  WHEN YOU PASS ALONG THE PROGRAM, INCLUDE ONLY THE
  25. 250 '  ORIGINAL UNMODIFIED VERSION.
  26. 260 '
  27. 270 '  DO NOT REMOVE THESE GUIDELINES FROM THE PROGRAM
  28. 280 '  OR DOCUMENT.
  29. 290 '
  30. 300 '  IF YOU FIND THE PROGRAM OF VALUE, A SMALL CONTRIBUTION
  31. 310 '  FOR MY EFFORT WILL BE APPRECIATED ($25 SUGGESTED).
  32. 320 '
  33. 330 '                       73's
  34. 340 '                       Glenn - KF4NB
  35. 350 '
  36. 360 '********************************************************************
  37. 370 DEFINT A-Z
  38. 380 DIM BDLOW(31),BDUP(31),BDOUT(127),BUF(4000),BUFL(4000)
  39. 390 DIM MON(12),MO$(12),R$(5),FK$(20),FLNM$(10),MAXBAUD(1),BD.RTE(1,9),BD.RT$(1,9)
  40. 391 DIM SUBR%(3):'THIS CODE FOR COMPILED BASIC ONLY (5 LINES)
  41. 392 SUBR%(0)=&H5B59:SUBR%(1)=&H5153:SUBR%(2)=&HEB83:SUBR%(3)=&HCB10
  42. 393 DEF USR0 = VARPTR(SUBR%(0))
  43. 394 I=0:P=USR0(I):DEF SEG = P:J=PEEK(&H80):PS$=""
  44. 395 FOR I=1 TO J:PS$=PS$+CHR$(PEEK(&H80+I)):NEXT I:DEF SEG
  45. 400 BSIZ=4000:'BUF(BSIZ) AND BUFL(BSIZ)
  46. 410 'DETERMINE SCREEN SIZE AND SET THE SCROLL PARAMETERS
  47. 420 KEY OFF:COLOR 7,0:SCREEN 0,1:CLS
  48. 430 'DETERMINE SCREEN SIZE AND SET THE SCROLL PARAMETERS
  49. 440 P=CSRLIN:PRINT STRING$(60," ");:IF P=CSRLIN THEN CMAX=80 ELSE CMAX=40
  50. 450 IF CMAX = 40 THEN LOCATE 10,15,0 ELSE LOCATE 10,35,0
  51. 460 PRINT"IBM PC RTTY":IF CMAX=40 THEN LOCATE 11,15,0 ELSE LOCATE 11,35,0
  52. 470 PRINT"Version 1.2E":IF CMAX=40 THEN LOCATE 13,13,0 ELSE LOCATE 13,33,0
  53. 480 PRINT"by Glenn Welman":IF CMAX=40 THEN LOCATE 15,18,0 ELSE LOCATE 15,38,0
  54. 490 PRINT"KF4NB":IF CMAX=40 THEN LOCATE 17,1,0 ELSE LOCATE 17,20,0
  55. 500 PRINT"(C) Copyright Welman Software 1983,1984":LOCATE 24,1,0:PRINT"Press any key to start";
  56. 510 P=VAL(RIGHT$(TIME$,2)):P=P+10:IF P>59 THEN P=P-60
  57. 520 IF INKEY$<>"" THEN 540
  58. 530 IF P<>VAL(RIGHT$(TIME$,2)) THEN 520
  59. 540 REM $PAGE
  60. 550 'BAUDOT RX CONVERSION TABLE
  61. 560 CLS
  62. 570 BDLOW(0)=&H0:BDUP(0)=&H0:BDLOW(1)=&H45:BDUP(1)=&H33:BDLOW(2)=&HA:BDUP(2)=&HA:BDLOW(3)=&H41:BDUP(3)=&H2D
  63. 580 BDLOW(4)=&H20:BDUP(4)=&H20:BDLOW(5)=&H53:BDUP(5)=&H7:BDLOW(6)=&H49:BDUP(6)=&H38:BDLOW(7)=&H55:BDUP(7)=&H37
  64. 590 BDLOW(8)=&HD:BDUP(8)=&HD:BDLOW(9)=&H44:BDUP(9)=&H24:BDLOW(10)=&H52:BDUP(10)=&H34:BDLOW(11)=&H4A:BDUP(11)=&H27
  65. 600 BDLOW(12)=&H4E:BDUP(12)=&H2C:BDLOW(13)=&H46:BDUP(13)=&H21:BDLOW(14)=&H43:BDUP(14)=&H3A:BDLOW(15)=&H4B:BDUP(15)=&H28
  66. 610 BDLOW(16)=&H54:BDUP(16)=&H35:BDLOW(17)=&H5A:BDUP(17)=&H22:BDLOW(18)=&H4C:BDUP(18)=&H29:BDLOW(19)=&H57:BDUP(19)=&H32
  67. 620 BDLOW(20)=&H48:BDUP(20)=&H23:BDLOW(21)=&H59:BDUP(21)=&H36:BDLOW(22)=&H50:BDUP(22)=&H30:BDLOW(23)=&H51:BDUP(23)=&H31
  68. 630 BDLOW(24)=&H4F:BDUP(24)=&H39:BDLOW(25)=&H42:BDUP(25)=&H3F:BDLOW(26)=&H47:BDUP(26)=&H26:BDLOW(27)=&H18:BDUP(27)=&H18
  69. 640 BDLOW(28)=&H4D:BDUP(28)=&H2E:BDLOW(29)=&H58:BDUP(29)=&H2F:BDLOW(30)=&H56:BDUP(30)=&H3B:BDLOW(31)=&H19:BDUP(31)=&H19
  70. 650 'BAUDOT TX CONVERSION TABLE
  71. 660 BDOUT(0)=&HC0:BDOUT(1)=&HC0:BDOUT(2)=&HC0:BDOUT(3)=&HC0:BDOUT(4)=&HC0:BDOUT(5)=&HC0:BDOUT(6)=&HC0:BDOUT(7)=&H85
  72. 670 BDOUT(8)=&HC0:BDOUT(9)=&HC0:BDOUT(10)=&HC2:BDOUT(11)=&HC0:BDOUT(12)=&HC0:BDOUT(13)=&HC8:BDOUT(14)=&HC0:BDOUT(15)=&HC0
  73. 680 BDOUT(16)=&HC0:BDOUT(17)=&HC0:BDOUT(18)=&HC0:BDOUT(19)=&HC0:BDOUT(20)=&HC0:BDOUT(21)=&HC0:BDOUT(22)=&HC0:BDOUT(23)=&HC0
  74. 690 BDOUT(24)=&H9B:BDOUT(25)=&H5F:BDOUT(26)=&HC0:BDOUT(27)=&HC0:BDOUT(28)=&HC0:BDOUT(29)=&HC0:BDOUT(30)=&HC0:BDOUT(31)=&HC0
  75. 700 BDOUT(32)=&H44:BDOUT(33)=&H8D:BDOUT(34)=&H91:BDOUT(35)=&H94:BDOUT(36)=&H89:BDOUT(37)=&HC0:BDOUT(38)=&H9A:BDOUT(39)=&H8B
  76. 710 BDOUT(40)=&H8F:BDOUT(41)=&H92:BDOUT(42)=&HC8:BDOUT(43)=&H5F:BDOUT(44)=&H8C:BDOUT(45)=&H83:BDOUT(46)=&H9C:BDOUT(47)=&H9D
  77. 720 BDOUT(48)=&H96:BDOUT(49)=&H97:BDOUT(50)=&H93:BDOUT(51)=&H81:BDOUT(52)=&H8A:BDOUT(53)=&H90:BDOUT(54)=&H95:BDOUT(55)=&H87
  78. 730 BDOUT(56)=&H86:BDOUT(57)=&H98:BDOUT(58)=&H8E:BDOUT(59)=&H9E:BDOUT(60)=&H5F:BDOUT(61)=&HC2:BDOUT(62)=&H9B:BDOUT(63)=&H99
  79. 740 BDOUT(64)=&H85:BDOUT(65)=&H43:BDOUT(66)=&H59:BDOUT(67)=&H4E:BDOUT(68)=&H49:BDOUT(69)=&H41:BDOUT(70)=&H4D:BDOUT(71)=&H5A
  80. 750 BDOUT(72)=&H54:BDOUT(73)=&H46:BDOUT(74)=&H4B:BDOUT(75)=&H4F:BDOUT(76)=&H52:BDOUT(77)=&H5C:BDOUT(78)=&H4C:BDOUT(79)=&H58
  81. 760 BDOUT(80)=&H56:BDOUT(81)=&H57:BDOUT(82)=&H4A:BDOUT(83)=&H45:BDOUT(84)=&H50:BDOUT(85)=&H47:BDOUT(86)=&H5E:BDOUT(87)=&H53
  82. 770 BDOUT(88)=&H5D:BDOUT(89)=&H55:BDOUT(90)=&H51:BDOUT(91)=&H9B:BDOUT(92)=&HC0:BDOUT(93)=&H5F:BDOUT(94)=&HC0:BDOUT(95)=&HC0
  83. 780 BDOUT(96)=&HC0:BDOUT(97)=&H43:BDOUT(98)=&H59:BDOUT(99)=&H4E:BDOUT(100)=&H49:BDOUT(101)=&H41:BDOUT(102)=&H4D:BDOUT(103)=&H5A
  84. 790 BDOUT(104)=&H54:BDOUT(105)=&H46:BDOUT(106)=&H4B:BDOUT(107)=&H4F:BDOUT(108)=&H52:BDOUT(109)=&H5C:BDOUT(110)=&H4C:BDOUT(111)=&H58
  85. 800 BDOUT(112)=&H56:BDOUT(113)=&H57:BDOUT(114)=&H4A:BDOUT(115)=&H45:BDOUT(116)=&H50:BDOUT(117)=&H47:BDOUT(118)=&H5E:BDOUT(119)=&H53
  86. 810 BDOUT(120)=&H5D:BDOUT(121)=&H55:BDOUT(122)=&H51:BDOUT(123)=&HC0:BDOUT(124)=&HC0:BDOUT(125)=&HC0:BDOUT(126)=&HC0:BDOUT(127)=&HC0
  87. 820 REM $PAGE
  88. 830 'READ THE INITIALIZATION PARAMETERS
  89. 840 COMM=1:DIV.LSB=&H3F8:ECHO=0:DIDL=0:QBEL=0:LPTR$="LPT1:":QSO$="":ZTM=0:MSG=0:TYPE=1:BLLF=0
  90. 850 XTAL!=1843200!/16:CWARN=57:CEND=65:ATCR=0:EURO=0:MARS=0:NCHR=60:QTIME=-1:RTS=1:DTR=1:ALCR=&H3E:PACKET=0:NSND=0:NCHK$="":SPLF=0
  91. 860 SELCAL=0:SCACT=0:BSEL=0:GBSEL$=CHR$(25)+"N"+CHR$(25)+"N"+CHR$(25)+"N":GASEL$="QST":ESEL$="NNNN":GESEL$="NNNN":BSELCAL$="??????????":ASELCAL$="??????????"
  92. 865 PDAT$="DAY YYMODDHHMMSS":PDATOK=-1
  93. 870 MAXBAUD(0)=6:MAXBAUD(1)=4:ART=0:UNSHIFT=0:NOBP=0:NOTKEYS=0:NOTKEYS$="* CONNECTE"
  94. 880 BD.RTE(0,0)=110!:BD.RTE(0,1)=100!:BD.RTE(0,2)=200!:BD.RTE(0,3)=300!:BD.RTE(0,4)=400!:BD.RTE(0,5)=1200!
  95. 890 BD.RT$(0,0)="110   ":BD.RT$(0,1)="100   ":BD.RT$(0,2)="200   ":BD.RT$(0,3)="300   ":BD.RT$(0,4)="400   ":BD.RT$(0,5)="1200  "
  96. 900 BD.RT$(0,6)="      ":BD.RT$(0,7)="      ":BD.RT$(0,8)="      ":BD.RT$(0,9)="      "
  97. 910 BD.RTE(1,0)=45.5:BD.RTE(1,1)=50!:BD.RTE(1,2)=56.9:BD.RTE(1,3)=74.2
  98. 920 BD.RT$(1,0)="45.5  ":BD.RT$(1,1)="50.0  ":BD.RT$(1,2)="56.9  ":BD.RT$(1,3)="74.2  ":BD.RT$(1,4)="      "
  99. 930 BD.RT$(1,5)="      ":BD.RT$(1,6)="      ":BD.RT$(1,7)="      ":BD.RT$(1,8)="      ":BD.RT$(1,9)="      "
  100. 940 ' SET THE DEFAULT COLOR PARAMETERS
  101. 950 TXF=7:TXB=0:RXF=7:RXB=0:STSF=0:STSB=7:KEYF=0:KEYB=7:ERRF=0:ERRB=7
  102. 960 REM $PAGE
  103. 962 IF RST THEN INPUT "ENTER THE NAME OF THE FILE CONTAINING RUNTIME PARAMETERS";PS$
  104. 964 IF LEFT$(PS$,1)=" " THEN PS$=RIGHT$(PS$,LEN(PS$)-1):GOTO 964
  105. 967 IF PS$="" THEN PARMS$="PARMS.RTY" ELSE PARMS$=PS$
  106. 970 ON ERROR GOTO 3280
  107. 980 FERR=0:OPEN PARMS$ FOR INPUT AS #1
  108. 990 IF FERR THEN GOTO 1480
  109. 1000 WHILE NOT EOF(1)
  110. 1010 INPUT#1,P$
  111. 1020 FOR PL=1 TO LEN(P$)
  112. 1030 P=ASC(MID$(P$,PL,1)):IF (P>&H60) AND (P<&H7B) THEN MID$(P$,PL,1)=CHR$(P-&H20)
  113. 1040 NEXT PL:PL$=LEFT$(P$,4):PRINT P$
  114. 1050 IF PL$="XTAL" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE XTAL!=VAL(RIGHT$(P$,LEN(P$)-PL))*1000000!/16:GOTO 1470
  115. 1060 IF PL$="COMM" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE DIV.LSB=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1470
  116. 1070 IF PL$="COM2" THEN COMM=2:DIV.LSB=&H2F8:GOTO 1470
  117. 1080 IF PL$="TIME" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE TMTYP$=RIGHT$(P$,LEN(P$)-PL):IF LEFT$(TMTYP$,1)="?" THEN GOTO 1470 ELSE QTIME=0:TMTYP$=LEFT$(TMTYP$,3):GOTO 1470
  118. 1090 IF LEFT$(PL$,3)="RTS" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE RTS=VAL(RIGHT$(P$,LEN(P$)-PL)):IF (RTS>1 AND RTS<10) OR (RTS>11) THEN 1460 ELSE 1470
  119. 1100 IF LEFT$(PL$,3)="DTR" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE DTR=VAL(RIGHT$(P$,LEN(P$)-PL)):IF (DTR>1 AND DTR<10) OR (DTR>11) THEN 1460 ELSE 1470
  120. 1110 IF PL$<>"BAUD" THEN 1120 ELSE PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460
  121. 1112 IF PL=5 THEN IF MAXBAUD(1)=10 THEN 1460 ELSE P=MAXBAUD(1):MAXBAUD(1)=P+1:GOTO 1114 ELSE P=VAL(MID$(P$,5,PL-5)):IF P>10 OR P>MAXBAUD(1)+1 THEN 1460 ELSE IF P>MAXBAUD(1) THEN MAXBAUD(1)=P:P=P-1 ELSE P=P-1
  122. 1114 BD.RTE(1,P)=VAL(RIGHT$(P$,LEN(P$)-PL)):MID$(BD.RT$(1,P),1)=RIGHT$(P$,LEN(P$)-PL)+"      ":GOTO 1470
  123. 1120 IF PL$<>"ASCI" THEN 1130 ELSE PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460
  124. 1122 IF PL=5 THEN IF MAXBAUD(0)=10 THEN 1460 ELSE P=MAXBAUD(0):MAXBAUD(0)=P+1:GOTO 1124 ELSE P=VAL(MID$(P$,5,PL-5)):IF P>10 OR P>MAXBAUD(0)+1 THEN 1460 ELSE IF P>MAXBAUD(0) THEN MAXBAUD(0)=P:P=P-1 ELSE P=P-1
  125. 1124 BD.RTE(0,P)=VAL(RIGHT$(P$,LEN(P$)-PL)):MID$(BD.RT$(0,P),1)=RIGHT$(P$,LEN(P$)-PL)+"      ":GOTO 1470
  126. 1130 IF PL$="BSEL" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE BSELCAL$=MID$(P$,PL+1,10):GOTO 1470
  127. 1140 IF PL$="ASEL" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE ASELCAL$=MID$(P$,PL+1,10):GOTO 1470
  128. 1150 IF PL$="BGSL" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE GBSEL$=MID$(P$,PL+1,10):GOTO 1470
  129. 1160 IF PL$="AGSL" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE GASEL$=MID$(P$,PL+1,10):GOTO 1470
  130. 1165 IF PL$="ESEL" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE ESEL$=MID$(P$,PL+1,10):GOTO 1470
  131. 1166 IF PL$="GESL" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE GESEL$=MID$(P$,PL+1,10):GOTO 1470
  132. 1167 IF PL$="NKEY" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE NOTKEYS$=MID$(P$,PL+1,10):GOTO 1470
  133. 1170 IF PL$="COLO" THEN TXF=11:TXB=1:RXF=14:RXB=2:STSF=0:STSB=6:KEYF=0:KEYB=3:ERRF=12:ERRB=0:GOTO 1470
  134. 1180 IF LEFT$(PL$,3)="TXF" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE TXF=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1470
  135. 1190 IF LEFT$(PL$,3)="TXB" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE TXB=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1470
  136. 1200 IF LEFT$(PL$,3)="RXF" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE RXF=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1470
  137. 1210 IF LEFT$(PL$,3)="RXB" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE RXB=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1470
  138. 1220 IF PL$="STSF" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE STSF=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1470
  139. 1230 IF PL$="STSB" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE STSB=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1470
  140. 1240 IF PL$="KEYF" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE KEYF=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1470
  141. 1250 IF PL$="KEYB" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE KEYB=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1470
  142. 1260 IF PL$="ERRF" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE ERRF=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1470
  143. 1270 IF PL$="ERRB" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE ERRB=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1470
  144. 1280 IF PL$="ALCR" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE ALCR=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1470
  145. 1290 IF PL$="BDUP" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE BDUP(VAL(MID$(P$,5,PL-5)))=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1470
  146. 1300 IF PL$="BDLW" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE BDLOW(VAL(MID$(P$,5,PL-5)))=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1470
  147. 1310 IF PL$="BDOT" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE BDOUT(VAL(MID$(P$,5,PL-5)))=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1470
  148. 1320 IF PL$="DIDL" THEN DIDL=-1:GOTO 1470
  149. 1330 IF PL$="ECHO" THEN ECHO=-1:GOTO 1470
  150. 1340 IF PL$="LPT2" THEN LPTR$="LPT2:":GOTO 1470
  151. 1350 IF PL$="LPT3" THEN LPTR$="LPT3:":GOTO 1470
  152. 1360 IF PL$="QB" THEN QBEL=-1:GOTO 1470
  153. 1362 IF PL$="ART" THEN ART=-1:GOTO 1470
  154. 1364 IF PL$="UOS" THEN UNSHIFT=-1:GOTO 1470
  155. 1370 IF PL$="ZULU" THEN ZTM=-1:GOTO 1470
  156. 1372 IF PL$="NPDT" THEN PDATOK=0:GOTO 1470
  157. 1373 IF PL$="PDAT" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE PDAT$=RIGHT$(P$,LEN(P$)-PL):GOTO 1470
  158. 1375 IF PL$="PACK" THEN PACKET=-1:TYPE=0:ALCR=&H03:GOTO 1470
  159. 1376 IF PL$="SPLF" THEN SPLF=-1:GOTO 1470
  160. 1377 IF PL$="MODE" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE IF MID$(P$,PL+1)="A" THEN TYPE=0:GOTO 1470 ELSE 1460
  161. 1378 IF PL$="BLLF" THEN BLLF=-1:GOTO 1470
  162. 1379 IF PL$="NOBP" THEN NOBP=-1:GOTO 1470
  163. 1380 IF PL$="ATCR" THEN ATCR=-1:GOTO 1470
  164. 1390 IF PL$="WARN" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE CWARN=VAL(RIGHT$(P$,LEN(P$)-PL))+1:GOTO 1470
  165. 1400 IF PL$="LLEN" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE CEND=VAL(RIGHT$(P$,LEN(P$)-PL))+1:GOTO 1470
  166. 1401 IF PL$="MARS" THEN MARS=-1:BDOUT(32)=&HC4:GOTO 1470
  167. 1405 IF PL$="NCHR" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE NCHR=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1470
  168. 1410 IF PL$="EURO" THEN EURO=-1 ELSE GOTO 1450
  169. 1420 ATCR=-1:BDUP(5)=&H27:BDUP(9)=&H23:BDUP(11)=&H7:BDUP(13)=&H5B:BDUP(17)=&H2B:BDUP(20)=&H21:BDUP(26)=&H5D:BDUP(30)=&H3D
  170. 1430 BDOUT(34)=&HC0:BDOUT(36)=&HC0:BDOUT(38)=&HC0:BDOUT(59)=&HC0:
  171. 1440 BDOUT(7)=&H8B:BDOUT(33)=&H94:BDOUT(35)=&H89:BDOUT(39)=&H85:BDOUT(43)=&H91:BDOUT(61)=&H9E:BDOUT(91)=&H8D:BDOUT(93)=&H9A:GOTO 1470
  172. 1450 IF PL$="FILE" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1460 ELSE P=VAL(MID$(P$,5,PL-5)):IF P<1 OR P>10 THEN 1460 ELSE FLNM$(P)=RIGHT$(P$,LEN(P$)-PL):GOTO 1470
  173. 1460 PRINT "INVALID PARMS.RTY ENTRY":PRINT "    ";P$;"    ":INPUT "PRESS ENTER TO CONTINUE";P$
  174. 1470 WEND
  175. 1480 CLOSE #1
  176. 1490 P=VAL(RIGHT$(TIME$,2)):P=P+3:IF P>59 THEN P=P-60
  177. 1500 IF INKEY$<>"" THEN 1520
  178. 1510 IF P<>VAL(RIGHT$(TIME$,2)) THEN 1500
  179. 1520 MOD.CTL=DIV.LSB+4:LINE.CTL=DIV.LSB+3:DIV.MSB=DIV.LSB+1:LINE.STS=DIV.LSB+5
  180. 1530 IF COMM=1 THEN COMM$="COM1" ELSE COMM$="COM2"
  181. 1540 IER=DIV.MSB
  182. 1550 RMSK=0:TMSK=0
  183. 1560 IF RTS>1 THEN RMSK=2
  184. 1570 IF RTS=1 OR RTS=11 THEN TMSK=2
  185. 1580 IF DTR>1 THEN RMSK=RMSK+1
  186. 1590 IF DTR=1 OR DTR=11 THEN TMSK=TMSK+1
  187. 1591 TXBR=TXB:TXFR=TXF MOD 8:TXB=TXB MOD 8:TXF=TXF MOD 32:SCTX=(TXB*16)+(TXF MOD 16)
  188. 1592 RXB=RXB MOD 8:RXF=RXF MOD 32:SCRX=(RXB*16)+(RXF MOD 16)
  189. 1593 STSBR=STSB:STSFR=STSF MOD 8:STSB=STSB MOD 8:STSF=STSF MOD 32
  190. 1594 KEYBR=KEYB:KEYFR=KEYF MOD 8:KEYB=KEYB MOD 8:KEYF=KEYF MOD 32
  191. 1595 ERRBR=ERRB:ERRFR=ERRF MOD 8:ERRB=ERRB MOD 8:ERRF=ERRF MOD 32
  192. 1600 'READ THE TTY ID FOR USE IN TRANSMITTING
  193. 1610 FERR=0:OPEN "TTYID.RTY" FOR INPUT AS #1
  194. 1620 IF FERR THEN TTYID$="":GOTO 1640
  195. 1630 LINE INPUT#1,TTYID$:TTYID$=" "+TTYID$+CHR$(254)
  196. 1640 CLOSE #1
  197. 1650 RRB=1:RRE=11
  198. 1660 RWE=23:IF CMAX=40 THEN RWB=14:SL=24 ELSE RWB=13:SL=25
  199. 1670 FOR I=0 TO BSIZ:BUFL(I)=-1:NEXT I
  200. 1680 MO$(1)="January":MO$(2)="February":MO$(3)="March":MO$(4)="April"
  201. 1690 MO$(5)="May":MO$(6)="June":MO$(7)="July":MO$(8)="August"
  202. 1700 MO$(9)="September":MO$(10)="October":MO$(11)="November":MO$(12)="December"
  203. 1710 MON(1)=31:MON(2)=28:MON(3)=31:MON(4)=30:MON(5)=31:MON(6)=30
  204. 1720 MON(7)=31:MON(8)=31:MON(9)=30:MON(10)=31:MON(11)=30:MON(12)=31
  205. 1730 REM $PAGE
  206. 1740 'INITIALIZE PROGRAM VARIABLES
  207. 1750 COLOR 7,0:CLS:MODE=0:BAUD=0:PRNTR=0:KEYS=-1
  208. 1760 BUFS=0:BUFE=0:BUFFULL=0:RFCNT=0:RCNT=1:TXBUF=0
  209. 1770 RST=0:BFILE=0:RFILE=0:DFILE=0:TPAUSE=0:CLOSE
  210. 1780 WIDTH LPTR$,255
  211. 1790 OPEN LPTR$ AS #4
  212. 1800 RR=RRB:CR=1
  213. 1810 RW=RWB:CW=1
  214. 1820 'SET THE GLOBAL KEYS
  215. 1830 FK$(1)="KEYS  ":FK$(3)="RX FLE":FK$(5)="END   ":FK$(6)="PRT OF":FK$(7)="45.5  ":FK$(9)="NEW LN":FK$(10)="LTRS  ":IF TYPE=0 THEN FK$(8)="ASCII " ELSE FK$(8)="BAUDOT"
  216. 1840 FK$(11)="KEYS  ":FK$(13)="TX FLE":FK$(14)="TX CQ ":FK$(15)="RESET ":FK$(16)="TX RYS":FK$(17)="PSE OF":FK$(18)="TTY ID":FK$(19)="QSO ID":FK$(20)="DT&TM "
  217. 1845 GOSUB 4082
  218. 1846 IF UNSHIFT THEN FK$(4)="UOS ON" ELSE FK$(4)="UOS OF"
  219. 1850 ON ERROR GOTO 3210
  220. 1860 'START COMMUNICATIONS FILE
  221. 1870 I = INP(LINE.STS)
  222. 1871 IF PACKET THEN 1875
  223. 1873 OPEN COMM$+":110,N,7,2,RS,CS0,DS0,CD0" AS #1:GOTO 1880
  224. 1875 OPEN COMM$+":110,N,8,1" AS #1:
  225. 1876 GOSUB 3970:'SET TO XMIT MODE
  226. 1880 GOSUB 3570:'SET MODE
  227. 1890 OUT MOD.CTL,(INP(MOD.CTL) AND &HFC) OR RMSK:'SET DTR AND RTS (PUT T.U. IN RX MODE)
  228. 1900 ON KEY(1) GOSUB 3320:KEY(1) ON:ON KEY(2) GOSUB 3970:KEY(2) ON
  229. 1910 GOSUB 3320
  230. 1920 IF NOT QTIME THEN 2010
  231. 1930 CLS:PRINT "THE DEFAULT TIME TYPE IS 'UTC'":INPUT "ENTER THE TIME TYPE ";TMTYP$:IF TMTYP$="" THEN TMTYP$="UTC" ELSE FOR PL=1 TO LEN(TMTYP$):P=ASC(MID$(TMTYP$,PL,1)):IF (P>&H60) AND (P<&H7B) THEN MID$(TMTYP$,PL,1)=CHR$(P-&H20):NEXT PL
  232. 1940 TMTYP$=LEFT$(TMTYP$,3)
  233. 1950 PRINT "THE TIME IS SET TO "+TIME$+" "+TMTYP$
  234. 1960 INPUT "ENTER THE TIME ";TCH$
  235. 1970 IF TCH$<>"" THEN TIME$ = TCH$
  236. 1980 PRINT "THE DATE IS SET TO "+DATE$
  237. 1990 INPUT "ENTER THE DATE ";TCH$
  238. 2000 IF TCH$<>"" THEN DATE$=TCH$
  239. 2010 TCH = VAL(RIGHT$(DATE$,4)):MON(2)=28:IF (TCH MOD 4) = 0 AND (TCH MOD 100) <>0 THEN MON(2)=29
  240. 2020 IF TMTYP$="UTC" THEN UTM=0 ELSE IF ZTM THEN INPUT "ENTER THE TIME DIFFERENCE FOR ZULU TIME";UTM
  241. 2030 CLS:GOSUB 3980:GOSUB 3420
  242. 2035 IF PACKET AND PDATOK THEN GOSUB 6030
  243. 2036 FOR I = 1 TO 12
  244. 2037 CALL SCROLL (RRB,RRE,CMAX,SCRX)
  245. 2038 CALL SCROLL (RWB,RWE,CMAX,SCTX)
  246. 2039 NEXT I
  247. 2040 LOCATE RW,CW,0:COLOR TXBR,TXFR:PRINT " ";
  248. 2050 GOSUB 5640:TSS!=TCS!
  249. 2060 IF INKEY$<>"" THEN 2060:'CLEAR THE INKEY$ BUFFER
  250. 2070 GOSUB 5660
  251. 2080 REM $PAGE
  252. 2090 '
  253. 2100 'THIS IS THE MAIN PROGRAM LOOP
  254. 2110 COLOR STSF,STSB:LOCATE 12,1,0:PRINT TIME$+" "+TMTYP$;:IF DATE$ <> ZDT$ THEN GOSUB 5660
  255. 2120 GOSUB 5640:IF TCS!<TSS! THEN TCS!=TCS!+86400!
  256. 2130 TS!=TCS!-TSS!:TH=INT(TS!/3600):TM=INT(TS!/60)-TH*60:TS=TS!-CSNG(TH)*3600-CSNG(TM)*60:LOCATE 12,30,0:PRINT USING "##_:##_:##";TH,TM,TS;
  257. 2140 IF BFILE THEN IF CMAX=40 THEN LOCATE 13,1,0 ELSE LOCATE 12,41,0
  258. 2150 IF BFILE THEN PRINT LEFT$("RX-"+BF$,19);
  259. 2160 IF RFILE THEN IF CMAX=40 THEN LOCATE 13,21,0 ELSE LOCATE 12,61,0
  260. 2170 IF RFILE THEN PRINT LEFT$("TX-"+RF$,19);
  261. 2180 COLOR TXF,TXB
  262. 2190 TCS!=FRE("")
  263. 2200 IF MSG THEN IF PMSG=VAL(RIGHT$(TIME$,2)) THEN GOSUB 5730
  264. 2210 FOR ML = 1 TO 10
  265. 2220 IF RST THEN IF PS$="" THEN 1750 ELSE CLOSE:CLEAR:RST=-1:GOTO 400
  266. 2230 IF NEWLINE THEN NEWLINE=0:B$=CHR$(13):GOSUB 3890:B$=CHR$(10):GOSUB 3890
  267. 2240 FOR MLL = 1 TO 2:IF NOT EOF(1) THEN GOSUB 2560:NEXT MLL
  268. 2250 IF TXEND THEN GOSUB 4010:GOTO 2280
  269. 2260 IF MODE=1 AND BUFS<>BUFE THEN GOSUB 4110 ELSE IF DIDL AND (MODE=1) AND NOT TPAUSE THEN GOSUB 5640:IF LDS<>SS THEN LDS=SS:COA=0:GOSUB 4190
  270. 2270 IF COA = 5 THEN GOSUB 3970:COA=0
  271. 2280 IF BUFFULL THEN 2320
  272. 2290 IF UNCOMP THEN GOSUB 4360:GOTO 2320
  273. 2300 IF RFILE THEN IF NOT EOF(2) THEN TCH$=INPUT$(1,#2):GOSUB 4360:GOTO 2320 ELSE GOSUB 5110:GOTO 2320
  274. 2310 IF DFILE THEN IF LEN(DTTM$)=0 THEN DFILE=0 ELSE TCH$=LEFT$(DTTM$,1):DTTM$=RIGHT$(DTTM$,LEN(DTTM$)-1):GOSUB 4360
  275. 2320 KCH$=INKEY$:IF KCH$="" THEN GOTO 2480
  276. 2330 IF LEN(KCH$)=1 THEN GOTO 2480 ELSE KCH2=ASC(RIGHT$(KCH$,1))
  277. 2340 IF KCH2<>30 THEN 2360 ELSE ART=NOT ART:GOSUB 4082
  278. 2350 GOSUB 5450:GOTO 2510
  279. 2360 IF KCH2<>31 THEN GOTO 2400 ELSE SELCAL=NOT SELCAL:IF SELCAL THEN GOSUB 5560 ELSE MSG$="SELCAL TURNED OFF":GOSUB 5680:GOTO 2510
  280. 2370 GOSUB 5620:INPUT "DO YOU WANT SELCAL DATA SENT TO DISK OR PRINTER (D/P) ";FSEL$:IF FSEL$="" THEN SELCAL=0:GOTO 2390 ELSE P$=LEFT$(FSEL$,1):IF P$<>"P" AND P$<>"p" AND P$<>"D" AND P$<>"d" THEN GOTO 2370
  281. 2380 IF P$="p" OR P$="P" THEN BSEL=0:MSG$="SELCAL SET TO PRINT":GOSUB 5680 ELSE BSEL=-1:GOSUB 5620:INPUT "ENTER SELCAL FILENAME FOR RECEIVING ";FSEL$
  282. 2390 GOSUB 5660:GOSUB 5590:GOTO 2510
  283. 2400 IF KCH2<>38 THEN GOTO 2450 ELSE GOSUB 5560:GOSUB 5620:INPUT "ENTER CALLSIGN OF STATION WORKED ";LOG1$
  284. 2410 GOSUB 5620:INPUT "ENTER COMMENTS AND/OR OTHER DATA ";LOG2$
  285. 2420 FERR=0:OPEN "LOG.RTY" FOR APPEND AS #5:IF FERR THEN GOTO 2440
  286. 2430 PRINT#5,DATE$+"  "+TIME$+"  ";:PRINT#5,USING "\        \";LOG1$;:PRINT#5,"  "+LOG2$
  287. 2440 CLOSE #5:GOSUB 5660:GOSUB 5590:GOTO 2510
  288. 2450 IF KCH2<>20 THEN 2460 ELSE MSG$="SWAP TRANSMIT BUFFER":GOSUB 5680:GOSUB 5780:GOTO 2510
  289. 2460 IF KCH2<>46 THEN 2470 ELSE MSG$="CLEAR TRANSMIT BUFFER":GOSUB 5680:GOSUB 5950:GOTO 2510
  290. 2470 IF KCH2<>49 THEN 2475 ELSE NOTKEYS=NOT NOTKEYS:IF NOTKEYS THEN MSG$="NOT AT KEYS MSG ON":GOSUB 5680:GOTO 2510 ELSE MSG$="NOT AT KEYS MSG OFF":GOSUB 5680:GOTO 2510
  291. 2475 IF KCH2<>32 THEN 2479 ELSE GOSUB 6030:GOTO 2510
  292. 2479 KCH2 = KCH2 - 119:IF KCH2<1 OR KCH2>10 THEN 2510 ELSE MSG$="SEND FILE"+STR$(KCH2):GOSUB 5680:GOSUB 5020:GOTO 2510
  293. 2480 IF (BUFFULL OR UNCOMP OR RFILE OR DFILE) THEN KEYBUF$=KEYBUF$+KCH$:GOTO 2510 ELSE IF LEN(KEYBUF$)=0 THEN TCH$=KCH$ ELSE TCH$=LEFT$(KEYBUF$,1):KEYBUF$=RIGHT$(KEYBUF$,LEN(KEYBUF$)-1)+KCH$
  294. 2490 IF LEN(TCH$)=0 THEN 2510
  295. 2500 GOSUB 4360
  296. 2510 NEXT ML
  297. 2520 GOTO 2110
  298. 2530 REM $PAGE
  299. 2540 '
  300. 2550 'GET THE NEXT RECEIVED CHARACTER AND DISPLAY IT
  301. 2560 IF NOT SELCAL THEN IF NOTKEYS THEN 2585 ELSE 2600
  302. 2570 IF TYPE=0 THEN 2580 ELSE IF BSELCAL$=RIGHT$(SELCHK$,LEN(BSELCAL$)) OR GBSEL$=RIGHT$(SELCHK$,LEN(GBSEL$)) THEN GOSUB 3030:GOTO 2600 ELSE GOTO 2590
  303. 2580 IF ASELCAL$=RIGHT$(SELCHK$,LEN(ASELCAL$)) OR GASEL$=RIGHT$(SELCHK$,LEN(GASEL$)) THEN GOSUB 3030:GOTO 2600
  304. 2585 IF NOTKEYS$=RIGHT$(SELCHK$,LEN(NOTKEYS$)) THEN GOSUB 5200:GOSUB 5082:IF NOT SELCAL THEN FSEL$="WHILE.OUT":GOSUB 3040:GOTO 2600 ELSE GOTO 2600
  305. 2590 IF ESEL$=RIGHT$(SELCHK$,LEN(ESEL$)) OR GESEL$=RIGHT$(SELCHK$,LEN(GESEL$)) THEN GOSUB 3100
  306. 2600 BAU=ASC(INPUT$(1,#1)) AND &H7F
  307. 2610 IF TYPE = 0 THEN B$=CHR$(BAU):IF BAU > 31 OR BAU=7 OR BAU=10 OR BAU=13 OR BAU=8 THEN 2690 ELSE RETURN
  308. 2620 'CONVERT BAUDOT INPUT TO ASCII CHARACTER
  309. 2630 IF BAU=0 THEN IF SELCAL OR NOTKEYS THEN SELCHK$=RIGHT$(SELCHK$,9)+CHR$(0):RETURN ELSE RETURN
  310. 2640 IF BAU=27 THEN IF CASE<>1 THEN CASE=1:RETURN ELSE IF SELCAL OR NOTKEYS THEN SELCHK$=RIGHT$(SELCHK$,9)+CHR$(24):RETURN ELSE RETURN
  311. 2650 IF BAU=31 THEN IF CASE<>0 THEN CASE=0:RETURN ELSE IF SELCAL OR NOTKEYS THEN SELCHK$=RIGHT$(SELCHK$,9)+CHR$(25):RETURN ELSE RETURN
  312. 2660 IF UNSHIFT AND BAU=4 THEN CASE=0
  313. 2670 IF CASE=0 THEN B$=CHR$(BDLOW(BAU)) ELSE B$=CHR$(BDUP(BAU))
  314. 2680 'B$ CONTAINS THE ASCII CHARACTER
  315. 2690 CURIN=ASC(B$)
  316. 2700 IF SELCAL OR NOTKEYS THEN SELCHK$=RIGHT$(SELCHK$,9)+B$
  317. 2710 IF CURIN=13 AND LASTIN=13 THEN RETURN
  318. 2711 IF MARS AND CURIN=7 AND TYPE<>0 THEN B$="@"
  319. 2720 IF NOT COMP THEN 2780
  320. 2730 IF NOT BFILE THEN 2850
  321. 2740 IF CURIN=10 THEN GOTO 2760
  322. 2750 IF CURIN=LASTIN THEN RCNT=RCNT+1:GOTO 2800 ELSE IF LASTIN<>10 AND LASTIN<>13 THEN IF RCNT=1 THEN PRINT#3,CMP$;:GOTO 2770 ELSE IF RCNT=2 THEN PRINT#3,CMP$;CMP$;:GOTO 2770
  323. 2760 IF LASTIN<>10 AND LASTIN<>13 THEN IF RCNT=26 THEN PRINT#3,CMP$;CHR$(255);CHR$(25);CMP$; ELSE PRINT#3,CHR$(255);CHR$(RCNT);CMP$;
  324. 2770 CMP$=B$:RCNT=1
  325. 2780 IF NOT BFILE THEN 2850
  326. 2790 IF ART THEN 2830
  327. 2800 IF CURIN=13 THEN PRINT#3,:GOTO 2840
  328. 2810 IF CURIN=10 AND LASTIN<>13 THEN PRINT#3,
  329. 2820 GOTO 2840
  330. 2830 IF CURIN=10 OR CURIN=13 THEN PRINT#3,CHR$(CURIN+10); ELSE IF LASTIN=10 OR LASTIN=13 THEN PRINT#3,
  331. 2840 IF NOT COMP AND CURIN<>10 AND CURIN<>13 THEN PRINT#3,B$;
  332. 2850 IF ART OR (CURIN <> 10 AND CURIN <> 13) THEN 2900
  333. 2860 IF CURIN=10 AND LASTIN=13 THEN LASTIN=10:RETURN
  334. 2870 IF CURIN=10 THEN 2900
  335. 2880 GOSUB 3890:IF PRNTR THEN LP$=B$:GOSUB 3140
  336. 2890 B$=CHR$(10)
  337. 2900 LASTIN = CURIN
  338. 2901 IF MARS AND CURIN=7 AND TYPE<>0 THEN B$=CHR$(7)
  339. 2910 IF PRNTR THEN LP$=B$:GOSUB 3140
  340. 2920 GOSUB 3890:'PUT CHARACTER ON SCREEN
  341. 2930 RETURN
  342. 2940 '
  343. 2950 'SET TO BAUDOT LETTERS MODE
  344. 2960 CASE=0:RETURN
  345. 2970 REM $PAGE
  346. 2980 'FORCE A CR-LF IN RX MODE
  347. 2990 IF PRNTR THEN LP$=CHR$(13):GOSUB 3140:LP$=CHR$(10):GOSUB 3140
  348. 3000 IF BFILE THEN PRINT#3,
  349. 3010 NEWLINE=-1:RETURN
  350. 3020 'START SELCAL SAVE FILE
  351. 3030 IF NOT BSEL THEN IF NOT PRNTR THEN PRNTR=-1:FK$(6)="PRT ON":GOSUB 5450:SCACT=-1:RETURN
  352. 3040 IF BFILE THEN RETURN ELSE GOSUB 5560:COMP=0:IF FSEL$="" THEN 3080
  353. 3050 BF$=FSEL$:FERR=0:OPEN FSEL$ FOR APPEND AS #3
  354. 3060 IF FERR THEN CLOSE #3:GOTO 3080
  355. 3070 BFILE=-1:SCACT=-1:GOSUB 5620
  356. 3080 GOSUB 5660:GOSUB 5590:RETURN
  357. 3090 'STOP SELCAL SAVE FILE
  358. 3100 IF NOT NOTKEYS AND NOT BSEL THEN IF SCACT THEN SCACT=0:PRNTR=0:FK$(6)="PRT OF":GOSUB 5450:RETURN
  359. 3110 IF BFILE AND NOT SCACT THEN RETURN ELSE GOSUB 5560:PRINT#3,:CLOSE #3:BFILE=0:SCACT=0:GOSUB 5660:GOSUB 5590:RETURN
  360. 3120 '
  361. 3130 'SEND DATA TO PRINTER
  362. 3140 ON ERROR GOTO 3290
  363. 3150 LP=ASC(LP$)
  364. 3160 IF LP<>7 THEN PRINT#4,LP$;
  365. 3170 IF LP>31 THEN LPCNT=LPCNT+1 ELSE IF LP=12 OR LP=13 THEN LPCNT=0 ELSE IF LP=10 THEN PRINT#4,STRING$(LPCNT," ");
  366. 3180 ON ERROR GOTO 3210:RETURN
  367. 3190 '
  368. 3200 'ERROR HANDLER
  369. 3210 IF ERR=57 OR ERR=69 THEN RESUME
  370. 3220 IF ERR=53 OR ERR=55 OR ERR=64 THEN FERR=-1:GOTO 3250
  371. 3230 IF ERR<>61 THEN ON ERROR GOTO 0:CLS:ERROR ERR:END
  372. 3240 BFILE=0:CLOSE #3
  373. 3250 IF ERR=53 THEN MSG$="FILE NOT FOUND" ELSE IF ERR=55 THEN MSG$="FILE ALREADY OPEN" ELSE IF ERR=64 THEN MSG$="BAD FILE NAME" ELSE MSG$="DISK FULL"
  374. 3260 GOSUB 5680:BEEP
  375. 3270 RESUME NEXT
  376. 3280 FERR=-1
  377. 3285 PRINT "ERROR ACCESSING FILE - ";PARMS$
  378. 3287 PRINT "ERROR NUMBER";ERR
  379. 3290 RESUME NEXT
  380. 3300 '
  381. 3310 'TOGGLE THE FUNCTION KEY DEFINITIONS
  382. 3320 KEYS = NOT KEYS
  383. 3330 GOSUB 5450
  384. 3340 IF KEYS THEN 3370
  385. 3350 ON KEY(3) GOSUB 3770:KEY(3) ON:ON KEY(4) GOSUB 5420:KEY(4) ON:ON KEY(5) GOSUB 3680:KEY(5) ON:ON KEY(6) GOSUB 3640:KEY(6) ON
  386. 3360 ON KEY(7) GOSUB 3410:KEY(7) ON:ON KEY(8) GOSUB 3550:KEY(8) ON:ON KEY(9) GOSUB 2990:KEY(9) ON:ON KEY(10) GOSUB 2960:KEY(10) ON:RETURN
  387. 3370 ON KEY(3) GOSUB 4930:KEY(3) ON:ON KEY(4) GOSUB 5080:KEY(4) ON:ON KEY(5) GOSUB 3610:KEY(5) ON:ON KEY(6) GOSUB 5050:KEY(6) ON
  388. 3380 ON KEY(7) GOSUB 5360:KEY(7) ON:ON KEY(8) GOSUB 4900:KEY(8) ON:ON KEY(9) GOSUB 4840:KEY(9) ON:ON KEY(10) GOSUB 5200:KEY(10) ON:RETURN
  389. 3390 REM $PAGE
  390. 3400 'TOGGLE THRU THE BAUD RATES AND SET THE NEW DIVISOR ON THE ASYNC ADAPTER
  391. 3410 BAUD = BAUD + 1
  392. 3420 IF BAUD >= MAXBAUD(TYPE) THEN BAUD = 0
  393. 3430 DIVHL=XTAL!/BD.RTE(TYPE,BAUD):DIVLO=DIVHL MOD 256:DIVHI=DIVHL\256:FK$(7)=BD.RT$(TYPE,BAUD)
  394. 3440 IER.SAVE=INP(IER)
  395. 3450 OUT IER,0
  396. 3460 OUT LINE.CTL,INP(LINE.CTL) OR &H80
  397. 3470 OUT DIV.LSB,DIVLO
  398. 3480 OUT DIV.MSB,DIVHI
  399. 3490 OUT LINE.CTL,INP(LINE.CTL) AND &H7F
  400. 3500 OUT IER,IER.SAVE
  401. 3510 GOSUB 5450
  402. 3520 RETURN
  403. 3530 '
  404. 3540 'TOGGLE BETWEEN BAUDOT AND ASCII MODE
  405. 3550 TYPE = TYPE+1
  406. 3560 IF TYPE >= 2 THEN TYPE = 0
  407. 3570 IF TYPE = 0 THEN OUT LINE.CTL,ALCR:FK$(8)="ASCII " ELSE OUT LINE.CTL,4:FK$(8)="BAUDOT"
  408. 3580 BAUD=0:GOTO 3430
  409. 3590 '
  410. 3600 'RESET REQUESTED
  411. 3610 RST = NOT RST:RETURN
  412. 3620 '
  413. 3630 'SEND RECEIVED CHARACTERS TO PRINTER
  414. 3640 PRNTR = NOT PRNTR:IF PRNTR THEN FK$(6)="PRT ON" ELSE FK$(6)="PRT OF"
  415. 3650 GOSUB 5450:RETURN
  416. 3660 '
  417. 3670 'ALL DONE - EXIT
  418. 3680 GOSUB 5560:GOSUB 5620
  419. 3690 BEEP:PRINT "DO YOU REALLY WANT TO QUIT (Y/N)?";
  420. 3700 P$=INKEY$:IF P$="" THEN 3700 ELSE IF P$="Y" OR P$="y" THEN 3730
  421. 3710 GOSUB 5660:GOSUB 5590
  422. 3720 RETURN
  423. 3730 COLOR 7,0:CLS:END
  424. 3740 REM $PAGE
  425. 3750 '
  426. 3760 'SEND RECEIVED CHARACTERS TO SPECIFIED FILE
  427. 3770 GOSUB 5560:IF NOT BFILE THEN GOTO 3790 ELSE IF ART OR (LASTIN<>10 AND LASTIN<>13) THEN PRINT#3,
  428. 3780 CLOSE #3:BFILE=0:LASTIN=10:GOTO 3850
  429. 3790 GOSUB 5620:INPUT "ENTER FILENAME FOR RECEIVING ";BF$
  430. 3800 IF BF$="" THEN 3850
  431. 3810 FERR=0:OPEN BF$ FOR APPEND AS #3
  432. 3820 IF FERR THEN GOTO 3850
  433. 3830 BFILE=-1:GOSUB 5620:INPUT "DO YOU WANT COMPRESSION (Y/N) ";P$
  434. 3840 P$=LEFT$(P$,1):IF P$="Y" OR P$="y" THEN COMP=-1 ELSE COMP=0
  435. 3850 GOSUB 5660:GOSUB 5590
  436. 3860 RETURN
  437. 3870 '
  438. 3880 'PUT RECEIVED CHARACTER ON SCREEN AND SCROLL IF NECESSARY
  439. 3890 RCH=ASC(B$):IF RCH=13 THEN CR=1:RETURN
  440. 3893 IF NOBP AND ART AND RCH=7 THEN RETURN
  441. 3900 IF RCH=10 THEN RR=RR+1:GOTO 3930
  442. 3902 IF PACKET AND RCH=8 THEN CR=CR-1:IF CR=0 THEN RR=RR-1:CR=CMAX-1:IF RR=0 THEN RR=1:CR=1
  443. 3903 IF PACKET AND RCH=8 THEN RETURN
  444. 3910 LOCATE RR,CR,0:COLOR RXF,RXB:PRINT B$;
  445. 3920 IF CR=CMAX-1 THEN RR=RR+1:CR=1 ELSE CR=CR+1
  446. 3930 IF RR=12 THEN RR=11:CALL SCROLL (RRB,RRE,CMAX,SCRX)
  447. 3940 RETURN
  448. 3950 '
  449. 3960 'TOGGLE BETWEEN RECEIVE AND TRANSMIT MODE
  450. 3970 MODE=MODE+1
  451. 3980 IF MODE >=2 THEN MODE = 0
  452. 3990 ON MODE+1 GOTO 4010,4050
  453. 4000 'RECEIVE MODE
  454. 4010 IF (INP(LINE.STS) AND &H60) <> &H60 THEN TXEND=-1:RETURN ELSE TXEND=0
  455. 4020 OUT MOD.CTL,(INP(MOD.CTL) AND &HFC) OR RMSK:GOSUB 4082
  456. 4030 NEWLINE=-1:GOSUB 5450:RETURN
  457. 4040 'TRANSMIT MODE
  458. 4050 OUT MOD.CTL,(INP(MOD.CTL)AND &HFC) OR TMSK:GOSUB 4082:SHIFT=0
  459. 4060 IW = VAL(RIGHT$(TIME$,2))
  460. 4070 IF IW = VAL(RIGHT$(TIME$,2)) THEN 4070
  461. 4080 NEWLINE=-1:GOSUB 5450:RETURN
  462. 4081 'SET THE STS INDICATOR FOR RECV/XMIT
  463. 4082 IF MODE=0 THEN FK$(2)="RECV  ":FK$(12)="RECV  " ELSE FK$(2)="XMIT  ":FK$(12)="XMIT  "
  464. 4083 IF ART THEN MID$(FK$(2),6,1)="A":MID$(FK$(12),6,1)="A" ELSE MID$(FK$(2),6,1)="N":MID$(FK$(12),6,1)="N"
  465. 4084 RETURN
  466. 4090 '
  467. 4100 'GET NEXT CHARACTER FROM BUFFER AND SEND IT
  468. 4110 IF TPAUSE THEN RETURN
  469. 4120 COA=BUF(BUFS):IF COA=254 THEN GOSUB 5640:TSS!=TCS! ELSE GOSUB 4180
  470. 4130 BUFS=BUFS+1:IF BUFS=BSIZ+1 THEN BUFS=0
  471. 4140 BUFC=BUFN-BUFS:IF BUFC<0 THEN BUFC=BUFC+BSIZ
  472. 4150 IF BUFC>=BSIZ-2 THEN BUFFULL=-1 ELSE BUFFULL=0
  473. 4160 RETURN
  474. 4170 'SEND CHARACTER TO ASYNC ADAPTER
  475. 4180 IF ECHO THEN B$=CHR$(COA):GOSUB 2690
  476. 4190 IF TYPE = 0 THEN CO$=CHR$(COA):GOTO 4260
  477. 4200 'BAUDOT MODE - CHANGE SHIFT IF NECESSARY AND CONVERT ASCII TO BAUDOT
  478. 4210 CT=BDOUT(COA) AND &HC0:CD=BDOUT(COA) AND &H3F:CO$=CHR$(CD)
  479. 4220 IF CT=&HC0 THEN 4260
  480. 4230 IF SHIFT<>1 AND CT=&H40 THEN SHIFT=1:PRINT#1,CHR$(&H1F);:IF CD=&H1F THEN GOTO 4270 ELSE GOTO 4250
  481. 4240 IF SHIFT<>2 AND CT=&H80 THEN SHIFT=2:PRINT#1,CHR$(&H1B);:IF CD=&H1B THEN GOTO 4270
  482. 4250 IF ASC(CO$)=0 THEN 4290
  483. 4260 IF SPLF AND COA=10 THEN 4290 ELSE PRINT#1,CO$;
  484. 4263 IF NSND THEN NLOOP=NLOOP-1:IF NLOOP=0 THEN NSND=0:GOTO 4290 ELSE GOTO 4210
  485. 4265 IF MARS THEN NCHK$ = RIGHT$(NCHK$,3)+CHR$(COA AND &HDF):IF NCHK$="NNNN" THEN NSND=-1:COA=NCHR:NLOOP=12:NCHK$="":GOTO 4210
  486. 4270 IF COA=13 AND NOT PACKET THEN PRINT#1,CO$; ELSE IF (COA=10) AND NOT MARS AND (TYPE<>0) THEN SHIFT=1:PRINT#1,CHR$(&H1F);
  487. 4280 IF NOT EURO AND COA=43 AND TYPE<>0 THEN FOR I = 1 TO 11:PRINT#1,CO$;:NEXT I
  488. 4290 GOSUB 5640:LDS=SS
  489. 4300 RETURN
  490. 4310 REM $PAGE
  491. 4320 'GET NEXT COLUMN NUMBER
  492. 4330 IF CWT<>0 AND CWT<>200 THEN CW=CWT
  493. 4340 RETURN
  494. 4350 'PUT CHAR TO SEND ON SCREEN AND INTO BUFFER
  495. 4360 TCH=ASC(TCH$):IF UNCOMP THEN TCNT=TCNT-1:TCH=UTCH:TCH$=UTCH$:IF TCNT=0 THEN UNCOMP=0:GOTO 4570 ELSE GOTO 4570
  496. 4370 IF UCNT THEN UCNT=0:UNCOMP=-1:UTCH=TCH:IF TCH=13 THEN UTCH$=CHR$(23):RETURN ELSE UTCH$=TCH$:RETURN
  497. 4380 IF USTRT THEN USTRT=0:UCNT=-1:TCNT=TCH:RETURN
  498. 4390 IF CRLF THEN CRLF=0:IF TCH=10 THEN LTCH=10:RETURN
  499. 4395 IF (BLLF OR MARS) AND TCH=13 AND CW=1 THEN TCH=10:CRLF=-1
  500. 4400 IF QBL THEN QBL=0:IF TCH=7 THEN LTCH=7:RETURN
  501. 4410 IF TCH<>8 THEN 4540 ELSE IF BUFS=BUFE THEN IF PACKET THEN 4531 ELSE RETURN ELSE BUFC=BUFE:BUFE=BUFE-1:IF BUFE<0 THEN BUFE=BSIZ
  502. 4420 IF BUFL(BUFE)=0 OR BUFL(BUFE)=200 THEN CWS=CW:LOCATE RW,CW,0:COLOR TXF,TXB:PRINT " ";:RW=RW-1:IF RW<RWB THEN RW=RWB:GOTO 4460 ELSE LOCATE RW,CW,0:STCH=SCREEN(RW,CW):COLOR TXBR,TXFR:PRINT CHR$(STCH):GOTO 4510
  503. 4430 LOCATE RW,CW,0:IF BUFL(BUFC)=0 THEN STCH=SCREEN(RW,CW):COLOR TXF,TXB:PRINT CHR$(STCH) ELSE COLOR TXF,TXB:PRINT " ";:IF BUF(BUFE)=13 THEN BUFL(BUFC)=-1:GOTO 4460
  504. 4440 IF BUFL(BUFE)=CMAX-1 THEN RW=RW-1
  505. 4450 IF RW>=RWB THEN 4500 ELSE RW=RWB
  506. 4460 BUFC=BUFE
  507. 4470 CWT=BUFL(BUFC):GOSUB 4330:LOCATE RW,CW,0:COLOR TXF,TXB:IF BUF(BUFC)=13 THEN PRINT CHR$(23); ELSE PRINT CHR$(BUF(BUFC));
  508. 4480 IF BUFC=BUFS THEN 4500 ELSE BUFC=BUFC-1:IF BUFC<0 THEN BUFC=BSIZ
  509. 4490 IF BUF(BUFC)<>10 AND BUF(BUFC)<>13 AND BUFL(BUFC)<>CMAX-1 THEN 4470
  510. 4500 CW=CWS:CWT=BUFL(BUFE):GOSUB 4330:LOCATE RW,CW,0:COLOR TXBR,TXFR:PRINT " ";:BUFL(BUFE)=-1
  511. 4510 BUFC=BUFE-1:IF BUFC<0 THEN BUFC=BSIZ
  512. 4520 LTCH=BUF(BUFC):IF LTCH=13 THEN LTCH=23
  513. 4530 RETURN
  514. 4531 COA=8:GOSUB 4180:IF CW=1 THEN RETURN ELSE LOCATE RW,CW,0:COLOR TXF,TXB:PRINT " ";:CW=CW-1:LOCATE RW,CW,0:COLOR TXBR,TXFR:PRINT " ";:RETURN
  515. 4540 IF TCH=18 THEN DTTM$=DTTM$+TL$:DFILE=-1:RETURN
  516. 4550 IF TCH=19 THEN 4770
  517. 4560 IF TCH=255 THEN USTRT=-1:RETURN
  518. 4570 IF TCH=13 OR TCH=10 THEN IF LTCH=20 OR LTCH=23 THEN RETURN ELSE TCH$=CHR$(TCH+10)
  519. 4580 LOCATE RW,CW,0:STCH=SCREEN(RW,CW):COLOR TXF,TXB:IF TCH<>10 AND TCH<>20 THEN PRINT TCH$ ELSE IF STCH<>32 THEN PRINT CHR$(STCH); ELSE IF NOT NOBP OR NOT ART OR TCH<>7 THEN PRINT TCH$;
  520. 4590 IF TCH=10 THEN BUFL(BUFE)=0 ELSE IF TCH=20 THEN BUFL(BUFE)=200 ELSE BUFL(BUFE)=CW
  521. 4600 IF TCH=13 OR TCH=23 THEN CW=1:GOTO 4630
  522. 4610 IF TCH=10 OR TCH=20 THEN RW=RW+1:GOTO 4630
  523. 4620 IF CW=CMAX-1 THEN RW=RW+1:CW=1 ELSE CW=CW+1
  524. 4630 BUFN=BUFE+1:IF BUFN=BSIZ+1 THEN BUFN=0
  525. 4640 BUFC=BUFN-BUFS:IF BUFC<0 THEN BUFC=BUFC+BSIZ
  526. 4650 IF BUFC>=BSIZ-2 THEN BUFFULL=-1
  527. 4660 IF TCH=20 OR TCH=23 THEN BUF(BUFE)=TCH-10 ELSE BUF(BUFE)=TCH
  528. 4670 BUFE=BUFN:LTCH=TCH
  529. 4680 IF TCH=13 THEN TCH=10:CRLF=-1:BUFL(BUFE)=0:GOTO 4610
  530. 4690 IF QBEL AND TCH=39 THEN TCH=7:TCH$=CHR$(7):QBL=-1:GOTO 4580
  531. 4700 IF RW=24 THEN RW=23:CALL SCROLL (RWB,RWE,CMAX,SCTX)
  532. 4710 LOCATE RW,CW,0:COLOR TXBR,TXFR:STCH=SCREEN(RW,CW):IF STCH=32 THEN PRINT " "; ELSE PRINT CHR$(STCH)
  533. 4720 IF CW=CWARN THEN BEEP
  534. 4730 IF (CW=CEND) AND ATCR THEN TCH=13:GOTO 4570
  535. 4740 RETURN
  536. 4750 '
  537. 4760 'GET TEMPORARY LINE TO STORE
  538. 4770 GOSUB 5560:GOSUB 5620
  539. 4780 BEEP:LINE INPUT "ENTER MESSAGE TO STORE ? ";TL$
  540. 4790 GOSUB 5660:GOSUB 5590
  541. 4800 RETURN
  542. 4810 REM $PAGE
  543. 4820 '
  544. 4830 'ENTER QSO ID FOR USE WITH TTY ID
  545. 4840 GOSUB 5560:GOSUB 5620
  546. 4850 BEEP:LINE INPUT "ENTER THE CALL SIGN ? ";QSO$
  547. 4860 GOSUB 5660:GOSUB 5590
  548. 4870 RETURN
  549. 4880 '
  550. 4890 'SEND RTTY ID
  551. 4900 DTTM$=DTTM$+QSO$+TTYID$:IF ZTM THEN DTTM$=DTTM$+"   ":GOTO 5250 ELSE DTTM$=DTTM$+CHR$(13):DFILE=-1:RETURN
  552. 4910 '
  553. 4920 'GET FILE TO SEND
  554. 4930 GOSUB 5560:IF RFCNT=6 THEN RETURN
  555. 4940 GOSUB 5620:INPUT "ENTER FILENAME FOR TRANSMITTING ";R$(RFCNT)
  556. 4950 IF R$(RFCNT)="STOP" OR R$(RFCNT)="stop" THEN 5110
  557. 4960 IF R$(RFCNT)="" THEN 4990
  558. 4970 RFCNT = RFCNT + 1
  559. 4980 IF NOT RFILE THEN 5110
  560. 4990 GOSUB 5660:GOSUB 5590
  561. 5000 RETURN
  562. 5010 'PUT SPECIFIED FILE IN TX QUE
  563. 5020 IF RFCNT=6 THEN RETURN ELSE R$(RFCNT)=FLNM$(KCH2):GOSUB 5560:GOTO 4960
  564. 5030 '
  565. 5040 'GET RYs FILE TO SEND
  566. 5050 IF RFCNT=6 THEN RETURN ELSE R$(RFCNT)="RYS.RTY":GOSUB 5560:GOTO 4970
  567. 5060 '
  568. 5070 'GET CQ FILE TO SEND
  569. 5080 IF RFCNT=6 THEN RETURN ELSE R$(RFCNT)="CQ.RTY":GOSUB 5560:GOTO 4970
  570. 5082 '
  571. 5084 'GET NOT HOME FILE TO SEND
  572. 5085 BEEP:BEEP
  573. 5086 IF RFCNT=6 THEN RETURN ELSE R$(RFCNT)="AWAY.MSG":GOSUB 5560:GOTO 4970
  574. 5090 '
  575. 5100 'CLOSE THE CURRENT TX FILE AND START THE NEXT ONE
  576. 5110 IF RFCNT=0 THEN CLOSE #2:RFILE=0:GOTO 4990 ELSE RF$=R$(0)
  577. 5120 FOR I=1 TO RFCNT-1:R$(I-1)=R$(I):NEXT I
  578. 5130 RFCNT=RFCNT-1:CLOSE #2
  579. 5140 FERR=0:OPEN RF$ FOR INPUT AS #2
  580. 5150 IF FERR THEN GOTO 5110
  581. 5160 RFILE=-1:GOTO 4990
  582. 5170 REM $PAGE
  583. 5180 '
  584. 5190 'SEND TIME AND DATE
  585. 5200 IF ZTM THEN 5250
  586. 5210 MO=VAL(MID$(DATE$,1,2)):DAY$=MID$(DATE$,4,2):YR$=MID$(DATE$,7,4)
  587. 5220 DTTM$=DTTM$+TIME$+" "+TMTYP$+"    "
  588. 5230 IF EURO THEN DTTM$=DTTM$+DAY$+"."+LEFT$(MO$(MO),3)+"."+YR$+CHR$(13) ELSE DTTM$=DTTM$+MO$(MO)+" "+DAY$+", "+YR$+CHR$(13)
  589. 5240 DFILE=-1:RETURN
  590. 5250 ZTM$=TIME$:ZDT$=DATE$
  591. 5260 MO=VAL(LEFT$(ZDT$,2)):DAY=VAL(MID$(ZDT$,4,2)):YR=VAL(RIGHT$(ZDT$,2))
  592. 5270 HR=VAL(LEFT$(ZTM$,2)):MIN=VAL(MID$(ZTM$,4,2))
  593. 5280 HR=HR+UTM:IF HR>23 THEN HR=HR-24:DAY=DAY+1:IF DAY>MON(MO) THEN DAY=1:MO=MO+1:IF MO>12 THEN MO=1:YR=(YR+1) MOD 100
  594. 5290 IF DAY>9 THEN DTTM$=DTTM$+RIGHT$(STR$(DAY),2) ELSE DTTM$=DTTM$+"0"+RIGHT$(STR$(DAY),1)
  595. 5300 IF HR>9 THEN DTTM$=DTTM$+RIGHT$(STR$(HR),2) ELSE DTTM$=DTTM$+"0"+RIGHT$(STR$(HR),1)
  596. 5310 IF MIN>9 THEN DTTM$=DTTM$+RIGHT$(STR$(MIN),2) ELSE DTTM$=DTTM$+"0"+RIGHT$(STR$(MIN),1)
  597. 5320 DTTM$=DTTM$+"Z "+LEFT$(MO$(MO),3):IF YR>9 THEN DTTM$=DTTM$+STR$(YR)+CHR$(13) ELSE DTTM$=DTTM$+" 0"+RIGHT$(STR$(YR),1)+CHR$(13)
  598. 5330 DFILE=-1:RETURN
  599. 5340 '
  600. 5350 'STOP SENDING CHARACTERS BUT STAY IN TX MODE
  601. 5360 TPAUSE = NOT TPAUSE
  602. 5370 IF TPAUSE THEN FK$(17)="PSE ON" ELSE FK$(17)="PSE OF"
  603. 5380 GOSUB 5450
  604. 5390 RETURN
  605. 5400 '
  606. 5410 'TOGGLE THE UNSHIFT ON SPACE FUNCTION - RECEIVE ONLY
  607. 5420 UNSHIFT=NOT UNSHIFT:IF UNSHIFT THEN FK$(4)="UOS ON" ELSE FK$(4)="UOS OF"
  608. 5430 '
  609. 5440 'DISPLAY THE CURRENT FUNCTION KEY DEFINITIONS
  610. 5450 IF (SL=24) AND MSG THEN RETURN
  611. 5460 GOSUB 5560:LOCATE SL,1,0:IF KEYS THEN IS=11:IE=20 ELSE IS=1:IE=10
  612. 5470 FOR I= IS TO IE
  613. 5480 COLOR KEYBR,KEYFR:PRINT USING"#";I MOD 10;
  614. 5490 COLOR KEYF,KEYB:PRINT FK$(I);
  615. 5500 IF I MOD 10 <> 0 THEN IF (I MOD 5 <> 0) OR (SL<>24) THEN COLOR KEYBR,KEYFR:PRINT " "; ELSE LOCATE 25,1,0
  616. 5510 NEXT
  617. 5520 GOSUB 5590:OLDCLR=SCREEN(OLDCUR,OLDPOS,1):OCLRF=OLDCLR MOD 16:OCLRB=((OLDCLR-OCLRF)/16) MOD 128:IF OLDCLR>127 THEN OCLRF=OCLRF+16
  618. 5530 COLOR OCLRF,OCLRB:RETURN
  619. 5540 '
  620. 5550 'GET THE CURRENT CURSOR LOCATION AND SAVE IT
  621. 5560 OLDCUR=CSRLIN:OLDPOS=POS(0):RETURN
  622. 5570 '
  623. 5580 'RELOCATE AT THE SAVED CURSOR LOCATION
  624. 5590 LOCATE OLDCUR,OLDPOS,0:RETURN
  625. 5600 '
  626. 5610 'ROUTINE TO CLEAR LINE 12
  627. 5620 COLOR STSBR,STSFR:LOCATE 12,1,0:PRINT STRING$(79," ");:COLOR STSF,STSB:LOCATE 12,1,0:RETURN
  628. 5630 'ROUTINE TO GET THE TIME IN HOURS, MINUTES, SECONDS AND TOTAL SECONDS
  629. 5640 TI$=TIME$:SH=VAL(MID$(TI$,1,2)):SM=VAL(MID$(TI$,4,2)):SS=VAL(MID$(TI$,7,2)):TCS!=CSNG(SH)*3600+CSNG(SM)*60+SS:RETURN
  630. 5650 'ROUTINE TO PRINT THE DATE ON LINE 12
  631. 5660 GOSUB 5620:LOCATE 12,15,0:ZDT$=DATE$:PRINT ZDT$;:RETURN
  632. 5670 'ROUTINE TO DISPLAY MESSAGE ON LINE 24
  633. 5680 GOSUB 5560:COLOR ERRBR,ERRFR:LOCATE 24,1,0:IF SL=24 THEN PRINT STRING$(39," "); ELSE PRINT STRING$(79," ");
  634. 5690 COLOR ERRF,ERRB:LOCATE 24,1,0:PRINT MSG$;
  635. 5700 PMSG=VAL(RIGHT$(TIME$,2)):PMSG=PMSG+5:IF PMSG>59 THEN PMSG=PMSG-60
  636. 5710 MSG=-1:RETURN
  637. 5720 'ROUTINE TO CLEAR LINE 24
  638. 5730 IF SL=24 THEN MSG=0:GOTO 5450
  639. 5740 GOSUB 5560:COLOR KEYBR,KEYFR:LOCATE 24,1,0:PRINT STRING$(79," ");:GOSUB 5590:GOSUB 5450
  640. 5750 MSG=0:RETURN
  641. 5760 '
  642. 5770 'ROUTINE TO SWAP THE TRANSMIT BUFFER
  643. 5780 IF TXBUF THEN 5880
  644. 5790 IF RFILE THEN CLOSE #2:RFILE=0:RFCNT=0
  645. 5800 FERR=0:OPEN "TXBUFFER.RTY" FOR OUTPUT AS #2
  646. 5810 IF FERR THEN 5860
  647. 5820 IF BUFS=BUFE THEN 5860
  648. 5830 PRINT#2,CHR$(BUF(BUFS));
  649. 5840 BUFS=BUFS+1:IF BUFS=BSIZ+1 THEN BUFS=0
  650. 5850 GOTO 5820
  651. 5860 CLOSE #2:TXBUF=-1
  652. 5870 GOSUB 5950:GOSUB 5620:GOSUB 5660:RETURN
  653. 5880 GOSUB 5950:RF$="TXBUFFER.RTY"
  654. 5890 FERR=0:OPEN RF$ FOR INPUT AS #2
  655. 5900 IF FERR THEN 5920
  656. 5910 RFILE=-1
  657. 5920 TXBUF=0:RETURN
  658. 5930 '
  659. 5940 'ROUTINE TO CLEAR THE TX BUFFER AND STOP ALL CURRENT INPUT TO IT
  660. 5950 IF RFILE THEN CLOSE #2
  661. 5960 RFILE=0:UNCOMP=0:DFILE=0:BUFFULL=0:KEYBUF$="":DTTM$="":RFCNT=0
  662. 5970 BUFS=0:BUFE=0:RW=RWB:CW=1
  663. 5980 FOR PL = 1 TO 15
  664. 5990 CALL SCROLL (RWB,RWE,CMAX,SCTX)
  665. 6000 NEXT PL
  666. 6010 LOCATE RW,CW,0:COLOR TXBR,TXFR:PRINT " ";
  667. 6020 RETURN
  668. 6030 PD$ = DATE$:PT$ = TIME$:PDT$ = PDAT$
  669. 6040 PSTR = INSTR(PDT$,"YYYY"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,4) = MID$(PD$,7,4)
  670. 6050 PSTR = INSTR(PDT$,"YY"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = MID$(PD$,9,2)
  671. 6060 PSTR = INSTR(PDT$,"MO"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = MID$(PD$,1,2)
  672. 6070 PSTR = INSTR(PDT$,"DD"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = MID$(PD$,4,2)
  673. 6080 PSTR = INSTR(PDT$,"HH"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = MID$(PT$,1,2)
  674. 6090 PSTR = INSTR(PDT$,"MM"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = MID$(PT$,4,2)
  675. 6100 PSTR = INSTR(PDT$,"SS"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = MID$(PT$,7,2)
  676. 6110 PRINT#1,PDT$
  677. 6120 RETURN
  678. 9000 ' THIS IS THE RTTYSUBS ASSEMBLER CODE FOR SCROLLING HALF SCREENS
  679. 9010 ' PAGE,132
  680. 9020 ' TITLE RTTY SUBROUTINES FOR BASIC PROGRAMS - BACKGROUND ATTRIBUTE PASSING
  681. 9030 ' SUBS    SEGMENT PUBLIC 'CODE'
  682. 9040 '         ASSUME  CS:SUBS,DS:NOTHING
  683. 9050 '
  684. 9060 '         PUBLIC  SCROLL
  685. 9070 '
  686. 9080 ' SCROLL  PROC    FAR
  687. 9090 ' ;**********************************************************************
  688. 9100 ' ;
  689. 9110 ' ;  ON ENTRY PARAMETERS PASSED ARE THE POINTERS TO
  690. 9120 ' ;  STARTING ROW (INTEGER), ENDING ROW (INTEGER)
  691. 9130 ' ;  NUMBER OF COLUMNS (INTEGER), AND BACKGROUND ATTRIBUTE
  692. 9140 ' ;
  693. 9150 ' ;**********************************************************************
  694. 9160 '
  695. 9170 '         PUSH    BP
  696. 9180 '         MOV     BP,SP           ;GET THE PARAMETERS FROM THE STACK AREA
  697. 9190 '         MOV     SI,[BP]+12      ;GET PARM 'A'
  698. 9200 '         MOV     CH,[SI]         ;STARTING ROW FOR SCROLL
  699. 9210 '         MOV     SI,[BP]+10      ;GET PARM 'B'
  700. 9220 '         MOV     DH,[SI]         ;ENDING ROW FOR SCROLL
  701. 9230 '         MOV     SI,[BP]+8       ;GET PARM 'C'
  702. 9240 '         MOV     DL,[SI]         ;NUMBER OF COLUMNS
  703. 9250 '         MOV     SI,[BP]+6       ;GET PARM 'D'
  704. 9260 '         MOV     BH,[SI]         ;ATTRIBUTE OF CHARACTER
  705. 9270 '         DEC     CH              ;CONVERT THE ROWS AND COLUMNS TO
  706. 9280 '         DEC     DH              ;VALUES REQUIRED BY THE
  707. 9290 '         DEC     DL              ;VIDEO-OUT INTERRUPT
  708. 9300 '         MOV     CL,0            ;START AT LEFT HAND SIDE OF SCREEN
  709. 9310 '         MOV     AX,CS           ;POINT TO A NEW STACK AREA
  710. 9320 '         CLI
  711. 9330 '         MOV     SS,AX
  712. 9340 '         MOV     SP,OFFSET STACK_TOP
  713. 9350 '         STI
  714. 9360 '         PUSH    BP              ;SAVE THE ORIGINAL STACK POINTER
  715. 9370 '         MOV     AX,601H         ;SCROLL UP LEAVING ONE LINE BLANK
  716. 9380 '         INT     10H             ;INVOKE BIOS VIDEO ROUTINES
  717. 9390 '         POP     BP              ;RETRIEVE THE ORIGINAL STACK POINTER
  718. 9400 '         CLI
  719. 9410 '         MOV     AX,DS           ;RESTORE THE ORIGINAL SS:SP
  720. 9420 '         MOV     SS,AX
  721. 9430 '         MOV     SP,BP
  722. 9440 '         STI
  723. 9450 '         POP     BP
  724. 9460 '         RET     8               ;RETURN TO BASIC
  725. 9470 ' PAGE
  726. 9480 '
  727. 9490 '         DW      50 DUP(?)
  728. 9500 ' STACK_TOP       LABEL   NEAR
  729. 9510 '
  730. 9520 ' SCROLL  ENDP
  731. 9530 '
  732. 9540 ' SUBS    ENDS
  733. 9550 '         END
  734.