home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / misc / yappprot / rtty.bas < prev    next >
BASIC Source File  |  1984-09-14  |  8KB  |  161 lines
  1. 5 'initialize
  2. 10 CLEAR:CLS:DEFINT A-Z:KEY OFF:FALSE=0:TRUE=NOT FALSE:OPTION BASE 0:DIM A$(31,1)
  3. 15 DIM C(128)
  4. 20 FOR I=1 TO 10:KEY I,"":NEXT
  5. 25 'set key interrupts
  6. 30 KEY(1) ON:KEY (2) ON:ON KEY(1) GOSUB 10000:ON KEY(2) GOSUB 11000
  7. 40 KEY(10) ON:ON KEY(10) GOSUB 12000
  8. 50 GOSUB 13000
  9. 55 'header
  10. 60 LOCATE 3,5:PRINT CHR$(201);STRING$(29,205);CHR$(187)
  11. 70 FOR I=4 TO 17:LOCATE I,5:PRINT CHR$(186);:LOCATE I,35:PRINT CHR$(186);:NEXT
  12. 80 LOCATE 18,5:PRINT CHR$(200);STRING$(29,205);CHR$(188)
  13. 90 COLOR 10,0:LOCATE 5,12:PRINT "***Murray/TTY***";:LOCATE 7,15:PRINT " de AA4L ";:LOCATE 9,12: PRINT "**Bob Johnson**";:COLOR 7,0
  14. 100 LOCATE 11,14:PRINT "Version 1.0";:LOCATE 13,15:PRINT "10/2/1982";:LOCATE 15,13:PRINT "Public domain";
  15. 110 COLOR 18,0:LOCATE 20,5:PRINT "any key";:COLOR 2,0:BEEP
  16. 120 Y$=INKEY$: IF Y$="" THEN 120
  17. 125 'array to restore soft keys
  18. 130 DATA "LIST ", RUN, LOAD", SAVE",CONT,LPT1,TRON,TROFF,"KEY ",SCREEN
  19. 140 FOR I=1 TO 10:READ KY$:IF I=2 OR I=5 OR I=7 OR I=8 THEN KY$=KY$+CHR$(13)
  20. 145 B$(I)=KY$:NEXT:B$(6)=","+CHR$(34)+B$(6)
  21. 147 'ascii to murray table for xmt
  22. 150 DATA 0,0,0,0,0,0,0,133,0,0,2,0,0,8,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,141,145,148,137,0,154,139,143,146,0,0,140,131,156,157,150,151,147,129,138,144,149,135,134,152,142,158,0,0,0,153,0
  23. 151 DATA 3,25,14,9,1,13,26,20,6,11,15,18,28,12,24,22,23,10,5,16,7,30,19,29,21,17,0,0,0,0,0,0,3,25,14,9,1,13,26,20,6,11,15,18,28,12,24,22,23,10,5,16,7,30,19,29,21,17,0,0,0,0,0,9
  24. 152 FOR I=0 TO 128:READ C(I):NEXT
  25. 155 'murray to ascii table for rcv
  26. 160 DATA "","",E,3,"","",A,-," "," ",S,"",I,8,U,7,"","",D,$,R,4,J,',N,",",F,!,C,":",K,(,T,5,Z,"",L,),W,2,H,#,Y,6,P,0,Q,1,O,9,B,?,G,&,f,f,M,.,X,/,V,;,~,~
  27. 170 FOR I= 0 TO 31:FOR J=0 TO 1:READ A$(I,J):NEXT:NEXT:A$(5,1)=CHR$(7):A$(17,1)=CHR$(34):A$(2,0)=CHR$(10):A$(2,1)=CHR$(10):A$(8,0)=CHR$(13):A$(8,1)=CHR$(13)
  28. 175 'menu
  29. 180 CLS:GOSUB 13000:LOCATE 1,4:PRINT STRING$(3,15);" MENU ";STRING$(3,15):PRINT
  30. 190 PRINT "1 }} Go to receive mode":PRINT:PRINT "2 }} Go to transmit mode":PRINT:PRINT "8 }} Exit to basic":PRINT :PRINT"9 }} Exit to DOS":PRINT
  31. 200 BEEP:COLOR 23,0:PRINT "Enter your choice":COLOR 7,0
  32. 205 CHOICE$=INKEY$:IF CHOICE$="" THEN 205 ELSE CHOICE=VAL(CHOICE$)
  33. 210 IF CHOICE <1 OR CHOICE >9 THEN GOTO 200
  34. 220 ON CHOICE GOTO 230,900,200,200,200,200,200,9000,9500
  35. 225 'start recv routine
  36. 230 SHFT=0: CLS:GOSUB 13000:LOCATE 1,1:PRINT "Date:  ";DATE$;"  Time:  ";TIME$: IF PRN THEN LPRINT "Date:  ";DATE$;"  Time:  ";TIME$
  37. 235 ON ERROR GOTO 15000
  38. 237 KEY(1)ON:KEY(2) ON
  39. 240 OPEN "COM1:110,N,5,2,RS,CS0,DS0,CD0" AS #1:WIDTH #1,255
  40. 245 OUT &H3FB,(INP(&H3FB) OR 128) 'enable speed change
  41. 250 OUT &H3F8,&HE7: OUT &H3F9,&H9 'change speed
  42. 260 OUT &H3FB,(INP (&H3FB) AND 127) 'restore
  43. 263 IF MENU.RET THEN CLOSE: MENU.RET=FALSE:IF NOT PRN THEN GOTO 180 ELSE LPRINT:GOTO 180
  44. 265 IF EOF(1) THEN GOTO 263
  45. 270 CH$= INPUT$(LOC(1),#1)
  46. 280 FOR I= 1 TO LEN(CH$)
  47. 285 CHM$=MID$(CH$,I,1)
  48. 286 IF ASC(CHM$)>31 OR ASC(CHM$)<1 THEN 400
  49. 300 CHA$= A$(ASC(CHM$),SHFT)
  50. 310 IF CHA$="f" THEN SHFT=1:GOTO 400
  51. 320 IF CHA$="~" THEN SHFT =0: GOTO 400
  52. 325 IF CRLF THEN IF CHA$=CHR$(13) THEN LOCATE CSRLIN,1:GOTO 400
  53. 326 IF CRLF THEN IF CHA$=CHR$(10) THEN GOTO 340
  54. 330 IF CHA$=" " OR CHA$=CHR$(13) OR CHA$=CHR$(10) THEN SHFT=0: CHA$=" "
  55. 340 PRINT CHA$;
  56. 350 IF PRN THEN LPRINT CHA$;
  57. 400 NEXT I
  58. 410 GOTO 263
  59. 898 STOP
  60. 899 'transmit routine
  61. 900 SHFT=0:OPEN "com1:110,n,5,2,cs0,ds0,cd0" AS #1:WIDTH #1,255
  62. 910 OUT &H3FB,(INP(&H3FB)OR 128)
  63. 920 OUT &H3F8,&HE7:OUT &H3F9,&H9
  64. 930 OUT &H3FB,(INP(&H3FB) AND 127)
  65. 940 CLS:GOSUB 13000:LOCATE 1,4: PRINT"Date:  ";DATE$;"  Time:  ";TIME$
  66. 950 GOTO 16000
  67. 1000 IF MENU.RET THEN CLOSE: MENU.RET =FALSE: GOTO 180
  68. 1001 FOR M=3 TO 7:KEY(M)ON:NEXT M
  69. 1010 CHK$=INKEY$:IF CHK$="" THEN GOTO 1000
  70. 1011 FOR M=3 TO 7:KEY(M)STOP:NEXT M
  71. 1020 IF LEN(CHK$)>1 THEN GOTO 1000
  72. 1030 CHX=C(ASC(CHK$))
  73. 1040 IF CHX=0 THEN GOTO 1000
  74. 1050 IF CHX AND 128 THEN CHX=CHX AND 31:IF SHFT GOTO 1100 ELSE GOSUB 2000:GOTO 1100 ' is a figs needed?
  75. 1060 IF CHX=4 THEN GOSUB 2500:GOTO 1100 ' ltrs on space
  76. 1065 IF CHX=8 THEN PRINT #1,CHR$(8);:PRINT#1,CHR$(2);:PRINT#1,CHR$(31);:SHFT=0:PRINT CHK$;:GOTO 1000
  77. 1070 IF SHFT THEN GOSUB 2500:GOTO 1100 ' shift set but not wanted so snd ltrs
  78. 1100 PRINT#1,CHR$(CHX);:PRINT CHK$;:GOTO 1000
  79. 1998 STOP
  80. 1999 REM  routine to insert figs
  81. 2000 PRINT#1,CHR$(27);:SHFT=1:RETURN
  82. 2498 STOP
  83. 2499 REM routine to insrt ltrs
  84. 2500 PRINT #1,CHR$(31);:SHFT=0:RETURN
  85. 2501 STOP
  86. 8999 STOP
  87. 9000 GOSUB 14000 ' return to basic
  88. 9010 END
  89. 9500 GOSUB 14000 ' return to dos
  90. 9510 SYSTEM
  91. 9998 STOP
  92. 9999 ' soft key 1
  93. 10000 CRLF=NOT CRLF:RETURN
  94. 10999 ' soft key 2   lprint to clear prtr bfr
  95. 11000 PRN=NOT PRN:IF NOT PRN THEN LPRINT
  96. 11010 RETURN
  97. 11999 ' soft key 10   set condx to return to menu
  98. 12000 MENU.RET = TRUE
  99. 12010 RETURN
  100. 12999 ' set soft key display
  101. 13000 Z$=STRING$(5,1):COLOR 0,7
  102. 13010 LOCATE 25,1:PRINT Z$;" F1 => cr/lf on/off ";Z$;" F2 => printer on/off ";Z$;" F10 => menu ";Z$;:COLOR 2,0
  103. 13020 RETURN
  104. 13999 ' prepare to exit  & restore soft keys
  105. 14000 CLOSE:CLS:PRINT"Off at:  "DATE$;"   ";TIME$;" (local)"
  106. 14010 IF PRN THEN LPRINT "Off at:  "DATE$;"   ";TIME$;" (local)"
  107. 14020 FOR I=1 TO 10:KEY I,B$(I):NEXT:KEY ON:ON ERROR GOTO 0
  108. 14050 RETURN
  109. 14999 ' disregard timeout and framing errors on recv
  110. 15000 IF ERR=57 THEN RESUME ELSE ON ERROR GOTO 0
  111. 15001 ' note : comm error characters are tagged with bit 8 on ** see line 286
  112. 15999 ' set transmit soft keys
  113. 16000 KEY(1)OFF:KEY(2)OFF
  114. 16010 LOCATE 25,1:COLOR 0,7:PRINT "       3=> CQ    4=> DE    5=> cwid    6=> Brag    7=> Test    10=> Menu       ";:COLOR 7,0:LOCATE 2,1
  115. 16020 ON KEY(3)GOSUB 17000:ON KEY(4)GOSUB 18000:ON KEY(5)GOSUB 19000:ON KEY(6)GOSUB 20000:ON KEY(7)GOSUB 21000
  116. 16030 FOR I=3 TO 7:KEY(I)STOP:NEXT:GOTO 1000
  117. 16040 STOP
  118. 17000 MSG$="cq cq cq cq cq cq cq cq cq cq de aa4l aa4l aa4l bob in raleigh nc"+CHR$(13):RETURN 22000
  119. 18000 MSG$="de aa4l aa4l bob in raleigh nc k k k"+CHR$(13):RETURN 22000
  120. 18999 STOP'***cwid***
  121. 19000 FOR I=3 TO 7:KEY(I)STOP:NEXT
  122. 19010 CLOSE #1:OPEN "com1:110,n,5,2,cs0,ds0,cd0" AS #1:WIDTH #1,255
  123. 19020 OUT &H3FB,(INP(&H3FB)OR 128)
  124. 19030 OUT &H3F8,&HE7:OUT &H3F9,&H9
  125. 19040 OUT &H3FB,(INP(&H3FB) AND 127)'***close file & reopen to purge output bfr before transmitting cwid***
  126. 19050 IC=INP(&H3FB):IZ=IC OR &H40
  127. 19055 FOR I=1 TO 1000:NEXT
  128. 19060 GOSUB 19500:GOSUB 19600:GOSUB 19700
  129. 19065 GOSUB 19500:GOSUB 19600:GOSUB 19700
  130. 19070 GOSUB 19500:GOSUB 19500:GOSUB 19500:GOSUB 19500:GOSUB 19600:GOSUB 19700
  131. 19080 GOSUB 19500: GOSUB 19600:GOSUB 19500:GOSUB 19500:GOSUB 19700
  132. 19090 PRINT"****ID SENT****";:FOR I=1 TO 1000:NEXT:MSG$=CHR$(13):RETURN 22005
  133. 19499 STOP'***dit***
  134. 19500 OUT &H3FB,IZ:FOR I=1 TO 120:NEXT:OUT &H3FB,IC:FOR I=1 TO 120:NEXT:RETURN
  135. 19599 STOP'***dah***
  136. 19600 OUT &H3FB,IZ:FOR I=1 TO 360:NEXT:OUT &H3FB,IC:FOR I=1 TO 120:NEXT:RETURN
  137. 19699 STOP'***space***
  138. 19700 FOR I= 1 TO 360:NEXT:RETURN
  139. 20000 LNGMSG=TRUE
  140. 20010 MSG1$=CHR$(13)+"bob johnson aa4l"+CHR$(13)+"11305 rums hill....raleigh nc....27614"+CHR$(13)+"ex w4cqj....ex k2eoc....member qcwa chapter 118"+CHR$(13)+"life member arrl....member rars....member wbcci arc"+CHR$(13)
  141. 20020 MSG2$="employed by ibm corp as senior engineer"+CHR$(13)+"rtty station:"+CHR$(13)+"128k ibm personal computer....ft101e....sb221....homebrew tu"+CHR$(13)+"vertical on 20 & inv vee on 40 & 80....end"+CHR$(13)
  142. 20030 RETURN 22000
  143. 21000 MSG$=CHR$(13)+"the quick brown fox jumped over the lazy dog's back"+CHR$(13)+"1m2m3m4m5m6m7m8m9m0m"+CHR$(13)+"ryryryryryryryryryryryryryryryryryryryryryryryryry"+CHR$(13)
  144. 21010 RETURN 22000
  145. 22000 FOR N=3 TO 7:KEY(N)STOP:NEXT N
  146. 22003 IF LNGMSG THEN MSG$=MSG1$
  147. 22005 FOR K=1 TO LEN(MSG$)
  148. 22010 CHX$=MID$(MSG$,K,1)
  149. 22020 CHX=C(ASC(CHX$))
  150. 22030 IF CHX=0 GOTO 22100
  151. 22040 IF CHX AND 128 THEN CHX=CHX AND 31:IF SHFT GOTO 22080 ELSE GOSUB 22500:GOTO 22080
  152. 22050 IF CHX=4 THEN GOSUB 22700:GOTO 22080
  153. 22060 IF CHX=8 THEN PRINT#1,CHR$(8);CHR$(2);CHR$(31);:SHFT=0:PRINT CHX$;:GOTO 22100
  154. 22070 IF SHFT THEN GOSUB 22700
  155. 22080 PRINT#1,CHR$(CHX);:PRINT CHX$;
  156. 22100 NEXT K
  157. 22101 IF LNGMSG THEN MSG$=MSG2$:LNGMSG=FALSE:GOTO 22005
  158. 22110 GOTO 1000
  159. 22500 PRINT#1,CHR$(27);:SHFT=1:RETURN
  160. 22700 PRINT#1,CHR$(31);:SHFT=0:RETURN
  161.