Encoder une chaine en Morse

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137

;@link http://j-reaux.developpez.com/tutoriel/asp/alphabet-radio-code-morse/index.php
EnableExplicit
;{ Alphabet Morse
  ;- Structures
  Structure S_Morse
    car_normal.s
    car_morse.s
  EndStructure
  ;- Constantes
  #Dim_Morse_Size = 55
  #Morse_Separateur = "|"
  ;-Tableaux
  Global Dim Dim_Morse.S_Morse(#Dim_Morse_Size+1)
  ;- Datasections
  DataSection
    Char_Normal:
    Data.s "0","1","2","3","4","5","6","7","8","9"
    Data.s "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"
    Data.s " ",".",",","?","'","!","/","(",")","&",":",";","=","+","-","_",Chr(34),"$","@","EUR"
    Char_Morse:
    Data.s "----",".----","..---","...--","....-","....","-....","--...","---..", "----."
    Data.s ".-","-...","-.-.","-..",".","..-..","--.","....","..",".---","-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-","..-","...-",".--","-..-","-.--","--.."
    Data.s "|",".-.-.-","--..--","..--..",".----.","-.-.-----.","-..-.","-.--.","-.--.-",".-...","---...","-.-.-.","-...-",".-.-.","-....-","..--.-",".-..-.","...-..-",".--.-.","...-.-.---"
  EndDataSection
  ;-Fonctions
  Procedure.s RemoveAccent(sString.s)
    sString = ReplaceString(sString, "Á", "A")
    sString = ReplaceString(sString, "Â", "A")
    sString = ReplaceString(sString, "Ã", "A")
    sString = ReplaceString(sString, "Ä", "A")
    sString = ReplaceString(sString, "Å", "A")
    sString = ReplaceString(sString, "Ç", "C")
    sString = ReplaceString(sString, "È", "E")
    sString = ReplaceString(sString, "É", "E")
    sString = ReplaceString(sString, "Ê", "E")
    sString = ReplaceString(sString, "Ë", "E")
    sString = ReplaceString(sString, "Ì", "I")
    sString = ReplaceString(sString, "Í", "I")
    sString = ReplaceString(sString, "Î", "I")
    sString = ReplaceString(sString, "Ï", "I")
    sString = ReplaceString(sString, "Ò", "O")
    sString = ReplaceString(sString, "Ó", "O")
    sString = ReplaceString(sString, "Ô", "O")
    sString = ReplaceString(sString, "Õ", "O")
    sString = ReplaceString(sString, "Ö", "O")
    sString = ReplaceString(sString, "Ù", "U")
    sString = ReplaceString(sString, "Ú", "U")
    sString = ReplaceString(sString, "Û", "U")
    sString = ReplaceString(sString, "Ü", "U")
    sString = ReplaceString(sString, "Ý", "Y")
    sString = ReplaceString(sString, "à", "a")
    sString = ReplaceString(sString, "á", "a")
    sString = ReplaceString(sString, "â", "a")
    sString = ReplaceString(sString, "ã", "a")
    sString = ReplaceString(sString, "ä", "a")
    sString = ReplaceString(sString, "å", "a")
    sString = ReplaceString(sString, "ç", "c")
    sString = ReplaceString(sString, "è", "e")
    sString = ReplaceString(sString, "é", "e")
    sString = ReplaceString(sString, "ê", "e")
    sString = ReplaceString(sString, "ë", "e")
    sString = ReplaceString(sString, "ì", "i")
    sString = ReplaceString(sString, "í", "i")
    sString = ReplaceString(sString, "î", "i")
    sString = ReplaceString(sString, "ï", "i")
    sString = ReplaceString(sString, "ð", "o")
    sString = ReplaceString(sString, "ò", "o")
    sString = ReplaceString(sString, "ó", "o")
    sString = ReplaceString(sString, "ô", "o")
    sString = ReplaceString(sString, "õ", "o")
    sString = ReplaceString(sString, "ö", "o")
    sString = ReplaceString(sString, "ù", "u")
    sString = ReplaceString(sString, "ú", "u")
    sString = ReplaceString(sString, "û", "u")
    sString = ReplaceString(sString, "ü", "u")
    sString = ReplaceString(sString, "ý", "y")
    sString = ReplaceString(sString, "ÿ", "y")
    ProcedureReturn sString
  EndProcedure
  ProcedureDLL Init_Morse()
    Protected Inc.l
    Restore Char_Normal
    For Inc = 0 To #Dim_Morse_Size
        Read.s Dim_Morse(Inc)\car_normal
    Next
    Restore Char_Morse
    For Inc = 0 To #Dim_Morse_Size
      Read.s Dim_Morse(Inc)\car_Morse
    Next
  EndProcedure
  ProcedureDLL.s Encode_Morse(sString.s)
    Protected sStringEncoded.s, sChar.s
    Protected lInc.l, lIncA.l
    sString = RemoveAccent(sString)
    sStringEncoded = ""
    For lInc = 0 To Len(sString) -1
      sChar = Mid(sString, lInc + 1, 1)
      For lIncA = 0 To #Dim_Morse_Size
        If Dim_Morse(lIncA)\car_normal = UCase(sChar)
          sStringEncoded + Dim_Morse(lIncA)\car_Morse + #Morse_Separateur
          Break
        EndIf
      Next
    Next
    ProcedureReturn sStringEncoded
  EndProcedure
  ProcedureDLL.s Decode_Morse(sString.s)
    Protected lInc.l, lIncA.l
    Protected sStringDecoded.s, sChar.s
    sString = ReplaceString(sString, #Morse_Separateur+#Morse_Separateur+#Morse_Separateur, #Morse_Separateur+" "+#Morse_Separateur)
    For lInc = 1 To CountString(sString, #Morse_Separateur)
      sChar = StringField(sString, lInc, #Morse_Separateur)
      If sChar <> " "
        For lIncA = 0 To #Dim_Morse_Size
          If Dim_Morse(lIncA)\car_Morse = sChar
            sStringDecoded + Dim_Morse(lIncA)\car_normal
            Break
          EndIf
        Next
      Else
        sStringDecoded + sChar
      EndIf
    Next
    ProcedureReturn sStringDecoded
  EndProcedure
;}

Define.s sInitial, sEncoded.s, sDecoded.s

Init_Morse()
sInitial = "C'est l'idée à 2EUR !"
sEncoded.s = Encode_Morse(sInitial)
sDecoded = Decode_Morse(sEncoded)

Debug sInitial
Debug sEncoded
Debug sDecoded