'===========================================================================
' Subject: MORSE CODE                        Date: 10-26-97 (20:22)       
' Author:  William Deer                      Code: QB, QBasic, PDS        
' Origin:  ag312350@student.uq.edu.au      Packet: ALGOR.ABC
'===========================================================================
DECLARE SUB Dot ()
DECLARE SUB GAP ()
DECLARE SUB Dash ()
DECLARE SUB WordSpace ()
DECLARE SUB CharacterSpace ()
DECLARE SUB Playchar (Key$)
DECLARE SUB UpdateMessages (Roman$, Morse$)
DECLARE SUB Box (X!, Y!, XX!, YY!, Fore!, Back%)
DECLARE SUB Option1 (Bracket%, Number!, Back%, Value!)
' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' MORSE.BAS     by William DEER c/o Ag312350@student.uq.oz.au           ³ 
' 26/10/97                              version 1.00                    ³
'                                                                       ³
'
' Mouse.Bas was designed to help me understant morse code. This program
' reads from a text file, or displays a built in message, and plays the
' Morse code through the internal PC speaker. This program was designed
' to be a 'learning' aid for people interested in Morse Code. This
' version uses INTERNATIONAL MORSE, Not American Morse.
'
'  For those of you who are unfamiliar with Morse Code, here
' is a brief explanation;
'
' Morse Code is the arbitrary set of signals used on the Telegraph.
' It may also be used with a flash lamp for Signalling.
' The International (or continental) Morse Code is a simplified
' form generally used in radio telegraphy.
'
' The unit of the code is the DOT, representing a very brief depression
' of the telegraphy key.  The DASH represents a depression lasting
' three times as long as a dot. Between the depressions there is a pause
' equal in time to one dot, except in a few letters and signs, when there
' is a wait of two dots. The pause between letters in a word lasts as
' long as one dash, between words it lasts as long as two dashes.
'   (Source of information = New Illustrated Columbia Encylopedia.)

SCREEN 0: KEY OFF: WIDTH 80, 25   ' Setup Screen for 80 * 25 Mode 0
CLS                               ' Clear Screen

' Init Variables                
DEFINT A-E                       ' These are used for loops and so forth
CONST MaxMorseNo = 38            ' Number of characters in Morse data set
FileIn = 0                       ' Flag for text file input
DIM SHARED Frequency AS SINGLE:  Frequency = 1050       ' Pitch of beeps
DIM SHARED UnitLength AS SINGLE: UnitLength = 2.4       ' Speed of morse code.
        ' I guess I should mention that I have used the standard DOT as the
        ' minimum time element. Using the sound statement, there are 18.2
        ' dots per second, therefore the larger the Unitlength number, the
        ' slower the morse speed. I have found 2.4 is easy to follow.
DIM SHARED MorseKeyLen AS INTEGER ' Length of the morse code for a particular character
DIM MorseList AS STRING           ' Single string containing each character
DIM SHARED MorseString AS STRING  ' This is the morse string on screen
DIM SHARED RomanString AS STRING  ' The roman equiv. on screen
DIM SHARED Morse(2, MaxMorseNo) AS STRING ' Define Morse Code storage space
                                          ' Morse(1,*) = Character(A.Z,etc)
                                          ' Morse(2,*) = Morse Code
MorseList = ""          ' Set to 0 length to verify emptiness

FOR A = 1 TO MaxMorseNo           ' For each character in the morse code set
 FOR B = 1 TO 2                   ' For both Roman and morse characters
  READ Morse(B, A)                ' Read in Data from below.
 NEXT B
 MorseList = MorseList + Morse(1, A) ' Update morsecode list with morse char.
NEXT A

' Screen Setup
 GOSUB MenuOptions                ' Updates the screen

A$ = "Welcome to Morse.BAS I hope you find it usefull." ' Welcoming message
Restart:
IF FileIn = 0 THEN                ' Blank the message list if not text file
RomanString = STRING$(80, " ")
MorseString = STRING$(80, " ")
END IF
OldMessage$ = A$                ' Keep a copy of the old list so repeat is able
MainLoop:
FOR A = 1 TO LEN(A$)            ' For every character in the message
 KeyBoard$ = INKEY$: IF KeyBoard$ <> "" THEN GOSUB KeyBoardHit

 Char$ = UCASE$(MID$(A$, A, 1)) ' Get specific character from message
 ' Now to Check that the Character, CHAR$ is a valid morse letter
 ' If it is not a valid character, e.g. "!","@",etc,
 ' then it will be ommitted.
 InstVal = INSTR(MorseList, Char$)
 IF InstVal <> 0 THEN
        ' Character is a valid one.
        MorseKey$ = Morse(2, InstVal)   ' Morse equivalent of Char$
        CALL UpdateMessages(Char$, MorseKey$) ' Update list for screen
        COLOR 15, 0: LOCATE 7, 20: PRINT RomanString; : ' Update screen
        COLOR 10, 0: LOCATE 8, 20: PRINT MorseString;
        CALL Playchar(MorseKey$)        'Produce morse code for character
        CALL CharacterSpace             'Silent space between characters
        CALL UpdateMessages(" ", " ")   ' Put a space on screen as well
                                ELSE
        ' Character is invalid, therefore use a space.
        CALL WordSpace                  ' Assume character is a space
        CALL UpdateMessages(" ", " ³ ") ' Put space and seperating line on screen
 END IF
