Réaliser un interpréteur en Pascal

Voici des mots simples qui ne poseront pas de problèmes particuliers :

• libellule
• porte-avions
• entendre
• EnTenDRe

Les nombres ne sont que des mots particuliers qui seront traités comme des mots ordinaires ou comme des nombres, suivant l'opération en cours :

• 1245
• 1E2(5)
• 13456,58

Les mots accentués et les caractères exotiques sont utilisables eux aussi, à condition de ne pas être choisis en tant qu'identificateur :

• éléphant
• %&/ç\

Un caractère pourtant interdit dans un mot GVLOGO peut toujours être introduit s'il est précédé du caractère d'échappement :

• Victor$ Hugo
• GVLOGO$ est$ un$ langage$ facile$ à$ apprendre
• $[encore$ un$ mot$]
• $(un$ autre$)
• 15$ $$

Lors de l'écriture des mots ainsi construits, le caractère d'échappement, sauf contre-ordre, n'apparaîtra pas à l'écran :

• ECRIS $[encore$ un$ mot$] donnera [encore un mot]
• ECRIS 15$ $$ donnera 15 $

En plus des délimiteurs, certains caractères sont utilisés par le langage lui-même et déterminent son comportement selon le contexte :

• le " (guillemet anglais) indique que le mot qui suit doit être pris tel quel, sans chercher à l'interpréter (par exemple, ECRIS "Bonjour.) ;
• les : (deux-points) indiquent que le mot qui suit est une variable dont la valeur est à rechercher (par exemple, ECRIS :salutation affichera, si elle existe, la valeur qui correspond à la variable « salutation ») ;
• le . (point) en début de mot indique une primitive dont l'emploi est risqué, car elle touche au cÅ“ur de GVLOGO (par exemple .EFFACE.TOUT détruit tous les objets en réinitialisant le noyau) ;
• le ? (point d'interrogation) est utilisé à la fin des primitives qui renvoient une valeur booléenne (VRAI/FAUX), mais, comme le point, son utilisation est une question d'habitude et n'a pas de caractère obligatoire.

METS.PREMIER (raccourci : MP) : attend deux mots en entrée - renvoie un mot - le mot rendu est composé du premier paramètre placé avant le second.

Exemple :

• ECRIS METS.PREMIER "tourne "dos → tournedos

METS.DERNIER (raccourci : MD) : attend deux mots en entrée - renvoie un mot - le mot rendu est composé du premier paramètre placé après le second.

Exemple :

• ECRIS METS.DERNIER "tourne "dé → détourne

MOT : attend deux mots en entrée - renvoie un mot - le mot rendu est composé du second paramètre placé après le premier.

Exemple :

• ECRIS MOT "dé "tourne → détourne

INSERE : attend un entier suivi deux mots en entrée - renvoie un mot - Le mot rendu est composé du deuxième paramètre inséré dans le dernier paramètre à la position précisée par l'entier.

Exemple :

• ECRIS INSERE 4 "en "atttion → attention

INVERSE : attend un mot en entrée - renvoie un mot - le mot rendu est celui d'entrée dont les lettres ont été inversées.

Exemple :

• ECRIS INVERSE "billet → tellib

MAJUSCULES : attend un mot en entrée - renvoie un mot - le mot rendu est en majuscules.

Exemple :

• ECRIS MAJUCULES "éléphant → Ä’LÄ’PHANT

MELANGE : attend un mot en entrée - renvoie un mot - le mot rendu a les mêmes lettres que celui d'origine, mais dans un ordre aléatoire.

Exemple :

• ECRIS MELANGE "alouette → eoetault

MINUSCULES : attend un mot en entrée - renvoie un mot - le mot rendu est en minuscules.

Exemple :

• ECRIS MINUSCULES "ESSAI → essai

REMPLACE : attend un entier suivi de deux mots en entrée - renvoie un mot - le mot rendu est composé de toutes les lettres du second mot en entrée, sauf celle visée par l'entier qui a été remplacée par le premier mot.

Exemple :

• ECRIS REMPLACE 3 "é "éliment → élément

TRIE : attend un mot en entrée - renvoie un mot - les lettres du mot sont triées par ordre alphabétique(6).

Exemple :

• ECRIS TRIE "important → aimnoprtt

ROTATION : attend un mot en entrée - renvoie un mot - la primitive renvoie le mot dont le premier caractère est placé à la fin.

Exemples :

• ECRIS ROTATION "essai → ssaie

ELEMENT : attend un entier suivi d'un mot en entrée - renvoie un mot - le mot rendu est composé de la lettre du mot en entrée indiquée par l'entier fourni.

Exemple :

• ECRIS ELEMENT 4 "Zorro → r

DERNIER (raccourci : DER) : attend un mot en entrée - renvoie un mot - le mot renvoyé est composé de la dernière lettre du mot en entrée.

Exemple :

• ECRIS DERNIER "important → t

HASARD : attend un mot en entrée - renvoie un mot - le mot renvoyé est composé d'une lettre du mot en entrée, tirée au hasard. Si le mot en entrée est un nombre, le mot renvoyé est un nombre compris entre 1 et ce nombre.

Exemples :

• ECRIS HASARD "destin → i
• ECRIS HASARD "destin → d
• ECRIS HASARD "10 → 8

PREMIER (raccourci : PREM) : attend un mot en entrée - renvoie un mot - le mot renvoyé est composé de la première lettre du mot en entrée.

Exemple :

• ECRIS PREMIER "important → i

SAUF.DERNIER (raccourci : SD) : attend un mot en entrée - renvoie un mot - le mot renvoyé est le mot en entrée amputé de sa dernière lettre.

Exemple :

• ECRIS SAUF.DERNIER "important → importan

SAUF.PREMIER (raccourci : SP) : attend un mot en entrée - renvoie un mot - le mot renvoyé est le mot en entrée amputé de sa première lettre.

Exemple :

• ECRIS SAUF.PREMIER "important → mportant

PLG? : attend deux mots en entrée - renvoie un booléen - la primitive renvoie "VRAI si le premier mot vient strictement après le second selon l'ordre alphabétique, "FAUX sinon.

Exemples :

• ECRIS PLG? "petit "grand → -1
• ECRIS PLG? 1245 138 → -1

PLP? : attend deux mots en entrée - renvoie un booléen - la primitive renvoie "VRAI si le premier mot vient strictement avant le second selon l'ordre alphabétique, "FAUX sinon.

Exemple :

• ECRIS PLP? "petit "grand → 0

COMPTE : attend un mot en entrée - renvoie un entier - la primitive renvoie le nombre de caractères du mot en entrée.

Exemple :

• ECRIS COMPTE "urticaire → 9

EGAL? : attend deux mots en entrée - renvoie un booléen - la primitive renvoie "VRAI si le premier mot est égal au second selon l'ordre alphabétique, "FAUX sinon.

Exemple :

• ECRIS EGAL? "100 "1E2 → -1

IDENTIFICATEUR? : attend un mot en entrée - renvoie un booléen - la primitive renvoie "VRAI si le mot en entrée est un identificateur correct, "FAUX sinon.

Exemples :

• ECRIS IDENTIFICATEUR? "MaFonction12 → -1
• ECRIS IDENTIFICATEUR? "12MaFonction → 0

MEMBRE? : attend deux mots en entrée - renvoie un booléen - la primitive renvoie "VRAI si le premier mot est compris dans le second, "FAUX sinon.

Exemple :

• ECRIS MEMBRE? "an "étonnant → -1

MOT? : attend un objet en entrée - renvoie un booléen - la primitive renvoie "VRAI si l'objet est un mot, "FAUX sinon.

Exemple :

• ECRIS MOT? [coucou] → 0

NOMBRE? : attend un mot en entrée - renvoie un booléen - la primitive renvoie "VRAI si le mot est un nombre, "FAUX sinon.

Exemple :

• ECRIS NOMBRE? "12458 → -1

PRECEDENT : attend deux mots en entrée - renvoie un mot - la primitive renvoie le mot qui vient le premier selon l'ordre alphabétique.

Exemple :

• ECRIS PRECEDENT "un "deux → deux

SUIVANT : attend deux mots en entrée - renvoie un mot - la primitive renvoie le mot qui vient le dernier selon l'ordre alphabétique.

Exemple :

• ECRIS SUIVANT "un "deux → un

VIDE? : attend un mot en entrée - renvoie un booléen - la primitive renvoie "VRAI si le mot en entrée est le mot vide, "FAUX sinon.

Exemple :

• ECRIS VIDE? " → -1

La difficulté essentielle dans le traitement des mots en GVLOGO réside dans la présence d'un caractère d'échappement dont il faut tenir compte pour toutes les opérations portant sur eux. L'objet TGVString accomplit le travail de normaliser tout mot qui lui est proposé. Il est capable de restituer le mot d'origine ainsi que celui transformé.

Voici sa partie interface :

type
  // *** objet chaîne ***
  TGVString = object
  strict private
    fRawStr: string; // chaîne brute entrée
    fIsValid: Boolean; // validité de la chaîne d'entrée
    fStr: string; // chaîne brute interne
    fFmtStr: string; // chaîne formatée interne
    function GetFmtStr: string; // renvoie la chaîne formatée
    function GetStr: string; // renvoie la chaîne brute
    procedure SetStr(const St: string); // établit une nouvelle chaîne brute
    function WithEsc(const St: string): string; // avec échappement
    function WithoutEsc(const St: string): string; // sans échappement
  public
    procedure Clear; // remise à zéro
    property IsValid: Boolean read fIsValid; // validité de la chaîne d'entrée
    property Str: string read GetStr write SetStr; // chaîne brute d'entrée
    property FmtStr: string read GetFmtStr; // chaîne formatée
    property RawStr: string read fRawStr; // chaîne brute
  end;

L'interface est bâtie de manière « classique » en proposant des propriétés dont l'implémentation est protégée par des méthodes privées. La propriété Str lit une chaîne afin de la transformer en chaîne normalisée et de la restituer ainsi. La propriété en lecture seule RawStr permet de retrouver la chaîne brute, telle qu'elle a été introduite.

La méthode SetStr est chargée de transformer la chaîne fournie en entrée. Elle invoque successivement WithoutEsc qui retire un éventuel formatage et WithEsc qui normalise la chaîne. Cette façon de procéder évite de formater une chaîne qui le serait déjà : en revanche, elle exige deux analyses de la chaîne et ne repère pas les mots normalisés par hasard !

L'algorithme utilisé par WithEsc est trivial. On remarquera cependant le couple for…in qui balaie la chaîne en lieu et place d'une boucle traditionnelle for…next moins lisible :

function TGVString.WithEsc(const St: string): string;
// *** normalise un mot en tenant compte du caractère d'échappement ***
var
  Lch: Char;
begin
  Result := EmptyStr; // chaîne vide par défaut
  for Lch in St do // balaie la chaîne de départ
  begin
    if Lch in CSeparators + [CLink] then
      // si séparateur ou échappement suit, on insère un échappement
      Result := Result + CLink;
    Result := Result + Lch; // caractère en cours ajouté
  end;
end;

Les utilisateurs de Delphi devront remplacer in CSeparators par la fonction CharInSet s'ils ne veulent pas obtenir un message d'avertissement.

La méthode WithoutEsc n'intéressera que pour l'utilisation d'un drapeau (variable LFlag) qui mémorise le fait d'avoir rencontré précédemment un caractère d'échappement. Ce drapeau est remis à zéro lorsqu'on a traité son repérage :

function TGVString.WithoutEsc(const St: string): string;
// *** sans caractère d'échappement ***
var
  LCh: Char;
  LFlag: Boolean;
begin
  Result := EmptyStr;
  // chaîne vide par défaut
  LFlag := False; // on n'a pas eu affaire à un caractère d'échappement
  for LCh in St do // on balaie la chaîne
    if (LCh <> CLink) or LFlag then // caractère d'échappement initial ?
    begin
      Result := Result + LCh; // non : on ajoute simplement
      LFlag := False; // on indique ce cas
    end
    else
      LFlag := True; // échappement initial qu'on ignore
end;

Les utilisateurs de Delphi pourront envisager de transformer cet objet en enregistrement. En effet, cet EDI accepte des enregistrements comprenant des méthodes.

La classe TGVNumber traite les chaînes susceptibles de représenter des nombres.

Voici sa partie interface :

  TGVNumber = class(TObject)
  strict private
    fError: TGVErrors; // traitement des erreurs
    fNum: Double; // nombre de travail
    fSt: string; // chaîne brute d'entrée
    fValid: Boolean; // drapeau de validité
    function GetInt: Integer; // renvoie un entier
    function GetDouble: Double; // renvoie un réel
    function GetStr: string; // acquiert une chaîne à convertir en nombre
    procedure SetStr(const St: string); // forme une chaîne à partir d'un nombre
  public
    constructor Create; // constructeur
    destructor Destroy; override; // destructeur
    procedure Clear; // remise à zéro
    function IsValid: Boolean; // est-ce un nombre ?
    function IsInt: Boolean; // est-ce un entier ?
    function IsZero: Boolean; // nombre 0 ?
    function IsNegate: Boolean; // nombre négatif ?
    property Text: string read GetStr write SetStr; // une chaîne de nombre
    property AsDouble: Double read GetDouble; // un réel
    property AsInt: Integer read GetInt; // un entier
    // notification d'une erreur
    property Error: TGVErrors read fError write fError;
  end;

La partie publique comprend, outre le constructeur et le destructeur, une procédure Clear qui remet à zéro le nombre interne, quatre fonctions utiles et quatre propriétés.

L'entrée dans la classe se fait par la propriété AsString. Si possible, la chaîne est de manière interne transformée en nombre. En cas d'échec, la fonction IsValid retournera False comme résultat. L'accès en lecture d'un nombre erroné déclenchera une erreur.

La lecture peut être effectuée de trois manières : sous forme de chaîne (AsString), d'entier (AsInt) ou de nombre réel (AsDouble). Il est par ailleurs possible de tester le nombre interne pour savoir s'il s'agit d'un entier grâce à la fonction IsInt. La fonction IsNegate permet de savoir si le nombre est négatif. Enfin, la fonction IsZero compare de manière correcte des nombres réels qui seraient jugés inégaux pour des raisons de représentation interne.

L'implémentation ne pose pas de problèmes particuliers. Voici celle de SetStr qui gère l'entrée d'une nouvelle chaîne à traduire :

procedure TGVNumber.SetStr(const St: string);
// *** forme un nombre si possible ***
begin
  fSt := St; // chaîne brute affectée
  fValid := TryStrToFloat(St, fNum); // transformation possible ?
end;

On conserve le paramètre d'entrée et on le teste grâce à la fonction TryStrToFloat. Le drapeau privé fValid sera vérifié avant de renvoyer une valeur : l'utilisateur est ainsi assuré de toujours disposer d'une valeur correcte ou d'obtenir le déclenchement d'une erreur.

La classe TGVWord est de loin la plus fournie de cette unité. Elle gère les mots, qu'ils soient des chaînes de caractères ou des nombres, en reprenant toutes les fonctionnalités définies dans la description du langage GVLOGO qui concernent les mots.

La classe utilise deux champs privés de la classe TGVString et autant de la classe TGVNumber : ils servent d'outils de travail et de comparaisons. L'emploi de ces classes évite d'avoir constamment à vérifier la présence des caractères spéciaux.

En voici l'interface :

  TGVWord = class(TObject)
  strict private
    fError: TGVErrors; // traitement des erreurs
    fText: TGVString; // mot à traiter
    fNum, fNum2: TGVNumber; // nombres de travail
    function GetFmtText: string; // texte formaté
    function GetText: string; // texte brut
    procedure SetText(const St: string); // établit le texte
  protected
    function Compare(const St: string): Integer; // comparaison de deux mots
  public
    constructor Create; // constructeur
    destructor Destroy; override; // destructeur
    procedure Clear; // nettoyage
    function First: string; // premier caractère d'un mot
    function Last: string; // dernier caractère d'un mot
    function ButFirst: string; // sauf le premier caractère d'un mot
    function ButLast: string; // sauf le dernier caractère d'un mot
    // concatène les deux mots, le second en premier
    function PutFirst(const St: string): string;
    // concatène les deux mots, le premier d'abord
    function PutLast(const St: string): string;
    // supprime si nécessaire le " initial d'un mot
    function WithoutQuote: string;
    // supprime si nécessaire le : initial d'un mot
    function WithoutColon: string;
    function IsValidIdent: Boolean; // est-ce un identificateur valide ?
    // les deux mots sont-ils égaux ?
    function IsEqual(const St: string): Boolean;
    // le premier mot est-il à placer avant le second par ordre alphabétique ?
    function IsLower(const St: string): Boolean;
    // renvoie le mot qui vient avant par ordre alphabétique
    function Lowest(const St: string): string;
    // le premier mot est-il à placer après le second par ordre alphabétique ?
    function IsGreater(const St: string): Boolean;
    // renvoie le mot qui vient après par ordre alphabétique
    function Greatest(const St: string): string;
    function IsEmptyWord: Boolean; // le mot est-il vide ?
    // le mot est-il compris dans un autre ?
    function IsMember(const St: string): Boolean;
    function Count: Integer; // longueur du mot
    function StrCount: string; // longueur de mot en chaîne
    function GetItem(const N: Integer): string; // élément N d'un mot
    // remplacement de l'élément N d'un mot
    function Replace(const N: Integer; const St: string): string;
    // suppression de l'élément N d'un mot
    function DelItem(const N: Integer): string;
    function Reverse: string; // mot inversé
    function Shuffle: string; // mot mélangé
    function AtRandom: string; // lettre au hasard
    function Uppercase: string; // mot en majuscules
    function Lowercase: string; // mot en minuscules
    // insertion en position N
    function Insert(const N: Integer; const St: string): string;
    function Sort: string; // tri des lettres du mot
    function IsNumber: Boolean; // est-ce un nombre ?
    function IsInt: Boolean; // est-ce un entier ?
    function IsBoolean: Boolean; // est-ce un booléen ?
    function AsNumber: Double; // renvoie un nombre
    function AsInt: Integer; // renvoie un entier
    function AsBoolean: Boolean; // renvoie un booléen
    function IsNegate: Boolean; // nombre négatif ?
    function WithEsc: string; // chaîne formatée
    function WithoutEsc: string; // chaîne brute
    function IsValid: Boolean; // le mot est-il valide sans traitement ?
    function Rotate: string; // rotation des caractères d'un mot
    property Item[N: Integer]: string read GetItem; default; // élément N
    property Text: string read GetText write SetText; // mot à traiter
    property FmtText: string read GetFmtText; // mot à traiter formaté
    // notification d'une erreur
    property Error: TGVErrors read fError write fError;
  end;

La méthode protégée Compare s'occupe des comparaisons : il faut tenir compte de la comparaison de chaînes ordinaires et de nombres. En effet, 99 vient après 121 par ordre alphabétique, mais avant par ordre de grandeur mathématique !

function TGVWord.Compare(const St: string): Integer;
// *** comparaison de deux mots ***
begin
  // essai de conversion en nombre des deux mots
  fNum.Text := Text;
  fNum2.Text := St;
  // ce sont des nombres ?
  if fNum.IsValid and fNum2.IsValid then
    // si oui, on les compare
    Result := CompareValue(fNum2.AsDouble, fNum.AsDouble)
  else
    // on compare les  mots ordinaires
    Result := UTF8CompareText(St, Text); // comparaison UTF8
end;

Le meilleur moyen de s'approprier les méthodes de la classe TGVWord est de les voir fonctionner dans un programme.

Les versions proposées sont au nombre de deux :

• une version Lazarus Win32 ;
• une version Lazarus Linux.

On trouvera les fichiers sources et les exécutables dans le sous-dossier « 01 - testgvwords » du dossier « tests ».

Le programme lui-même est trivial puisqu'il se contente d'affecter le résultat d'une méthode de TGVWord à un TLabel si aucune erreur n'a été déclenchée. C'est exactement ce qui était recherché : l'unité remplit parfaitement son rôle en limitant au possible les complications pour l'utilisateur final. On notera en particulier que les erreurs sont affichées correctement sans que les méthodes d'affichage aient à s'occuper de leur traitement.

Il est intéressant de modifier les paramètres des éditeurs pour voir le comportement de l'unité. Par exemple, on pourra entrer des mots tels que "Essai, cou[cou… On peut aussi entrer une phrase complète et constater qu'elle sera normalisée pour être comprise comme un mot ! Dans tout test, il est conseillé de provoquer des erreurs afin de voir comment se comporte l'unité.

Une fonction souvent méconnue est utilisée largement dans ce programme : il s'agit de IfThen. La version traitant les chaînes de caractères est définie dans l'unité strutils. Elle prend deux ou trois paramètres en entrée : le premier est une valeur booléenne, les deux suivants des chaînes de caractères. Si le troisième est omis, il est par défaut défini à la chaîne vide. Le principe de fonctionnement est semblable à celui d'un test avec if…then…else : si la valeur booléenne est vraie, le second paramètre est renvoyé, sinon c'est le troisième.

Par exemple :

procedure TGVMainForm.btnIsValidIdentClick(Sender: TObject);
// test de ISVALIDIDENT
var
  LS: string;
begin
  fWord.Text := LabEdtFirst.Text;
  LS := IfThen(fWord.IsValidIdent, P_True, P_False);
  if fWord.Error.OK then
    lblResult.Caption := LS;
end;

Le test de la fonction IsValidIdent est effectué sur le composant TLabelEdit : si le résultat est correct, c'est la constante P_True qui est affectée au Caption du composant TLabel, sinon c'est P_False.

Voici quelques listes simples :

• [un deux trois quatre cinq]
• [1 2 3 4 5]
• [GVLOGO est un langage facile à apprendre.]

Voici des listes complexes :

• [élément1 [liste imbriquée 1] élément3]
• [un [deux imbriquée [encore deux mais imbriquée]] trois]
• [[]]
• [un [deux [deux bis [deux ter]]] trois]
• [un (12*45+789) trois]

Une liste est fautive si elle ne contient pas des crochets correctement agencés et en bon nombre.

Voici des listes incorrectes :

• [oups ! [où est la fermeture ?]
• [fermée trop tôt][ceci est une autre liste]
• [le caractère d'échappement masque la fin de liste !$]
• [Une parenthèse se promène seule (]

Pour contourner le problème des crochets ou des parenthèses mal appariés, il suffit d'utiliser le caractère d'échappement, comme avec les mots :

• [le caractère d'échappement ne masque plus la fin de liste !$]]
• [Une parenthèse se promène seule sans problème $(]

METS.PREMIER (raccourci : MP) : attend deux listes en entrée ou un mot et une liste - renvoie une liste - la liste rendue est composée du premier paramètre placé avant le second.

Exemples :

• ECRIS METS.PREMIER [Coucou] [Tortue !] → [Coucou] Tortue !
• ECRIS METS.PREMIER "Coucou [Tortue !] → Coucou Tortue !

METS.DERNIER (raccourci : MD) : attend deux listes en entrée ou un mot suivi d'une liste - renvoie une liste - la liste rendue est composée du premier paramètre placé après le second.

Exemples :

• ECRIS METS.DERNIER [Coucou] [Tortue !] → Tortue ! [Coucou]
• ECRIS METS.DERNIER "Coucou [Tortue !] → Tortue ! Coucou

PHRASE (raccourci : PH) : attend deux listes ou deux mots ou une combinaison des deux en entrée - renvoie une liste - la liste rendue est composée des deux éléments séparés par un espace sans les crochets et/ou sans les guillemets anglais.

Exemples :

• ECRIS PHRASE "je "viens → je viens
• ECRIS PHRASE [je] [pars] → je pars
• ECRIS PHRASE "je [reviens] → je reviens
• ECRIS PHRASE [je] "repars → je repars

INSERE : attend un entier, un mot ou une liste, puis une liste en entrée - renvoie une liste - la liste rendue est composée du deuxième paramètre inséré à la position précisée par l'entier dans la liste finale.

Exemples :

• ECRIS INSERE 2 "très [c'est bien] → c'est très bien
• ECRIS INSERE 1 [zéro] [[un][deux][trois]] → [zéro][un][deux][trois]

INVERSE : attend une liste en entrée - renvoie une liste - la liste rendue est celle d'entrée dont les éléments ont été inversés.

Exemple :

• ECRIS INVERSE [un deux trois] → trois deux un

MAJUSCULES : attend une liste en entrée - renvoie une liste - la liste rendue est en majuscules.

Exemple :

• ECRIS MAJUCULES [le soleil se lève] → LE SOLEIL SE LÈVE

MELANGE : attend une liste en entrée - renvoie une liste - la liste rendue a les mêmes éléments que celle d'origine, mais dans un ordre aléatoire.

Exemple :

• ECRIS MELANGE [un deux [troisa troisb]] → deux [troisa troisb] un

MINUSCULES : attend une liste en entrée - renvoie une liste - la liste rendue est en minuscules.

Exemple :

• ECRIS MINUSCULES [LES ENFANTS SE LÈVENT] → Les enfants se lèvent

REMPLACE : attend un entier, une liste ou un mot, puis une liste en entrée - renvoie une liste - la liste rendue est composée de tous les éléments de la liste finale, sauf celui visé par l'entier qui a été remplacé par le deuxième paramètre.

Exemples :

• ECRIS REMPLACE 4 "couchent [Les enfants se lèvent] → Les enfants se couchent
• ECRIS REMPLACE 2 [deuxième] [[premier][seconde][troisième]] → [premier][deuxième][troisième]

TRIE : attend une liste en entrée - renvoie une liste - les éléments de la liste sont triés par ordre alphabétique(9).

Exemple :

• ECRIS TRIE [zèbre tartine accent dommage] → accent dommage tartine zèbre

ROTATION : attend une liste en entrée - renvoie une liste - la primitive renvoie la liste dont le premier élément est placé à la fin.

Exemple :

• ECRIS ROTATION [un deux trois quatre] → deux trois quatre un

ELEMENT : attend un entier suivi d'une liste en entrée - renvoie une liste ou un mot - l'objet rendu est l'élément de la liste en entrée indiqué par l'entier.

Exemple :

• ECRIS ELEMENT 2 [un deux [trois]] → deux

DERNIER (raccourci : DER) : attend une liste en entrée - renvoie un mot ou une liste - l'objet renvoyé est composé du dernier élément de la liste en entrée.

Exemple :

• ECRIS DERNIER [un deux] → deux

HASARD : attend une liste en entrée - renvoie un mot ou une liste - l'objet renvoyé est composé d'un élément de la liste en entrée, tiré au hasard.

Exemple :

• ECRIS HASARD [un [deux] trois quatre] → trois

PREMIER (raccourci : PREM) : attend une liste en entrée - renvoie un mot ou une liste - l'objet renvoyé est composé du premier élément de la liste en entrée.

Exemple :

• ECRIS PREMIER [beau laid] → beau

PREMS : attend une liste en entrée - renvoie une liste - l'objet renvoyé est composé de chaque premier élément des éléments de la liste en entrée.

Exemples :

• ECRIS PREMS [beau [laid]] → b laid
• ECRIS PREMS [[moi beau] [toi laid]] → [moi] [toi]

SAUF.DERNIER (raccourci : SD) : attend une liste en entrée - renvoie un mot ou une liste - l'objet renvoyé est composé de la liste en entrée sans son dernier élément.

Exemple :

• ECRIS SAUF.DERNIER [pas cette liste stupide] → pas cette liste

SAUF.PREMIER (raccourci : SP) : attend une liste en entrée - renvoie un mot ou une liste - l'objet renvoyé est composé de la liste en entrée sans son premier élément.

Exemple :

• ECRIS SAUF.PREMIER [pas cette liste stupide] → cette liste stupide

SAUF.PREMS : attend une liste en entrée - renvoie une liste - l'objet renvoyé est composé de la liste en entrée sans chaque premier élément de ses éléments.

Exemples :

• ECRIS SAUF.PREMS [pas cette liste stupide] → as ette iste tupide
• ECRIS SAUF.PREMS [[un chat] [une chouette]] → [chat] [chouette]

PLG? : attend deux listes en entrée - renvoie un booléen - la primitive renvoie "VRAI si la première liste vient strictement après la seconde selon l'ordre alphabétique, "FAUX sinon.

Exemple :

• ECRIS PLG? [un petit chat] [un chat] → -1

PLP? : attend deux listes en entrée - renvoie un booléen - la primitive renvoie "VRAI si la première liste vient strictement avant la seconde selon l'ordre alphabétique, "FAUX sinon.

Exemple :

• ECRIS PLP? [le renard] [un renard] → -1

COMPTE : attend une liste en entrée - renvoie un entier - la primitive renvoie le nombre d'éléments de la liste en entrée.

Exemple :

• ECRIS COMPTE [un [deux encore deux] trois] → 3

EGAL? : attend deux listes en entrée - renvoie un booléen - la primitive renvoie "VRAI si la première liste est identique à la seconde, "FAUX sinon.

Exemple :

• ECRIS EGAL? [c'est la même] METSPREMIER "c'est [la même] → -1

MEMBRE? : attend une liste ou un mot, puis une liste en entrée - renvoie un booléen - la primitive renvoie "VRAI si le premier objet est compris dans le second, "FAUX sinon.

Exemples :

• ECRIS MEMBRE? [oui] [un deux [oui]] → -1
• ECRIS MEMBRE? "oui [un deux [oui]] → 0

LISTE? : attend un objet en entrée - renvoie un booléen - la primitive renvoie "VRAI si l'objet est une liste, "FAUX sinon.

Exemples :

• ECRIS LISTE? [coucou] → -1
• ECRIS LISTE? "coucou → 0

PRECEDENT : attend deux listes en entrée - renvoie une liste - la primitive renvoie la liste qui vient la première selon l'ordre alphabétique.

Exemple :

• ECRIS PRECEDENT [je suis premier] [je suis second] → je suis premier

SUIVANT : attend deux listes en entrée - renvoie une liste - la primitive renvoie la liste qui vient la dernière selon l'ordre alphabétique.

Exemple :

• ECRIS SUIVANT [je suis premier] [je suis second] → je suis second

VIDE? : attend une liste en entrée - renvoie un booléen - la primitive renvoie "VRAI si la liste en entrée est la liste vide, "FAUX sinon.

Exemples :

• ECRIS VIDE? [] → -1
• ECRIS VIDE? SAUF.PREMIER [un] → -1

Les constantes ont simplement été complétées avec les chaînes nécessaires au signalement des erreurs et un type énuméré baptisé TGVError qui reprend les erreurs sous forme codée.

La classe TGVListUtils concentre les méthodes utiles au traitement des listes. Il aurait été possible de les implémenter en tant que procédures et fonctions indépendantes, mais l'utilisation d'une classe et de son interface permet une meilleure maîtrise des outils : la classe définit précisément ce pour quoi elle est faite.

En voici l'interface :

  // *** classe des utilitaires pour les listes ***
  TGVListUtils = class
  strict private
    fError: TGVErrors; // traitement des erreurs
    fWord: TGVWord; // mot de travail
    fPos: Integer; // position de travail
    fSt: TGVString; // chaîne de travail
  public
    constructor Create; // constructeur
    destructor Destroy; override; // destructeur
    procedure Clear; // nettoyage
    // conversion d'une liste en mot
    function ListToWord(const St: string): string;
    // conversion d'un mot en liste
    function WordToList(const St: string): string;
    // conversion d'une liste en chaîne
    function ListToStr(const St: string): string; overload;
    function ListToStr(const St: string; out ASt: string): Boolean; overload;
    // conversion d'une chaîne en liste
    function StrToList(const St: string): string;
    // retourne la liste vide
    function EmptyList: string;
    // vérifie la validité d'une liste
    function IsValid(const St: string): Boolean;
    // teste la validité d'une valeur (mot ou liste)
    function IsValidValue(const St: string): Boolean;
    // liste simple ?
    function IsSimpleList(const St: string): Boolean;
    // notification d'une erreur
    property Error: TGVErrors read fError write fError;
  end;

En dehors de la fonction EmptyList qui se contente de renvoyer la liste vide, il s'agit essentiellement de méthodes de conversion et de validation.

Ainsi ListToStr et StrToList convertissent une liste en chaîne et réciproquement. ListToWord et WordToList prennent en compte le caractère d'échappement. Pour ces quatre méthodes, un contrôle de la validité des listes est effectué.

Le contrôle de la validité d'une liste s'effectue grâce à IsValid qui est de loin la plus complexe. Elle analyse une chaîne et contrôle caractère par caractère que les règles relatives aux listes sont respectées : autant de crochets ouvrants que de crochets fermants, dans le bon ordre ; autant de parenthèses ouvrantes que de parenthèses fermantes, dans le bon ordre ; prise en compte du caractère d'échappement ; interdiction des sous-listes à l'intérieur d'une expression parenthésée.

Les autres méthodes de contrôle sont plus simples. IsSimpleValue se contente de vérifier la présence des crochets pour une liste. IsValidValue exploite l'unité GVWords pour tester un mot et la méthode précédente pour une liste. TestValue est une procédure qui déclenche une exception si la chaîne en entrée n'est ni un mot ni une liste au sens de GVLOGO.

La classe TGVList implémente la gestion des listes pour GVLOGO. Elle hérite de TStringList qui gère les listes de chaînes. En fait, une liste en LOGO est une chaîne particulière de caractères : elle nécessite d'être entourée de crochets et, si elle comprend d'autres listes, de comprendre à l'intérieur autant de crochets ouvrants que de crochets fermants (dans le bon ordre évidemment !). Cette dernière remarque s'applique aussi pour les éventuelles expressions imbriquées dans la liste. Pour parvenir à cet effet, il faut surcharger les méthodes d'entrée : Add, LoadFromStream, Assign, Insert et Put. Chaque élément de la liste (mot ou sous-liste) est stocké dans une chaîne de la TStringList.

Toutes les nouvelles méthodes renvoient une chaîne ou une valeur sans modifier la liste d'entrée. En cas d'erreur lors de la construction de la liste, la liste interne est la chaîne vide et la propriété LastErrorPos renvoie l'indice de l'erreur détectée.

En voici l'interface(10) :

  TGVList = class(TStringList)
  strict private
    fRawStr: string; // chaîne brute en entrée
    fError: TGVErrors; // traitement des erreurs
    fIsValid: Boolean; // validité de la liste
    fPos: Integer; // position de travail
    fLoading: Boolean; // chargement en cours ?
    fNumLastItem: Integer; // dernier élément trouvé
    fWord: TGVWord; // mot de travail
    fUtil: TGVListUtils; // utilitaire pour liste
  protected
    procedure Put(Index: Integer; const St: string); override; // assignation
    function Get(Index: Integer): string; override; // élément choisi
    function GetTextStr: string; override; // récupération du texte
    procedure SetTextStr(const AValue: string); override; // validation du texte
  public
    constructor Create; overload; // création
    destructor Destroy; override; // destruction
    procedure Clear; override; // nettoyage
    function Add(const St: string): Integer; override; // ajout
    procedure LoadFromStream(Stream: TStream); overload; override; // chargement
    procedure Assign(Source: TPersistent); override; // assignation
    procedure Insert(Index: Integer; const St: string); override; // insertion
    // nouvelles méthodes (*** ne modifient pas la liste interne ***)
    // renvoie la liste sous forme de chaîne
    function ToStr: string;
    // renvoie la liste sous forme de chaîne sans crochets
    function ToWBStr: string;
    // la liste est-elle la liste vide ?
    function IsEmptyList: Boolean;
    // renvoie le premier élément de la liste
    function First: string;
    // renvoie le dernier élément de la liste
    function Last: string;
    // sauf le premier de la liste
    function ButFirst: string;
    // sauf le dernier de la liste
    function ButLast: string;
    // supprime l'élément N
    function DeleteItem(N: Integer): string;
    // insertion d'un élément en position N
    function InsertAItem(N: Integer; const St: string): string;
    // remplacement de l'élément N
    function ReplaceItem(N: Integer; const St: string): string;
    // met en premier
    function PutFirst(const St: string): string;
    // met en dernier
    function PutLast(const St: string): string;
    // phrase à droite
    function SentenceRight(const St: string): string;
    // phrase à gauche
    function SentenceLeft(const St: string): string;
    // tri des éléments
    function SortItems: string;
    // inversion des éléments
    function ReverseItems: string;
    // mélange des éléments
    function ShuffleItems: string;
    // membre présent ?
    function IsItem(const St: string): Boolean;
    // ajout d'une paire
    function TwoAdd(const St1, St2: string): string;
    // suppression d'une paire
    function TwoDelete(const N: Integer): string;
    // liste en majuscules
    function UpperCase: string;
    // liste en minuscules
    function LowerCase: string;
    // rotation de la liste
    function Rotate: string;
    // élément de la liste choisi au hasard
    function AtRandom: string;
    // premier élément de chaque élément d'une liste
    function Firsts: string;
    // tout sauf le premier élément de chaque élément d'une liste
    function ButFirsts: string;
    // dernier élément traité
    property LastItem: Integer read fNumLastItem default -1;
    // chaîne brute en entrée
    property RawStr: string read fRawStr; // chaîne brute en entrée
    // notification d'une erreur
    property Error: TGVErrors read fError write fError;
    // validité de la liste
    property IsValid: Boolean read fIsValid default False;
    // acquisition du texte
    property Text: string read GetTextStr write SetTextStr;
  end;

La méthode la plus complexe est certainement Add. Elle prend en charge l'ensemble du contrôle de la validité de la liste. Cette méthode comprend une partie générale qui teste les mots et les listes avant de renvoyer une éventuelle position d'erreur ou de stocker les chaînes trouvées, et une procédure imbriquée qui examine le contenu de la chaîne. Cette dernière lit les caractères un par un et répartit le travail suivant ce qu'elle rencontre : blanc, crochet ouvrant, parenthèse ouvrante, échappement, crochet et parenthèse fermants mais orphelins, autre caractère.

Elle est en cela similaire à la méthode IsValid de TGVListUtils, sinon qu'elle stocke les éléments en vue de leur exploitation. Du point de vue de l'utilisateur, l'entrée d'une nouvelle liste se fait grâce à la propriété héritée Text de l'unité : il suffit d'affecter une chaîne à cette propriété pour qu'elle soit analysée et stockée.

La propriété LastItem n'est affectée que par l'utilisation de la méthode IsItem. Si cette dernière renvoie True, LastItem contiendra le numéro de l'élément de la liste qui correspond à celui recherché.

Comme lors du test de TGVWords, les versions proposées sont au nombre de deux :

• une version Win32 ;
• une version Linux.

Le programme lui-même ne pose pas de problèmes particuliers. Il ne s'agit en effet que de mettre à jour la liste de travail et d'appliquer la méthode voulue.

Il est encore une fois conseillé de modifier les différents paramètres pour observer les réactions de l'unité.

Comme pour les unités précédentes, l'unité GVConsts a été complétée afin de prendre en compte les nouveaux besoins. Les ajouts ont été effectués au niveau des constantes elles-mêmes.

On remarquera l'extension pour les fichiers et surtout l'en-tête qui permettra de vérifier qu'un fichier est conforme au format attendu : il précèdera les données proprement dites.

Les chaînes de ressources ont aussi été complétées, de même pour l'énumération des erreurs possibles.

Comme son nom l'indique, l'énumération est un moyen de dresser la liste des éléments contenus dans un objet. Aussi bien Lazarus que Delphi en font un usage étendu à travers les objets tels que les listes.

La technique d'implémentation, finalement assez simple, obéit à un schéma type : on doit fournir l'élément en cours (pointé par une propriété en lecture seule) et être capable d'indiquer si l'on peut se déplacer vers l'élément suivant.

Cela donne dans le cas des listes de propriétés l'interface suivante :

type
  // *** classe pour énumération ***
  TGVPropListEnumerator = class(TObject)
  private
    fLst: TStringList;
    fIndex: Integer;
  protected
    function GetCurrent: string; virtual; // élément en cours
  public
    constructor Create(const Value: TStrings); // création
    destructor Destroy; override; // destruction
    function MoveNext: Boolean; // vers le suivant
    property Current: string read GetCurrent; // valeur de l'élément courant
  end;

Comme les listes de propriétés fonctionnent via une liste interne, il suffit d'en manipuler les éléments grâce à un index.

La classe TGVPropList fonctionne grâce à un champ privé fNames de type TStringList. Les méthodes sont organisées en trois blocs : méthodes générales, celles concernant les listes de propriétés et celles concernant les propriétés.

En voici l'interface :

  // *** classe des listes de propriétés ***
  TGVPropList = class(TObject)
  strict private
    fError: TGVErrors; // enregistrement d'une erreur
    fNames: TStringList; // listes
    fOnchange: TNotifyEvent; // notification de changement
    function GetLPByNum(N: Integer): string; // liste par numéro
    function GetLPByName(const Name: string): string; // renvoie liste par nom
    procedure SetLPByName(const Name, Value: string); // fixe liste par nom
  protected
    procedure Change; // changement
  public
    // constructeur de la classe
    constructor Create;
    // destructeur de la classe
    destructor Destroy; override; // destructeur
    // énumération
    function GetEnumerator: TGVPropListEnumerator;
    // nettoie les listes de propriétés
    procedure Clear;
    // *** listes de propriétés ***
    // renvoie la liste des listes de propriétés
    function ListP: string;
    // la liste existe-t-elle ?
    function IsListP(const Name: string): Boolean;
    // renvoie le numéro d'une liste de propriétés
    function NumListP(const Name: string): Integer;
    // crée ou met à jour la liste de propriétés
    function UpDateListP(const Name, Prop, Value: string): Boolean;
    // renvoie la valeur d'une liste
    function ValListP(const Name: string): string;
    // destruction d'une liste de propriétés
    function RemoveListP(const Name: string): Boolean;
    // valeur d'une liste de propriétés par numéro
    function ValNumListP(N: Integer; out Name, Value: string): Boolean;
    // la propriété N existe-t-elle?
    function IsListPByNum(N: Integer): Boolean;
    // renvoie le nombre de listes de propriétés
    function CountListP: Integer;
    // chargement des listes
    procedure LoadFromFile(const FileName: string);
    // sauvegarde des listes
    procedure SaveToFile(const FileName: string);
    // *** propriétés
    // la propriété existe-t-elle ?
    function IsProp(const Name, Prop: string): Boolean;
    // renvoie le numéro d'une propriété
    function NumProp(const Name, Prop: string): Integer;
    // valeur d'une propriété
    function ValProp(const Name, Prop: string): string;
    // destruction d'une propriété
    function RemoveProp(const Name, Prop: string): Boolean;
    // renvoie le nombre de propriétés attachées à une liste
    function CountProps(const Name: string): Integer;
    // valeur d'une propriété par numéro
    function ValNumProp(const Name: string; N: Integer; out Prop: string)
      : Boolean; overload;
    function ValNumProp(const Name: string; N: Integer): string;
    // liste des propriétés d'une liste
    function ListOfProps(const Name: string): string;
    // nom d'une propriété par numéro
    function NameOfProp(const Name: string; N: Integer): string; overload;
    // changement dans la liste de propriétés
    property OnChange: TNotifyEvent read fOnchange write fOnchange;
    // liste de propriétés par numéro
    property ListPByNum[N: Integer]: string read GetLPByNum; default;
    // liste de propriétés par nom
    property LPByName[const Name: string]: string read GetLPByName
       write SetLPByName;
    // notification d'une erreur
    property Error: TGVErrors read fError write fError;
  end;

Parmi les difficultés, on relèvera :

• Les listes de propriétés sont numérotées à partir de 1 et non de 0 comme en Pascal ;
• La méthode RemoveProp détruit aussi la liste si elle ne contient plus aucune propriété ;
• La méthode UpdateListP crée et met à jour les listes et les propriétés ;
• Il est fait un usage intensif de la fonction Odd qui vérifie qu'un nombre est impair : en effet, comme les propriétés sont organisées par paires, il est nécessaire de bien différencier le nom de la propriété (élément impair) de sa valeur (élément pair).

Comme d'habitude, le programme de test est décliné en deux versions :

• Lazarus pour Windows 32 ;
• Lazarus pour Linux.

Un fichier de listes préenregistrées permet de tester immédiatement LoadFromFile : « ListPs.GPL ». Il peut être édité par n'importe quel lecteur de textes simples (genre NotePad).

Le champ de la tortue est la surface sur laquelle elle peut évoluer. Le coin inférieur gauche de l'écran est la position d'abscisse 0 et d'ordonnée 0. Par défaut, le point supérieur droit a pour abscisse la largeur du composant d'accueil et pour ordonnée sa hauteur(12).

CLOS : n'attend rien en entrée - ne renvoie rien - le champ de la tortue est limité à l'écran visible. Toute tentative de sortir de l'écran se soldera par un échec.

Exemple :

• CLOS → -

ENROULE : n'attend rien en entrée - ne renvoie rien - le champ de la tortue s'enroule sur lui-même : quand la tortue atteint un bord, elle réapparaît sur le bord opposé.

Exemple :

• ENROULE → -

FENETRE (raccourci : FEN) : n'attend rien en entrée - ne renvoie rien - le champ de la tortue s'étend au-delà de l'écran. La tortue peut donc disparaître du champ de vision de l'utilisateur.

Exemple :

• FENETRE → -

ETAT.ECRAN : n'attend rien en entrée - renvoie une liste - la liste renvoyée indique l'état actuel de l'écran avec les données suivantes : couleur, hauteur et largeur.

Exemple :

• ECRIS ETAT.ECRAN → 0 700 677

FIXE.ECHELLE : attend une liste de deux entiers en entrée - ne renvoie rien - la primitive détermine les proportions du déplacement de la tortue. Par défaut, la valeur pour les abscisses (premier entier) et pour les ordonnées (second paramètre) est de 100. Une valeur moindre réduira les déplacements dans la proportion indiquée et une valeur supérieure l'augmentera. Par exemple, fixer le premier entier à 200 et le second à 50 fera que la tortue se déplacera deux fois plus vite horizontalement que la normale et deux fois plus lentement verticalement.

Exemple :

• FIXE.ECHELLE [200 50] → -

FIXE.ECHELLEX : attend un entier en entrée - ne renvoie rien - la primitive détermine la proportion du déplacement de la tortue selon l'axe des abscisses.

Exemple :

• FIXE.CHELLEX 200 → -

FIXE.ECHELLEY : attend un entier en entrée - ne renvoie rien - la primitive détermine la proportion du déplacement de la tortue selon l'axe des ordonnées.

Exemple :

• FIXE.ECHELLEY 50 → -

ECHELLE : n'attend rien en entrée - renvoie une liste de deux entiers - la liste renvoyée contient un premier entier qui indique l'échelle des déplacements de la tortue selon l'axe des abscisses et un second entier qui indique l'échelle selon l'axe des ordonnées.

Exemple :

• ECRIS ECHELLE → 100 100

VIDE.ECRAN (raccourci : VE) : n'attend rien en entrée - ne renvoie rien - l'espace de la tortue est nettoyé et la tortue retrouve sa place et son cap d'origine, ainsi que toutes ses valeurs par défaut.

Exemple :

• VIDE.ECRAN → -

ORIGINE : n'attend rien en entrée - ne renvoie rien - la tortue retrouve sa position d'origine en [300 300] et son cap initial de 90. L'état du crayon n'est pas modifié. Si le crayon est baissé, le déplacement de la tortue laisse une trace.

Exemple :

• ORIGINE → -

NETTOIE : n'attend rien en entrée - ne renvoie rien - l'espace de la tortue est nettoyé, sans changer la position de la tortue ni son cap, pas plus que les valeurs du crayon.

Exemple :

• NETTOIE → -

FIXE.COULEUR.FOND (raccourci : FCF) : attend un entier en entrée - ne renvoie rien - la primitive détermine la couleur de fond de l'écran de la tortue.

Exemple :

• FIXE.COULEUR.FOND 19 → -

COULEUR.FOND (raccourci : CF) : n'attend rien en entrée - renvoie un entier - l'entier renvoyé correspond à la couleur du fond de l'écran de la tortue.

Exemple :

• ECRIS COULEUR.FOND → 19

DISTANCE : attend deux entiers en entrée - renvoie un entier - l'entier renvoyé correspond à la distance de la tortue au point de coordonnées fournies en entrée (abscisse puis ordonnée).

Exemple :

• ECRIS DISTANCE 50 50 → 190

AVANCE (raccourci : AV) : attend un entier en entrée - ne renvoie rien - la tortue avance du nombre de pixels indiqué par le paramètre en entrée, sauf si les échelles ont été changées. Elle laisse une trace sur la zone de dessin à moins que son crayon ne soit levé ou qu'elle soit en mode gomme.

Exemple :

• AVANCE 45 → -

RECULE (raccourci : RE) : attend un entier en entrée - ne renvoie rien - la tortue recule du nombre de pixels indiqué par le paramètre en entrée, sauf si les échelles ont été changées. Elle laisse une trace sur la zone de dessin à moins que son crayon ne soit levé ou qu'elle soit en mode gomme.

Exemple :

• RECULE 50 → -

GAUCHE (raccourci : TG) : attend un réel en entrée - ne renvoie rien - la tortue tourne à gauche du nombre de degrés indiqué en entrée.

Exemple :

• GAUCHE 90 → -

DROITE (raccourci : TD) : attend un réel en entrée - ne renvoie rien - la tortue tourne à droite du nombre de degrés indiqué en entrée.

Exemple :

• DROITE 90 → -

FIXE.POS (raccourci : FPOS) : attend une liste de deux entiers en entrée - ne renvoie rien - la tortue est envoyée à la position indiquée par la liste : le premier élément fixe l'abscisse tandis que le second détermine l'ordonnée.

Exemple :

• FIXE.POS [200 100] → -

FIXE.XY (raccourci : FXY) : attend deux entiers en entrée - ne renvoie rien - la tortue est envoyée à la position indiquée par les paramètres : le premier élément fixe l'abscisse tandis que le second détermine l'ordonnée.

Exemple :

• FIXE.XY 200 100 → -

FIXE.X (raccourci : FX) : attend un entier en entrée - ne renvoie rien - l'abscisse de la tortue est fixée à l'entier fourni en entrée.

Exemple :

• FIXE.X 200 → -

FIXE.Y (raccourci : FY) : attend un entier en entrée - ne renvoie rien - l'ordonnée de la tortue est fixée à l'entier fourni en entrée.

Exemple :

• FIXE.Y 100 → -

POS : n'attend rien en entrée - renvoie une liste de deux entiers - la liste renvoyée contient un premier entier qui indique l'abscisse de la tortue et un second entier qui indique son ordonnée.

Exemple :

• ECRIS POS → 200 100

XCOOR : n'attend rien en entrée - renvoie un entier - l'entier renvoyé indique l'abscisse de la tortue.

Exemple :

• ECRIS XCOOR → 200

YCOOR : n'attend rien en entrée - renvoie un entier - l'entier renvoyé indique l'ordonnée de la tortue.

Exemple :

• ECRIS YCOOR → 100

FIXE.VITESSE : attend un entier en entrée - ne renvoie rien - la vitesse de la tortue est fixée à l'entier fourni en entrée.

Exemple :

• FIXEVITESSE 100 → -

VITESSE : n'attend rien en entrée - renvoie un entier - l'entier renvoyé indique la vitesse de dessin de la tortue.

Exemple :

• ECRIS VITESSE → 100

FIXE.CAP (raccourci : FCAP) : attend un réel en entrée - ne renvoie rien - le cap de la tortue est fixé au nombre fourni en entrée. Le cap est compris entre 0 et 360.

Exemple :

• FIXECAP 90 → -

CAP : n'attend rien en entrée - renvoie un entier - l'entier renvoyé indique le cap de la tortue.

Exemple :

• ECRIS CAP → 90

VERS : attend une liste de deux entiers en entrée - renvoie un entier - L'entier renvoyé indique le cap que devrait avoir la tortue pour pointer vers le point dont les coordonnées sont fournies en entrée.

Exemple :

• VERS [0 0] → 214

MONTRE.TORTUE (raccourci : MT) : n'attend rien en entrée - ne renvoie rien - la tortue devient visible.

Exemple :

• MONTRE.TORTUE → -

CACHE.TORTUE (raccourci : CT) : n'attend rien en entrée - ne renvoie rien - la tortue devient invisible.

Exemple :

• CACHE.TORTUE → -

VISIBLE? : n'attend rien en entrée - renvoie un booléen - la primitive renvoie "VRAI si la tortue est visible, "FAUX sinon.

Exemple :

• ECRIS VISIBLE? → -1

ETAT.TORTUE : n'attend rien en entrée - renvoie une liste - la liste renvoyée fournit les données relatives à la tortue : son abscisse, son ordonnée, son cap, sa taille, sa vitesse, sa visibilité et si elle est figurée par un triangle.

Exemple :

• ECRIS ETAT.TORTUE → 300 300 98 8 100 -1 0

FIXE.ETAT.TORTUE : attend une liste en entrée - ne renvoie rien - l'état de la tortue est fixé selon le contenu de la liste : abscisse, ordonnée, orientation, taille, vitesse, visibilité et type de tortue. La tortue dessine durant le changement si le crayon est baissé.

Exemple :

• FIXE.ETAT.TORTUE [100 100 0 8 100 -1 -1] → -

TORTUE.NORMALE : n'attend rien en entrée - ne renvoie rien - quand elle est visible, la tortue est symbolisée par un triangle. C'est le mode par défaut.

Exemple :

• TORTUE.NORMALE → -

TORTUE.VERTE : n'attend rien en entrée - ne renvoie rien - quand elle est visible, la tortue est dessinée à partir d'images au format PNG.

Exemple :

• TORTUE.VERTE → -

FIXE.TAILLE : attend un entier en entrée - ne renvoie rien - la taille de la tortue est fixée au nombre fourni en entrée.

Exemple :

• FIXE.TAILLE 10 → -

TAILLE : n'attend rien en entrée - renvoie un entier - l'entier renvoyé indique la taille actuelle de la tortue.

Exemple :

• ECRIS TAILLE → 8

BAISSE.CRAYON (raccourci : BC) : n'attend rien en entrée - ne renvoie rien - le crayon est baissé et donc dessine avec les attributs qui lui ont été affectés. C'est la position par défaut du crayon.

Exemple :

• BAISSE.CRAYON → -

LEVE.CRAYON (raccourci : LC) : n'attend rien en entrée - ne renvoie rien - le crayon est levé et donc ne dessine pas lorsque la tortue est déplacée.

Exemple :

• LEVE.CRAYON → -

BAISSE? : n'attend rien en entrée - renvoie un booléen - la primitive renvoie "VRAI si le crayon est baissé, "FAUX sinon.

Exemple :

• ECRIS BAISSE? → -1

FIXE.COULEUR.CRAYON (raccourci : FCC) : attend un entier en entrée - ne renvoie rien - la primitive détermine la couleur d'écriture du crayon de la tortue(13).

Exemple :

• FIXE.COULEUR.CRAYON 5 → -

COULEUR.CRAYON (raccourci : CC) : n'attend rien en entrée - renvoie un entier - l'entier renvoyé correspond à la couleur du crayon de la tortue.

Exemple :

• ECRIS COULEUR.CRAYON → 5

FIXE.TAILLE.CRAYON : attend un entier en entrée - ne renvoie rien - l'épaisseur du trait du crayon de la tortue est fixée au nombre fourni en entrée.

Exemple :

• FIXE.TAILLE.CRAYON 2 → -

TAILLE.CRAYON : n'attend rien en entrée - renvoie un entier - l'entier renvoyé correspond à l'épaisseur de trait du crayon de la tortue.

Exemple :

• ECRIS TAILLE.CRAYON → 2

INVERSE.CRAYON : n'attend rien en entrée - ne renvoie rien - le crayon écrit dans la couleur complémentaire de la couleur en cours.

Exemple :

• INVERSE.CRAYON → -

GOMME : n'attend rien en entrée - ne renvoie rien - le crayon efface en avançant.

Exemple :

• GOMME → -

NORMAL : n'attend rien en entrée - ne renvoie rien - le crayon n'inverse plus et n'efface plus.

Exemple :

• NORMAL → -

ETAT.CRAYON : n'attend rien en entrée - renvoie une liste - la liste renvoyée fournit les données relatives au crayon de la tortue : sa couleur, son épaisseur, s'il écrit ou non, si l'écriture est inversée ou non.

Exemple :

• ECRIS ETAT.CRAYON → 1 1 -1 0

FIXE.CRAYON ou FIXE.ETAT.CRAYON (raccourci : FEC) : attend une liste en entrée - ne renvoie rien - l'état du crayon est fixé selon le contenu de la liste : couleur, épaisseur, écriture ou non, inversion ou non.

Exemple :

• FIXE.ETAT.CRAYON [1 2 -1 0] → -

GVLOGO fournit plusieurs formes prédéfinies qui seront dessinées soit à une position indiquée par l'utilisateur soit par rapport à la position de la tortue. Ces formes ne sont pas orientables suivant un angle (par exemple, celui de l'orientation de la tortue), mais de telles formes sont facilement programmables en LOGO lui-même.

Afin d'éviter un conflit entre le nom des éventuelles procédures définies par l'utilisateur et celui des primitives de dessins de formes, on emploie pour nommer ces dernières le préfixe F_.

F.RECTANGLE : attend une liste en entrée - ne renvoie rien - un rectangle est dessiné avec les coordonnées de deux points fournies en entrée(14).

Exemple :

• F.RECTANGLE [100 100 200 200] → -

F.RECTANGLE.ARRONDI : attend une liste en entrée - ne renvoie rien - un rectangle arrondi est dessiné avec les coordonnées de deux points fournies en entrée.

Exemple :

• F.RECTANGLE.ARRONDI [50 100 150 200] → -

F.CARRE : attend une liste en entrée - ne renvoie rien - un carré est dessiné avec les coordonnées du point supérieur gauche suivies de la longueur de son côté.

Exemple :

• F.CARRE [20 20 50] → -

F.ELLIPSE : attend une liste en entrée - ne renvoie rien - une ellipse est dessinée avec les coordonnées de deux points fournies en entrée.

Exemple :

• F.ELLIPSE [100 100 200 200] → -

F.CERCLE : attend une liste en entrée - ne renvoie rien - un cercle est dessiné avec les coordonnées du premier point du cercle suivies de la longueur de son rayon.

Exemple :

• F.CERCLE [20 20 50] → -

REMPLIS : n'attend rien en entrée - ne renvoie rien - les figures seront pleines et par conséquent recouvriront celles qui seront placées dans leur espace de dessin.

Exemple :

• REMPLIS → -

LAISSE.VOIR : n'attend rien en entrée - ne renvoie rien - les figures seront transparentes et par conséquent ne recouvriront pas celles qui seront placées dans leur espace de dessin.

Exemple :

• LAISSE.VOIR → -

La tortue peut écrire à son emplacement. Le texte aura alors sa couleur et son orientation. L'utilisateur peut aussi écrire à un emplacement défini par lui avec l'orientation, la taille et la couleur de son choix.

TEXTE.TORTUE : attend un mot ou une liste en entrée - ne renvoie rien - le texte spécifié en paramètre est écrit sur l'écran de la tortue en utilisant ses coordonnées, sa taille, sa couleur et son orientation.

Exemple :

• TEXTE.TORTUE [Bonjour mon ami !] → -

FIXE.ANGLE.TEXTE : attend un entier en entrée - ne renvoie rien - le texte sera écrit avec l'angle spécifié en entrée, selon le même principe que l'orientation de la tortue.

Exemple :

• FIXE.ANGLE.TEXTE 90 → -

ANGLE.TEXTE : n'attend rien en entrée - renvoie un entier - la primitive renvoie l'angle actuel d'écriture d'un texte sur l'écran de la tortue.

Exemple :

• ECRIS ANGLE.TEXTE → 90

FIXE.TAILLE.FONTE : attend un entier en entrée - ne renvoie rien - le texte sera écrit avec la taille de caractère spécifiée en entrée, si cette taille est possible pour la police en cours.

Exemple :

• FIXE.TAILLE.FONTE 16 → -

TAILLE.FONTE : n'attend rien en entrée - renvoie un entier - la primitive renvoie la taille actuelle d'écriture d'un texte sur l'écran de la tortue.

Exemple :

• ECRIS TAILLE.FONTE → 16

FIXE.COULEUR.TEXTE (raccourci : FCT) : attend un entier en entrée - ne renvoie rien - le texte sera écrit avec la couleur de caractère spécifiée en entrée.

Exemple :

• FIXE.COULEUR.TEXTE 5 → -

COULEUR.TEXTE : n'attend rien en entrée - renvoie un entier - la primitive renvoie la couleur actuelle d'écriture d'un texte sur l'écran de la tortue.

Exemple :

• ECRIS COULEUR.TEXTE → 5

TEXTE.LIBRE.TORTUE : attend deux entiers puis un mot ou une liste en entrée - ne renvoie rien - le texte indiqué par le mot ou la liste fourni en paramètre est écrit sur l'écran de la tortue en utilisant les entiers comme coordonnées (abscisse et ordonnée). La taille, la couleur et l'orientation sont celles définies par les primitives définies ci-dessus.

Exemple :

• TEXTE.LIBRE.TORTUE 100 150 [Bonjour mon ami !] → -

L'unité GVConsts n'est modifiée que modestement par l'ajout de quelques constantes :

  // *** tortue graphique ***
  // couleurs de base
  CColors: array[0..19] of TColor = (clBlack, clMaroon, clGreen, clOlive,
    clNavy, clPurple, clTeal, clGray, clSilver, clRed, clLime, clYellow,
    clBlue, clFuchsia, clAqua, clWhite, clMoneyGreen, clSkyBlue, clCream,
    clMedGray);
  DgToRad = Pi / 180; // pour les conversions en radians
  RadToDg = 180 / Pi; // pour les conversions en degrés
  CDefaultScale = 100; // échelle par défaut
  CDefaultHeading = 90; // cap par défaut
  CDefaultXY = 600; // taille écran tortue par défaut
  CDefaultSize = 8; // taille d'une tortue par défaut
  CMaxSize = 20; // taille maximale de la tortue
  CMaxSpeed = 100; // vitesse maximum de la tortue
  CDefaultPenColor = clWhite; // couleur de fond par défaut
  CDefaultBackColor = clBlack; // couleur du crayon par défaut
  CDefaultPenWidth = 1; // largeur du crayon par défaut

Quelques types viennent compléter le tout afin de définir le type d'écran et de tortue, ainsi qu'un enregistrement possible de l'état complet de la tortue :

type
  // *** type d'écrans : enroulement, fenêtre illimitée ou champ clos ***
  TScreenTurtle = (teWin, teGate, teRoll);

  // *** types de tortue : triangle, dessin ou personnalisée (réservée) ***
  TTurtleKind = (tkTriangle, tkPng, tkOwner);

  // *** définition d'une tortue ***
  TTurtle = record
    rSaved: Boolean; // drapeau de sauvegarde
    rX: Extended; // abscisse
    rY: Extended; // ordonnée
    rKind: TTurtleKind; // type de tortue
    rSize: Integer; // taille de la tortue
    rVisible: Boolean; // drapeau de visibilité
    rHeading: Extended; // direction
    rPenDown: Boolean; // drapeau de crayon baissé
    rPenRubber: Boolean; // drapeau d'effacement
    rScaleX: Integer; // échelle des X
    rScaleY: Integer; // échelle des Y
    rFilled: Boolean; // remplissage
    rPenWidth: Integer; // largeur de crayon
    rBrush: TBrush; // type de brosse
    rPen: TPen; // type de crayon
    rFont: TFont; // type de fonte
  end;

Afin de déterminer un déplacement de la tortue sur la surface de travail, il faut connaître ses coordonnées pas à pas en fonction de son cap. Pour cela, on utilisera les fonctions sinus et cosinus :

Aussi bien Lazarus que Delphi fournissent une procédure bien pratique(16) pour les déterminer : SinCos définie pour un réel étendu de la manière suivante :

procedure sincos(theta : float;out sinus;cosinus : float) ;

Theta est l'angle exprimé en radians et les sinus et cosinus sont renvoyés dans les paramètres appropriés.

Voici par exemple comment elle est utilisée dans la procédure Move qui déplace la tortue :

procedure TGVTurtle.Move(Value: Double);
// *** la tortue se déplace ***
var
  LSinT, LCosT: Extended;
  LTX, LTY: Double;
begin
  // calcul du cosinus et du sinus du cap
  SinCos((Heading - 90) * DgToRad, LSinT, LCosT);
  // calcul des nouvelles coordonnées
  LTX := fX - Value * LSinT * (ScaleX / CDefaultScale);
  LTY := fY + Value * LCosT * (ScaleY / CDefaultScale);
  SetPos(LTX, LTY); // déplacement si possible
end;

fX et fY sont les coordonnées avant le déplacement. On remarquera la transformation des degrés en radians pour l'orientation ainsi que l'utilisation des échelles pour déterminer le nombre réel de pixels à franchir. La position sera par la suite arrondie puisqu'on ne peut dessiner que des pixels à des positions entières.

De la même manière, lorsqu'on voudra dessiner le triangle représentant la tortue, des formules similaires seront utilisées :

procedure TGVTurtle.DrawTriangleTurtle;
// *** dessin de la tortue triangulaire ***
var
  LCosT, LSinT: Extended;
  LX1, LX2, LX3, LY1, LY2, LY3: Integer;
begin
  // on efface la surface
  fTtlImg.FillRect(0,0,fWidth, fHeight, BGRAPixelTransparent, dmSet);
  // calcul des coordonnées des points de la tortue
  SinCos((90 + Heading) * DgToRad, LSinT, LCosT);
  LX1 := Round(CoordX + Size * LCosT - LSinT);
  LY1 := cY(Round(CoordY + Size * LSinT + LCosT));
  LX2 := Round(CoordX - Size * LCosT - LSinT);
  LY2 := cY(Round(CoordY - Size * LSinT + LCosT));
  LX3 := Round(CoordX - LCosT + (Size shl 1) * LSinT);
  LY3 := cY(Round(CoordY - LSinT - (Size shl 1) * LCosT));
  with fTtlImg.CanvasBGRA do
  begin
    if PenColor <> BGRAToColor(BGRAPixelTransparent) then
      Pen.Color := PenColor
    else
      Pen.Color := CDefaultPenColor;
    MoveTo(LX1, LY1); // dessin de la tortue
    Pen.Width := 2;
    LineTo(LX2, LY2);
    Pen.Width := 1;
    LineTo(LX3, LY3);
    LineTo(LX1, LY1);
  end;
end;

En ce qui concerne la tortue personnalisée, les données sont tout à fait différentes. Le choix a été fait de partir d'une série de « clichés » de la tortue au format « png », car il supporte très bien la transparence. Malheureusement, les algorithmes qui permettent les rotations sont complexes : c'est pourquoi la solution d'images préenregistrées a été choisie. Elle est par ailleurs plutôt rapide.

procedure TGVTurtle.DrawPNGTurtle;
// *** dessin de la tortue PNG ***
var
  LCosT, LSinT: Extended;
  LX, LY: Integer;
begin
  // on efface la surface
  fTtlImg.FillRect(0,0,fWidth, fHeight, BGRAPixelTransparent, dmSet);
  BeforeChange; // récupère la bonne image
  // calcul des coordonnées de la tortue
  SinCos((90 + Heading) * DgToRad, LSinT, LCosT);
  LX := Round(CoordX + LCosT - LSinT);
  LY := Round(CoordY + LSinT + LCosT);
  // copie de la tortue .png
  fTtlImg.CanvasBGRA.Draw(LX - (fPNGTurtle.Width shr 1),
        cY(LY) - (fPNGTurtle.Height shr 1), fPNGTurtle);
end;

Une autre fonction complexe est Towards qui permet de rendre l'orientation nécessaire de la tortue pour qu'elle pointe vers un point. Elle utilise la fonction mathématique ArcTan qui détermine un angle dont la tangente est donnée.

En voici le listing(17) :

function TGVTurtle.Towards(X, Y: Integer): Double;
// *** renvoie le cap vers un point ***
var
  LPX, LPY: Integer;
begin
  LPX := Round(CoordX) - X; // calcul des différences entre les points
  LPY := Y - Round(CoordY);
  Result := 0; // suppose 0
  // évalue suivant les calculs
  if ((LPX = 0) and (LPY < 0)) then
    Result := 270
  else if ((LPX = 0) and (LPY > 0)) then
    Result := 90
  else if ((LPX > 0) and (LPY >= 0)) then
    Result := 180 - ArcTan(LPY / LPX) * RadToDg
  else if ((LPX < 0) and (LPY > 0)) then
    Result := (ArcTan(LPY / Abs(LPX)) * RadToDg)
  else if ((LPX < 0) and (LPY <= 0)) then
    Result := 360 - (ArcTan(LPY / LPX) * RadToDg)
  else if ((LPX > 0) and (LPY < 0)) then
    Result := 180 + (ArcTan(Abs(LPY) / LPX) * RadToDg);
end;

Enfin, la fonction Distance permet de calculer la distance entre la tortue et un point donné. Elle fait appel à de simples calculs à partir de triangles rectangles, donc en appliquant le théorème de Pythagore.

La formule bien connue est :

avec x_a, y_a les coordonnées du premier point et x_b, y_b celles du second.

La fonction en Pascal donne(18) :

function TGVTurtle.Distance(X, Y: Integer): Double;
// *** renvoie la distance de la tortue à un point donné ***
begin
  Result := Sqrt(Sqr(X - CoordX) + Sqr(Y - CoordY));
end;

En dehors de ces quelques notions de mathématiques, le déplacement de la tortue à l'écran pose des problèmes d'affichage. La solution adoptée est celle de la transparence bien maîtrisée par la bibliothèque BGRABitmap.

Sans cette bibliothèque, le comportement de la tortue avec Lazarus était erratique : la transparence fonctionne avec Lazarus dès qu'il s'agit de dessiner une forme simple sur le canevas ; mais si l'on désire déplacer la tortue sur une surface transparente qui prend sa couleur de fond sur un contrôle, le dessin en entier disparaît… du moins, dans la limite de mes connaissances !

Le dessin met en jeu trois couches : la première s'occupe du fond, la deuxième du dessin laissé par la tortue, la troisième par la représentation de cette dernière. On est ainsi assuré que les objets manipulés n'interféreront pas. La bibliothèque fournit en effet les éléments qui permettent de superposer ces couches en gérant la transparence nécessaire.

La méthode centrale se présente ainsi :

function TGVTurtle.GetImg: TBGRABitmap;
// *** récupération de l'image ***
begin
  with fActualImg do // on procède par couches
  begin
    PutImage(0,0,fBckImg,dmDrawWithTransparency); // le fond
    PutImage(0,0,fDrwImg,dmDrawWithTransparency); // le dessin
    if TurtleVisible then // tortue visible ?
    begin
      case Kind of
        tkTriangle: DrawTriangleTurtle; // on dessine la tortue triangulaire
        tkPNG: DrawPNGTurtle; // tortue PNG
      end;
      PutImage(0,0,fTtlImg,dmDrawWithTransparency); // on l'affiche
    end;
  end;
  Result := fActualImg; // on renvoie l'image
end;

On utilise fBckImg pour afficher le fond, fDrwImg pour le dessin et enfin fTtlImg pour la tortue. Les trois éléments sont du type TBGRABitmap. C'est la bibliothèque BGRABitmap qui s'occupe de fondre ces trois couches afin d'obtenir le dessin souhaité.

On notera aussi que les procédures LineTo et MoveTo adaptent les coordonnées fournies afin de les rendre cohérentes avec un repère dont l'origine est située en bas à gauche de la surface de dessin et non en haut à gauche comme en Pascal.

procedure TGVTurtle.LineTo(X, Y: Double);
// *** déplacement en écrivant ***
begin
  fDrwImg.CanvasBGRA.LineTo(Round(X), cY(Round(Y))); // écriture effective
end;

procedure TGVTurtle.MoveTo(X, Y: Double);
// *** déplacement sans écrire ***
begin
  fDrwImg.CanvasBGRA.MoveTo(Round(X), cY(Round(Y))); // déplacement effectif
end;

C'est la fonction cY qui est chargée du travail de modification du repère :

function TGVTurtle.cY(Y: Integer): Integer;
// *** change l'ordonnée pour le nouveau repère ***
begin
  Result := fHeight - Y; // inversion des ordonnées
end;

Le déplacement proprement dit de la tortue est traité par la méthode DoGo qui prend en compte le type d'écran teRoll, c'est-à-dire l'enroulement. En voici l'implémentation :

procedure TGVTurtle.DoGo(X, Y: Double);
// *** effectue un déplacement de la tortue ***
begin
    // si champ clos et hors limites => erreur
    if (Screen <> teGate) or IsWithinLimits(X, Y) then
    begin
      fX := X; // nouvelle abscisse
      fY := Y; // nouvelle ordonnée
      // ralentit le dessin
      Sleep(CMaxSpeed - Speed);
      // dessine
      if PenDown then  // crayon baissé ?
        LineTo(X, Y) // en écrivant
      else
        MoveTo(X, Y); // sans écrire
      Change; // changement notifié
    end;
    // on continue si l'écran s'enroule
    if (Screen = teRoll) and not IsWithinLimits(X,Y) then
    begin
    // mise à jour des coordonnées après enroulement
    // débordement à droite ?
    if (X > fWidth) then
    begin
      MoveTo(0, Y);
      X := X - fWidth;
    end;
    // débordement en bas ?
    if (Y > fHeight) then
    begin
      MoveTo(X, 0);
      Y := Y - fHeight;
    end;
    // débordement à gauche ?
    if (X < 0) then
    begin
      MoveTo(fWidth, Y);
      X := fWidth + X;
    end;
    // débordement en haut ?
    if (Y < 0) then
    begin
      MoveTo(X, fHeight);
      Y := fHeight + Y;
    end;
    fX := X; // nouvelle abscisse
    fY := Y; // nouvelle ordonnée
    // ralentit le dessin
    Sleep(CMaxSpeed - Speed);
    // dessine ou déplace suivant l'état du crayon
    if PenDown then
      LineTo(X, Y)
    else
      MoveTo(X, Y);
  end;
end;

Bien que ce soit une erreur que de vouloir faire sortir la tortue de son espace alors qu'elle est en mode champ clos, GVLOGO se contente de ne pas déplacer la tortue dans ce cas. On pourrait aussi déclencher une exception, mais, d'un point de vue pédagogique, il a semblé plus intéressant de laisser à l'utilisateur le soin de comprendre ce qu'il se passe dans ce cas.

La récupération de l'image désirée de la tortue est effectuée par le programme qui exploite la classe TGVTurtle. Même si les multiples liens entre les procédures et les unités rendent l'ensemble plutôt complexe, le principe de fonctionnement est simple : quand l'instance de la classe TGVTurtle a besoin de dessiner la tortue, elle exécute la procédure BeforeChange qui envoie en paramètre essentiel l'orientation de la tortue. En retour, elle s'attend à ce que l'unité appelée ou le programme ait affecté la bonne image à sa propriété TurtleImg.

Autrement dit, il s'agit d'une sorte d'aller-retour entre les deux unités : la première envoie un pointeur vers elle-même et l'orientation de la tortue si elle trouve une procédure affectée à son champ privé fOnBeforeChange ; la seconde récupère l'orientation de la tortue, cherche l'image correspondante et l'affecte en retour à la propriété TurtleImg de l'unité génératrice de l'événement.

La méthode BeforeChange est déclarée ainsi, dans la partie protected de la définition :

      procedure BeforeChange; // avant le changement

Et voici sa propre définition :

procedure TGVTurtle.BeforeChange;
// *** gestion avant le changement ***
// (permet de mettre à jour une image pour la tortue avant de la dessiner)
begin
  if Assigned(fOnBeforeChange) then  // si le gestionnaire existe
    fOnBeforeChange(Self, Round(Heading)); // on l'exécute
end;

On voit que la procédure fait elle-même référence au champ privé fOnBeforeChange défini ainsi :

      fOnBeforeChange: TTurtleBeforeEvent; // notification avant cap changé

Quant au type TTurtleBeforeEvent, il fournit un squelette de la procédure appelante :

  // avant le changement de la tortue
  TTurtleBeforeEvent = procedure(Sender: TObject; cHeading: Integer) of object;

Ce squelette est essentiel puisqu'en fournissant un modèle commun il permet aux unités de communiquer entre elles.

Voici à présent comment le programme de test opère pour répondre à la requête de l'unité GVTurtles :

procedure TMainForm.TurtleBeforePaint(Sender: TObject; cHeading: Integer);
// *** image associée à la tortue ***
var
  BitM: TBitmap;
begin
  // charge l'image de la tortue
  BitM := TBitmap.Create;
  try
    // les images de la tortue sont proposées tous les 5 degrés
    ImageListTurtles.GetBitmap(Round(cHeading) div 5, BitM);
    // celle qui correspond est assignée au bitmap
    GVTurtle.PNGTurtle.Assign(BitM);
  finally
    BitM.Free;
  end;
end;

On remarquera que fOnBeforeChange de l'unité GVTurtles et TurtleBeforePaint du programme de test ont exactement le même en-tête calqué sur TTurtleBeforeEvent. Peu importe que les noms soient différents : ce qui compte, ce sont les paramètres absolument identiques dans leur nombre, leur agencement et leurs types.

Pour que l'ensemble fonctionne, il faut évidemment affecter la procédure appelée au gestionnaire d'événements approprié avec une ligne du genre :

procedure TMainForm.FormCreate(Sender: TObject);
begin
  // on crée la tortue
  GVTurtle := TGVTurtle.Create(imgTurtle.Width, imgTurtle.Height);
  GVTurtle.OnChange := @TurtleState;  // gestionnaire de changement
  GVTurtle.OnBeforeChange := @TurtleBeforePaint; // idem avant de dessiner
  GVTurtle.ReInit; // initialisation
  seSetPosX.Value := imgTurtle.Width shr 1; // position au centre
  seSetPosY.Value := imgTurtle.Height shr 1;
end;

Ici, GVTurtle est une instance de la classe TGVTurtle. Cette ligne figure dans la méthode FormCreate de la fiche. Le programme « sait » à présent quelle procédure il doit appeler lorsque l'événement est déclenché.

Un second événement plus simple est déclenché à chaque modification de la tortue : il s'agit de TTurtleEvent :

type
  // changement de la tortue
  TTurtleEvent = TNotifyEvent;

Cet événement ne transmet qu'un pointeur vers l'instance de la classe qui a déclenché l'événement, mais permet ainsi d'accéder aux propriétés de la tortue susceptibles d'avoir été modifiées : ses coordonnées, son cap, l'état de sa visibilité, celui de sa capacité à écrire et la couleur d'écriture du crayon. L'intérêt d'une telle notification est, par exemple, de renseigner en temps réel une barre de statut qui affichera en clair ces données pour informer l'utilisateur.

Du côté de l'unité GVTurtles, on retrouve :

• un champ privé qui conservera la procédure affectée si elle existe :

      fOnchange: TTurtleEvent; // changement notifié

• une propriété en accès public et renvoyant à ce champ privé :

      // événement après le changement de la tortue
      property OnChange: TTurtleEvent read fOnchange write fOnchange;

• une procédure dans la partie protected de la définition de la classe, appelée quand nécessaire et en charge d'appeler elle-même la procédure de l'unité qui exploite la tortue :

      procedure Change; // gestion du changement

• la définition de cette procédure :

procedure TGVTurtle.Change;
// *** notification de changement ***
begin
  if Assigned(fOnchange) then // on exécute le gestionnaire s'il existe
    fOnchange(Self);
end;

Il ressemble tout à fait au gestionnaire vu précédemment : si le champ privé fOnChange est affecté, on exécute la méthode à laquelle il renvoie.

Du côté du programme de test, on retrouve :

• la déclaration de la procédure qui sera appelée en se conformant au squelette fourni par TTurtleEvent :

  public
    // message de la tortue
    procedure TurtleState(Sender: TObject);

• sa définition qui affiche les données fournies sur la barre de statut :

procedure TMainForm.TurtleState(Sender: TObject);
// état de la tortue
begin
  GVTurtle.TurtleBitmap.Draw(imgTurtle.Canvas,0,0);
  imgTurtle.Invalidate;
  // données de la tortue
  with GVTurtle do
    statusbar.Panels[1].Text := Format('X: %.3d Y: %.3d Cap: %.3d',
      [Round(CoordX), Round(CoordY), Round(Heading)]) +
      ' Visible: ' + IfThen(TurtleVisible, P_True, P_False) +
      ' Baissé: ' + IfThen(PenDown, P_True, P_False);
  cbPenColor.Selected := GVTurtle.PenColor; // couleur du crayon
  cbScreenColor.Selected := GVTurtle.ScreenColor; // couleur du fond
end;

• afin de créer le lien entre les deux unités, son affectation lors de la création de la fiche :

procedure TMainForm.FormCreate(Sender: TObject);
begin
  // on crée la tortue
  GVTurtle := TGVTurtle.Create(imgTurtle.Width, imgTurtle.Height);
  GVTurtle.OnChange := @TurtleState;  // gestionnaire de changement
  GVTurtle.OnBeforeChange := @TurtleBeforePaint; // idem avant de dessiner
  GVTurtle.ReInit; // initialisation
  seSetPosX.Value := imgTurtle.Width shr 1; // position au centre
  seSetPosY.Value := imgTurtle.Height shr 1;
end;

On a là un cas très classique de gestion d'événements, avec toutes les étapes de sa mise en place. Le code source de l'unité est alors émaillé d'appels à Change lorsqu'intervient un changement concernant la tortue.

Voici l'interface de la copieuse classe TGVTurtle :

  TGVTurtle = class(TObject)
    strict private
      fError: TGVErrors; // gestion des erreurs
      // *** la tortue ***
      fX: Double; // abscisse
      fY: Double; // ordonnée
      fHeading: Double; // cap
      fSize: Integer; // taille
      fTurtleKind: TTurtleKind; // type
      fTurtleVisible: Boolean; // visibilité
      fSpeed: Integer; // vitesse
      fPNGTurtle: TBGRABitmap; // PNG en cours
      fSavedTurtle: TTurtle; // sauvegarde
      fOnchange: TTurtleEvent; // changement notifié
      fOnBeforeChange: TTurtleBeforeEvent; // notification avant cap changé
      // *** le crayon ***
      fPenDown: Boolean; // levé/baissé
      fPenRubber: Boolean; // gomme
      fPenWidth: Integer; // largeur
      fPenColor: TColor; // couleur
      fTempColor: TColor; // sauvegarde temporaire de la couleur d'écriture
      // *** l'écran ***
      fScreen: TScreenTurtle; // mode
      fHeight: Integer; // hauteur de la surface d'origine
      fWidth: Integer; // largeur de la surface d'origine
      fScaleX: Integer; // échelle des X
      fScaleY: Integer; // échelle des Y
      fScreenColor: TColor; // couleur
      fBckImg: TBGRABitmap; // fond
      fDrwImg: TBGRABitmap; // surface dessinée
      fTtlImg: TBGRABitmap; // dessin de la tortue
      fActualImg: TBGRABitmap; // surface réelle
      fFilled: Boolean; // drapeau de remplissage
      // *** méthodes internes des propriétés ***
      function GetCoordX: Double;
      function GetCoordY: Double;
      function GetImg: TBGRABitmap;
      function GetLocalPenColor: Integer;
      procedure SetLocalPenColor(AValue: Integer);
      function GetLocalScreenColor: Integer;
      procedure SetLocalScreenColor(AValue: Integer);
      procedure SetCoordX(AValue: Double);
      procedure SetCoordY(AValue: Double);
      procedure SetFilled(AValue: Boolean);
      procedure SetHeading(AValue: Double);
      procedure SetPenColor(AValue: TColor);
      procedure SetPenDown(AValue: Boolean);
      procedure SetPenWidth(AValue: Integer);
      procedure SetScreen(AValue: TScreenTurtle);
      procedure SetScreenColor(AValue: TColor);
      procedure SetSize(AValue: Integer);
      procedure SetSpeed(AValue: Integer);
      procedure SetTurtleKind(AValue: TTurtleKind);
      procedure SetTurtleVisible(AValue: Boolean);
      procedure SetRubberPen(AValue: Boolean);
      // *** états ***
      function GetTurtleState: string; // état de la tortue
      procedure SetTurtleState(const St: string);
      function GetPenState: string; // état du crayon
      procedure SetPenState(const St: string);
      function GetPosState: string; // position du crayon
      procedure SetPosState(const St:string);
      function GetScaleState: string; // état de l'échelle
      procedure SetScaleState(const St: string);
      function GetScreenState: string; // état de l'écran
      procedure SetScreenState(const St: string);
      // *** méthodes internes générales ***
      function IsWithinLimits(X, Y: Double): Boolean; // dans limites ?
      procedure DoGo(X, Y: Double); // effectue un déplacement
      procedure LineTo(X, Y: Double); // déplacement en écrivant
      procedure MoveTo(X, Y: Double); // déplacement sans écrire
      // *** figures prédéfinies générales ***
      // arc d'ellipse (b : début, e : fin - en degrés)
      procedure ArcAntialias(x, y, rx, ry: single; b, e: word;
        c: TBGRAPixel; w: single);
      // arc d'ellipse rempli (b : début, e : fin - en degrés)
      procedure FillArcAntiAlias(x, y, rx, ry: single; b, e: word;
        c: TBGRAPixel);
      // portion d'ellipse (b : début, e : fin - en degrés)
      procedure PieAntialias(x, y, rx, ry: single; b, e: word;
        c: TBGRAPixel; w: single);
      // portion d'ellipse remplie (b : début, e : fin - en degrés)
      procedure FillPieAntiAlias(x, y, rx, ry: single; b, e: word;
        c: TBGRAPixel);
      // *** fonctions utiles ***
      function ColorToIntColor(N: TColor): Integer; // couleur en couleur locale
      function IntColorToColor(N: Integer): TColor; // couleur locale en couleur
    protected
      function cY(Y: Integer): Integer; virtual; // ordonnée dans nouveau repère
      procedure DrawTriangleTurtle; virtual; // tortue triangulaire
      procedure DrawPNGTurtle; virtual; // tortue PNG
      procedure Change; // gestion du changement
      procedure BeforeChange; // avant le changement
    public
      constructor Create(Width, Height: Integer); // création
      destructor Destroy; override; // destructeur
      procedure ReInit; // réinitialisation de l'objet
      procedure PenReverse; // inversion de l'écriture
      procedure Move(Value: Double); // la tortue se déplace
      procedure SetPos(X, Y: Double); // fixe les coordonnées de la tortue
      procedure Turn(Value: Double); // la tortue tourne
      procedure Home; // tortue à l'origine
      procedure Wipe; // nettoyage de l'écran
      procedure SaveTurtle; // sauvegarde de la tortue
      procedure ReloadTurtle(Clean: Boolean); // récupère une tortue sauvée
      // renvoie le cap vers un point
      function Towards(X, Y: Integer): Double; overload;
      function Towards(const St: string): Double; overload;
      // renvoie la distance de la tortue à un point donné
      function Distance(X, Y: Integer): Double; overload;
      function Distance(const St: string): Double; overload;
      // *** gestion du texte ***
      // texte affiché sur l'écran de la tortue
      procedure Text(const St: string; X,Y, Angle: Integer); overload;
      // texte affiché à l'emplacement de la tortue
      procedure Text(const St: string); overload;
      // *** figures prédéfinies ***
      // dessine un rectangle
      procedure Rectangle(X1, Y1, X2, Y2: Integer); overload;
      // dessine un rectangle à l'emplacement de la tortue
      procedure Rectangle(X2, Y2: Integer); overload;
      // dessine un carré
      procedure Square(X1, Y1, L: Integer); overload;
      // dessine un carré à l'emplacement de la tortue
      procedure Square(L: Integer); overload;
      // dessine un rectangle arrondi
      procedure RoundRect(X1, Y1, X2, Y2: Integer); overload;
      // dessine un rectangle arrondi à l'emplacement de la tortue
      procedure RoundRect(X2, Y2: Integer); overload;
      // dessine une ellipse
      procedure Ellipse(X1, Y1, X2, Y2: Integer); overload;
      // dessine une ellipse à l'emplacement de la tortue
      procedure Ellipse(X2, Y2: Integer); overload;
      // dessine un cercle
      procedure Circle(X1, Y1, R: Integer); overload;
      // dessine un cercle à l'emplacement de la tortue
      procedure Circle(R: Integer); overload;
      // dessine un arc d'ellipse
      procedure Arc(X1, Y1, X2, Y2, X3, Y3: Integer); overload;
      // dessine un arc d'ellipse à l'emplacement de la tortue
      procedure Arc(X2, Y2, X3, Y3: Integer); overload;
      // dessine une section d'ellipse
      procedure Pie(X1, Y1, X2, Y2, X3, Y3: Integer); overload;
      // dessine une section d'ellipse à l'emplacement de la tortue
      procedure Pie(X2, Y2, X3, Y3: Integer); overload;
      // *** propriétés ***
      // abscisse de la tortue
      property CoordX: Double read GetCoordX write SetCoordX;
      // ordonnée de la tortue
      property CoordY: Double read GetCoordY write SetCoordY;
      // type de tortue
      property Kind: TTurtleKind read fTurtleKind write SetTurtleKind
        default tkTriangle;
      // visibilité de la tortue
      property TurtleVisible: Boolean read fTurtleVisible write SetTurtleVisible
        default True;
      // direction de la tortue
      property Heading: Double read fHeading write SetHeading;
      // taille de la tortue
      property Size: Integer read fSize write SetSize default CDefaultSize;
      // drapeau d'écriture
      property PenDown: Boolean read fPenDown write SetPenDown default True;
      // type de zone de déplacement
      property Screen: TScreenTurtle read fScreen write SetScreen
        default teWin;
      // échelle des X
      property ScaleX: Integer read fScaleX write fScaleX default CDefaultScale;
      // échelle des Y
      property ScaleY: Integer read fScaleY write fScaleY default CDefaultScale;
      property PenRubber: Boolean read fPenRubber write SetRubberPen
        default False; // état de la gomme
      property PenColor: TColor read fPenColor write SetPenColor
        default CDefaultPenColor; // couleur du crayon
      property LocalPenColor: Integer read GetLocalPenColor
        write SetLocalPenColor; // couleur du crayon en couleur locale
      property PenWidth: Integer read fPenWidth write SetPenWidth default
        CDefaultPenWidth; // largeur du crayon
      // état du remplissage
      property Filled: Boolean read fFilled write SetFilled default True;
      // vitesse de dessin de la tortue
      property Speed: Integer read fSpeed write SetSpeed default CMaxSpeed;
      property ScreenColor: TColor read fScreenColor write SetScreenColor
        default CDefaultBackColor; // couleur du fond d'écran
      property LocalScreenColor: Integer read GetLocalScreenColor
        write SetLocalScreenColor; // couleur de l'écran en couleur locale
      // événement après le changement de la tortue
      property OnChange: TTurtleEvent read fOnchange write fOnchange;
      // événement avant le changement de la tortue
      property OnBeforeChange: TTurtleBeforeEvent read fOnBeforeChange
        write fOnBeforeChange;
      // surface de dessin de la tortue
      property TurtleBitmap: TBGRABitmap read GetImg;
      // tortue PNG
      property PNGTurtle: TBGRABitmap read fPNGTurtle write fPNGTurtle;
      // notification d'une erreur
      property Error: TGVErrors read fError write fError;
      // état de la tortue
      property TurtleState: string read GetTurtleState write SetTurtleState;
      // état du crayon
      property PenState: string read GetPenState write SetPenState;
      // position du crayon
      property PosState: string read GetPosState write SetPosState;
      // échelle
      property ScaleState: string read GetScaleState write SetScaleState;
      // écran
      property ScreenState: string read GetScreenState write SetScreenState;
  end;

En dehors des aspects déjà étudiés, la classe ne présente pas de problèmes majeurs. La tortue fait bien sûr appel à des propriétés afin que l'utilisateur puisse en maîtriser l'aspect et le comportement. L'interface est aussi alourdie par de nombreuses fonctions de dessin : une première version dessine en se référant à des coordonnées traditionnelles tandis qu'une seconde version surchargée grâce à overload utilise les coordonnées de la tortue pour amorcer son dessin.

On notera que les coordonnées sont des réels alors que la position finale est un entier : cela permet de calculer au plus près la position de la tortue avant de l'arrondir, évitant ainsi des approximations cumulées.

Comme toujours, le programme de test est décliné en deux versions :

• Lazarus pour Windows 32 ;
• Lazarus pour Linux.

L'utilisateur pourra tester la plupart des fonctions et propriétés définies pour manipuler la tortue. Le programmeur sera plus intéressé par le mécanisme des notifications d'événements tel que décrit plus haut.

Pour avoir une idée des possibilités de dessin de la tortue, un bouton marqué « dessin » dessine une série de 36 carrés en rosace. Afin de se rendre compte de la rapidité de la tortue triangulaire par rapport à celle graphique, il est judicieux d'utiliser ce bouton spécial dans trois configurations : graphique, triangle et tortue cachée.

On remarquera aussi quatre boutons : le premier met en œuvre la méthode Text dans sa version indépendante de la tortue tandis que le second la teste avec des coordonnées fournies par cette même tortue ; le troisième illustre ce que peut réaliser la méthode Text avec une fleur de mots en couleurs ; enfin, le dernier, accompagné d'un TSpinEdit, contrôle l'épaisseur du trait de la tortue lorsqu'elle dessine. De plus, trois boutons TRadioEdit permettent de contrôler le type de champ de la tortue : illimité avec teWin (valeur par défaut), limité par les bords de l'écran (teGate) et enfin enroulé (teRoll).