home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1993 May / SIMTEL_0593.ISO / msdos / hamradio / morse.bas < prev    next >
BASIC Source File  |  1988-06-07  |  6KB  |  142 lines
  1. 10    ' Morse Code Practice Program. Elwood Downey, WB0OEW, August, 1983.
  2. 20    ' Written for the IBM PC in Microsoft Basica, V1.1, for PC-DOS V1.1.
  3. 30    ' This program may be freely used, traded or copied but the author's
  4. 40    ' name and this stipulation shall remain as comments and the program
  5. 50    ' shall never be sold for profit.
  6. 60    '
  7. 80    KEY OFF
  8. 90    '
  9. 100   ' select input source: either from a file, the keyboard or random.
  10. 101 PRINT:PRINT "   ALL entries are to be in LOWER case letters":PRINT
  11. 104   ' check for color or monochrome
  12. 105   INPUT "Do you have a color monitor";ZZZ$
  13. 106   IF LEFT$(ZZZ$,1)="Y" OR LEFT$(ZZZ$,1)="y" THEN COLOR 7,1
  14. 107   CLS
  15. 110   INPUT "Name of input file? (or `random' or `con:' or file name) ",F$
  16. 120   IF F$="random" THEN RANFILE=1 ELSE RANFILE=0
  17. 130   IF RANFILE=1 THEN RANDOMIZE VAL(RIGHT$(TIME$,2)): NCHRS=0: NGRPS=0
  18. 140   IF RANFILE=0 THEN OPEN F$ FOR INPUT AS #1
  19. 150   '
  20. 160   ' select speed
  21. 170   INPUT "wpm? ", WPM
  22. 180   '
  23. 190   ' initialize code strings
  24. 200   ' to add more characters, such as apostrophe, increase numcodes,
  25. 210   ' add code string and character at end of current lists and add case
  26. 220   ' to main loop, below.
  27. 230   NUMCODES = 41  ' . , / ? - plus 26 + 10
  28. 240   DIM CODES$(NUMCODES-1)
  29. 250   DIM CHARS$(NUMCODES-1)
  30. 260   FOR I=0 TO NUMCODES-1
  31. 270     READ CODES$(I)
  32. 280   NEXT
  33. 290  FOR I=0 TO NUMCODES-1
  34. 300    READ CHARS$(I)
  35. 310  NEXT
  36. 320  ' code strings. in one-to-one correspondence with characters, below.
  37. 330  DATA ".-", "-...", "-.-.", "-..", ".", "..-.", "--.", "...."
  38. 340  DATA "..", ".---", "-.-", ".-..", "--"
  39. 350  DATA "-.", "---", ".--.", "--.-", ".-.", "...", "-"
  40. 360  DATA "..-", "...-", ".--", "-..-", "-.--", "--.."
  41. 370  DATA "-----", ".----", "..---", "...--", "....-", "....."
  42. 380  DATA "-....", "--...", "---..", "----."
  43. 390  DATA ".-.-.-", "--..--", "-..-.", "..--..", "-...-"
  44. 400  ' characters.
  45. 410  DATA "A", "B", "C", "D", "E", "F", "G", "H"
  46. 420  DATA "I", "J", "K", "L", "M"
  47. 430  DATA "N", "O", "P", "Q", "R", "S", "T"
  48. 440  DATA "U", "V", "W", "X", "Y", "Z"
  49. 450  DATA "0", "1", "2", "3", "4", "5"
  50. 460  DATA "6", "7", "8", "9"
  51. 470  DATA ".", ",", "/", "?", "-"
  52. 480 '
  53. 490 ' set up arrow keys to change speed and frequency.
  54. 500 PRINT
  55. 510 PRINT CHR$(24); " "; CHR$(25); " to raise or lower tone,   ";
  56. 520 PRINT CHR$(27); " "; CHR$(26); " for slower or faster code."
  57. 530 PRINT "Ctrl-Break to quit, F9 to pause."
  58. 540 PRINT
  59. 550 ON KEY(11) GOSUB 1040: KEY(11) ON
  60. 560 ON KEY(14) GOSUB 1050: KEY(14) ON
  61. 570 ON KEY(12) GOSUB 1090: KEY(12) ON
  62. 580 ON KEY(13) GOSUB 1080: KEY(13) ON
  63. 590 ON KEY(9) GOSUB 1330: KEY(9) ON
  64. 600 '
  65. 610 ' set defaults, init screen.
  66. 620 F = 600             ' initial tone frequency
  67. 630 SIL = 32767         ' special code for no tone
  68. 640 GOSUB 1120   ' calculate dit, dah and space lengths.
  69. 650 GOSUB 1180   ' display wpm and freq
  70. 660 '
  71. 670 ' define character type checking functions
  72. 680  DEF FNLOWER(C$) = "a"<=C$ AND C$<="z"
  73. 690  DEF FNUPPER(C$) = "A"<=C$ AND C$<="Z"
  74. 700  DEF FNDIGIT(C$) = "0"<=C$ AND C$<="9"
  75. 710 '
  76. 720 ' main loop. read (or generate) each character, sound it and print it.
  77. 730  IF RANFILE THEN GOSUB 1240: GOSUB 900: PRINT CHARS$(MORSE);: GOTO 870
  78. 740  C$ = INPUT$(1,#1)
  79. 750  IF " "=C$ OR C$=CHR$(13) THEN GOSUB 990: GOTO 860
  80. 760  IF "."=C$ THEN MORSE=36: GOTO 850  ' morse <- codes$ array index
  81. 770  IF ","=C$ THEN MORSE=37: GOTO 850
  82. 780  IF "/"=C$ THEN MORSE=38: GOTO 850
  83. 790  IF "?"=C$ THEN MORSE=39: GOTO 850
  84. 800  IF "-"=C$ THEN MORSE=40: GOTO 850
  85. 810  IF FNLOWER(C$) THEN C$ = CHR$(ASC(C$)-32)
  86. 820  IF FNUPPER(C$) THEN MORSE=ASC(C$)-ASC("A"):  GOTO 850
  87. 830  IF FNDIGIT(C$) THEN MORSE=ASC(C$)-ASC("0")+26: GOTO 850
  88. 840  GOTO 870
  89. 850 GOSUB 900
  90. 860 PRINT C$;
  91. 870 GOTO 730
  92. 880 '
  93. 890 ' sound dit for each ".", dah for each "-" in string codes$(morse)
  94. 900 FOR I=1 TO LEN(CODES$(MORSE))
  95. 910   IF MID$(CODES$(MORSE),I,1) = "." THEN GOSUB 1000 ELSE GOSUB 1010
  96. 920 NEXT
  97. 930 GOSUB 980
  98. 940 RETURN
  99. 950 '
  100. 960 ' produce elemental sounds, or silences.
  101. 970  SOUND SIL,DIT: RETURN      ' element space
  102. 980 SOUND SIL,ELE*2: RETURN     ' character space, allow for previous trailing
  103. 990 SOUND SIL,ELE*6: RETURN   ' word space, allow for trailing.
  104. 1000 SOUND F,DIT: GOSUB 970: RETURN        ' dit
  105. 1010 SOUND F,DAH: GOSUB 970: RETURN        ' dah
  106. 1020 '
  107. 1030 ' change frequency of tone
  108. 1040 F = F*1.104: GOSUB 1180: RETURN
  109. 1050 F = F/1.104: GOSUB 1180: RETURN
  110. 1060 '
  111. 1070 ' change speed; update element timings.
  112. 1080 WPM = WPM+1: GOSUB 1120: GOSUB 1180: RETURN
  113. 1090 WPM = WPM-1: GOSUB 1120: GOSUB 1180: RETURN
  114. 1100 '
  115. 1110 ' calculate element timings. units are clock ticks, which are at 18.2hz.
  116. 1120 IF WPM<13 THEN CWPM=13 ELSE CWPM=WPM
  117. 1130 DIT = 21.84/CWPM: DAH = 3*DIT
  118. 1140 IF WPM>=13 THEN ELE=DIT ELSE ELE=DIT*((CWPM/WPM-1)*13+2)/2
  119. 1150 RETURN
  120. 1160 '
  121. 1170 ' display current speed and frequency. return cursor where it was.
  122. 1180 COL=POS(0): ROW=CSRLIN: LOCATE 1,60
  123. 1190 PRINT " wpm: "; WPM: LOCATE 2,60: PRINT "freq: "; F; "     "
  124. 1200 LOCATE 2,5: PRINT WPM; "   "
  125. 1210 LOCATE ROW,COL
  126. 1220 RETURN
  127. 1230 '
  128. 1240 ' set MORSE to random value from 0 up to numcodes to select random char.
  129. 1250 ' force a space character after every fifth time we are called
  130. 1260 ' and a newline before every 13 groups.
  131. 1270 IF NCHRS=5 THEN PRINT " ";: GOSUB 990: NCHRS=0: NGRPS=NGRPS+1
  132. 1280 IF NCHRS=0 AND NGRPS=13 THEN PRINT: NGRPS=0
  133. 1290 MORSE = INT(RND*NUMCODES)
  134. 1300 NCHRS=NCHRS+1: RETURN
  135. 1310 '
  136. 1320 ' handle F9, the pause control.
  137. 1330 COL9=POS(0): ROW9=CSRLIN
  138. 1340 LOCATE 24,30: COLOR 16,7: PRINT " Press any key to continue ";
  139. 1350 X$=INKEY$: IF X$="" THEN 1350
  140. 1360 LOCATE 24,30: COLOR 7,1:  PRINT "                           ";
  141. 1370 LOCATE ROW9,COL9: RETURN
  142.