home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1
/
HamRadio.cdr
/
misc
/
hamscan
/
re-morse.bas
< prev
next >
Wrap
BASIC Source File
|
1987-02-01
|
6KB
|
164 lines
10 'MORSE.BAS modified somewhat
20 'displays have been changed
30 'time delay after characters and words has been optimized for 20wpm
40 'you might want to adjust these values for low speed
50 'code speed is approximate, see comment below
60 'if you don't like the title page code, comment out the 3 lines after
70 ' ... send title page in morse ...
80 '
90 '-------------------------------------------------------------
100 'Variable-speed Morse code
110 'generator programmed by Dick Conklin
120 '
130 WIDTH 80:KEY OFF:KEY 1,"":KEY 3,"":KEY 4,""
140 DEF SEG:POKE 106,0:CLS:S=1!:F=1000
150 KEY 2,"CQ CQ de N4AT "
160 '
170 'send title page in morse
180 S=.8:F=950:LOCATE 5,31:MSG$="Morse Code Generator":GOSUB 540
190 S=1.5:F=850:LOCATE 10,26:MSG$="Written by Dick Conklin, N4AT":GOSUB 540
200 S=1!:F=900:LOCATE 15,29:MSG$="Variable Speed and Pitch":GOSUB 540
210 '
220 'main menu
230 CLS:LOCATE 5,10:PRINT "Select Code Speed:"
240 LOCATE 8,15:PRINT "Enter speed in words per minute."
250 LOCATE 10,15:PRINT "Speed can be 1 to 98 wpm."
260 LOCATE 12,15:PRINT "Default speed is 20 wpm ( no number entered )."
270 LOCATE 14,15:PRINT "For SLOW ( Novice ) speed, enter 5"
280 LOCATE 16,15:PRINT "For FAST speed, enter 40"
290 LOCATE 18,15:PRINT "Enter 99 to stop this program."
300 LOCATE 21,10:PRINT "ENTER desired code speed --> "
310 LOCATE 21,40:INPUT "",W:IF W=0 THEN W=20
320 IF W=99 THEN END
330 'this calculation sets actual code speed
340 S=18/W 'original was S=21/W
350 '
360 'file options
370 CLS:LOCATE 1,1
380 PRINT "You can enter the text to be coded from the keyboard or from a file."
390 LOCATE 3,1:INPUT "Do you want to create a new file? [ Y/N ] --> ";Q$
400 IF (Q$="y") OR (Q$="Y") THEN GOSUB 1550
410 '
420 LOCATE 4,1
430 INPUT "Do you want to generate code from an existing file? [ Y/N ] --> ";Q$:
440 IF (Q$="y") OR (Q$="Y") THEN GOSUB 1450:GOTO 230
450 '
460 'screen display of code entered from keyboard
470 CLS:LOCATE 25,10
480 PRINT "F1 = End keyboard input F3 = Lower tone F4 = Higher tone";
490 LOCATE 1,1:PRINT "Text typed below sent at ";W;" WPM:":LOCATE 3,1,1
500 'keyboard input
510 I$=INKEY$:IF I$="" THEN 510
520 GOSUB 620
530 GOTO 510
540 '
550 'this subroutine sends characters to the code generator
560 FOR I=1 TO LEN(MSG$)
570 I$=MID$(MSG$,I,1):GOSUB 600
580 NEXT I
590 RETURN
600 '
610 'this subroutine generates code for each character
620 C$=CHR$(ASC(I$) OR 32)
630 IF C$="a" THEN B$=".-":GOTO 1250
640 IF C$="b" THEN B$="-...":GOTO 1250
650 IF C$="c" THEN B$="-.-.":GOTO 1250
660 IF C$="d" THEN B$="-..":GOTO 1250
670 IF C$="e" THEN B$=".":GOTO 1250
680 IF C$="f" THEN B$="..-.":GOTO 1250
690 IF C$="g" THEN B$="--.":GOTO 1250
700 IF C$="h" THEN B$="....":GOTO 1250
710 IF C$="i" THEN B$="..":GOTO 1250
720 IF C$="j" THEN B$=".---":GOTO 1250
730 IF C$="k" THEN B$="-.-":GOTO 1250
740 IF C$="l" THEN B$=".-..":GOTO 1250
750 IF C$="m" THEN B$="--":GOTO 1250
760 IF C$="n" THEN B$="-.":GOTO 1250
770 IF C$="o" THEN B$="---":GOTO 1250
780 IF C$="p" THEN B$=".--.":GOTO 1250
790 IF C$="q" THEN B$="--.-":GOTO 1250
800 IF C$="r" THEN B$=".-.":GOTO 1250
810 IF C$="s" THEN B$="...":GOTO 1250
820 IF C$="t" THEN B$="-":GOTO 1250
830 IF C$="u" THEN B$="..-":GOTO 1250
840 IF C$="v" THEN B$="...-":GOTO 1250
850 IF C$="w" THEN B$=".--":GOTO 1250
860 IF C$="x" THEN B$="-..-":GOTO 1250
870 IF C$="y" THEN B$="-.--":GOTO 1250
880 IF C$="z" THEN B$="--..":GOTO 1250
890 IF C$="1" THEN B$=".----":GOTO 1250
900 IF C$="2" THEN B$="..---":GOTO 1250
910 IF C$="3" THEN B$="...--":GOTO 1250
920 IF C$="4" THEN B$="....-":GOTO 1250
930 IF C$="5" THEN B$=".....":GOTO 1250
940 IF C$="6" THEN B$="-....":GOTO 1250
950 IF C$="7" THEN B$="--...":GOTO 1250
960 IF C$="8" THEN B$="---..":GOTO 1250
970 IF C$="9" THEN B$="----.":GOTO 1250
980 IF C$="0" THEN B$="-----":GOTO 1250
990 IF C$="." THEN B$=".-.-.-":GOTO 1250
1000 IF C$="?" THEN B$="..--..":GOTO 1250
1010 IF C$="," THEN B$="--..--":GOTO 1250
1020 IF C$="-" THEN B$="-...-":GOTO 1250
1030 IF C$="/" THEN B$="-..-.":GOTO 1250
1040 IF I$=" " THEN B$=" ":GOTO 1250
1050 FK=MID$(I$,1,1)=CHR$(0)
1060 F1=MID$(I$,2,1)=CHR$(59)
1070 F3=MID$(I$,2,1)=CHR$(61)
1080 F4=MID$(I$,2,1)=CHR$(62)
1090 '
1100 IF FK AND F3 THEN F=F-10
1110 IF FK AND F4 THEN F=F+10
1120 IF FK AND F1 THEN 230
1130 '
1140 IF I$=CHR$(8) THEN B$="........"
1150 LOCATE ,POS(0)-1:PRINT " ";
1160 LOCATE ,POS(0)-1:C$=""
1170 GOTO 1250
1180 '
1190 IF I$=":" THEN B$="---...":GOTO 1250
1200 IF I$=";" THEN B$="-.-.-.":GOTO 1250
1210 IF I$="(" OR C$=")" THEN B$="-.--.-":GOTO 1250
1220 IF I$="+" OR I$="&" THEN B$=". ...":GOTO 1250
1230 C$="" :B$="":I$=""
1240 '
1250 PRINT I$; 'Display while sending
1260 '
1270 'convert code string to morse
1280 FOR C=1 TO LEN(B$)
1290 'dit length = 1 * S
1300 IF MID$(B$,C,1)="." THEN SOUND F,S ELSE GOTO 1330
1310 GOTO 1380
1320 'dah length = 3 * S
1330 IF MID$(B$,C,1)="-" THEN SOUND F,S*3 ELSE GOTO 1360
1340 GOTO 1380
1350 'blank space ( between words ) pause = 2 * S
1360 SOUND 32767,S*2 'original was S*1
1370 'pause after dit, dah, or blank = 1 * S
1380 SOUND 32767,S
1390 'get next dot or dash
1400 NEXT C
1410 'done with this character, pause after character = 2 * S
1420 SOUND 32767,S*2 'original was S*1.5
1430 RETURN 'Get the next letter
1440 '
1450 'Convert text file into code
1460 ON ERROR GOTO 1480:LOCATE 10,1
1470 PRINT "Current files: ";:FILES "*. ":PRINT
1480 INPUT "Enter file name: ",CODEFILE$
1490 OPEN CODEFILE$+". " FOR INPUT AS #1
1500 CLS:LOCATE 25,1:PRINT "Reading from file ";CODEFILE$
1510 LOCATE 1,1:PRINT "Text typed below sent at ";W;" WPM":LOCATE 3,1
1520 IF EOF(1) THEN CLOSE:CLS:RETURN
1530 INPUT #1,MSG$:GOSUB 540:PRINT:GOTO 1520
1540 '
1550 'Enter and store text
1560 ON ERROR GOTO 1580:LOCATE 10,1
1570 PRINT "Current files: ";:FILES "*. ":PRINT
1580 INPUT "Enter file name: ",CODEFILE$:OPEN CODEFILE$+". " FOR OUTPUT AS #1
1590 CLS:LOCATE 25,1:PRINT "Push ENTER twice to close file."
1600 LOCATE 1,1:PRINT "Enter text to be stored in file:"
1610 LINE INPUT TEXT$
1620 IF TEXT$="" THEN CLOSE:CLS:RETURN
1630 PRINT #1,CHR$(34);TEXT$;" ";CHR$(34):GOTO 1610