Source:Dictionnaire.pb

Vous trouverez les fichiers nécessaires pour le dico à cette adresse.

Ou alors, remplacez le fichier par celui de votre choix.

Le code original et les explications se trouvent ici : Arbres VII-4

N'hésitez pas à proposer d'autres solutions ou à améliorer ce code., ça peut être utile pour des jeux de lettres comme le scrabble, etc.

;Comtois 23/01/05
;Codage d'un dictionnaire

Declare CreateNoeud()

Structure Noeud
  lettre.s ; lettre contenue dans ce noeud de l'arbre
  entier.b ; flag indiquant si le mot est entier
  *Fils.Noeud[26]
EndStructure
;initialise l'arbre
Global *Tete.Noeud
*Tete = CreateNoeud()

;-Procedures

Procedure CreateNoeud()
  *Noeud.Noeud = AllocateMemory(SizeOf(Noeud))
  If *Noeud
    For c = 0 To 25
      *Noeud\Fils[c] = #Null
    Next c   
    *Noeud\lettre = ""
    *Noeud\entier = #False
  Else
    MessageRequester("Erreur", "Impossible d'allouer de la mémoire !", 0)
    End
  EndIf
  ProcedureReturn *Noeud
EndProcedure

Procedure rajouter_mot(*courant.Noeud, LeMot.s)
  If LeMot = ""
    *courant\entier = #True
    ProcedureReturn
  EndIf
  car.s = Left(LeMot, 1)
  lettre = Asc(car) - 'A'
  If *courant\Fils[lettre] <> #Null  ; si la lettre existe déjà
    *courant = *courant\Fils[lettre] ; alors On se positionne sur la lettre suivante
  Else ; sinon il faut créer cette lettre dans l'arbre
    *courant\Fils[lettre] = CreateNoeud()
    *courant = *courant\Fils[lettre]
    *courant\lettre = car
    *courant\entier = #False
  EndIf
  LeMot = Mid(LeMot, 2, Len(LeMot) - 1); on efface la lettre du mot puisqu'elle est déjà dans l'arbre
  rajouter_mot(*courant, LeMot); et on rajoute le reste
EndProcedure

Procedure Affiche(*courant.Noeud, s.s);
  If *courant\entier : Debug s : EndIf
  For i = 0 To 25
    If *courant\Fils[i] <> #Null
      *aux.Noeud = *courant
      *courant = *courant\Fils[i]
      Affiche(*courant,s + Chr( i + 'A'))  
      *courant = *aux
    EndIf
  Next i 
EndProcedure

Procedure trouve(*courant.Noeud, LeMot.s,  OK.l)
  If LeMot = ""  And OK
    trouve = #True
  Else
    car.s = Left(LeMot, 1)
    lettre = Asc(car) - 'A'
    LeMot = Mid(LeMot, 2, Len(LeMot) - 1)
    If lettre < 0 Or lettre > 25 Or *courant\Fils[lettre] = #Null
      trouve = #False
    Else
      *courant = *courant\Fils[lettre]
      trouve = trouve(*courant, LeMot, *courant\entier)
    EndIf
  EndIf
  ProcedureReturn trouve
EndProcedure

Procedure.s EpureMot(Mot.s)
  Mot = UCase(Trim(Mot))
  MotAux.s = ""
  car.s = ""
  For i = 1 To Len(Mot)
    car = Mid(Mot, i, 1)
    If car = "Â" Or car = "Ä" Or car = "À" Or car = "Á"
      car = "A"
    ElseIf car = "Ç"
      car = "C"
    ElseIf car = "È" Or car = "É" Or car = "Ê" Or car = "Ë" Or car = "Œ"
      car = "E"
    ElseIf car = "Î" Or car = "Ï" Or car = "Ì"
      car = "I"
    ElseIf car = "Ô" Or car = "Ö"
      car = "O"
    ElseIf car = "Ù" Or car = "Û" Or car = "Ü" Or car = "Ú"
      car = "U"
    EndIf
    MotAux = MotAux + car
  Next i
  ; suppression des blancs et des tirets et autres trucs qui n'existent pas dans le jeu
  Mot = MotAux 
  MotAux  =""
  For i = 1 To Len(Mot)
    car = Mid(Mot, i, 1)
    If (car <> " ") And (car <> "-") And (car <> "'")
      MotAux = MotAux+car
    EndIf
  Next i
  ProcedureReturn MotAux 
EndProcedure

Procedure charger(Fichier$)
  If OpenFile(0, Fichier$)
    While Eof(0) = 0
      Mot.s = EpureMot(ReadString())
      rajouter_mot(*Tete, Mot) ; et on rajoute le mot
    Wend
    CloseFile(0)
  Else
    MessageRequester("Erreur", "Impossible d'ouvrir le fichier " + Fichier$, 0)
  EndIf
EndProcedure

;-Charge le dico en mémoire
;Fichier$ = "dicofr\dicofr.txt" << C'est le dico une fois épuré , ça m'évite de l'épurer à chaque chargement
For i=0 To 25
  Fichier$ = "dicofr\" + Chr(i + 'A') + ".txt"
  charger(Fichier$)
Next i
;charger(Fichier$)

;-Valide cette ligne si tu veux afficher le résultat
;Affiche(*Tete, "")
 
;-et maintenant quelques tests
Repeat
  Test$ = EpureMot(InputRequester(  "Test Dictionnaire", "Indiquez un mot ", ""))
  If Test$ <> ""
    If trouve(*Tete, Test$, 0)
      Rep$ = "Le mot " + Test$ + " se trouve dans le dictionnaire"
    Else
      Rep$ = "Le mot " + Test$ + " ne se trouve pas dans le dictionnaire"
    EndIf
    MessageRequester("Test Dictionnaire", Rep$, 0)
  EndIf
Until Test$ = ""