Afficher un texte caractère par caractère

rem ============================================================================
rem            Afficher un texte caractère par caractère
rem            avec émission d un beep à chaque caractère
rem ============================================================================
label Affiche
dim t$,l,i
t$ = "J'affiche un texte" + chr$(13) + "... au ralenti ..." : l = len(t$)
alpha 10 : top 10,50 : left 10,50 : font_bold 10 : font_size 10,40
font_name 10,"arial" : font_color 10,0,0,255
timer 99 :  on_timer 99, Affiche
end
Affiche:
   i = i + 1
   caption 10,caption$(10) + mid$(t$,i,1) : beep
   if i = l
      timer_off 99 : pause 1000
      caption 10,caption$(10) + chr$(13) + "Ouf ! J'ai terminé !"
   end_if
return
rem ============================================================================

dim voy$,cons$,apos$,sepa$,c$,t$,i,last,nbsyll
label fin
voy$="aeiouy"
cons$="bcdfghjklmnpqrstvwxz"
' TR CH (pochtron)
sepa$="- "
apos$="'()"
rem syl:V(a),V_(a ),VnV(oue),VnV_(aie),VC(on),VC_(un ),CVC(cal),CVC_ (arc ),CV(po),CCV(che,gne)
rem dans les chaines nV+C,nV+sp,VC+V(age),VC+C(acte),CVC+C(calter),CVC+V(calembour)
rem VCC+sp(arc-de-cercle),CCV+C(cheval)
t$="J'ai envie de dormir... "
label syllabes
gosub syllabes
END
syllabes:
i=0:last=0:nbsyll=0
  while i<len(t$)-1
    i=i+1:c$=mid$(t$,i,1):c$=lower$(c$)

     fin:
  print c$+" "+str$(nbsyll)+" ";
  end_while
print "nombre de syllabes... "+str$(nbsyll)

dim a%,b%,bb%,t%,v%,vol%,stop%,a$,txt$
v% =0 : vol%=70
dll_on "\\Serveur\docs-serveur\sapi.dll"
label traitement , copie , effacer , accelerer , ralentir , mfort , pfort , stopper , quitter
full_space 0
memo 1:bar_both 1 : width 1,width(0)-25:height 1,height(0)-65 : top 1,20 : left 1,5 : font_name 1,"Courier New"
button 2: parent 2,0 : left 2,0 : width 2,70 : height 2,20 : caption 2,"EFFACER" : on_click 2,effacer
button 3: parent 3,0 : left 3,80 : width 3,70 : height 3,20 : caption 3,"COLLER" : on_click 3,copie
button 4 : parent 4,0 : left 4,160 : width 4,70 : height 4,20 : caption 4,"LECTURE" : on_click 4,traitement
button 5 : parent 5,0 : left 5,240 : width 5,70 : height 5,20 : caption 5,"RALENTIR" : on_click 5,ralentir
alpha 6 : parent 6,0 : left 6,320 : top 6,3 : width 6,20 : height 6,20 :  caption 6,str$(v%)+"  "
button 7 : parent 7,0 : left 7,340 : width 7,70 : height 7,20 : caption 7,"ACCELERER" : on_click 7,accelerer
button 8: parent 8,0 : left 8,420 : width 8,70 : height 8,20 : caption 8,"- FORT" : on_click 8,mfort
alpha 9 : parent 9,0 : left 9,500 : top 9,3 : width 9,20 : height 9,20 :  caption 9,str$(vol%)+"  "
button 10 : parent 10,0 : left 10,520 : width 10,70 : height 10,20 : caption 10,"+ FORT" : on_click 10,pfort
button 11 : parent 11,0 : left 11,600 : width 11,70 : height 11,20 : caption 11,"STOP" : on_click 11,stopper
button 12 : width 12,70 : height 12,20 : caption 12,"QUITTER" : left 12,1350 : on_click 12,quitter
end