NEXT A
 ' Message is now finished. Program will zero message or jump back to text file.
 IF FileIn = 1 THEN RETURN
A$ = "  "               ' Zero message
GOTO MainLoop           ' Display zeroed message until keyboard is hit

KeyBoardHit:
        SELECT CASE KeyBoard$
         CASE "1"       'Input a message
          COLOR 7, 0: LOCATE 10, 4: INPUT "Message"; A$
          LOCATE 10, 2: PRINT STRING$(77, " ");
          GOTO Restart
          
         CASE "2"       'Load a text file
          LOCATE 10, 4: INPUT "FileName of Text file"; FileName$
          FileIn = 1
          GOSUB TxtIn
          FileIn = 0
        
         CASE "3"       'Play an internal message
          LOCATE 16, 50: PRINT "There are 6 internal messages";
          LOCATE 17, 50: INPUT "Which one do you want"; MessageNumber
          LOCATE 16, 50: PRINT "                            "
          LOCATE 17, 50: PRINT "                            "
          ON MessageNumber GOSUB M1, M2, M3, M4, M5, M6
          GOTO Restart

         CASE "4"       'Pause/Continue Playback
          LOCATE 10, 30: COLOR 31, 0: PRINT "Hit any key to continue";
          WHILE INKEY$ = ""
           ' We wait
          WEND
          LOCATE 10, 30: PRINT "                         ";
         
         CASE "5"       'Exit Program
          GOSUB Closing
          RESET: END
        
         CASE "6"       'Replay existing message
          A$ = OldMessage$
          GOTO MainLoop
        
         CASE "7"       'Change speed
          LOCATE 16, 50: PRINT "Current speed = "; UnitLength
          LOCATE 17, 50: INPUT "New Speed = "; UnitLength
          LOCATE 16, 50: PRINT "                            "
          LOCATE 17, 50: PRINT "                            "
        
         CASE "8"       'Change pitch
          LOCATE 16, 50: PRINT "Current pitch = "; Frequency
          LOCATE 17, 50: INPUT "New Speed = "; Frequency
          LOCATE 16, 50: PRINT "                            "
          LOCATE 17, 50: PRINT "                            "
        END SELECT
 GOSUB MenuOptions
RETURN

MenuOptions:
CLS
CALL Box(1, 1, 79, 24, 7, 0)
CALL Box(30, 2, 50, 4, 7, 0)
COLOR 15, 0: LOCATE 3, 31: PRINT "MORSE.BAS : Trainer";
LOCATE 12, 5: CALL Option1(10, 15, 0, 1): COLOR 7, 0: PRINT "Input a message"
LOCATE 14, 5: CALL Option1(10, 15, 0, 2): COLOR 7, 0: PRINT "Load a text file "
LOCATE 16, 5: CALL Option1(10, 15, 0, 3): COLOR 7, 0: PRINT "Play an internal message"
LOCATE 18, 5: CALL Option1(10, 15, 0, 4): COLOR 7, 0: PRINT "Pause/Continue Playback"
LOCATE 20, 5: CALL Option1(10, 15, 0, 5): COLOR 7, 0: PRINT "Exit Program"
LOCATE 22, 5: CALL Option1(10, 15, 0, 6): COLOR 7, 0: PRINT "Replay existing message"
LOCATE 12, 40: CALL Option1(10, 15, 0, 7): COLOR 7, 0: PRINT "Change speed ("; UnitLength; ")";
LOCATE 14, 40: CALL Option1(10, 15, 0, 8): COLOR 7, 0: PRINT "Change pitch ("; Frequency; " Hz)";
RETURN

M1:     ' Message 1
A$ = "This is message 1. It is short and easy to follow. goodbye."
RETURN
M2:     ' Message 2
A$ = "This program was brought to you through the magical electrical ether by a crazed loon from Australia."
A$ = A$ + " He spent his entire Sunday trying to get his drug addled mind to think up nice things to do and"
A$ = A$ + " barely succeeded."
RETURN
M3:     ' Message 3
A$ = "This is recon group Sigma Alpha Delta, awaiting instructions for extraction. Our primary LUP is too hot"
A$ = A$ + " and request an immediate extract. Grid coordinates 462391 rep 462391 LUZ three. Authorization "
A$ = A$ + " Sigma Tango Unicorn Party Icon Delta. SAD over and out. "
RETURN
M4:     ' Message 4
A$ = "Hmmm it is really hard to think up witty and clean comments to leave on this program. I'm sure some of "
A$ = A$ + "you will play SOS through the computer and then patch into shipping channels. HA HA HA HA HA HA. Eat"
A$ = A$ + " your heart out Exon Valdez. Empowerment to the anarchists."
RETURN
M5:     ' Message 5
A$ = "I just want to say that the previous statement was typed in without the benefit of my daily medication."
A$ = A$ + "Im all right now, really I am. Look Out, shooter on the grassy knoll. I am not an animal. Bleep Bleep,"
A$ = A$ + " im coming to get you Pacman. Reedip reedip, Im a little spot of light on the wall. Oh no, darkness falls"
A$ = A$ + " across the land, the midnight hour is close at hand. Creatures roam in search of blood, and terrorize your"
A$ = A$ + " neighbourhood. thoust whoever shall be found without the soul for getting down, shall find themselves way"
A$ = A$ + " down in hell, and rot inside a corpsed shell."

