Morse code: Difference between revisions
Content added Content deleted
(Added solution for Action!) |
|||
| Line 288: | Line 288: | ||
IN NEXT word_coded = |{ word_coded } { _morse_code }| ) ) ) ) |
IN NEXT word_coded = |{ word_coded } { _morse_code }| ) ) ) ) |
||
)->display( ).</lang> |
)->display( ).</lang> |
||
=={{header|Action!}}== |
|||
<lang Action!>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</lang> |
|||
{{out}} |
|||
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Morse_code.png Screenshot from Atari 8-bit computer] |
|||
<pre> |
|||
SOS |
|||
... --- ... |
|||
Atari Action! |
|||
.- - .- .-. .. .- -.-. - .. --- -. -.-.-- |
|||
www.rosettacode.org |
|||
.-- .-- .-- .-.-.- .-. --- ... . - - .- -.-. --- -.. . .-.-.- --- .-. --. |
|||
</pre> |
|||
=={{header|Ada}}== |
=={{header|Ada}}== |
||