XProfan

Windowtitle "Mors Mors":Windowstyle 24:cls:font 2:declare mc$,m$[],n&,words$,c$
mc$="A .- B -... C -.-. D -.. E . F .-. G --. H .... I .. J .--- K -.- L .-.. M -- "+\
"N -. O --- P .--. Q --.- R .-. S ... T - U ..- V ...- W .-- X -..- Y -.-- Z --.. "+\
"1 .---- 2 ..--- 3 ...-- 4 ....- 5 ..... 6 -.... 7 --... 8 ---.. 9 ----. 0 ----- "+\
"À .--.- Å .--.- Ä .-.- È .-..- É ..-.. Ö(OE) ---. Ü ..-- ß(SZ) ...--.. CH ---- "+\
"Ñ --.-- .(AAA) .-.-.- ,(MIM) --..-- :(OS) ---... ;(NNN) -.-.-. ?(IMI) ..--.. "+\
"- -....- _(UK) ..--.- ((KN) -.--. )(KK) -.--.- ' .----. = -...- +(AR) .-.-. "+\
"/(DN) -..-. @(AC) .--.-. KA(Spruchanfang) -.-.- BT(Pause) -...- "+\
"AR(Spruchende) .-.-. VE(verstanden) ...-. SK(Verkehrsende) ...-.- "+\
"SOS(internationalerNotruf) ...---... HH(WhlgAbLetztVollständWort) ........"
m$[]=explode(mc$," "):nochma:
usepen 0,1,0:usebrush 1,rgb(255,250,205):rectangle 0,0-width(%hwnd),height(%hwnd)\8
locate 2,2:print "Text:";:locate 2,10:input words$
usebrush 1,rgb(205,255,205):rectangle 0,height(%hwnd)\8-width(%hwnd),height(%hwnd)
clearclip:locate 10,2:whileloop len(words$):c$=upper$(Mid$(Words$,&Loop,1))

if c$<>" ":whileloop 0,sizeof(m$[])\2-1:if c$=m$[2*&Loop]

    print m$[2*&Loop+1]+" ";:putclip m$[2*&Loop+1]+" ":endif
    endwhile:else : print "    ";:endif:endwhile:goto "nochma"

WindowTitle "Morse-Hörtrainer: NumPad +/- ClipBd:Text=*  ESC=Reset"
WindowStyle 1048
Window 400,200
Font 2
Var m$=\
"A§.-#B§-...#C§-.-.#D§-..#E§.#F§..-.#G§--.#H§....#I§..#J§.---#K§-.-#L§.-..#"+\
"M§--#N§-.#O§---#P§.--.#Q§--.-#R§.-.#S§...#T§-#U§..-#V§...-#W§.--#X§-..-#"+\
"Y§-.--#Z§--..#0§-----#1§.----#2§..---#3§...--#4§....-#5§.....#6§-....#"+\
"7§--...#8§---..#9§----.#À§.--.-#ŧ.--.-#ħ.-.-#ȧ.-..-#ɧ..-..#Ö§---.#ܧ..--#"+\
"ߧ...--..#ѧ--.--#.§.-.-.-§(AAA)#,§--..--§(MIM)#:§---...§(OS)#"+\
";§-.-.-.§(NNN)#?§..--..§(IMI)#-§-....-#_§..--.-§(UK)#(§-.--.§(KN)#"+\
")§-.--.-§(KK)#'§.----.#=§-...-#+§.-.-.§(AR)Ende#/§-..-.§(DN)#@§.--.-.§(AC)#"+\
"[§-.--. -.--.#]§-.--.- -.--.-#{§---... -.--.#}§-.--.- ---...#!§.-.-.- -..-.#"+\
" §  #<§-..-. ..--.-#>§..--.- -..-.#*§.-.-.-#"+chr$(34)+"§.-..-.#$§.-.-.  .-.-."
Declare brk%,b!,a$,g$,s$,k&,j&,b$[],c$[],z$[],mc$[]
b$[]=explode(m$,"#")
Clear m$

WhileLoop 0,SizeOf(b$[])-1

    Clear c$[]
    c$[]=Explode(b$[&Loop],"§")
    z$[&Loop]=c$[0]
    Case SizeOf(c$[])>1:mc$[&Loop]=c$[1]

EndWhile

Clear c$[],b$[]
b!=0.666
rept:
locate 2,1
Print "Text = ";
Input a$

if a$="*"

    a$="°"+GetClip$()
    case len(a$)<4:a$="°"+"Das Clipboard war leer. Ersatztext: The quick brown fox jumps over the lazy dog. "

endif

a$=upper$(a$)

WhileLoop len(a$)

    g$=mid$(a$,&Loop,1)

    whileloop 0,sizeof(mc$[])-1

        j&=&Loop

        if g$=z$[j&]

            case left$(a$,1)<>"°":print mc$[j&]+" ",

            whileloop len(mc$[j&]+" §")

                select mid$(mc$[j&]+" §",&Loop,1)

                    caseof "§"

                    waitinput 100
                    continue

                    caseof " "

                    waitinput 330*b!+120
                    k&=%key

                    if k&=27:brk%=1:break:cls:endif

                        if k&=45:b!=1.1*b!:print int(2000-b!*1000),:endif

                            if k&=43:b!=b!*0.9:print int(2000-b!*1000),:endif

                                continue

                                caseof "."

                                waitinput 40*b!
                                sound 880,60*b!
                                waitinput 30
                                continue

                                caseof "-"

                                waitinput 20*b!
                                sound 880,190*b!
                                waitinput 20
                                continue

                            endselect

                        endwhile

                    endif

                    case brk%:break

                endwhile

                case brk%:break

            EndWhile

            brk%=0

            if left$(a$,1)="°":print:print right$(a$,len(a$)-1);:waitinput 7000:endif

                waitinput 2200
                cls
                Goto "rept"