RosettaCodeData/Task/Morse-code/Action-/morse-code.action

125 lines
2.5 KiB
Plaintext

DEFINE PTR="CARD"
DEFINE COUNT="$60"
PTR ARRAY code(COUNT)
BYTE
PALNTSC=$D014,
dotDuration,dashDuration,
intraGapDuration,letterGapDuration,wordGapDuration
PROC Init()
Zero(code,COUNT)
code('!)="-.-.--" code('")=".-..-."
code('$)="...-..-" code('&)=".-..."
code('')=".----." code('()="-.--.-"
code('))="---.." code('+)=".-.-."
code(',)="--..--" code('-)="-....-"
code('.)=".-.-.-" code('/)="-..-."
code('0)="-----" code('1)=".----"
code('2)="..---" code('3)="...--"
code('4)="....-" code('5)="....."
code('6)="-...." code('7)="--..."
code('8)="---.." code('9)="----."
code(':)="---..." code(';)="-.-.-."
code('=)="-...-" code('?)="..--.."
code('@)=".--.-." code('A)=".-"
code('B)="-..." code('C)="-.-."
code('D)="-.." code('E)="."
code('F)="..-." code('G)="--."
code('H)="...." code('I)=".."
code('J)=".---" code('K)="-.-"
code('L)=".-.." code('M)="--"
code('N)="-." code('O)="---"
code('P)=".--." code('Q)="--.-"
code('R)=".-." code('S)="..."
code('T)="-" code('U)="..-"
code('V)="...-" code('W)=".--"
code('X)="-..-" code('Y)="-.--"
code('Z)="--.." code('\)=".-..-."
code('_)="..--.-"
IF PALNTSC=15 THEN
dotDuration=6
ELSE
dotDuration=5
FI
dashDuration=2*dotDuration
intraGapDuration=dotDuration
letterGapDuration=3*intraGapDuration
wordGapDuration=7*intraGapDuration
RETURN
PROC Wait(BYTE frames)
BYTE RTCLOK=$14
frames==+RTCLOK
WHILE frames#RTCLOK DO OD
RETURN
PROC ProcessSound(CHAR ARRAY s BYTE last)
BYTE i
FOR i=1 TO s(0)
DO
Sound(0,30,10,10)
IF s(i)='. THEN
Wait(dotDuration)
ELSE
Wait(dashDuration)
FI
Sound(0,0,0,0)
IF i<s(0) THEN
Wait(intraGapDuration)
FI
OD
RETURN
PROC Process(CHAR ARRAY a)
CHAR ARRAY seq,subs
BYTE i,first,afterSpace
CHAR c
PrintE(a)
first=1
afterSpace=0
FOR i=1 TO a(0)
DO
c=a(i)
IF c>='a AND c<='z THEN
c=c-'a+'A
ELSEIF c>=COUNT THEN
c=0
FI
seq=code(c)
IF seq#0 THEN
IF first=1 THEN
first=0
ELSE
Put(' )
IF afterSpace=0 THEN
Wait(letterGapDuration)
FI
FI
subs=code(c)
Print(subs)
ProcessSound(subs)
afterSpace=0
ELSEIF c=' THEN
Print(" ")
Wait(wordGapDuration)
afterSpace=1
ELSE
afterSpace=0
FI
OD
PutE() PutE()
Wait(wordGapDuration)
RETURN
PROC Main()
Init()
Process("SOS")
Process("Atari Action!")
Process("www.rosettacode.org")
RETURN