home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / misc / yappprot / tty22.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1983-09-29  |  8.4 KB  |  309 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): DIM C(128): DIVMSB=&H9: DIVLSB=&HE7: DIM S$(50): XX=1: LN=0
  3. 15  FOR I=1 TO 10: KEY I ,"": NEXT
  4. 17  XX=1:LN=0
  5. 20  GOTO 1000
  6. 25  '
  7. 30  REM *** The following gotos are dummies used as pointers.
  8. 40  GOTO 10000 ' *** subroutine to write header
  9. 50  GOTO 11000 ' *** subroutine to build translate table arrays.
  10. 60  GOTO 12000 ' *** subroutine to open comm file for receive.
  11. 70  GOTO 12500 ' *** open comm file for transmit
  12. 80  GOTO 13000 ' *** menu
  13. 85  GOTO 13500 ' ***change transmission speed
  14. 86  GOTO 13700 ' *** exit routines
  15. 90  GOTO 14000 ' *** Receive
  16. 95  GOTO 14800 ' *** receive error subroutine
  17. 100  GOTO 15000 ' *** Transmit
  18. 110  GOTO 15100 '*** transmit single character subroutine
  19. 120  GOTO 16000 ' *** function key routines
  20. 130  GOTO 18000 ' *** gosubs to send callsign -- cwid
  21. 200  '
  22. 999  '*** main program
  23. 1000  GOSUB 10000
  24. 1010  GOSUB 11000
  25. 1020  GOTO 13000
  26. 9997  END
  27. 9998  '
  28. 9999  REM *** Print Header
  29. 10000  LOCATE 3,5: PRINT CHR$(201);STRING$(29,205);CHR$(187)
  30. 10005  FOR I=4 TO 17: LOCATE I,5: PRINT CHR$(186);: LOCATE I,35:                          PRINT CHR$(186);: NEXT
  31. 10010  LOCATE 18,5: PRINT CHR$(200);STRING$(29,205);CHR$(188)
  32. 10020  COLOR 10,0: LOCATE 5,12: PRINT "***Murray/TTY***";: LOCATE 7,15: PRINT " de AA4L ";: LOCATE 9,12: PRINT "**Bob Johnson**";: COLOR 7,0
  33. 10030  LOCATE 11,14: PRINT "Version 2.2";: LOCATE 13,15: PRINT "2/14/1983";:              LOCATE 15,13: PRINT "Public domain";
  34. 10040  COLOR 18,0: LOCATE 20,5: PRINT "any key";: COLOR 2,0: BEEP
  35. 10050  Y$=INKEY$: IF Y$="" THEN 10050
  36. 10060  RETURN
  37. 10998  '
  38. 10999  REM *** Build translate tables
  39. 11000  'ascii to murray table for xmt
  40. 11020  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
  41. 11030  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,133,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,0
  42. 11040  FOR I=0 TO 128:READ C(I):NEXT
  43. 11050  ' *** In the transmit table, chararacters which require the figs shift            have had hex `100' (decimal 128) added to the murray value.
  44. 11060  'murray to ascii table for rcv
  45. 11070  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,;,         ~,~
  46. 11080  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)
  47. 11090  RETURN
  48. 11998  '
  49. 11999  REM *** open comm file for receive
  50. 12000  OPEN "COM1:110,N,5,2,RS,CS0,DS0,CD0" AS #1:WIDTH #1,255
  51. 12005  V=INP(&H3F9) 'save int reg status
  52. 12006  OUT &H3F9,0 'disable comm interrupts
  53. 12010  OUT &H3FB,(INP(&H3FB) OR 128) 'enable speed change
  54. 12020  OUT &H3F8,DIVLSB: OUT &H3F9,DIVMSB 'change speed
  55. 12030  OUT &H3FB,(INP (&H3FB) AND 127) 'restore
  56. 12035  OUT &H3F9,V 'restore int reg status
  57. 12040  RETURN
  58. 12498  '
  59. 12499  REM *** open comm file for transmit
  60. 12500  OPEN "COM1:110,N,5,2,CS0,DS0,CD0" AS #1:WIDTH #1,255
  61. 12505  V=INP(&H3F9) 'save int reg status
  62. 12506  OUT &H3F9,0 'disable comm interrupts
  63. 12510  OUT &H3FB,(INP(&H3FB) OR 128) 'enable speed change
  64. 12520  OUT &H3F8,DIVLSB: OUT &H3F9,DIVMSB 'change speed
  65. 12530  OUT &H3FB,(INP (&H3FB) AND 127) 'restore
  66. 12535  OUT &H3F9,V 'restore int reg status
  67. 12540  RETURN
  68. 12998  '
  69. 12999  REM *** MENU
  70. 13000  CLS
  71. 13010  PRINT "      *** Function Menu ***"
  72. 13020  PRINT
  73. 13030  PRINT "<1> Change transmission speed."
  74. 13040  PRINT "    Note: Default is 45.45 Baud (60 wpm).": PRINT
  75. 13050  PRINT "<2> Exit to BASIC.": PRINT
  76. 13060  PRINT "<3> Exit to DOS.": PRINT
  77. 13065  PRINT "<4> Switch to 110 baud ASCII": PRINT
  78. 13070  PRINT "<"+CHR$(24)+"> Receive": PRINT
  79. 13080  PRINT "<"+CHR$(25)+"> Transmit": PRINT
  80. 13085  DEF SEG=0: POKE 1050,PEEK (1052): POKE &H417,&H40: DEF SEG
  81. 13090  BEEP: PRINT "Enter Choice: "
  82. 13100  CHOICE$=INKEY$
  83. 13105  IF CHOICE$="" THEN 13100
  84. 13106  CLS
  85. 13110  IF LEN(CHOICE$)=2 THEN IF RIGHT$(CHOICE$,1)="P" THEN 15000 ELSE IF              RIGHT$(CHOICE$,1)="H" THEN 14000 ELSE GOTO 13010
  86. 13120  IF VAL(CHOICE$)=1 THEN 13500 ELSE IF VAL(CHOICE$)=2 THEN 13700 ELSE             IF VAL(CHOICE$)=3 THEN 13700 ELSE IF VAL(CHOICE$)=4 THEN CHAIN "asctty"         ELSE 13010
  87. 13130  STOP
  88. 13498  '
  89. 13499  REM *** Speed change
  90. 13500  CLS
  91. 13505  PRINT "       ** Select Transmission Speed **": PRINT
  92. 13510  PRINT "<1> 60 wpm .... 45.45 Baud": PRINT
  93. 13520  PRINT "<2> 75 wpm .... 56.92 Baud": PRINT
  94. 13530  PRINT "<3> 100 wpm ... 74.20 Baud": PRINT
  95. 13540  BEEP: PRINT "Enter choice: "
  96. 13550  CHOICE$=INKEY$
  97. 13560  IF CHOICE$="" THEN 13550
  98. 13570  CHOICE=VAL(CHOICE$)
  99. 13580  ON CHOICE GOTO 13600,13640,13680
  100. 13590  GOTO 13550
  101. 13595  '
  102. 13600  DIVMSB=&H9: DIVLSB=&HE7: GOTO 13000
  103. 13639  '
  104. 13640  DIVMSB=&H7: DIVLSB=&HE8: GOTO 13000
  105. 13679  '
  106. 13680  DIVMSB=&H6: DIVLSB=&H11: GOTO 13000
  107. 13698  '
  108. 13699  REM *** Exit to BASIC
  109. 13700  PRINT : PRINT : PRINT "Off at ";DATE$;"    ";TIME$
  110. 13710  IF PRN THEN PRINT#2,: PRINT#2,"Off at ";DATE$;"     ";TIME$
  111. 13720  CLOSE
  112. 13730  IF VAL(CHOICE$)=3 THEN 13750
  113. 13740  END
  114. 13750  SYSTEM
  115. 13800  STOP
  116. 13998  '
  117. 13999  REM *** Receive Routine
  118. 14000  PRINT :PRINT :PRINT DATE$ SPC(5) TIME$
  119. 14003  Y=CSRLIN
  120. 14005  SHFT=0
  121. 14010  LOCATE 25,1: COLOR 0,7
  122. 14020  PRINT" F1=> cr & lf on/off ... F2=> printer on/off ... F10=> menu ... <"+CHR$(25)+">=> transmit ";: COLOR 7,0:LOCATE Y,1
  123. 14025  DEF SEG =0: POKE 1050, PEEK(1052): DEF SEG
  124. 14030  ON KEY(1) GOSUB 14900: KEY(1) ON
  125. 14040  ON KEY(2) GOSUB 14920: KEY(2) ON
  126. 14050  ON KEY(10) GOSUB 14940: KEY(10) ON
  127. 14060  ON KEY(14) GOSUB 14960: KEY(14) ON
  128. 14065  GOSUB 12000
  129. 14066  ON ERROR GOTO 14800
  130. 14070  IF MENU.RET OR XMT.FL THEN 14080 ELSE 14100
  131. 14080  KEY(1) OFF: KEY(2) OFF: KEY(10) OFF: KEY(14) OFF: ON ERROR GOTO 0:              CLOSE #1
  132. 14090  IF MENU.RET THEN MENU.RET = FALSE: GOTO 13000
  133. 14095  IF XMT.FL THEN XMT.FL=FALSE: GOTO 15000
  134. 14099  '
  135. 14100  IF EOF(1) THEN 14400
  136. 14110  X$=INPUT$(LOC(1),#1)
  137. 14120  FOR I=1 TO LEN(X$)
  138. 14130    MU$=MID$(X$,I,1): IF ASC(MU$)>31 THEN 14210
  139. 14140    AS$=A$(ASC(MU$),SHFT)
  140. 14150    IF AS$=CHR$(13) THEN 14210
  141. 14160    IF AS$=" " THEN SHFT=0: GOTO 14200
  142. 14170    IF AS$=CHR$(10) THEN SHFT=0: IF CRLF THEN AS$=CHR$(13) ELSE AS$=" ":            GOTO 14200
  143. 14180    IF AS$="f" THEN SHFT=1: GOTO 14210
  144. 14190    IF AS$="~" THEN SHFT=0: GOTO 14210
  145. 14200    PRINT AS$;: IF PRN THEN PRINT #2,AS$;
  146. 14210    NEXT
  147. 14220  GOTO 14070
  148. 14399  '
  149. 14400  K$=INKEY$: IF K$="" THEN 14070
  150. 14405  IF LEN(K$)>1 THEN 14070
  151. 14410  Y=CSRLIN: X=POS(0)
  152. 14420  S$(LN)=S$(LN)+K$
  153. 14425  IF K$=CHR$(13) THEN LN =LN+1: XX=1: GOTO 14070
  154. 14430  LOCATE 25,XX,1
  155. 14440  PRINT K$+" CSRLIN";
  156. 14450  XX=XX+1
  157. 14460  IF XX=>75 THEN S$(LN)=S$(LN)+CHR$(13): XX=1: LN=LN+1
  158. 14470  LOCATE Y,X
  159. 14480  GOTO 14070
  160. 14799  '
  161. 14800  IF ERR=25 OR ERR=27 THEN 14810 ELSE 14820
  162. 14810  PRINT: PRINT "check printer": BEEP: PRINT: RESUME
  163. 14820  IF ERR=57 THEN RESUME NEXT
  164. 14830  ON ERROR GOTO 0
  165. 14840  '
  166. 14899  '
  167. 14900  IF CRLF THEN CRLF=FALSE ELSE CRLF=TRUE
  168. 14905  RETURN
  169. 14910  '
  170. 14920  IF NOT PRN THEN OPEN "lpt1:" FOR OUTPUT AS #2: PRN=TRUE: WIDTH #2,255:          RETURN
  171. 14925  CLOSE #2: PRN=FALSE: RETURN
  172. 14930  '
  173. 14940  MENU.RET=TRUE: RETURN
  174. 14950  '
  175. 14960  XMT.FL=TRUE: RETURN
  176. 14970  '
  177. 14998  '
  178. 14999  '*** transmit
  179. 15000  PRINT: PRINT: PRINT DATE$ SPC(5) TIME$
  180. 15010  Y=CSRLIN
  181. 15020  SHIFT=FALSE
  182. 15030  COLOR 0,7: LOCATE 25,1
  183. 15040  PRINT" F1-F3=>Msg1-3 \ F4=>CQ \ F5=>de \ F6=>Test \ F7=>id \ F10=>Menu \ "+CHR$(24)+"=>Receive  ";
  184. 15050  COLOR 7,0: LOCATE Y,1,1
  185. 15060  GOSUB 12500
  186. 15070  DEF SEG=0: POKE 1050,PEEK(1052): DEF SEG
  187. 15080  X$=INKEY$: IF X$="" THEN 15080
  188. 15090  IF LEN(X$)>1 THEN 15200
  189. 15092  GOSUB 15100
  190. 15093  GOTO 15080
  191. 15098  '
  192. 15099  '*** this subroutine converts a character from ascii to murray                   and transmits it
  193. 15100  IF X$=CHR$(13) THEN PRINT X$;: PRINT #1,CHR$(2)+CHR$(8)+CHR$(31);: SHIFT=FALSE: RETURN
  194. 15110  IF X$=" " THEN PRINT X$;: PRINT #1,CHR$(4)+CHR$(31);: SHIFT=FALSE: RETURN
  195. 15120  MU=C(ASC(X$)): IF MU=0 THEN RETURN
  196. 15130  IF MU>127 THEN IF NOT SHIFT THEN SHIFT=TRUE: PRINT #1,CHR$(27);
  197. 15135  IF MU>127 THEN MU=MU-128: GOTO 15150
  198. 15140  IF SHIFT THEN SHIFT=FALSE: PRINT #1,CHR$(31);
  199. 15150  PRINT #1,CHR$(MU);: PRINT X$;
  200. 15160  RETURN
  201. 15199  '
  202. 15200  Z=INSTR(";<=>?@ADHC",RIGHT$(X$,1))
  203. 15210  ON Z GOTO 16000,16100,16200,16300,16400,16500,16600,16700,16800,16900
  204. 15220  GOTO 15080
  205. 15998  '
  206. 15999  '*** routines to handle function keys
  207. 16000  FILENM$="msg1"
  208. 16010  GOSUB 17000
  209. 16020  GOTO 15080
  210. 16099  '
  211. 16100  FILENM$="msg2"
  212. 16110  GOSUB 17000
  213. 16120  GOTO 15080
  214. 16199  '
  215. 16200  FILENM$="msg3"
  216. 16210  GOSUB 17000
  217. 16220  GOTO 15080
  218. 16299  '
  219. 16300  MSG$=CHR$(13)+"cq cq cq cq cq cq cq de aa4l aa4l aa4l bob in raleigh nc"
  220. 16310  GOSUB 17500
  221. 16320  GOTO 15080
  222. 16399  '
  223. 16400  MSG$=CHR$(13)+"de aa4l aa4l bob in raleigh nc"
  224. 16410  GOSUB 17500
  225. 16420  GOTO 15080
  226. 16499  '
  227. 16500  MSG$=CHR$(13)+"the quick brown fox jumped over the lazy dog's back"+CHR$(13)+"ryryryryryryryryryryryryryryryryryryryryryryryryryryryry"+CHR$(13)+"1m2m3m4m5m6m7m8m9m0"
  228. 16510  GOSUB 17500
  229. 16520  GOTO 15080
  230. 16599  '
  231. 16600  MSG$=CHR$(13)+"cw id:"
  232. 16610  GOSUB 17500
  233. 16620  CLOSE #1 'close file to purge buffer
  234. 16625  GOSUB 12500 'reopen file to key transmitter
  235. 16630  GOSUB 18000
  236. 16640  GOTO 15080
  237. 16699  '
  238. 16700  CLOSE#1: LOCATE 25,1: PRINT SPACE$(79): GOTO 13000
  239. 16799  '
  240. 16800  CLOSE#1: GOTO 14000
  241. 16888  '
  242. 16889  '***transmit keybd buffer
  243. 16900  FOR II = 0 TO LN-1
  244. 16910  MSG$=S$(II)
  245. 16920  GOSUB 17500
  246. 16925  S$(II)=""
  247. 16930  NEXT II
  248. 16940  LN=0: XX=1
  249. 16950  GOTO 15080
  250. 16998  '
  251. 16999  '*** subroutine to get a message from disk and transmit it
  252. 17000  ON ERROR GOTO 17300
  253. 17010  OPEN FILENM$ FOR INPUT AS #3
  254. 17020  WHILE NOT EOF(3)
  255. 17030    LINE INPUT #3,M$
  256. 17040    MSG$=CHR$(13)+M$
  257. 17050    GOSUB 17500
  258. 17060  WEND
  259. 17070  CLOSE #3
  260. 17075  ON ERROR GOTO 0
  261. 17080  GOTO 15080
  262. 17298  '
  263. 17299  '*** disk error
  264. 17300  IF ERR=53 OR ERR=71 OR ERR=72 THEN PRINT"***Can't read file for ";FILENM$;"***";:CLOSE #3: RESUME 15080
  265. 17310  ON ERROR GOTO 0
  266. 17498  '
  267. 17499  '*** subroutine to transmit a msg
  268. 17500  FOR I=1 TO LEN(MSG$)
  269. 17510    X$=MID$(MSG$,I,1)
  270. 17520    GOSUB 15100
  271. 17530  NEXT
  272. 17540  RETURN
  273. 17998  '
  274. 17999  '*** cwid
  275. 18000  SOUND 32767,20
  276. 18010  GOSUB 18500
  277. 18020  GOSUB 18600
  278. 18030  GOSUB 18700 'A
  279. 18040  GOSUB 18500
  280. 18050  GOSUB 18600
  281. 18060  GOSUB 18700 'A
  282. 18070  GOSUB 18500
  283. 18080  GOSUB 18500
  284. 18090  GOSUB 18500
  285. 18100  GOSUB 18500
  286. 18110  GOSUB 18600
  287. 18120  GOSUB 18700 '4
  288. 18130  GOSUB 18500
  289. 18140  GOSUB 18600
  290. 18150  GOSUB 18500
  291. 18160  GOSUB 18500
  292. 18170  SOUND 32767,20  'L
  293. 18180  SOUND 32767,1
  294. 18190  RETURN
  295. 18498  '
  296. 18499  '***DIT SUBROUTINE
  297. 18500  SOUND 800,1.5: MOTOR 1
  298. 18510  SOUND 32767,1.5: MOTOR 0
  299. 18520  RETURN
  300. 18598  '
  301. 18599  '***dah subroutine
  302. 18600  SOUND 800,4.5: MOTOR 1
  303. 18610  SOUND 32767,1.5: MOTOR 0
  304. 18620  RETURN
  305. 18698  '
  306. 18699  '***inter-character space subroutine
  307. 18700  SOUND 32767,3
  308. 18710  RETURN
  309.