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