25 Years of Programming
An open source source for C, C++, OWL, BASIC, MDB, XLS, DOT, and more...

Home Projects Up Sitemap Search Blog Forum+Chat About Us Privacy Terms of Use Feedback FAQ Images Services Payments Humor Music

Language translation
by Google is available
when JavaScript enabled.
Google Translate
is an alternative.

Encode a string into Morse code, Microsoft MBASIC

This odd program takes a string and encodes it into:

Morse code
Binary Morse code where a dot = 1 and a dash = 0
"Decimal coded binary Morse code". I don't remember what that means.

I think this was written while trying to solve a puzzle in a early 1980's puzzle book called something like "The Puzzle Mountain". It offered a large cash prize to the first person to solve the book's main puzzle, but solving it required solving all the other puzzles first.

The program is written in Microsoft MBASIC, which was used by the Heathkit H-89 computer.

ENCODE.BAS

1 REM ENCODE.BAS - ENCODES A GIVEN STRING INTO SEVERAL DIFFERENT MORSE-RELATED CODES.
5 'COPYRIGHT (C)1984 STEVEN WHITNEY.    
6 'Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
7 'Initially published by http://25yearsofprogramming.com.
10 PRINT "THIS PROGRAM CODES A WORD OR PHRASE INTO MORSE CODE"
15 PRINT "TURN ON CAPS LOCK. INPUT MUST BE UPPER CASE."
20 INPUT "WHAT IS THE WORD OR PHRASE";A1$
30 DEFSTR A,B,T
35 'COULD CONVERT TO UPPER CASE HERE, BUT I DON'T REMEMBER WHAT FUNCTIONS WERE AVAILABLE IN MBASIC.
40 FOR I=1 TO LEN(A1$)
50 A=MID$(A1$,I,1)
60 PRINT A
70 GOSUB 1280
80 T=T+B
90 IF I<>LEN(A1$) THEN T=T+"S"
100 NEXT I
104 PRINT
105 PRINT, "IN PLAIN MORSE"
106 PRINT
110 PRINT T
119 PRINT
120 PRINT, "IN BINARY MORSE -- DOT=1, DASH = 0  "
125 PRINT
130 FOR I=1 TO LEN(T)
140 IF MID$(T,I,1)="." THEN T1=T1+"1"
150 IF MID$(T,I,1)="-" THEN T1=T1+"0"
160 IF MID$(T,I,1)="S" THEN T1=T1+" "
170 NEXT I
180 PRINT T1
185 PRINT
190 PRINT, "IN DECIMAL CODED BINARY MORSE"
200 PRINT
205 DEFSTR N : DIM N(100),M(100)
206 J=0
210 FOR I=1 TO LEN(T1)
220 IF MID$(T1,I,1)=" " THEN J=J+1 ELSE N(J)=N(J)+MID$(T1,I,1)
230 NEXT I
240 FOR K=0 TO J
250 FOR L=1 TO LEN(N(K))
260 M(K)=M(K)+VAL(MID$(N(K),L,1))*(2^(LEN(N(K))-L))
270 NEXT L
280 NEXT K
290 FOR K=0 TO J
300 PRINT M(K);
310 NEXT K
320 END
1000 IF A=".-" THEN B="A":RETURN
1010 IF A="-..." THEN B="B":RETURN
1020 IF A="-.-." THEN B="C":RETURN
1030 IF A="-.." THEN B="D":RETURN
1040 IF A="." THEN B="E":RETURN
1050 IF A="..-." THEN B="F":RETURN
1060 IF A="--." THEN B="G":RETURN
1070 IF A="...." THEN B="H":RETURN
1080 IF A=".." THEN B="I":RETURN
1090 IF A=".---" THEN B="J":RETURN
1100 IF A="-.-" THEN B="K":RETURN
1110 IF A=".-.." THEN B="L":RETURN
1120 IF A="--" THEN B="M":RETURN
1130 IF A="-." THEN B="N":RETURN
1140 IF A="---" THEN B="O":RETURN
1150 IF A=".--." THEN B="P":RETURN
1160 IF A="--.-" THEN B="Q":RETURN
1170 IF A=".-." THEN B="R":RETURN
1180 IF A="..." THEN B="S":RETURN
1190 IF A="-" THEN B="T":RETURN
1200 IF A="..-"THEN B="U":RETURN
1210 IF A="...-"THEN B="V":RETURN
1220 IF A=".--" THEN B="W":RETURN
1230 IF A="-..-"THEN B="X":RETURN
1240 IF A="-.--" THEN B="Y":RETURN
1250 IF A="--.." THEN B="Z":RETURN
1260 B=" ":RETURN
1270 REM ABOVE LINE IS FOR WHEN UNDEFINED STRING SENT TO SUBROUTINE.
1280 IF A="A" THEN B=".-":RETURN
1290 IF A="B" THEN B="-...":RETURN
1300 IF A="C" THEN B="-.-.":RETURN
1310 IF A="D" THEN B="-..":RETURN
1320 IF A="E" THEN B=".":RETURN
1330 IF A="F" THEN B="..-.":RETURN
1340 IF A="G" THEN B="--.":RETURN
1350 IF A="H" THEN B="....":RETURN
1360 IF A="I" THEN B="..":RETURN
1370 IF A="J" THEN B=".---":RETURN
1380 IF A="K" THEN B="-.-":RETURN
1390 IF A="L" THEN B=".-..":RETURN
1400 IF A="M" THEN B="--":RETURN
1410 IF A="N" THEN B="-.":RETURN
1420 IF A="O" THEN B="---":RETURN
1430 IF A="P" THEN B=".--.":RETURN
1440 IF A="Q" THEN B="--.-":RETURN
1450 IF A="R" THEN B=".-.":RETURN
1460 IF A="S" THEN B="...":RETURN
1470 IF A="T" THEN B="-":RETURN
1480 IF A="U" THEN B="..-":RETURN
1490 IF A="V" THEN B="...-":RETURN
1500 IF A="W" THEN B=".--":RETURN
1510 IF A="X" THEN B="-..-":RETURN
1520 IF A="Y" THEN B="-.--":RETURN
1530 IF A="Z" THEN B="--..":RETURN
1540 B="":RETURN