Code Morse pour 007

rem ' Code morse - par jjn4 - le 15/10/2019 ===================================
   dim COD$(55) , SIG$(55) : rem CODes morse et SIGnifications
   dim SEC$ : rem SÉquence Corrigée
   dim V1M% : rem Variables à utilisation Multiple
   label clic : rem Gestion de tous les on-click

rem Form0 et autres préparations ==============================================
   width 0,1025 : height 0,500 : caption 0,"   CODE MORSE"
   font_bold 0 : font_size 0,16 : font_name 0,"Arial" : font_color 0,255,0,0
   for V1M% = 1 to 26 : SIG$(V1M%)=chr$(V1M%+64) : next V1M%
   for V1M% = 27 to 35 : SIG$(V1M%)=chr$(V1M%+22) : next V1M%
   for V1M% = 1 to 18 : read SIG$(V1M%+36) : next V1M%
   SIG$(36)="0" : SIG$(52)=chr$(34) : SIG$(55)="SOS"
   for V1M% = 1 to 55 : read COD$(V1M%) : next V1M%
  
rem Construction de la façade =================================================
   alpha 100 : left 100,20 : top 100,5
      caption 100,"Écrivez votre message en clair (ex: Bonjour 007 !) :"
   memo 110 : left 110,10 : top 110,35 : width 110,988 : height 110,280
      font_size 110,14 : font_color 110,0,0,255
   button 120 : left 120,10 : top 120,325 : width 120,150 : height 120,125
      caption 120,"Quitter" : on_click 120,clic
   button 130 : left 130,170 : top 130,325 : width 130,120 : height 130,125
      caption 130,"Vider" : on_click 130,clic
   button 140 : left 140,300 : top 140,325 : width 140,300 : height 140,125
      caption 140,"Traduire en morse" : on_click 140,clic
   memo 150 : left 150,610 : top 150,325 : width 150,387 : height 150,125
      bar_vertical 150  
   set_focus 110
   midi_on
   midi_instrument 110
   midi_volume 127
  
end : ' Début des routines ====================================================

clic: : rem Gestion de tous les on-click ======================================
   select number_click
      case 120 : quit()
      case 130 : vide()
      case 140 : trad()
   end_select
return

sub corrige(qsc$) : rem Correction de la séquence par rapport aux accents ======
   rem qsc$ = Quelle Séquence à Corriger
   dim_local v1co% , v2co$ , v3co$ , v4co% , v5co$
   SEC$=""
   for v1co% = 1 to len(qsc$)
      v2co$=mid$(lower$(qsc$),v1co%,1)
      v3co$=v2co$
      v4co%=asc(v2co$)
      if v4co%>64 and v4co%<91 : v3co$=chr$(v4co%+32) : end_if
      if v4co%>191 and v4co%<198 : v3co$="a" : end_if
      if v4co%=162 or v4co%=199 or v4co%=231 : v3co$="c" : end_if
      if v4co%>199 and v4co%<204 : v3co$="e" : end_if
      if v4co%>203 and v4co%<208 : v3co$="i" : end_if
      if v4co%=209 or v4co%=241 : v3co$="n" : end_if
      if v4co%>209 and v4co%<215 : v3co$="o" : end_if
      if v4co%>216 and v4co%<221 : v3co$="u" : end_if
      if v4co%=221 or v4co%=253 or v4co%=255 : v3co$="y" : end_if
      if v4co%>223 and v4co%<230 : v3co$="a" : end_if
      if v4co%>231 and v4co%<236 : v3co$="e" : end_if
      if v4co%>235 and v4co%<240 : v3co$="i" : end_if
      if v4co%>241 and v4co%<247 : v3co$="o" : end_if
      if v4co%>248 and v4co%<253 : v3co$="u" : end_if
      if v4co%=198 or v4co%=230 : v3co$="ae" : end_if
      if v4co%=208 : v3co$="d" : end_if
      SEC$=SEC$+v3co$
   next v1co%
   SEC$=upper$(SEC$)
end_sub

