home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / misc / hammisc1 / asctty.bas (.txt) next >
Encoding:
GW-BASIC  |  1985-05-09  |  5.3 KB  |  235 lines
  1. 5  'initialize
  2. 10  CLEAR: CLS: DEFINT A-Z: KEY OFF: FALSE=0: TRUE=NOT FALSE: OPTION BASE 0: DIM S$(50): XX=1: LN=0
  3. 15  FOR I=1 TO 10: KEY I ,"": NEXT
  4. 17  XX=1:LN=0
  5. 19  REM **********************************************************************
  6. 20  REM *** This is a version of the TTY program which transmits and       ***
  7. 30  REM *** receives 110 baud ascii, 7 data bits, parity always space,     ***
  8. 40  REM *** two stop bits. It is intended to be called by the tty          ***
  9. 50  REM *** program by a "chain" instruction.                              ***
  10. 60  REM *** AA4L  2/14/83                                                  ***
  11. 70  REM **********************************************************************
  12. 999  '*** main program
  13. 1020  GOTO 13000
  14. 9997  END
  15. 9998  '
  16. 11998  '
  17. 11999  REM *** open comm file for receive
  18. 12000  OPEN "COM1:110,S,7,2,RS,CS0,DS0,CD0" AS #1:WIDTH #1,255
  19. 12040  RETURN
  20. 12498  '
  21. 12499  REM *** open comm file for transmit
  22. 12500  OPEN "COM1:110,S,7,2,CS0,DS0,CD0" AS #1:WIDTH #1,255
  23. 12540  RETURN
  24. 12998  '
  25. 12999  REM *** MENU
  26. 13000  CLS
  27. 13010  PRINT "      *** Function Menu ***"
  28. 13020  PRINT
  29. 13050  PRINT "<2> Exit to BASIC.": PRINT
  30. 13060  PRINT "<3> Exit to DOS.": PRINT
  31. 13065  PRINT"<4> Switch to Murray Code": PRINT
  32. 13070  PRINT "<"+CHR$(24)+"> Receive": PRINT
  33. 13080  PRINT "<"+CHR$(25)+"> Transmit": PRINT
  34. 13085  DEF SEG=0: POKE 1050,PEEK (1052): DEF SEG
  35. 13090  BEEP: PRINT "Enter Choice: "
  36. 13100  CHOICE$=INKEY$
  37. 13105  IF CHOICE$="" THEN 13100
  38. 13106  CLS
  39. 13110  IF LEN(CHOICE$)=2 THEN IF RIGHT$(CHOICE$,1)="P" THEN 15000 ELSE IF              RIGHT$(CHOICE$,1)="H" THEN 14000 ELSE GOTO 13010
  40. 13120  IF VAL(CHOICE$)=2 OR VAL(CHOICE$)=3 THEN 13700 ELSE IF VAL(CHOICE$)=4             THEN CHAIN "tty22" ELSE 13010
  41. 13130  STOP
  42. 13498  '
  43. 13698  '
  44. 13699  REM *** Exit to BASIC
  45. 13700  PRINT : PRINT : PRINT "Off at ";DATE$;"    ";TIME$
  46. 13710  IF PRN THEN PRINT#2,: PRINT#2,"Off at ";DATE$;"     ";TIME$
  47. 13720  CLOSE
  48. 13730  IF VAL(CHOICE$)=3 THEN 13750
  49. 13740  END
  50. 13750  SYSTEM
  51. 13800  STOP
  52. 13998  '
  53. 13999  REM *** Receive Routine
  54. 14000  PRINT :PRINT :PRINT DATE$ SPC(5) TIME$
  55. 14003  Y=CSRLIN
  56. 14005  SHFT=0
  57. 14010  LOCATE 25,1: COLOR 0,7
  58. 14020  PRINT" F1=> cr & lf on/off ... F2=> printer on/off ... F10=> menu ... <"+CHR$(25)+">=> transmit ";: COLOR 7,0:LOCATE Y,1
  59. 14025  DEF SEG =0: POKE 1050, PEEK(1052): DEF SEG
  60. 14030  ON KEY(1) GOSUB 14900: KEY(1) ON
  61. 14040  ON KEY(2) GOSUB 14920: KEY(2) ON
  62. 14050  ON KEY(10) GOSUB 14940: KEY(10) ON
  63. 14060  ON KEY(14) GOSUB 14960: KEY(14) ON
  64. 14065  GOSUB 12000
  65. 14066  ON ERROR GOTO 14800
  66. 14070  IF MENU.RET OR XMT.FL THEN 14080 ELSE 14100
  67. 14080  KEY(1) OFF: KEY(2) OFF: KEY(10) OFF: KEY(14) OFF: ON ERROR GOTO 0:              CLOSE #1
  68. 14090  IF MENU.RET THEN MENU.RET = FALSE: GOTO 13000
  69. 14095  IF XMT.FL THEN XMT.FL=FALSE: GOTO 15000
  70. 14099  '
  71. 14100  IF EOF(1) THEN 14400
  72. 14110  X$=INPUT$(LOC(1),#1)
  73. 14120  FOR I=1 TO LEN(X$)
  74. 14130    AS$=MID$(X$,I,1)
  75. 14150    IF AS$=CHR$(10) THEN IF CRLF THEN PRINT CHR$(13);: IF PRN THEN PRINT#2,CHR$(13);
  76. 14160    IF AS$=CHR$(7) THEN BEEP: GOTO 14210
  77. 14190    IF ASC(AS$)<32 OR ASC(AS$)>127 THEN 14210
  78. 14200    PRINT AS$;: IF PRN THEN PRINT #2,AS$;
  79. 14210  NEXT
  80. 14220  GOTO 14070
  81. 14399  '
  82. 14400  K$=INKEY$: IF K$="" THEN 14070
  83. 14410  Y=CSRLIN: X=POS(0)
  84. 14420  S$(LN)=S$(LN)+K$
  85. 14425  IF K$=CHR$(13) THEN LN =LN+1: XX=1: GOTO 14070
  86. 14430  LOCATE 25,XX,1
  87. 14440  PRINT K$+" CSRLIN";
  88. 14450  XX=XX+1
  89. 14460  IF XX=>75 THEN S$(LN)=S$(LN)+CHR$(13): XX=1: LN=LN+1
  90. 14470  LOCATE Y,X
  91. 14480  GOTO 14070
  92. 14799  '
  93. 14800  IF ERR=25 OR ERR=27 THEN 14810 ELSE 14820
  94. 14810  PRINT: PRINT "check printer": BEEP: PRINT: RESUME
  95. 14820  IF ERR=57 THEN RESUME NEXT
  96. 14830  ON ERROR GOTO 0
  97. 14840  '
  98. 14899  '
  99. 14900  IF CRLF THEN CRLF=FALSE ELSE CRLF=TRUE
  100. 14905  RETURN
  101. 14910  '
  102. 14920  IF NOT PRN THEN OPEN "lpt1:" FOR OUTPUT AS #2: PRN=TRUE: WIDTH #2,255:          RETURN
  103. 14925  CLOSE #2: PRN=FALSE: RETURN
  104. 14930  '
  105. 14940  MENU.RET=TRUE: RETURN
  106. 14950  '
  107. 14960  XMT.FL=TRUE: RETURN
  108. 14970  '
  109. 14998  '
  110. 14999  '*** transmit
  111. 15000  PRINT: PRINT: PRINT DATE$ SPC(5) TIME$
  112. 15010  Y=CSRLIN
  113. 15030  COLOR 0,7: LOCATE 25,1
  114. 15040  PRINT" F1-F3=>Msg1-3 \ F4=>CQ \ F5=>de \ F6=>Test \ F7=>id \ F10=>Menu \ "+CHR$(24)+"=>Receive  ";
  115. 15050  COLOR 7,0: LOCATE Y,1,1
  116. 15060  GOSUB 12500
  117. 15070  DEF SEG=0: POKE 1050,PEEK(1052): DEF SEG
  118. 15080  X$=INKEY$: IF X$="" THEN 15080
  119. 15090  IF LEN(X$)>1 THEN 15200
  120. 15092  GOSUB 15100
  121. 15093  GOTO 15080
  122. 15098  '
  123. 15099  '*** this subroutine transmits an ascii character
  124. 15100  IF X$="\" THEN PRINT#1,CHR$(7);: PRINT X$;: GOTO 15160
  125. 15150  PRINT #1,X$;: PRINT X$;
  126. 15160  RETURN
  127. 15199  '
  128. 15200  Z=INSTR(";<=>?@ADHC",RIGHT$(X$,1))
  129. 15210  ON Z GOTO 16000,16100,16200,16300,16400,16500,16600,16700,16800,16900
  130. 15220  GOTO 15080
  131. 15998  '
  132. 15999  '*** routines to handle function keys
  133. 16000  FILENM$="msg1"
  134. 16010  GOSUB 17000
  135. 16020  GOTO 15080
  136. 16099  '
  137. 16100  FILENM$="msg2"
  138. 16110  GOSUB 17000
  139. 16120  GOTO 15080
  140. 16199  '
  141. 16200  FILENM$="msg3"
  142. 16210  GOSUB 17000
  143. 16220  GOTO 15080
  144. 16299  '
  145. 16300  MSG$=CHR$(13)+"cq cq cq cq cq cq cq de aa4l aa4l aa4l bob in raleigh nc"
  146. 16310  GOSUB 17500
  147. 16320  GOTO 15080
  148. 16399  '
  149. 16400  MSG$=CHR$(13)+"de aa4l aa4l bob in raleigh nc"
  150. 16410  GOSUB 17500
  151. 16420  GOTO 15080
  152. 16499  '
  153. 16500  MSG$=CHR$(13)+"the quick brown fox jumped over the lazy dog's back"+CHR$(13)+"U*U*U*U*U*U*U*U*U*U*U*U*U*U*U*U*U*U*U*U*U*U*U*U*U*U*U*U*"+CHR$(13)+"1 2 3 4 5 6 7 8 9 0 \ "
  154. 16510  GOSUB 17500
  155. 16520  GOTO 15080
  156. 16599  '
  157. 16600  MSG$=CHR$(13)+"cw id:"
  158. 16610  GOSUB 17500
  159. 16620  CLOSE #1 'close file to purge buffer
  160. 16625  GOSUB 12500 'reopen file to key transmitter
  161. 16630  GOSUB 18000
  162. 16640  GOTO 15080
  163. 16699  '
  164. 16700  CLOSE: LOCATE 25,1: PRINT SPACE$(79): GOTO 13000
  165. 16799  '
  166. 16800  CLOSE: GOTO 14000
  167. 16888  '
  168. 16889  '***transmit keybd buffer
  169. 16900  FOR II = 0 TO LN-1
  170. 16910  MSG$=S$(II)
  171. 16920  GOSUB 17500
  172. 16925  S$(II)=""
  173. 16930  NEXT II
  174. 16940  LN=0: XX=1
  175. 16950  GOTO 15080
  176. 16998  '
  177. 16999  '*** subroutine to get a message from disk and transmit it
  178. 17000  ON ERROR GOTO 17300
  179. 17010  OPEN FILENM$ FOR INPUT AS #2
  180. 17020  WHILE NOT EOF(2)
  181. 17030    LINE INPUT #2,M$
  182. 17040    MSG$=CHR$(13)+M$
  183. 17050    GOSUB 17500
  184. 17060  WEND
  185. 17070  CLOSE #2
  186. 17075  ON ERROR GOTO 0
  187. 17080  GOTO 15080
  188. 17298  '
  189. 17299  '*** disk error
  190. 17300  IF ERR=53 OR ERR=71 OR ERR=72 THEN PRINT"***Can't read file for ";FILENM$;"***";:CLOSE #3: RESUME 15080
  191. 17310  ON ERROR GOTO 0
  192. 17498  '
  193. 17499  '*** subroutine to transmit a msg
  194. 17500  FOR I=1 TO LEN(MSG$)
  195. 17510    X$=MID$(MSG$,I,1)
  196. 17520    GOSUB 15100
  197. 17530  NEXT
  198. 17540  RETURN
  199. 17998  '
  200. 17999  '*** cwid
  201. 18000  SOUND 32767,20
  202. 18010  GOSUB 18500
  203. 18020  GOSUB 18600
  204. 18030  GOSUB 18700 'A
  205. 18040  GOSUB 18500
  206. 18050  GOSUB 18600
  207. 18060  GOSUB 18700 'A
  208. 18070  GOSUB 18500
  209. 18080  GOSUB 18500
  210. 18090  GOSUB 18500
  211. 18100  GOSUB 18500
  212. 18110  GOSUB 18600
  213. 18120  GOSUB 18700 '4
  214. 18130  GOSUB 18500
  215. 18140  GOSUB 18600
  216. 18150  GOSUB 18500
  217. 18160  GOSUB 18500
  218. 18170  SOUND 32767,20  'L
  219. 18180  SOUND 32767,1
  220. 18190  RETURN
  221. 18498  '
  222. 18499  '***DIT SUBROUTINE
  223. 18500  SOUND 800,1.5: MOTOR 1
  224. 18510  SOUND 32767,1.5: MOTOR 0
  225. 18520  RETURN
  226. 18598  '
  227. 18599  '***dah subroutine
  228. 18600  SOUND 800,4.5: MOTOR 1
  229. 18610  SOUND 32767,1.5: MOTOR 0
  230. 18620  RETURN
  231. 18698  '
  232. 18699  '***inter-character space subroutine
  233. 18700  SOUND 32767,3
  234. 18710  RETURN
  235.