home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / w3_apps / morsewin.arj / MORSE1.BAS (.txt) < prev   
Encoding:
GW-BASIC  |  1991-06-16  |  6.1 KB  |  335 lines
  1. 1  REM          MORSE CODE SEND IN BASIC BY RAJIB MITRA FOR IBM COMPATIBLE                      COMPUTERS.  DESIGNED FOR AMATEUR RADIO OPERATORS.  PLEASE                       DO NOT SELL FOR MONEY.
  2. 2  KEY OFF : GOSUB 6000 : REM sends user to setup
  3. 3  PRINT"Morse Code Send","by Rajib K. Mitra, KB9DJE"
  4. 5  KEY 1,CS$
  5. 6  PRINT"Type letters to send, \ when done, or ' to change setup."
  6. 7  A$=INKEY$:IF P$="y"THEN PRINT A$; : REM gets key and prints it if asked
  7. 8  IF A$=" "THEN SOUND 32767,7*FARNS : REM these identify the key pressed and send you to the correct subroutine
  8. 9  IF A$="\"THEN GOTO 4000
  9. 10  IF     A$="a"THEN GOTO 300
  10. 11  IF A$= "'"THEN GOSUB 6010
  11. 20  IF     A$="b"THEN GOTO 310
  12. 30  IF     A$="c"THEN GOTO 320
  13. 40  IF     A$="d"THEN GOTO 330
  14. 50  IF     A$="e"THEN GOTO 340
  15. 55  IF A$="?"THEN GOTO 840
  16. 60  IF     A$="f"THEN GOTO 350
  17. 65  IF A$="-"THEN GOTO 850
  18. 70  IF     A$="g"THEN GOTO 360
  19. 80  IF     A$="h"THEN GOTO 370
  20. 90  IF     A$="i"THEN GOTO 380
  21. 100  IF     A$="j"THEN GOTO 390
  22. 120  IF     A$="k"THEN GOTO 400
  23. 130  IF     A$="l"THEN GOTO 410
  24. 140  IF     A$="m"THEN GOTO 420
  25. 150  IF     A$="n"THEN GOTO 430
  26. 160  IF     A$="o"THEN GOTO 440
  27. 170  IF     A$="p"THEN GOTO 450
  28. 180  IF     A$="q"THEN GOTO 460
  29. 190  IF     A$="r"THEN GOTO 470
  30. 200  IF     A$="s"THEN GOTO 480
  31. 210  IF     A$="t"THEN GOTO  490
  32. 220  IF     A$="u"THEN GOTO  500
  33. 230  IF     A$="v"THEN GOTO  510
  34. 235  IF A$=","THEN GOTO 820
  35. 240  IF     A$="w"THEN GOTO  520
  36. 250  IF     A$="x"THEN GOTO  530
  37. 255  IF A$="."THEN GOTO 830
  38. 260  IF     A$="y"THEN GOTO  540
  39. 261  IF A$="1"THEN GOTO 700
  40. 262  IF A$="2"THEN GOTO 710
  41. 263  IF A$="3"THEN GOTO 720
  42. 264  IF A$="4"THEN GOTO 730
  43. 265  IF A$="5"THEN GOTO 740
  44. 266  IF A$="6"THEN GOTO 750
  45. 267  IF A$="7"THEN GOTO 760
  46. 268  IF A$="8"THEN GOTO 770
  47. 269  IF A$="9"THEN GOTO 780
  48. 270  IF     A$="z"THEN GOTO 550
  49. 271  IF A$="0"THEN GOTO 790
  50. 272  IF A$="/"THEN GOTO 800
  51. 279  GOTO 7 : REM searches again if nothing is pressed
  52. 280  SOUND 32767,FARNS*3 : GOTO 7 : REM character pause and return to key capturing routine
  53. 290  REM the following are the subroutines for the letters indicated
  54. 300  GOSUB 1000 : REM A
  55. 301  GOSUB 2000
  56. 302  GOTO 280
  57. 310  GOSUB 2000 : REM B
  58. 311  GOSUB 1000
  59. 312  GOSUB 1000
  60. 313  GOSUB 1000
  61. 314  GOTO 280
  62. 320  GOSUB 2000 : REM C
  63. 321  GOSUB 1000
  64. 322  GOSUB 2000
  65. 323  GOSUB 1000
  66. 324  GOTO 280
  67. 330  GOSUB 2000 : REM D
  68. 331  GOSUB 1000
  69. 332  GOSUB 1000
  70. 333  GOTO 280
  71. 340  GOSUB 1000 : REM E
  72. 341  GOTO 280
  73. 350  GOSUB 1000 : REM F
  74. 351  GOSUB 1000
  75. 352  GOSUB 2000
  76. 353  GOSUB 1000
  77. 354  GOTO 280
  78. 360  GOSUB 2000 : REM G
  79. 361  GOSUB  2000
  80. 362  GOSUB 1000
  81. 363  GOTO 280
  82. 370  GOSUB 1000 : REM H
  83. 371  GOSUB 1000
  84. 372  GOSUB 1000
  85. 373  GOSUB 1000
  86. 374  GOTO 280
  87. 380  GOSUB 1000 : REM I
  88. 381  GOSUB 1000
  89. 382  GOTO 280
  90. 390  GOSUB 1000 : REM J
  91. 391  GOSUB 2000
  92. 392  GOSUB 2000
  93. 393  GOSUB 2000
  94. 394  GOTO 280
  95. 400  GOSUB 2000 : REM K
  96. 401  GOSUB 1000
  97. 402  GOSUB 2000
  98. 403  GOTO 280
  99. 410  GOSUB 1000 : REM L
  100. 411  GOSUB 2000
  101. 412  GOSUB 1000
  102. 413  GOSUB 1000
  103. 414  GOTO 280
  104. 420  GOSUB 2000 : REM M
  105. 421  GOSUB 2000
  106. 422  GOTO 280
  107. 430  GOSUB 2000 : REM N
  108. 431  GOSUB 1000
  109. 432  GOTO 280
  110. 440  GOSUB 2000 : REM O
  111. 441  GOSUB 2000
  112. 442  GOSUB 2000
  113. 443  GOTO 280
  114. 450  GOSUB 1000 : REM P
  115. 451  GOSUB 2000
  116. 452  GOSUB 2000
  117. 453  GOSUB 1000
  118. 454  GOTO 280
  119. 460  GOSUB 2000 : REM Q
  120. 461  GOSUB 2000
  121. 462  GOSUB 1000
  122. 463  GOSUB 2000
  123. 464  GOTO 280
  124. 470  GOSUB 1000 : REM R
  125. 471  GOSUB 2000
  126. 472  GOSUB 1000
  127. 473  GOTO 280
  128. 480  GOSUB 1000 : REM S
  129. 481  GOSUB 1000
  130. 482  GOSUB 1000
  131. 483  GOTO 280
  132. 490  GOSUB 2000 : REM T
  133. 491  GOTO 280
  134. 500  GOSUB 1000 : REM U
  135. 501  GOSUB 1000
  136. 502  GOSUB 2000
  137. 503  GOTO 280
  138. 510  GOSUB 1000 : REM V
  139. 511  GOSUB 1000
  140. 512  GOSUB 1000
  141. 513  GOSUB 2000
  142. 514  GOTO 280
  143. 520  GOSUB 1000 : REM W
  144. 521  GOSUB 2000
  145. 522  GOSUB 2000
  146. 523  GOTO 280
  147. 530  GOSUB 2000 : REM X
  148. 531  GOSUB 1000
  149. 532  GOSUB 1000
  150. 533  GOSUB 2000
  151. 534  GOTO 280
  152. 540  GOSUB 2000 : REM Y
  153. 541  GOSUB 1000
  154. 542  GOSUB 2000
  155. 543  GOSUB 2000
  156. 544  GOTO 280
  157. 550  GOSUB 2000 : REM Z
  158. 551  GOSUB 2000
  159. 552  GOSUB 1000
  160. 553  GOSUB 1000
  161. 554  GOTO 280
  162. 700  GOSUB 1000 : REM 1
  163. 701  GOSUB 2000
  164. 702  GOSUB 2000
  165. 703  GOSUB 2000
  166. 704  GOSUB 2000
  167. 705  GOTO 280
  168. 710  GOSUB 1000 : REM 2
  169. 711  GOSUB 1000
  170. 712  GOSUB 2000
  171. 713  GOSUB 2000
  172. 714  GOSUB 2000
  173. 715  GOTO 280
  174. 720  GOSUB 1000 : REM 3
  175. 721  GOSUB 1000
  176. 722  GOSUB 1000
  177. 723  GOSUB 2000
  178. 724  GOSUB 2000
  179. 725  GOTO 280
  180. 730  GOSUB 1000 : REM 4
  181. 731  GOSUB 1000
  182. 732  GOSUB 1000
  183. 733  GOSUB 1000
  184. 734  GOSUB 2000
  185. 735  GOTO 280
  186. 740  GOSUB 1000 : REM 5
  187. 741  GOSUB 1000
  188. 742  GOSUB 1000
  189. 743  GOSUB 1000
  190. 744  GOSUB 1000
  191. 745  GOTO 280
  192. 750  GOSUB 2000 : REM 6
  193. 751  GOSUB 1000
  194. 752  GOSUB 1000
  195. 753  GOSUB 1000
  196. 754  GOSUB 1000
  197. 755  GOTO 280
  198. 760  GOSUB 2000 : REM 7
  199. 761  GOSUB 2000
  200. 762  GOSUB 1000
  201. 763  GOSUB 1000
  202. 764  GOSUB 1000
  203. 765  GOTO 280
  204. 770  GOSUB 2000 : REM 8
  205. 771  GOSUB 2000
  206. 772  GOSUB 2000
  207. 773  GOSUB 1000
  208. 774  GOSUB 1000
  209. 775  GOTO 280
  210. 780  GOSUB 2000 : REM 9
  211. 781  GOSUB 2000
  212. 782  GOSUB 2000
  213. 783  GOSUB 2000
  214. 784  GOSUB 1000
  215. 785  GOTO 280
  216. 790  GOSUB 2000 : REM 0
  217. 791  GOSUB 2000
  218. 792  GOSUB 2000
  219. 793  GOSUB 2000
  220. 794  GOSUB 2000
  221. 795  GOTO 280
  222. 800  GOSUB 2000 : REM /
  223. 801  GOSUB 1000
  224. 802  GOSUB 1000
  225. 803  GOSUB 2000
  226. 804  GOSUB 1000
  227. 805  GOTO 280
  228. 820  GOSUB 2000 : REM ,
  229. 821  GOSUB 2000
  230. 822  GOSUB 1000
  231. 823  GOSUB 1000
  232. 824  GOSUB 2000
  233. 825  GOSUB 2000
  234. 826  GOTO 280
  235. 830  GOSUB 1000 : REM .
  236. 831  GOSUB 2000
  237. 832  GOSUB 1000
  238. 833  GOSUB 2000
  239. 834  GOSUB 1000
  240. 835  GOSUB 2000
  241. 836  GOTO 280
  242. 840  GOSUB 1000 : REM ?
  243. 841  GOSUB 1000
  244. 842  GOSUB 2000
  245. 843  GOSUB 2000
  246. 844  GOSUB 1000
  247. 845  GOSUB 1000
  248. 846  GOTO 280
  249. 850  GOSUB 2000 : REM -
  250. 851  GOSUB 1000
  251. 852  GOSUB 1000
  252. 853  GOSUB 1000
  253. 854  GOSUB 2000
  254. 855  GOTO 280
  255. 1000  SOUND    B, A
  256. 1100  SOUND 32767 , A
  257. 1200  RETURN
  258. 2000  SOUND    B, 3*A
  259. 2100  SOUND 32767 , A
  260. 2200  RETURN
  261. 4000  COLOR 14,0
  262. 4010  CLS : REM end subroutine
  263. 4020  PRINT"Thanks for using Morse Code Send by Rajib K. Mitra, KB9DJE."
  264. 4030  PRINT"This program is designed for amateur radio operators, not"
  265. 4040  PRINT"to be sold for money."
  266. 4075  SYSTEM
  267. 4100  REM            SPEED IS SLOWER IF NUMBER IS BIGGER
  268. 4101  REM            DECIMAL VALUES ARE OK
  269. 4102  REM            SPEED CAN BE LESS THAN .75 OR MORE THAN 3
  270. 4103  REM            TONE CAN BE LESS THAN 500 OR MORE THAN 2000
  271. 4104  REM            PROPER SPEED DEPENDS ON COMPUTER SPEED, etc.
  272. 6000  CLS
  273. 6002  KEY 2,"cq cq cq de "
  274. 6005  GOTO 6750 : REM sends to subroutine which searches for saved configuration
  275. 6009  REM the following asks questions for setup
  276. 6010  PRINT"THESE ARE COLORS THAT YOU CAN CHOOSE FROM:"
  277. 6020  PRINT"0 BLACK"
  278. 6030  PRINT"1 BLUE"
  279. 6035  PRINT"2 GREEN"
  280. 6040  PRINT"3 LIGHT BLUE"
  281. 6050  PRINT"4 RED"
  282. 6060  PRINT"5 PURPLE"
  283. 6070  PRINT"6 BROWN"
  284. 6080  PRINT"7 WHITE"
  285. 6090  PRINT:INPUT "WHICH FOREGROUND COLOR ";Z
  286. 6100  COLOR Z : PRINT"0 DARK"
  287. 6105  COLOR 7 : PRINT"  OR"
  288. 6110  COLOR Z+8 : PRINT"1 LIGHT"
  289. 6115  COLOR 7
  290. 6120  INPUT X
  291. 6130  IF X=1 THEN Z=Z+8
  292. 6135  COLOR Z
  293. 6140  PRINT:INPUT "WHICH BACKROUND COLOR ";C
  294. 6141  IF C=Z THEN GOTO  6200
  295. 6142  INPUT"enter send speed <.75 to 3> (not in wpm) ";A : INPUT"enter spacing speed";FARNS
  296. 6143  INPUT"enter tone <500 to 2000> (in hertz) ";B: INPUT "show letters <y-n> ";P$
  297. 6145  INPUT"please enter your callsign to be stored in F1 ";CS$
  298. 6147  INPUT "WOULD YOU LIKE TO SAVE THE INFO TO THE PRESENT DISK AND DIRECTORY ";V$
  299. 6148  GOTO 6500
  300. 6150  COLOR Z,C
  301. 6160  CLS
  302. 6165  PRINT"BE SURE YOU ARE IN LOWER CASE (caps lock light off)"
  303. 6167  KEY 1,CS$ : REM sets call to F1
  304. 6170  RETURN
  305. 6200  SOUND 2000,5
  306. 6210  PRINT"YOU DON'T WANT IT THE SAME AS FOREGROUND!!!"
  307. 6220  GOTO 6140
  308. 6500  IF V$="N"                        THEN GOTO 6150
  309. 6501  IF V$="NO"THEN GOTO 6150
  310. 6502  IF V$="n"THEN GOTO 6150
  311. 6503  IF V$="no"THEN GOTO 6150
  312. 6510  COLOR Z,C
  313. 6520  CLS : REM SUBROUTINE FOR SAVING DATA
  314. 6530  PRINT"MORSE CODE SEND DATA"
  315. 6535  PRINT:PRINT"Tone is ";B;". Speed is ";A;"and";FARNS;". Callsign is ";CS$;"."
  316. 6537  IF P$="y" THEN PRINT"Letters are being shown."
  317. 6539  IF P$="n" THEN PRINT"Letters are not being shown."
  318. 6540  INPUT"DO YOU WANT THIS CONFIGURATION ";B$
  319. 6551  IF B$="n"THEN RUN
  320. 6552  IF B$="no"THEN RUN
  321. 6560  PRINT"saving to disk now"
  322. 6570  OPEN "O",#1,"MORSE.DAT"
  323. 6580  WRITE#1,Z,C,A,B,P$,CS$,FARNS
  324. 6590  CLOSE
  325. 6600  PRINT"SAVING COMPLETED"
  326. 6610  INPUT "PRESS ENTER";L$
  327. 6620  RUN
  328. 6750  ON ERROR GOTO 6010 : REM subroutine for finding saved configuration
  329. 6760  OPEN "I",#1,"MORSE.DAT"
  330. 6770  INPUT #1, Z, C, A, B,P$, CS$, FARNS
  331. 6780  CLOSE
  332. 6790  COLOR Z,C
  333. 6800  CLS
  334. 6810  RETURN
  335.