traitement:
   if count(1)>0
      b%=0 : bb%=1
      for a%=1 to count(1)
         b%=len(item_read$(1,a%))+2
         select_text 1,bb%,b%
         a$=select_read$(1)
         t% = DLL_CALL1("SpeakMode",1) : t%=DLL_CALL4("Speak",adr(a$),vol%,v%,0)
         bb%=bb%+b%
         ' if STOP%=1 then exit_for
      next a%
   end_if
return

copie:
   clipboard_paste 1
return

effacer:
   clear 1 : a$=""
return

accelerer:
   if v%<10
      txt$="Lecture accélérée" : v%=v%+1 : caption 6,str$(v%)+"  " : t% = DLL_CALL1("SpeakMode",1) : t%=DLL_CALL4("Speak",adr(txt$),vol%,v%,0)
   end_if
return

ralentir:
   if v%>-10
      txt$="Lecture ralentie" : v%=v%-1 : caption 6,str$(v%)+"  " : t% = DLL_CALL1("SpeakMode",1) : t%=DLL_CALL4("Speak",adr(txt$),vol%,v%,0)
   end_if
return

mfort:
   vol%=vol%-5
   if vol%<0
      vol%=0
   else
      caption 9,str$(vol%)+"  " : txt$="Moins fort" : t% = DLL_CALL1("SpeakMode",1) : t%=DLL_CALL4("Speak",adr(txt$),vol%,v%,0)
   end_if
return

pfort:
   vol%=vol%+5
   if vol%>100
      vol%=100
   else
      caption 9,str$(vol%)+"  " : txt$="Plus fort" : t% = DLL_CALL1("SpeakMode",1) : t%=DLL_CALL4("Speak",adr(txt$),vol%,v%,0)
   end_if
return

stopper:
   stop%=1
return

quitter:
terminate