rem Datas =====================================================================
   data "." , "," , "?" , "'" , "!" , "/" , "(" , ")" , "&" , ":" , ";" , "="
   data "+" , "-" , "_" , "«" , "$" , "@"
   data ".-" , "-..." , "-.-." , "-.." , "." , "..-." , "--." , "...." ,".."
   data ".---" , "-.-" , ".-.." , "--" , "-." , "---" , ".--." , "--.-" , ".-."
   data "..." , "-" , "..-" , "...-" , ".--" , "-..-" , "-.--" , "--.."
   data ".----" , "..---" , "...--" , "....-" , "....." , "-..." , "--..."
   data "---.." , "----." , "-----" , ".-.-.-" , "--..--" , "..--.." , ".----."
   data "-.-.--" , "-..-." , "-.--." , "-.--.-" , ".-..." , "---..." , "-.-.-."
   data "-...-" , ".-.-." , "-....-" , "..--.-" , ".-..-." , "...-..-" , ".--.-."
   data "...---..."
rem Fin des datas

sub quit() : rem Fin du programme =============================================
   midi_off : terminate
end_sub

sub trad() : rem Traduction en morse ==========================================
   dim_local v1tr% , v2tr% , v3tr% , v4tr$
   v4tr$=upper$(text$(110))
   corrige(v4tr$)
   if SEC$<>""
      if SEC$=SIG$(55)
         item_add 150,SEC$+" = "+COD$(55)
         for v3tr% = 1 to len(COD$(55))
            if mid$(COD$(55),v3tr%,1)="."
               midi_play 90,10
               wait 125
            else
               midi_play 90,9
               wait 125
            end_if
         next v3tr%
      else
         for v1tr% = 1 to len(SEC$)
            if mid$(SEC$,v1tr%,1)=" "
               item_add 150,""
               wait 500
            else
               for v2tr% = 1 to 54
                  if mid$(SEC$,v1tr%,1)=SIG$(v2tr%)
                     item_add 150,mid$(SEC$,v1tr%,1)+" = "+COD$(v2tr%)
                     for v3tr% = 1 to len(COD$(v2tr%))
                        if mid$(COD$(v2tr%),v3tr%,1)="."
                           midi_play 90,10
                           wait 125
                        else
                           midi_play 90,9
                           wait 125
                        end_if
                     next v3tr%
                  end_if
               next v2tr%
               wait 250
            end_if
         next v1tr%
      end_if
   end_if
end_sub

sub vide() : rem Vide le mémo =================================================
   clear 110 : clear 150 : set_focus 110
end_sub

DIM i%,j%,l%,m$(100),d,tx$,a$,c$,v$,x0,y0,x,y
LABEL Exec
DATA "-----",".----","..---","...--","....-" : ' 0 à 4
DATA ".....","-....","--...","---..","....-" : ' 5 à 9
DATA ".-","-...","-.-.","-..",".","..-.","--.": ' A à G
DATA "....","..",".---","-.-",".-..","--","-.": ' H à N
DATA "---",".--.","--.-",".-.","...","-","..-": ' O à U
DATA "...-",".--","-..-","-.--","--..": ' V à Z
FOR i% = 48 TO 57: READ  m$(i%): NEXT i%
FOR i% = 65 TO 90: READ m$(i%): NEXT i%
WIDTH 0,800: HEIGHT 0,200: BORDER_SMALL 0: FONT_BOLD 0: FONT_SIZE 0,10
COLOR 0,180,255,255
ALPHA 1: TOP 1,2: CAPTION 1,"Texte:"
EDIT 2: LEFT 2,45: WIDTH 2,300
BUTTON 3: LEFT 3,LEFT(2)+WIDTH(2): CAPTION 3,"OK": ON_CLICK 3,Exec
PICTURE 10: TOP 10,30: WIDTH 10,WIDTH_CLIENT(0): HEIGHT 10,150
2D_TARGET_IS 10: PRINT_TARGET_IS 10: FONT_SIZE 10,12
d = 5: ' diamètre du point élémentaire
2D_PEN_WIDTH d
x0 = 20: y0 = 50
END
' ==========
Exec:
x = x0: y = y0: CLS
tx$ = TEXT$(2): tx$ = UPPER$(tx$)
FOR i% = 1 TO LEN(tx$)
    v$ = MID$(tx$,i%,1): l% = ASC(v$): a$ = m$(l%)
    PRINT_LOCATE x,y-30: PRINT v$
    IF l% = 32: ' espace
        x = x+4*d
    ELSE
        FOR j% = 1 TO LEN(a$)
            c$ = MID$(a$,j%,1)
            IF c$ = "."
                2D_CIRCLE x,y,d/4: x = x+2*d: ' point
            ELSE
                2D_LINE x,y,x+2*d,y: x = x+4*d: ' trait
            END_IF
        NEXT j%
        x = x+2*d
    END_IF
NEXT i%
RETURN
' ==========