majuscule rapide

'
'
'   Silverman, septembre 2016
'
' 3 algorithmes de mise en majuscule d'une chaîne de caratère(du - rapide au + rapide)



label choix,test1,test2,test3
label VERY_FAST_Uppercase

dim choix%,result$,ch$,start%,tim%, nb_accent% , info$



full_space 0


' un bouton
button 1 : on_click 1,choix : hide 1


' un memo
memo 2
full_space 2
font_name 2,"dejavu sans mono"


' fabriquer une longue chaine
ch$="L'accent aigu : Cet accent n'est employé que sur le e     - Au début ou à l'intérieur d'un mot : le é se trouve uniquement en finale de syllabe     ex : cé/lé/bri/té     - En fin de mot le é est utilisé : soit en finale absolue : animé  soit devant e             : animée  soit devant s             : animés     L'accent grave : - sur le e C'est là son emploi principal. La règle générale est de mettre un accent grave sur le e que lorsqu'il est précédé d'une autre lettre et aussi suivi d'une syllabe qui comporte un e muet. Dans le cas contraire on met un accent aigu     Ex : une pièce ==> une piécette     - Sur le a     Dans ce cas l'accent permet de distinguer a (verbe avoir) de à (préposition)     - Sur le u     Dans ce cas l'accent permet de distinguer ou (conjonction de coordination) de où (pronom relatif)"
for start%=1 to 5
   ch$=ch$+ch$
next start%



' l'écrire dans le memo
text 2,ch$
COMPTE_ACCENT(ch$)
info$ = str$(len(ch$))+" caractères dont "+str$(nb_accent%)+" caractères accentués "
caption 0,info$


' Test des algorithmes

' test1
message "Premier test : algorithme classique dit 'naïf'"
choix%=1
trigger_click 1

' test2
message "Second test : algorithme optimisé"
text 2,ch$
choix%=2
trigger_click 1

' test3
message "Troisième test : algorithme optimisé + utilisation de la commande POKE"
text 2,ch$
choix%=3
trigger_click 1

' fini
message "Démo terminé!"
terminate


END
' ################################################## sous-routines et subs ##################################################
'
' choix
choix:
   select choix%
      case 1: gosub test1
      case 2: gosub test2
      case 3: gosub test3
   end_select
return


' conversions
test1:
   tim%=number_ticks
   ch$=text$(2)
   '
   Uppercase(ch$)
   '
   text 2,result$
   caption 0,info$+" : premier test réalisé en "+str$(number_ticks-tim%)+" millisecondes"
return


test2:
   tim%=number_ticks
   ch$=text$(2)
   '
   FAST_Uppercase(ch$)
   '
   text 2,result$
   caption 0,info$+" : second test réalisé en "+str$(number_ticks-tim%)+" millisecondes"
return


test3:
   tim%=number_ticks
   ch$=text$(2)
   '
   gosub VERY_FAST_Uppercase
   '
   text 2,result$
   caption 0,info$+" : troisième test réalisé en "+str$(number_ticks-tim%)+" millisecondes"
return


sub compte_accent(txt$)
' le résultat est retourné dans la variable globale 'nb_accent%'
   nb_accent% = 0
   '
   IF txt$<>""
      ' déclaration des variables
      dim_local max_char% , i% , lasti% , cpt% , newtxt$ , entre_2_accent$

      ' remplissage d'un tableau contenant les caractères à traiter(16 diacritiques et 2 ligatures)
      if variable("diacritique$") = 0
         dim_local i$
         '
         data "COMPTE_ACCENT:"
         data "é","à","è","ê","î","ç","â","ô","û","ù","œ","ï","ë","ü","ö","ä","æ","ÿ"
         data "É","À","È","Ê","Î","Ç","Â","Ô","Û","Ù","Œ","Ï","Ë","Ü","Ö","Ä","Æ","Ÿ"
         '
         data "END_OF_DATA"
         '
         ' compter les datas
         restore : repeat : read i$ : until i$="COMPTE_ACCENT:"   :' émule une commande inexistante : RESTORE_LABEL
         i%=0 : read newtxt$
         while newtxt$<>"END_OF_DATA"
            read newtxt$ : i%=i%+1
         end_while
         max_char% = i%
         '
         dim_local diacritique$(max_char%)
         '
         ' lecture des datas
         restore : repeat : read i$ : until i$="COMPTE_ACCENT:"   :' émule une commande inexistante : RESTORE_LABEL
         for i%=1 to max_char%
            read newtxt$
            diacritique$(i%) = newtxt$
         next i%
      end_if

      ' initialisation
      cpt% = 0

      ' traitement
      repeat
         cpt% = cpt% + 1
         i%=0
         repeat
            i% = instr_pos(txt$,diacritique$(cpt%),i%+1)
            if i%>0   :' si un caractère accentué est trouvé
               nb_accent%=nb_accent%+1
            end_if
         until i%=0
      until cpt%=max_char%   :' jusqu'à ce qu'il soient tous traités
      '
   END_IF