rem ============================================================================
rem             Syllabes
rem ============================================================================
rem La syllabe correspond à une voyelle ou à une réunion de lettres qui se prononcent
rem d une seule émission de voix.
rem Toute syllabe comprend au moins une voyelle.
rem - Oh ! pain, ta/ble, oa/sis, li/ber/té, é/cu/rie, en/tre/pri/se.
' ------------------------------------------------------------------------------
rem Pour décomposer des mots en syllabes, théoriquement on commence par la fin du mot,
rem en disposant un séparateur devant chaque consonne qui se trouve elle-même placée
rem devant la voyelle d un mot :
rem La phrase :
rem  "Voici la naissance de la nouvelle voiture."
rem donne :
rem  "Voi/ci /la /nais/san/ce /de /la /nou/vel/le /voi/tu/re."
' ------------------------------------------------------------------------------
rem Les monosyllabes sont des mots formés d une seule syllabe   :
rem     Exemple : Ours, pont, mal.
rem Les polysyllabes sont des mots formés de plusieurs syllabes :
rem     Exemple : Cavalier = ca / va / lier.
rem     Exemple : Bureau   = bu / reau.
' ------------------------------------------------------------------------------
rem  On détache les syllabes entre deux consonnes :
rem     Exemple :  Prin / ci / pa / le.  In / ver / sion.   Bal / lon.  Lis / te
rem  On détache les syllabes entre une voyelle et une consonne :
rem     Exemple :  Cou / per.    Rhu / ma / tis / me.
' ------------------------------------------------------------------------------
rem  Si elles représentent un seul son  (gh, ph, rh, th, ill, ps ) :
rem     Pignon    > pi / gnon.
rem     Rattacher > rat / ta / cher.
rem     Théorème  > thé / o / rème.
' ------------------------------------------------------------------------------
rem  Si la deuxième consonne est un "r" ou un "l" et la première différente de "r" et "l" :
rem     Exemple : Table > ta / ble. Propriété > pro / pri / é / té.
' ------------------------------------------------------------------------------
rem  Quand il y a trois consonnes, on coupe après la deuxième consonne :
rem     Exemple ; Ancrage > anc / rage. Instituteur > ins / ti / tu / teur.
' ------------------------------------------------------------------------------
rem  Mais on coupe après la première, lorsqu elles représentent un son unique
rem  ou encore si la troisième consonne est un "r" ou un "l" :
rem     Exemple : Amphibie > am / phi / bie.
rem     Exemple : Marchand > mar / chand.
rem     Exemple : Prescription > pres / crip / tion.
rem     Exemple : Application  > ap / pli / ca / tion.
' ------------------------------------------------------------------------------
rem  Quand il y a quatre consonnes, on coupe après la deuxième consonne :
rem     Exemple : Construction > cons / truc / tion.
rem     Exemple : Instrument   > ins / tru / ment.
' ------------------------------------------------------------------------------
rem  Quand un mot est composé d un préfixe "dé" ou "pré", on coupe après le préfixe :
rem     Exemple : Détacher     > dé / ta / cher.
rem     Exemple : Présélection > pré / sé / lec / tion.
' ==============================================================================
rem  Il y a d autres exceptions, comme par exemple 3 ou 4 voyelles qui se suivent:
rem     Exemple : aient <--- monosyllabe
rem     Exemple : oient (verbe ouïr 3ème personne du pluriel au présent) < --- monosyllabe
rem     Exemple : oyais (verbe ouïr 1ere personne du singulier à l imparfait) <--- monosyllabe
rem ============================================================================

 procedure Syllabify(Syllables: TStringList; s: string);
  const
    Consonants  = ['b','B','c','C','d','D','f','F','g','G',
            'h','H','j','J','k','K','l','L','m','M','n','N',
            'ñ','Ñ','p','P','q','Q','r','R','s','S','t','T',
            'v','V','w','W','x','X','y','Y','z','Z'];
    StrongVowels = ['a','A','á','Á','e','E','é','É',
                    'í','Í','o','ó','O','Ó','ú','Ú'];
    WeakVowels  = ['i','I','u','U','ü','Ü'];
    Vowels      = StrongVowels + WeakVowels;
    Letters      = Vowels + Consonants;
  var
    i, j, n, m, hyphen: integer;
  begin
    j := 2;
    s := #0 + s + #0;
    n := Length(s) - 1;
    i := 2;
    Syllables.Clear;
    while i <= n do begin
      hyphen := 0; // Do not hyphenate
      if s[i] in Consonants then begin
        if s[i+1] in Vowels then begin
          if s[i-1] in Vowels then hyphen := 1;
        end else if (s[i] in ['s', 'S']) and (s[i-1] in ['n', 'N'])
            and (s[i+1] in Consonants) then begin
          hyphen := 2;
        end else if (s[i+1] in Consonants) and
                    (s[i-1] in Vowels) then begin
          if s[i+1] in ['r','R'] then begin
            if s[i] in ['b','B','c','C','d','D','f','F','g',
                'G','k','K','p','P','r','R','t','T','v','V']
            then hyphen := 1 else hyphen := 2;
          end else if s[i+1] in ['l','L'] then begin
            if s[i] in ['b','B','c','C','d','D','f','F','g',
                'G','k','K','l','L','p','P','t','T','v','V']
            then hyphen := 1 else hyphen := 2;
          end else if s[i+1] in ['h', 'H'] then begin
            if s[i] in ['c', 'C', 's', 'S', 'p', 'P']
            then hyphen := 1 else hyphen := 2;
          end else
            hyphen := 2;
        end;
      end else if s[i] in StrongVowels then begin
        if (s[i-1] in StrongVowels) then hyphen := 1
      end else if s[i] = '-' then begin
        Syllables.Add(Copy(s, j, i - j));
        Syllables.Add('-');
        inc(i);
        j := i;
      end;
      if hyphen = 1 then begin  // Hyphenate here
        Syllables.Add(Copy(s, j, i - j));
        j := i;
      end else if hyphen = 2 then begin  // Hyphenate after
        inc(i);
        Syllables.Add(Copy(s, j, i - j));
        j := i;
      end;
      inc(i);
    end;
    m := Syllables.Count - 1;
    if (j = n) and (m >= 0) and (s[n] in Consonants) then
      Syllables[m] := Syllables[m] + s[n]  // Last letter
    else
      Syllables.Add(Copy(s, j, n - j + 1)); // Last syllable
  end;