RETURN
M6:     ' Message 6
A$ = "Around the world,Around the world,Around the world,Around the world,Around the world."
A$ = A$ + " written by some daft punk. HA HA Were you expecting the lyrics to barbie girl."
RETURN

TxtIn:  ' This part inputs a text file, and runs it through
OPEN FileName$ FOR INPUT AS #1
 WHILE NOT EOF(1)
   A$ = INPUT$(1, #1)
   GOSUB Restart
 WEND
CLOSE 1
RETURN


Closing:
CLS
CALL Box(1, 1, 79, 9, 7, 0)
LOCATE 3, 13: PRINT "Well, I hope that this program was somehow usefull to you."
LOCATE 4, 13: PRINT "Any suggestions or queries can be made to the E-mail address"
LOCATE 5, 13: PRINT "here   Ag312350@student.uq.oz.au  "
LOCATE 6, 13: PRINT "Thanks for taking the time to use this program."
LOCATE 7, 40: PRINT "W.DEER"


' INTERNATIONAL MORSE CODE
DATA "A","._"
DATA "B","_..."
DATA "C","_._."
DATA "D","_.."
DATA "E","."
DATA "F",".._."
DATA "G","__."
DATA "H","...."
DATA "I",".."
DATA "J",".___"
DATA "K","_._"
DATA "L","._.."
DATA "M","__"
DATA "N","_."
DATA "O","___"
DATA "P",".__."
DATA "Q","__._"
DATA "R","._."
DATA "S","..."
DATA "T","_"
DATA "U",".._"
DATA "V","..._"
DATA "W",".__"
DATA "X","_.._"
DATA "Y","_.__"
DATA "Z","__.."
DATA "1",".____"
DATA "2","..___"
DATA "3","...__"
DATA "4","...._"
DATA "5","....."
DATA "6","_...."
DATA "7","__..."
DATA "8","___.."
DATA "9","____."
DATA "0","_____"
DATA ".","._._._"
DATA ",","__..__"

SUB Box (X, Y, XX, YY, Fore, Back)
 ' This subrountine draws a simple box of size (x,y)-(xx,yy) and coloured
 ' fore,back.
A = XX - X:                            B = YY - Y
Top$ = "Õ" + STRING$(A - 1, "Í") + "¸"
Bot$ = "Ô" + STRING$(A - 1, "Í") + "¾"
COLOR Fore, Back
FOR c = Y TO YY
 LOCATE c, X: PRINT "³"; :              LOCATE c, XX: PRINT "³";
NEXT c
LOCATE Y, X: PRINT Top$; :              LOCATE YY, X: PRINT Bot$;
END SUB

SUB CharacterSpace
 SOUND 0, 3 * UnitLength
 ' The Space between words is 1 Dash in length
END SUB

SUB Dash
 SOUND Frequency, 3 * UnitLength
 ' Duration of Dash is three times that of the dot
END SUB

SUB Dot
 SOUND Frequency, UnitLength
 ' Duration of the dot is one unit length
END SUB

SUB GAP
 SOUND 0, UnitLength
 ' Duration of gap between dots and dashes within a word is
 ' 1 dot
END SUB

SUB Option1 (Bracket, Number, Back, Value)
 COLOR Bracket, Back
  PRINT "<<";
 COLOR Number, Back
  PRINT INT(Value);
 COLOR Bracket, Back
  PRINT ">> ";
END SUB

SUB Playchar (Key$)
 KeyLen = LEN(Key$)
 FOR A = 1 TO KeyLen            ' For every piece of the key
  Piece$ = MID$(Key$, A, 1)     ' Get the piece
  '  Now the piece$ can only be "_" or "."
  SELECT CASE Piece$
        CASE ".": CALL Dot               ' Dot
        CASE "_": CALL Dash              ' Dash
  END SELECT
  IF A <> KeyLen THEN CALL GAP
        ' Letter has not ended, therefore a GAP must be inserted
 NEXT A
END SUB

SUB UpdateMessages (Roman$, Morse$)
 KeyLen = LEN(Morse$)
 MorseString = RIGHT$(MorseString + Morse$, 40)
 RomanString = RIGHT$(RomanString + Roman$ + STRING$(KeyLen - 1, " "), 40)
END SUB

SUB WordSpace
 SOUND 0, 6 * UnitLength
 ' The Space between words is 2 Dashes in length
END SUB