end_sub


' ################################################## TEST1 ##################################################
'
sub Uppercase(txt$)
  dim_local cup$, clow$, i%, l%, c%, t$
  if variable("UpperCase$")=0 then dim UpperCase$
  cup$ = "ÀÇÉÈÊÎÏÔÛ"
  clow$  = "àçéèêîïôû"
  UpperCase$ = upper$(txt$)   :' chaîne de travail
  l% = len(UpperCase$)
  if l%=0 then exit_sub
  ' lit les caractères de la chaîne, un par un
  for i%=1 to l%
    c% = instr(clow$,mid$(UpperCase$,i%,1))   :' si c'est un caractère accentué
    if c%>0
      if i%>1   :' si la chaîne contient plus d'un caratère
        t$ = left$(UpperCase$,i%-1)   :' récupère la partie gauche de la chaîne de travail sans le caractère accentué, et écrit là dans une chaîne temporaire
      else
        t$ = ""   :' sinon c'est déjà fini
      end_if
      t$ = t$ + mid$(cup$,c%,1)   :' ' ajoute le caracère version majuscule
      if i%<l% then t$ = t$ + mid$(UpperCase$,i%+1,len(UpperCase$))   :' puis la partie droite de la chaîne de travail
      UpperCase$ = t$   :' reconstruit la chaîne de travail
    end_if
  next i%   :' jusqu'à ce que tous les caractères aient été lu
  result$ = UpperCase$
end_sub


' ################################################## TEST2 ##################################################
'
sub FAST_Uppercase(txt$)
' le résultat est retourné dans la variable globale 'result$'
'
   IF txt$<>""
      ' déclaration des variables
      dim_local max_char% , i% , lasti% , cpt% , newtxt$ , entre_2_accent$

      ' remplissage d'un tableau contenant les caractères à traiter(16 diacritiques et 2 ligatures)
      if variable("diacritique$") = 0
         dim_local i$
         '
         data "TEST2:"
         '
         data "é","à","è","ê","î","ç","â","ô","û","ù","œ","ï","ë","ü","ö","ä","æ","ÿ"
         data "É","À","È","Ê","Î","Ç","Â","Ô","Û","Ù","Œ","Ï","Ë","Ü","Ö","Ä","Æ","Ÿ"
         '
         data "END_OF_DATA"
         '
         ' compter les datas
         restore : repeat : read i$ : until i$="TEST2:"   :' émule une commande inexistante : RESTORE_LABEL
         i%=0 : read newtxt$
         while newtxt$<>"END_OF_DATA"
            read newtxt$ : i%=i%+1
         end_while
         max_char% = i%
         '
         dim_local diacritique$(max_char%)
         '
         ' lecture des datas
         restore : repeat : read i$ : until i$="TEST2:"   :' émule une commande inexistante : RESTORE_LABEL
         for i%=1 to max_char%
            read newtxt$
            diacritique$(i%) = newtxt$
         next i%
         max_char% = (max_char%-1)/2
      end_if

      ' initialisation
      cpt% = 0

      ' traitement
      repeat
         lasti% = 0
         i%=0
         cpt% = cpt% + 1
         newtxt$ = ""   :' chaine temporaire
         repeat
            i% = instr_pos(txt$,diacritique$(cpt%),i%+1)
            if i%>0   :' si un caractère accentué est trouvé
               ' traitement d'un bug de panoramic
               if (i%-lasti%)>1   :' !!! ATTENTION !!! : le 3ème paramètre de la fonction mid$() = 0 si 2 accents consécutif trouvé ---> panoramic retourne une erreur mais ne devrait pas(bug!)
                  entre_2_accent$ = mid$(txt$,lasti%+1,i%-lasti%-1)
               else
                  entre_2_accent$ = ""
               end_if
               newtxt$ = newtxt$ + entre_2_accent$ + diacritique$(cpt%+18)   :' remplace le caratère par sa version majuscule
               lasti% = i%
            end_if
         until i%=0
         newtxt$ = newtxt$ + right$(txt$,len(txt$)-lasti%)   :' complète la chaine temporaire
         txt$ = newtxt$   :' réaffecte la chaine originale et passe au caractère accentué suivant
      until cpt%=max_char%   :' jusqu'à ce qu'il soient tous traités
   end_if

   ' résultat
   result$ = upper$(txt$)   :' maintenant que tous les caractères accentués sont en majuscules, on met le reste aussi en majuscule
   '