// To test the procedure you can drop a Textbox and a Label on a form and
//in the Change event of the Textbox write:

  procedure TForm1.Edit1Change(Sender: TObject);
  var
    Syllables: TStringList;
  begin
    Syllables := TStringList.Create;
    try
      Syllabify(Syllables, Edit1.Text);
      Label1.Caption := StringReplace(Trim(Syllables.Text),
        #13#10, '-', [rfReplaceAll]);
    finally
      Syllables.Free;
    end;
  end;

lesVariables()
lesLabels()
laPhrase()
gui()
gosub minuscules
gosub supprimePunkt
gosub separeLesMots
gosub motParMot


END
'
sub lesLabels()
label minuscules,supprimePunkt,separeLesMots,motParMot
end_sub
'
sub lesVariables()
dim nbsyll,nbTruc,nbMachin
dim i,j,k,flag,nbMots,c$,ca$,cca$,t$,mot$,chaine$,punkt$,br$
dim tbis$,v$,dblc$,va$,cc$,g$,d$
dblc$="bcdfglmnprstz"
c$=dblc$+"hjkqvwxç"
cc$="bl*br*cl*cr*dr*fl*fr*gl*gn*gr*pl*pr*pn*qu*tr"
v$="aeiouy"
va$="àâéêèîôùû"
punkt$="(),.;:!?"
t$="J'ai assez longtemps erré libre sous de plus ou moins grands portiques..."
end_sub
'
sub laPhrase()
t$=message_input$("Vérification","Saisis une phrase","Dis, ça va marcher, hein !?!")
end_sub
'
sub gui()
list 10:font_size 10,12:height 10,height(0)-40:width 10,200
list 11:font_size 11,12:height 11,height(0)-40:width 11,200:left 11,width(10)+4
end_sub
'
minuscules:
t$=lower$(t$)
return
'
separeLesMots:
i=0:t$=t$+" "
  repeat
    i=i+1:ca$=mid$(t$,i,1)
      if ca$=" " then nbMots=nbMots+1:item_add 10,mot$:mot$="":ca$=""
    mot$=mot$+ca$
  until i=len(t$)
return
'
supprimePunkt:
i=0
  repeat
    i=i+1:ca$=mid$(t$,i,1)
      if instr(punkt$,ca$)>0 then ca$=""
    chaine$=chaine$+ca$
  until i=len(t$)
t$=chaine$
if right$(t$,1)=" " then t$=left$(t$,len(t$)-1)
return
'
motParMot:
' couper aux consonnes doubles (deux l, deux r etc.)
  for i=1 to nbMots
    mot$=item_read$(10,i)
    j=0
      for j=1 to len(mot$)-1
        if mid$(mot$,j+1,1)=mid$(mot$,j,1)
        flag=1
          ' message mid$(mot$,j+1,1)+" et "+mid$(mot$,j,1)
          item_add 11,left$(mot$,j):item_add 11,right$(mot$,len(mot$)-j)
          nbTruc=nbTruc+2
        end_if
      next j
  if flag=0 then item_add 11,mot$ :nbTruc=nbTruc+1
  if flag=1 then flag=0
  next i
clear 10
' couper aux bl,br etc.
  for i=1 to nbTruc
    mot$=item_read$(11,i)
    j=0
      for j=1 to len(mot$)
        for k=1 to len(cc$)-3
          br$=mid$(cc$,1+3*(k-1),2)
          ' if (mid$(mot$,j,2)="br") and (j<>1)
          if (mid$(mot$,j,2)=br$) and (j<>1)
        flag=1
          item_add 10,left$(mot$,j-1):item_add 10,right$(mot$,1+len(mot$)-j)
          nbMachin=nbMachin+1
        end_if
        next k
      next j
  if flag=0 then item_add 10,mot$:nbMachin=nbMachin+1
  if flag=1 then flag=0
  next i
return