edit: a dot is 1 sound unit and dash is 3 sound units and prosign eg <AA> has no delay between chars.
Code: Select all
#dot = 1
#dash = 2
Structure morse
code.u
count.u
EndStructure
Global Dim amorse.morse(128)
For a = 0 To 128
amorse.morse(a)\code = $ffff
Next
amorse('<')\code = 0
amorse('>')\code = 0
Procedure Addcode(symbol,a,b=0,c=0,d=0,e=0,f=0,g=0)
amorse(symbol)\code = a-1
If b
amorse(symbol)\code << 1 | (b-1)
amorse(symbol)\count=1
EndIf
If c
amorse(symbol)\code << 1 | (c-1)
amorse(symbol)\count=2
EndIf
If d
amorse(symbol)\code << 1 | (d-1)
amorse(symbol)\count=3
EndIf
If e
amorse(symbol)\code << 1 | (e-1)
amorse(symbol)\count=4
EndIf
If f
amorse(symbol)\code << 1 | (f-1)
amorse(symbol)\count=5
EndIf
If g
amorse(symbol)\code << 1 | (g-1)
amorse(symbol)\count=6
EndIf
EndProcedure
Addcode('A',#dot,#dash)
Addcode('B',#dash,#dot,#dot,#dot)
Addcode('C',#dash,#dot,#dash,#dot)
Addcode('D',#dash,#dot,#dot)
Addcode('E',#dot)
Addcode('F',#dot,#dot,#dash,#dot)
Addcode('G',#dash,#dash,#dot)
Addcode('H',#dot,#dot,#dot,#dot)
Addcode('I',#dot,#dot)
Addcode('J',#dot,#dash,#dash,#dash)
Addcode('K',#dash,#dot,#dash)
Addcode('L',#dot,#dash,#dot,#dot)
Addcode('M',#dash,#dash)
Addcode('N',#dash,#dot)
Addcode('O',#dash,#dash,#dash)
Addcode('P',#dot,#dash,#dash,#dot)
Addcode('Q',#dash,#dash,#dot,#dash)
Addcode('R',#dot,#dash,#dot)
Addcode('S',#dot,#dot,#dot)
Addcode('T',#dash)
Addcode('U',#dot,#dot,#dash)
Addcode('V',#dot,#dot,#dot,#dash)
Addcode('W',#dot,#dash,#dash)
Addcode('X',#dash,#dot,#dot,#dash)
Addcode('Y',#dash,#dot,#dash,#dash)
Addcode('Z',#dash,#dash,#dot,#dot)
Addcode('0',#dash,#dash,#dash,#dash,#dash)
Addcode('1',#dot,#dash,#dash,#dash,#dash)
Addcode('2',#dot,#dot,#dash,#dash,#dash)
Addcode('3',#dot,#dot,#dot,#dash,#dash)
Addcode('4',#dot,#dot,#dot,#dot,#dash)
Addcode('5',#dot,#dot,#dot,#dot,#dot)
Addcode('6',#dash,#dot,#dot,#dot,#dot)
Addcode('7',#dash,#dash,#dot,#dot,#dot)
Addcode('8',#dash,#dash,#dash,#dot,#dot)
Addcode('9',#dash,#dash,#dash,#dash,#dot)
Addcode('&',#dot,#dash,#dot,#dot,#dot)
Addcode(39, #dot,#dash,#dash,#dash,#dash,#dot)
Addcode('@',#dot,#dash,#dash,#dot,#dash,#dot)
Addcode(')',#dash,#dot,#dash,#dash,#dot,#dash)
Addcode('(',#dash,#dot,#dash,#dash,#dot)
Addcode(':',#dash,#dash,#dash,#dot,#dot,#dot)
Addcode(',',#dash,#dash,#dot,#dot,#dash,#dash)
Addcode('=',#dash,#dot,#dot,#dot,#dash)
Addcode('!',#dash,#dot,#dash,#dot,#dash,#dash)
Addcode('.',#dot,#dash,#dot,#dash,#dot,#dash)
Addcode('-',#dash,#dot,#dot,#dot,#dot,#dash)
Addcode('*',#dash,#dot,#dot,#dash)
Addcode('+',#dot,#dash,#dot,#dash,#dot)
Addcode(34,#dot,#dash,#dot,#dot,#dash,#dot)
Addcode('?',#dot,#dot,#dash,#dash,#dot,#dot)
Addcode('/',#dash,#dot,#dot,#dash,#dot)
Procedure playcode(msg.s,speed)
Protected *char.Unicode =@Msg
Protected ct,v,out.s,bdelay=1
While *char\u <> 0
If amorse(*char\u)\code <> $ffff
If *char\u = '<' ;if Prosign no delay between chars
bdelay = 0
*char+2
Continue
ElseIf *char\u = '>'
bdelay = 1
*char+2
Continue
EndIf
ct = amorse(*char\u)\count
For a = 0 To amorse(*char\u)\count
v = ((amorse(*char\u)\code >> ct) & 1) + 1
ct-1
If v = 1
out+"."
Else
out + "-"
v=3
EndIf
Beep_(550,v*speed)
Delay(speed)
Next
Debug Chr(*char\u) + " " + out
out = ""
If bdelay
Delay(speed*3)
EndIf
Else
If *char\u = 32
Debug " "
Delay(speed*7)
EndIf
EndIf
*char+2
Wend
EndProcedure
playcode(UCase("Testing morse in purebasic 123 <AA> <SOS> <HH> <0/0> !"),50)