end_sub


' ################################################## TEST3 ##################################################
'
VERY_FAST_Uppercase:
      ' préparation
      ' remplissage d'un tableau contenant les caractères à traiter(16 diacritiques et 2 ligatures)
      if variable("diacritique$") = 0
         dim max_char% , i% , txt$ , tmptxt$ , newtxt% , newtxt$ , cpt%
         tmptxt$=ch$
         '
         data "TEST3:"
         data "é","à","è","ê","î","ç","â","ô","û","ù","œ","ï","ë","ü","ö","ä","æ","ÿ"
         data 201,192,200,202,206,199,194,212,219,217,140,207,203,220,214,196,198,159
         '
         data "END_OF_DATA"
         '
         ' compter les datas
         RESTORE_LABEL("test3:")   :'   :-/   !!!
         i%=0 : read newtxt$
         while newtxt$<>"END_OF_DATA"
            read newtxt$ : i%=i%+1
         end_while
         max_char% = i%
         max_char% = max_char%/2
         '
         dim diacritique$(max_char%)
         dim diacritique%(max_char%)
         '
         ' lecture des datas : ligne 1
         RESTORE_LABEL("test3:")   :'   :-/   !!!
         for i%=1 to max_char%
            read txt$
            diacritique$(i%) = txt$
         next i%
         '
         ' lecture des datas : ligne 2
         for i%=1 to max_char%
            read newtxt%
            diacritique%(i%) = newtxt%
         next i%
      end_if

      ' initialisation
      tmptxt$ = upper$(tmptxt$)
      txt$ = tmptxt$
      '
      cpt% = 0
      i% = 0
      GET_STRING_PTR(adr(start%),adr(txt$))
      start%=start%-1

      ' traitement
      repeat
         cpt% = cpt% + 1
         i%=0
         repeat
            i% = instr_pos(txt$,diacritique$(cpt%),i%+1)
            if i%>0   :' si un caractère accentué est trouvé
               poke start%+i%,diacritique%(cpt%)   :' remplace le caratère par sa version majuscule
            end_if
         until i%=0
      until cpt%=max_char%   :' jusqu'à ce qu'il soient tous traités
      result$=tmptxt$

      ' libère les ressources
      free max_char%
      free i%
      free txt$
      free newtxt%
      free cpt%
      free tmptxt$
      free diacritique$
      free diacritique%
return


sub GET_STRING_PTR(adr_destination%,adr_source%)
' retrouve l'adresse du pointeur de chaîne
  poke adr_destination%,peek(adr_source%)
  poke adr_destination%+1,peek(adr_source%+1)
  poke adr_destination%+2,peek(adr_source%+2)
  poke adr_destination%+3,peek(adr_source%+3)
end_sub


sub restore_label(etiq$)
' émule une commande inexistante
 dim_local i$
   restore
   repeat
      read i$
   until lower$(i$)=lower$(etiq$)
end_sub