home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 31
/
CDASC_31_1996_juillet_aout.iso
/
index
/
source
/
trouve.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-06-14
|
60KB
|
1,819 lines
(****************************************************************************)
(* TROUVE *)
(*--------------------------------------------------------------------------*)
(* Le but de ce programme est de permettre la recherche d'archives suivant *)
(* de nombreux critères dans un ensemble de fichiers de descriptions de *)
(* CD-ROM. Il peut être lancé soit en ligne de commande, soit par une *)
(* interface contextuelle (dans ce cas l'utilisateur sera limité à quatre *)
(* critères de recherche. *)
(*--------------------------------------------------------------------------*)
(* Auteur : Stéphane EVAIN. *)
(* Création : Octobre 1993. *)
(* Dernière modif. : 14/06/96 *)
(****************************************************************************)
PROGRAM cd_rom ;
USES crt, DOS ;
{========================= Quelques constantes ==============================}
CONST delim1 = ' ═' ;
delim2 = ' ■' ;
Ctrl_E = #255 ;
Ctrl_O = #254 ;
Ctrl_N = #253 ;
version = '2.6' ;
Type_asc = 1 ;
Type_Vrac = 2 ;
Type_Autre = 3 ;
{============================ Quelques types ================================}
TYPE pLigne = ^tLigne ; { Ce type stocke une description. }
tLigne = RECORD
ligne : String ;
suiv : pLigne ;
END ;
pFichier = ^tFichier ; { Ce type contient la liste des fichiers. }
tFichier = RECORD
nom : String ;
tipe : Byte ;
etat : Boolean ;
suiv : pFichier ;
END ;
pCritere = ^tCritere ; { Ce type contient la liste des critères. }
tCritere = RECORD
decalage : ARRAY [0..255] OF Byte ;
champ : String ;
transition : Byte ; { 0-rien, 1-et, 2-ou. }
negation : Boolean ;
suiv : pCritere ;
END ;
pelt = ^telt ; { Ce type contient une liste de fichiers. }
telt = RECORD { elle est utilisée dans l'objet }
elt : pfichier ; { liste de l'interface. }
suiv : pelt ;
END ;
{========================= Très peu de variables globales ===================}
VAR fichier : Boolean ; { Pour sauter un fichier. }
section : Boolean ; { Pour sauter une section. }
esc : Boolean ; { Pour tout sauter (quelle santé!) }
menu : Boolean ; { Indique que l'on veut retourner au menu.. }
Souris : Boolean ; { Doît-on géré la souris. }
MAJmin : Boolean ;
cherche : String ; { Chaine principale recherchée. }
taille, { Pour la gestion de la progression. }
SectionAsc,
SectionVrac,
EnsFichier,
Total,
nblu : LongInt ;
Liste_Fichier
: pFichier ; { Pour les listes de fichiers. }
tetecritere { Pointe sur la tête de liste (pour les }
: pCritere ; { élections?) des critêres. }
{ ENSEMBLES DES PROCEDURES FACILEMENT PORTABLES SUR D'AUTRES SYSTEMES. }
{====================== Manipulations de curseurs =====================}
PROCEDURE HideCursor ; ASSEMBLER ;
ASM
mov AH , $01 { Et si je veux porter sur mon PET de Commodore je fais }
mov CX , $2020 { comment surtout que j'ai 4Ko et pas de souris.... }
Int $10
END ;
PROCEDURE ShowCursor ; ASSEMBLER ;
ASM
mov AH , $01
mov CX , $0708
Int $10
END ;
{====================== Ecritures directes à l'écran ======================}
{ Efface l'écran, étonnant non? }
PROCEDURE Cls ; ASSEMBLER ;
ASM
mov AX , $0B800 { Clrscr encore plus de la mort qu'avant }
mov ES , AX { mais beaucoup plus rapide et plus }
mov CX , 1000 { compact, vive l'ASM, fuck the C! }
XOR DI , DI
db $66 { xor eax, eax }
XOR AX, AX
db $f3
db $66
db $ab { rep stosd (d = double word!) }
END ;
{ Cette procédure ecrit en mémoire vidéo à partir de l'adresse D, la chaîne
dont l'adresse est S et la taille n. }
PROCEDURE toScrA (VAR s; D, n: Word); ASSEMBLER;
ASM
mov CX, n
jcxz @X { Si la chaîne est vide, on ne l'écrit pas. }
push DS
mov AX, $0B800
mov ES, AX
mov DI, D
SHL DI, 1
mov AL, TextAttr
lds SI, s { ALERT, DS modified, fucking bug! }
cld
@L:
movsb { Ne modifie pas AL, heureusement... }
stosb { On charge le caractère suivant. }
loop @L
pop DS
@X:
END;
{ Calcul les paramètres pour l'appel de ToScrA (écriture directe en mem vidéo:
win 95 Suxxxx.... }
PROCEDURE qWrite (Row, Col: Byte; S: String);
VAR NbCol : Word ABSOLUTE $0040 : $004A;
BEGIN
toScrA (MemW [Seg (S): Succ (Ofs (S) ) ],
Pred (Row) * NbCol + Pred (Col), Length (S) );
END;
{ Centrage d'une chaîne. }
PROCEDURE centre ( s : String ; ligne : Word ) ;
BEGIN
ASM
mov AX, ligne
Dec AX
mov BX, AX
mov AX, 160
mul BX
mov DI, AX
mov AX , $0B800 { Remplissage de la ligne. }
mov ES , AX
mov CX , 80
mov AH , TextAttr
mov AL , 32
rep stosw
END ;
QWrite (ligne, (80 - Length (s) ) DIV 2, s) ;
END ;
{ Passe une chaîne en majuscule. Version archi-tiny-fast. }
PROCEDURE Maj (VAR S: String); ASSEMBLER;
ASM
push DS { Sauve DS sur la pile. }
lds SI, S { Charge DS:SI avec le pointeur de S. }
cld { Pour le parcours des chaînes il faut avancer? }
lodsb { Charge la longueur de S. }
sub AH, AH { Efface le poids fort de AX. }
mov CX, AX { Transfert AX dans CX. }
jcxz @Done { Si la longueur est nulle alors on a fini. }
mov AX, DS { ES=DS en deux instructions car on n'est pas }
mov ES, AX { en mode flat (386 required). }
mov DI, SI { DI=SI qui pointent sur le premier caractère. }
{ donc lodsb charge une lettre, stosb la sauve. }
@UpCase:
lodsb { Charge une lettre. }
cmp AL, 'a'
jb @notLower { inférieur à 'a' -- on fait rien. }
cmp AL, 'z'
ja @notLower { supérieur à 'z' -- on fait toujours rien. }
sub AL, ('a' - 'A') { convertit la lettre en majuscule. }
@notLower:
stosb { Sauve la lettre. }
loop @UpCase { Et on boucle sur toute la chaîne. }
@Done:
pop DS { Retablit DS de la pile. }
END ;
{=============================================================}
{ G E S T I O N D E S L I S T E S C H A I N E E S }
{=============================================================}
{ Insère une ligne dans la liste chaînée représentant la description d'un
fichier.... }
PROCEDURE ajoute ( VAR l : pLigne ; s : String ) ;
VAR temp : pLigne ;
BEGIN
IF l = NIL
THEN
BEGIN
{ Insertion en tête. }
New (l) ;
{ On suppose que l'heureux possesseur d'un lecteur cdrom }
{ possède suffisamment de mémoire pour allouer au moins }
{ une ligne (300 octets en comptant large). }
temp := l ;
END
ELSE
BEGIN
{ Suffisamment de mémoire ??? }
IF MaxAvail < SizeOf (tligne)
THEN
BEGIN
{Cls;}
WriteLn ('Bigre pas assez de mémoire...');
Halt (1);
{ Le test de mémoire a été mis surtout pour la }
{ phase de débogage du programme et au cas ou }
{ l'utilisateur essayerais le programme sur un }
{ fichier ne suppportant pas la grammaire }
{ indiquée dans la documentation (petit }
{ sacripant). }
END ;
{ On cherche la queue, sans arrière pensée! }
temp := l ;
WHILE temp^. suiv <> NIL DO
temp := temp^. suiv ;
{ Insertion en pas tête... toi y'en a être français? }
New (temp^. suiv) ;
temp := temp^. suiv ;
END ;
temp^. ligne := s ;
temp^. suiv := NIL ;
END ;
{ Destruction d'une description. }
PROCEDURE detruit ( l : pLigne ) ;
VAR temp : pLigne ;
BEGIN
temp := l ; { Cette procédure est tellement bateau }
{ que je la commente uniquement pour }
WHILE l <> NIL { faire gonfler artificiellement la }
DO { taille du source. }
BEGIN { ┌────┤ ├──┬──┤ ┌───┤ ┌────┐ ─┬─ ─┬─ }
l := l^. suiv ; { │ │ │ │ │ │ │ }
Dispose (temp) ; { └────┐ │ ├─┤ ├────┘ ├────┤ }
temp := l ; { │ │ │ │ │ │ }
END ; { ├────┘ ─┴─ └───┤ ─┴─ ─┴─ ─┴─ }
END ; { Pas mal pour un militaire? }
{==================================================================}
{ G E S T I O N D ' A F F I C H A G E E N P A S C A L }
{==================================================================}
{ Affichage des bannières en haut et en bas de l'écran de l'interface. }
PROCEDURE banniere ;
BEGIN
TextColor (Yellow) ;
centre ('Cherche et trouve ' + version + ' EVAIN Stéphane (C) 1994', 1) ;
centre ('Greetings to PAT, TAF, WRB & NANOUK...', 2) ;
centre ('Tab, Shift-Tab : changement de champ - Esc : Quitter - Entrée : Valider', 25) ;
TextColor (LightGray) ;
QWrite (4, 4, 'Saisie') ;
QWrite (11, 60, 'Fichiers:') ;
QWrite (4, 60, 'Sélection rapide:') ;
END ;
{ Convertit une chaîne en nombre. }
FUNCTION Val2 (chaine : String) : Byte ;
VAR i, code : Integer ;
BEGIN
FOR i := 1 TO Length (chaine) DO
IF NOT (chaine [i] IN ['0'..'9'] ) THEN
Delete (chaine, i, 1) ;
Val (Chaine, I, Code);
Val2 := i ;
END ;
{ Tri les noms dans la liste pour les mettre dans l'ordre chronologique
inverse. Offset indique le décalage des mots 3 pour ASC, 4 pour VRAC,
debut et fin donne les indices dans la liste des sections asc et vrac. }
PROCEDURE tri ( OFFSET, tipescan : Byte ) ;
VAR fin, next,
start, Pred,
debut, preced,
dernier : PFichier ;
permutation : Boolean ;
ind_deb : Word ;
Valeur, valeur2 : Byte ;
FUNCTION elt_i (num: Word) : pfichier ;
VAR i : Word ;
res : pfichier ;
BEGIN
i := 0 ;
res := Liste_Fichier ;
WHILE (i <> num) DO
BEGIN
res := res^. suiv ;
Inc (i) ;
END ;
elt_i := res ;
END ;
BEGIN
Permutation := TRUE ;
{ On parcours la liste pour trouver le premier fichier à traiter.
Dans preced on sauve le précédent de la tête de la recherche pour les
permutations, si =Nil alors on commence en tête. }
debut := Liste_Fichier ;
preced := NIL ;
ind_deb := 0 ;
{ La il y avait un bug jusqu'à la 2.51! }
WHILE (debut <> NIL) AND (debut^. tipe <> tipescan) DO
BEGIN
preced := debut ;
debut := debut^. suiv ;
Inc (ind_deb) ;
END ;
fin := debut ;
WHILE (fin <> NIL) AND (fin^. tipe = tipescan) DO
fin := fin^. suiv ;
WHILE Permutation
DO BEGIN
{ On doit reparcourir la liste depuis le début à chaque fois
car on peut avoir modifié plusieurs fois la tête. }
start := elt_i (ind_deb) ;
Pred := Preced ;
dernier := NIL ;
next := start^. Suiv ;
permutation := FALSE ;
WHILE (next <> fin) AND (next <> NIL)
DO BEGIN
Valeur := Val2 (Copy (start^. nom, OFFSET, 2) ) ;
Valeur2 := Val2 (Copy (next^. nom, OFFSET, 2) );
IF (Valeur < Valeur2)
THEN BEGIN
{ Echange de start et next. }
{ On saute Next. }
Start^. Suiv := Next^. Suiv ;
{ On rebranche next. }
Next^. Suiv := Start ;
{ Si on n'est pas sur la tête }
IF Pred <> NIL
THEN
Pred^. Suiv := Next
ELSE
Liste_Fichier := Next ;
{ On a effectué une permutation. }
permutation := TRUE ;
{ On s'est arrêté ici. }
dernier := start ;
{ On passe au suivant. }
Pred := Next ;
Next := Start^. Suiv ;
END
ELSE BEGIN
Pred := Start ;
start := next ;
next := start^. Suiv ;
END ;
END ;
IF permutation
THEN { Tout est trié après dernier. }
fin := dernier ;
END ;
END ;
{ Tris les noms de fichiers 'ascXX.asc' et 'vracXX.bbx'. }
PROCEDURE trie ;
BEGIN
{ tri les asc. }
tri (4, type_asc) ;
{ tri les vrac. }
tri (5, type_vrac) ;
END ;
{ Bascule tous les fichiers d'un certain type pour les valider ou non, cette
procédure est surtout utilisé par les boutons à cocher. }
PROCEDURE Bascule (num : Byte; nouveau : Boolean );
VAR temp : pFichier ;
BEGIN
temp := Liste_Fichier ;
WHILE temp <> NIL
DO
BEGIN
IF temp^. tipe = num
THEN
temp^. etat := nouveau ;
temp := temp^. suiv ;
END ;
END ;
{$i interfac.pas} {???, bravo you found the secret part! }
{=============================================================================
P R O C E D U R E S D I V E R S E T V A R I E E S
============================================================================}
{ Affichage du titre (nom du fichier, section si on est dans un fichier ASC. }
PROCEDURE titre (nom : String; categ : String) ;
BEGIN
{ On efface l'écran. }
Cls ;
{ On affiche la bannière en haut et on précise, si on le peut, la section
où l'on a trouvé la description (NEWS ou VRAC). }
TextBackground (Blue) ;
TextColor (Yellow) ;
categ := Copy (categ, 1, 3) ;
IF categ = delim1
THEN
centre (nom + ' NEWS', 1) ;
IF categ = delim2
THEN
centre (nom + ' MAJ', 1) ;
IF (categ <> delim1) AND (categ <> delim2)
THEN
centre (nom, 1) ;
{ On se prépare à afficher la description. }
TextColor (LightGray) ;
TextBackground (Black) ;
GotoXY (1, 2);
END ;
{ Cette procédure cherche si la clé de recherche est dans la phrase et la
colorie si il la trouve sachant que phrase se trouve sur la ligne ligne! }
PROCEDURE couleur (phrase : String; ligne : Byte) ;
CONST EnsCoul : ARRAY [0..3] OF Byte =
(LightRed, LightGreen, LightBlue, Magenta) ;
VAR temp : pcritere ;
cle : String ;
posit,
i, j,
indice : Byte ;
BEGIN
{ On prépare la coloration, on va parcourir tous les critères. }
temp := tetecritere ;
indice := 0 ;
{ L'écran commence à l'adresse 0 et non à l'adresse 80! }
Dec (ligne) ;
{ Tant qu'il reste des champs à inspecter. }
WHILE (temp <> NIL) AND (temp^. champ <> '')
DO
BEGIN
{ On met la clé en majuscule. }
cle := temp^. champ ;
maj (cle) ;
{ On cherche la clé dans la phrase. }
Posit := Pos (cle, phrase) ;
{ Si on a trouvé la couleur... }
IF posit <> 0 THEN
BEGIN
{ On passe par une variable locale car on ne peut pas
accédé facilement directement au tableau par BASM.}
j := enscoul [indice] ;
{ Pour tous les caractères de la clé. }
FOR i := posit TO Pred (Length (cle) + posit)
DO
ASM
mov AX, 0b800h { }
mov ES, AX { mov es,0B800h }
mov AX, 160 { ax := 160 }
XOR BX, BX { bx := 0 (surtout bh). }
mov BL, ligne { bl := ligne }
mul BX { ax := 160*ligne }
mov BL, i { bl := i }
Dec BX { bl := i-1 }
SHL BX, 1 { bl := 2*(i-1) }
Inc BX { bl := 2*(i-1)+1 }
add AX, BX { ax := 160*ligne+2*(i-1)+1 }
mov DI, AX { di := ax }
mov AL, j { al := j (enscoul[indice]) }
stosb { [$b800:160*ligne+2*(i-1)+1}
END ; { :=j}
{
C'est l'équivalent de:
mem[$B800:160*ligne+2*(i-1)+1] :=
EnsCoul[indice] ;
}
END ;
{ On passe au critère suivant. }
temp := temp^. suiv ;
{ On passe à la couleur suivante. }
Inc (indice) ;
IF indice = 4 { Quatre couleurs différentes.... }
THEN
indice := 0 ;
END ;
END;
{ Affichage d'une description, avec gestion du clavier. }
PROCEDURE affiche (l : pligne) ;
VAR toto : Integer ;
modif,
suivant : Boolean ;
temp,
debut : pligne ;
{ Gestion du clavier. }
PROCEDURE attente ;
VAR CH : Char ;
chaine : String ;
BEGIN
TextBackground (Blue) ;
TextColor (Yellow) ;
IF modif
THEN
BEGIN
{ Construit l'aide en ligne }
chaine := '<ESC> = FIN' ;
IF temp <> NIL
THEN
IF debut <> l
THEN
chaine := chaine+ ' - <> = Défilement'
ELSE
chaine := chaine+ ' - < > = Défilement'
ELSE
IF debut <> l
THEN
chaine := chaine+ ' - < > = Défilement' ;
chaine := chaine + ' - <M> = Menu - <F> = Fic Suiv - <S> = Sec Suiv' ;
{ Centre la chaîne sur la ligne courante. }
centre (chaine, WhereY);
END ;
modif := FALSE ;
CASE ReadKey OF
#27 : esc := FALSE ;
's',
'S' : Section := FALSE ;
'f',
'F' : Fichier := FALSE ;
'm',
'M' : menu := FALSE ;
#0 : CASE ReadKey OF
'P' : IF (temp <> NIL) { Bas }
THEN
BEGIN
modif := TRUE ;
debut := debut^. suiv ;
END ;
'H' : IF debut <> l { Haut }
THEN
BEGIN { Recherche du précédent. }
temp := l ;
WHILE temp^. suiv <> debut
DO
temp := temp^. suiv ;
debut := temp ;
modif := TRUE ;
END ;
#71, #73 : IF (debut <> l) { PgUp, Home }
THEN
BEGIN
modif := TRUE ;
debut := l ;
END ;
#81, #79 : IF (temp <> NIL) { PgDn, End }
THEN
BEGIN
modif := TRUE ;
WHILE (temp <> NIL)
DO
BEGIN
temp := temp^. suiv ;
debut := debut^. suiv ;
END ;
END ;
END ;
ELSE suivant := FALSE ;
END;
IF modif
THEN
BEGIN
ASM
{ Wait For Retrace }
MOV DX, $3DA
@RT:
IN AL, DX
Test AL, 8
JZ @RT
{ Efface l'écran sauf la première et la dernière ligne. }
push ES
mov AX , $0B800
mov ES , AX
{ On parle sérieux ici pas du word du }
mov CX , (2000 - 160) / 2{ double word alors on divise. }
mov DI , 160
db $66 { idem }
XOR AX , AX
db $f3
db $66
db $ab { rep stosd (d = double word!) }
pop ES
END ;
temp := debut ;
END ;
GotoXY (1, 2) ; { On se positionne au début de la description. }
END ;
{ Dessin de la description. }
PROCEDURE redraw ;
VAR li : Integer ;
up,
upper : String ;
BEGIN
li := 1 ;
TextBackground (Black) ;
TextColor (LightGray) ;
WHILE ( temp <> NIL ) AND ( li <> 24 )
DO
BEGIN
Inc (li) ;
upper := temp^. ligne ;
{ On affiche la ligne. }
QWrite (li, 1, temp^. ligne) ;
maj (upper) ;
{ On colorise la ligne si nécessaire. }
Couleur (upper, li );
temp := temp^. suiv ;
END ;
{ On rafraichit la position du curseur, car avant on effectue des
écritures directement en mémoire. }
GotoXY (1, li + 1);
END ;
BEGIN
debut := l ;
temp := l ;
modif := TRUE ;
redraw ;
suivant := TRUE ;
{ S'il ne reste plus de lignes à afficher, on ne gère pas le scrolling. }
IF temp = NIL
THEN
attente
ELSE
BEGIN
{ Gestion du scrolling... }
WHILE (esc) AND (suivant) AND (Fichier) AND (Section)
AND (menu)
DO
BEGIN
attente ;
{ On ne redessine que si on a appuyé sur une
flêche. }
IF modif
THEN
redraw ;
END ;
END ;
END ;
{ Recherche les différents critères de recherche dans une description. }
FUNCTION Chercher (l : pligne) : Boolean ;
VAR res1,
resultat : Boolean ;
critere : pcritere ;
{ Recherche d'une chaîne dans une autre selon l'algo de Boyer Moore, il
faudrait le passer en ASM car il va aussi vite que le pos standard. }
FUNCTION Pos2 ( chaine : String ) : Byte ;
VAR i, j,
m : Byte ;
found : Boolean ;
BEGIN
m := Length (critere^. champ) ;
j := m ;
found := FALSE ;
(*
WHILE (NOT found) AND (j <= Length (chaine) ) DO
*)
ASM
@WHILE1:
cmp Byte Ptr [BP - 106h], 0
je @suite1
jmp @wend
@suite1:
mov AL, [BP - 104h]
cmp AL, [BP - 102h]
jbe @DO
jmp @wend
@DO:
{ i := m ; }
mov AL, [BP - 105h]
mov [BP - 103h], AL
{ WHILE (i > 0) AND (chaine [j - m + i] = critere^. champ [i] ) }
@WHILE2:
cmp Byte Ptr [BP - 103h], 0
jbe @wend2
mov AL, [BP - 103h]
XOR AH, AH
mov DI, [BP + 4]
les DI, ss: [DI - 08]
add DI, AX
mov BL, ES: [DI + 100h]
mov AL, [BP - 103h]
{ xor ah,ah - stupid compiler... }
mov CX, AX
mov AL, [BP - 105h]
{ xor ah,ah }
mov DX, AX
mov AL, [BP - 104h]
{ xor ah,ah }
sub AX, DX
add AX, CX
mov DI, AX
mov AL, [BP + DI - 102h]
cmp AL, BL
jne @wend2
{ Dec(i); }
Dec Byte Ptr [BP - 103h]
jmp @WHILE2
@wend2:
{ IF i = 0 THEN }
db 80h, 0beh, 0fdh, 0feh, 00h {cmp byte Ptr [BP - 103h]}
jne @ELSE
{ found := TRUE }
mov Byte Ptr [BP - 106h], 1
jmp @WHILE1 { On évite un jmp en plus (on ne rebondit pas!). }
{ ELSE
j := j + critere^. decalage [Ord (chaine [j] ) ] ; }
@ELSE:
mov AL, [BP - 104h]
XOR AH, AH
mov DI, AX
mov AL, [BP + DI - 102h]
{ xor ah, ah }
mov DI, [BP + 4]
les DI, ss: [DI - 8]
add DI, AX
mov AL, ES: [DI]
{ xor ah,ah }
mov DX, AX
mov AL, [BP - 104h]
{ xor ah,ah }
add AX, DX
mov DI, AX
mov AL, [BP + DI - 102h]
XOR AH, AH
mov DI, [BP + 4]
les DI, ss: [DI - 8]
add DI, AX
mov AL, ES: [DI]
{ xor ah,ah }
mov DX, AX
mov AL, [BP - 104h]
{ xor ah,ah }
add AX, DX
mov [BP - 104h], AL
jmp @WHILE1
@wend:
END ;
{ Si on a trouvé la chaîne on renvoie l'offset, sinon 0. }
IF found
THEN
Pos2 := j - m + 1 { <-- Another shity bug! }
ELSE
Pos2 := 0 ;
END ;
{ La phrase recherchée est-elle dans la description? }
FUNCTION recherche : Boolean ;
VAR temp : pligne ;
Upper : String ;
BEGIN
temp := l ;
Upper := temp^. ligne ;
if not MAJmin then
maj (Upper) ;
WHILE (temp <> NIL) AND ( Pos2 ( Upper ) = 0 )
DO
BEGIN
temp := temp^. suiv ;
Upper := temp^. ligne ;
if not MAJmin then
maj (Upper) ;
END ;
recherche := temp <> NIL ;
END ;
{ Je sais pas si vous allez me croire mais cette procédure récursive à
marché du premier coup, il faut dire que mon projet de fin d'année en
maîtrise était un programme en CAML, alors les trucs récursifs, euh...
facile pour moi, ok, allez les petits gars retournez jouer aux billes. }
PROCEDURE RetireCRLF ( VAR ligne : pligne) ;
BEGIN
IF ligne = NIL { Si on est rendu au fond de la récursion, on remonte. }
THEN
Exit
ELSE
RetireCRLF (ligne^. suiv) ; { sinon on descend. }
{ En remontant, on regarde si la ligne est vide, si elle est vide on la
supprime et on continue de remonter, ce qu'il faut garder à l'esprit
c'est l'ordre d'exécution de cette procédure: c'est une fois que l'on
est rendu à la dernière ligne que l'on commence à regarder si la ligne
est vide! }
IF (ligne^. ligne = '') AND (ligne^. suiv = NIL)
THEN
BEGIN
Dispose (ligne) ;
ligne := NIL ;
END ;
END ;
BEGIN
critere := TeteCritere ;
WHILE (Critere <> NIL) AND (critere^. champ <> '')
DO
BEGIN
res1 := Recherche ;
IF Critere^. Negation
THEN
res1 := NOT res1 ;
{ Le premier critère doit toujours avoir comme type de
transition, la transition 0 pour initialiser la
recherche. }
CASE Critere^. transition OF
0 : resultat := res1 ;
1 : resultat := resultat AND res1 ;
2 : resultat := resultat OR res1 ;
END ;
critere := critere^. suiv ;
END ;
{ Si la description est bonne alors on prépare la description pour son
affichage. }
IF resultat
THEN
RetireCRLF (l) ;
Chercher := resultat ;
END ;
{ Affichage des barres de progression. }
PROCEDURE progression ( nom : String ) ;
VAR i, j : Word ;
BEGIN
TextColor ( Yellow ) ;
TextBackground ( Blue ) ;
{ Dessin du cadre supérieur. }
GotoXY (12, 8) ;
Write ('╔') ;
FOR i := 1 TO 55
DO
Write ('═') ;
Write ('╗') ;
{ Dessin du cadre intérieur. }
FOR i := 9 TO 17
DO BEGIN
GotoXY (12, i) ;
Write ('║') ;
FOR j := 1 TO 55
DO
Write (' ') ;
Write ('║') ;
END ;
{ Dessin du cadre inférieur. }
QWrite (18, 12, '╚═ F : Fichier suivant ═ S : Section suivante ═ M : Menu╝') ;
{ Remplissage du cadre avec les informations qui vont bien. }
TextColor ( LightRed ) ;
QWrite ( 10, (80 - Length (nom) ) DIV 2, nom) ;
TextColor ( LightCyan ) ;
QWrite ( 12, (80 - Length (cherche) ) DIV 2, cherche) ;
{ Dessin du fond des barres de progression. }
TextColor (Green) ;
TextBackground (White) ;
GotoXY (15, 14) ;
FOR i := 1 TO 50
DO
Write ('░') ;
GotoXY (15, 16) ;
FOR i := 1 TO 50
DO
Write ('░') ;
TextBackground (Black) ;
END ;
{ Mise à jour des barres de progression. }
PROCEDURE MiseAJourBarre ( pourcent : Byte ) ;
VAR i : Word ;
BEGIN
TextBackground ( White ) ;
TextColor ( Green ) ;
GotoXY (15, 14) ;
{ Mise à jour de la barre de progression du fichier. }
FOR i := 1 TO PourCent DIV 2
DO
Write ('█') ;
TextColor (Green) ;
TextBackground (White) ;
GotoXY (15, 16) ;
{ Mise à jour de la barre de progression du total. }
FOR i := 1 TO Round ( (Total + NbLu) * 100 / EnsFichier) DIV 2
DO
Write ('█') ;
END ;
{=============================================================================
P A R C O U R S D E S F I C H I E R S
============================================================================}
{ Parcours d'un fichier contenant un ensemble de description. }
PROCEDURE parcours ( nom : String ) ;
VAR f : Text ; { Fichier qu'il faut analyser. }
fic : File ; { Pour connaitre la taille du fichier. }
l : pligne ; { Contient la description. }
s : String ; { Phrase lu dans le fichier. }
tipe : Boolean ; { Vrai, on est dans NEWs sinon on est dans MAJ. }
BEGIN
{ On détermine la taille du fichier (pour les barres de progression). }
Assign ( fic , nom ) ;
{$I-}
Reset (fic, 1) ;
{ S'il y a une erreur lors de l'ouverture on considère que le fichier
est scruté mais on ne peut pas répercuté sa taille dans la barre de
progression d'où un décalage possible, mais bon....}
IF IOResult <> 0
THEN
Exit ;
taille := FileSize ( fic ) ;
Close (fic);
{ On ouvre le fichier. }
Assign ( f , nom ) ;
Reset (f) ;
{ On initialise la recherche. }
l := NIL ;
ReadLn (f, s) ;
IF IOResult <> 0
THEN
BEGIN
Total := Total + taille ;
Exit ;
END ;
nblu := Length (s) + 2; { 2 pour CRLF. }
tipe := (Copy (nom, 1, 3) = 'ASC') ;
Progression (Nom ) ;
fichier := TRUE ;
{ Tant que non fini et non interrompu. }
WHILE ( NOT EoF (f) ) AND (esc) AND (section) AND (fichier) AND (menu) DO
BEGIN
IF tipe
THEN
ajoute ( l , s )
ELSE
BEGIN
ajoute ( l , Copy (s, 1, 31) ) ;
ajoute ( l, Copy (s, 32, Length (s) - 30) ) ;
END ;
ReadLn (f, s) ;
IF IOResult <> 0
THEN
BEGIN
Total := Total + taille ;
Exit ;
END ;
nblu := nblu + Length (s) + 2;
IF tipe
THEN
{ Lecture d'une description de type ASC. }
WHILE (Copy (s, 1, 3) <> delim1) {Fin de description. }
AND
(Copy (s, 1, 3) <> delim2) {Passage de new à maj}
AND
NOT EoF (f) { Fin de fichier. }
DO
BEGIN
ajoute (l, s) ; { On insère dans la liste }
ReadLn (f, s) ; { et on passe au suivant. }
IF IOResult <> 0
THEN
BEGIN
Total := Total + taille ;
Exit ;
END ;
nblu := nblu + Length (s) + 2;
END
ELSE
{ Lecture d'une description de type BBS. }
WHILE (s [1] = ' ') { Fin de description. }
AND
NOT EoF (f) { Fin de fichier. }
DO
BEGIN
{ Les 34 premiers caractères sont des
espaces alors pourquoi ne pas en couper
une partie??? }
ajoute (l, Copy (s, 32, Length (s) - 30) ) ;
ReadLn (f, s) ; { on passe au suivant. }
IF IOResult <> 0
THEN
BEGIN
Total := Total + taille ;
Exit ;
END ;
nblu := nblu + Length (s) + 2;
END ;
IF EoF (f)
THEN
ajoute (l, s) ; { The last but not the least. }
{ Si on a trouvé l'élément alors on affiche la description. }
IF chercher (l)
THEN
BEGIN
titre (nom, l^. ligne) ;
affiche (l) ;
Progression (nom) ;
END ;
{ Mise à jour de la progression. }
MiseAJourBarre ( Round (nblu * 100 / taille) );
{ On efface la description. }
detruit (l);
{ Interruption user? }
IF KeyPressed
THEN
CASE ReadKey OF
#27 : esc := FALSE ; { Oui. }
's',
'S' : section := FALSE ;
'f',
'F' : fichier := FALSE ;
'm',
'M' : menu := FALSE ;
END ;
END ;
Total := Total + Taille ;
Close (f) ;
END ;
{ Insertion d'un fichier dans la liste. }
PROCEDURE ajouteFichier (nom : String; VAR elt : pfichier) ;
BEGIN
IF elt = NIL
THEN
New (elt)
ELSE
BEGIN
New (elt^. suiv) ;
elt := elt^. suiv ;
END ;
elt^. nom := nom ;
elt^. suiv := NIL ;
elt^. etat := TRUE ;
END ;
{ Création de la liste des fichiers et détermination de la taille totale des
fichiers. }
PROCEDURE CalculeTaille ;
VAR temp : pfichier ;
toto : SearchRec ;
BEGIN
temp := NIL ;
Liste_Fichier := NIL ;
FindFirst ('*.asc', Archive, toto) ;
WHILE (DosError = 0)
DO
BEGIN
ajouteFichier (toto. Name, temp) ;
temp^. tipe := type_asc ;
IF Liste_Fichier = NIL
THEN
Liste_Fichier := temp ;
FindNext (toto) ;
END ;
FindFirst ('vrac*.bbs', Archive, toto) ;
WHILE (DosError = 0)
DO
BEGIN
ajouteFichier (toto. Name, temp) ;
temp^. tipe := type_vrac ;
IF Liste_Fichier = NIL
THEN
Liste_Fichier := temp ;
FindNext (toto) ;
END ;
FindFirst ('*.bbs', Archive, toto) ;
WHILE (DosError = 0)
DO
BEGIN
IF Copy (toto. Name, 1, 4) <> 'VRAC'
THEN
BEGIN
ajouteFichier (toto. Name, temp) ;
temp^. tipe := type_autre ;
IF Liste_Fichier = NIL
THEN
Liste_Fichier := temp ;
END ;
FindNext (toto) ;
END ;
END ;
{ Alloue l'espace pour un critère puis affecte les différents champs avec les
valeurs par défaut: chaine= '', transition = Et, négation = false. }
FUNCTION InitCritere : PCritere ;
VAR temp : pCritere ;
BEGIN
New (temp) ;
WITH temp^ DO
BEGIN
Negation := FALSE ;
champ := '' ;
transition := 1 ;
suiv := NIL ;
END ;
InitCritere := temp ;
END ;
{ Cette procédure calcul les décalages pour l'algo de recherche de Boyer
Moore. }
PROCEDURE CalculDecalage ;
VAR critere : pcritere ;
i : Byte ;
BEGIN
critere := teteCritere ;
WHILE (critere <> NIL) AND (critere^. champ <> '') DO
WITH critere^ DO
BEGIN
if not MAJmin then
maj (critere^. champ) ; { <-- Shity bug! }
{ Par défaut on saute tout le critère. }
FOR i := 0 TO 255 DO
decalage [i] := Length (champ) ;
{ Pour tous les caractères de la clé }
FOR i := Length (champ) DOWNTO 1 DO
{ on calcul le décalage que si le caractère n'est pas déjà
apparu (dans august, le décalage sur le 'u' est 2 et non 4
à l'informatique.... another shity bug!) }
IF decalage [Ord (champ [i] ) ] = Length (champ) THEN
decalage [Ord (champ [i] ) ] := Length (champ) - i ;
{ Si le dernier caractère de la clé est répété alors il faut faire
un décalage de 1: another shity bug! Boyer moore, pfff.... }
IF decalage [Ord (champ [Length (champ) ] ) ] = 0
THEN
decalage [Ord (champ [Length (champ) ] ) ] := 1 ;
critere := critere^. suiv ;
END ;
END ;
{ Recalcul de la taille totale des fichiers + calcul décalage des clés de
recherche. }
PROCEDURE PrepareRecherche ;
VAR fic : File OF Byte ;
temp : pfichier ;
BEGIN
{ Détermination de la nouvelle taille. }
temp := Liste_Fichier ;
SectionAsc := 0 ;
SectionVrac := 0 ;
EnsFichier := 0 ;
Total := 0 ;
WHILE temp <> NIL
DO
BEGIN
IF temp^. etat
THEN
BEGIN
Assign (fic , temp^. nom) ;
Reset (fic) ;
EnsFichier := EnsFichier + FileSize (fic) ;
CASE temp^. tipe OF
Type_asc : SectionAsc := SectionAsc + FileSize (fic) ;
Type_vrac : SectionVrac := SectionVrac + FileSize (fic) ;
END ;
Close (fic) ;
END ;
temp := temp^. suiv ;
END ;
IF Souris
THEN
HideMouse ;
HideCursor ;
CalculDecalage ;
END ;
{ Détermination des options de recherche par l'interface. }
PROCEDURE Inter ;
VAR CH : Char ;
Numero : Byte ;
courant : PObjet ;
saisie : PSaisie ;
fini : Boolean ;
bureau : PBureau ;
temp : pFichier ;
fic : File OF Byte ;
Critere3,
Critere2,
Critere : PGroupeCritere ;
Majuscule,
asc,
vrac,
autre : PBoutonCocherBis ;
BEGIN
{====================== Préparation de l'écran =========================}
{ Préparation de l'écran de fond. }
TextBackground (Blue) ;
ClS ;
ASM
mov AX , 0B800h { Remplis le milieu de l'écran. }
mov ES , AX
mov AX , 07B2h { Caractère B2h en couleur 7 sur fond 0. }
mov DI , 320 { Saute les 2 premières lignes. }
mov CX , 2000 - 320 + 80
rep stosw
END ;
banniere ;
{========================= Création du bureau ==========================}
{ Déclaration des objets du bureau. }
saisie := New ( PSaisie, init (4, 5, 40) ) ;
liste := New ( PListe, init (60, 12, 18, 10) ) ;
asc := New ( PBoutonCocherBis, init (60, 5, 'ASC', TRUE) );
vrac := New ( PBoutonCocherBis, init (60, 6, 'VRAC', TRUE) );
autre := New ( PBoutonCocherBis, init (60, 7, 'AUTRES', TRUE) );
Majuscule := New ( PBoutonCocherBis, init (60, 9, 'MAJ/min', FALSE) );
Critere := New ( PGroupeCritere, init (4, 9, TeteCritere^. Suiv) ) ;
Critere2 := New ( PGroupeCritere, init (4, 14, TeteCritere^. Suiv^.
Suiv) ) ;
Critere3 := New ( PGroupeCritere, init (4, 19, TeteCritere^. Suiv^.
Suiv^. Suiv) ) ;
saisie^. chaine := tetecritere^. champ ;
asc^. num := 1 ;
vrac^. num := 2 ;
autre^. num := 3 ;
{ Tri des fichiers du plus récent au plus ancien pour les ASC et les
VRAC. }
trie ;
{ Transfert des fichiers dans la liste. }
temp := Liste_Fichier ;
WHILE (temp <> NIL)
DO
BEGIN
liste^. ajoute (temp) ;
temp := temp^. suiv ;
END ;
{ Définition du bureau. }
Bureau := New (PBureau, init) ;
Bureau^. ajoute (Saisie) ;
Bureau^. ajoute (Critere) ;
Bureau^. ajoute (Critere2) ;
Bureau^. ajoute (Critere3) ;
Bureau^. ajoute (Asc) ;
Bureau^. ajoute (Vrac) ;
Bureau^. ajoute (Autre) ;
Bureau^. ajoute (Majuscule) ;
Bureau^. ajoute (Liste) ;
{================================== Exécution ==========================}
Bureau^. Exec ;
{ Normalement on utilise plus la souris à partir de maintenant jusqu'à
un hypothétique retour dans l'interface. }
IF Souris
THEN
HideMouse ;
{ Récupération du premier critère pour savoir si on veut faire une
recherche. }
TeteCritere^. Champ := Saisie^. Chaine ;
IF TeteCritere^. Champ = ''
THEN
esc := FALSE ;
{ NEW - récupération du booléen de la distinction MAJUSCULE/minuscule. }
MAJmin := Majuscule^. etat ;
{ Libération de la mémoire. }
Dispose (bureau, done) ;
{ On prépare la recherche, ah bon? je croyais qu'on allait au pêche aux
moules derrière le pont de Beslon. }
PrepareRecherche ;
END ;
{ Scanne les fichiers de descriptions + réservation du premier critère. }
PROCEDURE init ;
BEGIN
ASM
mov AX, 3 { On passe en mode texte. }
Int 10h
END ;
FileMode := 0 ; { Passe en mode lecture seule pour l'utilisation à
partir d'un CD-ROM. }
{ Préparation du programme. }
Souris := TRUE ;
esc := TRUE ;
MAJmin := FALSE ;
CalculeTaille ;
IF Liste_Fichier = NIL
THEN
BEGIN
ClrScr ;
WriteLn ('Aucun fichier de description...') ;
Halt ;
END ;
New (TeteCritere) ;
TeteCritere^. champ := '' ;
TeteCritere^. Transition := 0 ;
TeteCritere^. Negation := FALSE ;
TeteCritere^. suiv := NIL ;
END ;
{ Procédure de recherche principale, elle est commune à la recherche
contextuelle ou en ligne de commande. }
PROCEDURE Recherche ;
VAR prog : Byte ;
temp : pFichier ;
BEGIN
temp := Liste_Fichier ;
prog := 1 ;
section := TRUE ;
menu := TRUE ;
WHILE (temp <> NIL) AND (menu) AND (esc)
DO
BEGIN
IF temp^. etat
THEN
parcours (temp^. nom) ;
temp := temp^. suiv ;
IF NOT section
THEN
BEGIN
{ On saute la section courante. }
CASE prog OF
type_asc : Total := SectionAsc ;
type_vrac : Total := SectionAsc + SectionVrac ;
END ;
WHILE temp^. tipe = prog
DO
temp := temp^. suiv ;
prog := temp^. tipe ;
END ;
section := TRUE ;
END ;
END ;
{ Fonction d'analyse de la ligne de commande. }
FUNCTION ParseCmdLine : Boolean ;
VAR Pointeur : Byte ;
Chaine : String ;
Resultat,
ToutSel : Boolean ;
{ Sélectionne tout un groupe, ASC, VRAC ou Autre. Attention si c'est la
première fois que l'on sélectionne un groupe il faut déselectionner tous
les autres. }
PROCEDURE AffectationGroupe (Groupe: String) ;
BEGIN
Maj (Groupe) ;
IF ToutSel
THEN
{ On teste si on a bien saisi le groupe, pour n'avoir qu'à
tester le deuxième caractère, optim quand tu nous tiens... }
IF ( (Groupe = 'ASC') OR (Groupe = 'VRAC') OR (Groupe = 'AUTRE') )
THEN
BEGIN
ToutSel := FALSE ;
Bascule (1, FALSE);
Bascule (2, FALSE);
Bascule (3, FALSE);
END
ELSE
Resultat := TRUE ; { Il y a un problème. }
{ Pourquoi on ne peut pas faire un case avec des chaînes en pascal? }
CASE Groupe [2] OF
'S' : Bascule (1, TRUE) ; { ASC }
'R' : Bascule (2, TRUE) ; { VRAC }
'U' : Bascule (3, TRUE) ; { AUTRE }
END ;
END ;
FUNCTION LectureCle : String ;
VAR Chaine,
Mot : String ;
BEGIN
Mot := ParamStr (Pointeur) + ' ' ;
Chaine := '';
WHILE NOT (Mot [1] IN ['/', '-', '+', '*', '@'] )
AND (Pointeur <= ParamCount)
DO
BEGIN
Chaine := Chaine + Mot ;
Inc (Pointeur) ;
Mot := ParamStr (Pointeur) + ' ' ;
END ;
IF Chaine <> ''
THEN
Delete (Chaine, Length (Chaine), 1) ;
LectureCle := Chaine ;
END ;
PROCEDURE InsertCritere (Mot: String) ;
VAR criter : pcritere ;
BEGIN
criter := TeteCritere ;
{ On se positionne sur le dernier critère. }
WHILE criter^. suiv <> NIL
DO
criter := criter^. suiv ;
criter^. suiv := InitCritere ; { on alloue. }
Criter := criter^. suiv ;
CASE mot [1] OF
'+' : Criter^. transition := 2; { ou. }
'*' : Criter^. transition := 1; { et. }
END ;
{ Le '+' et le '*' ne font pas partie de la clé. }
Delete (chaine, 1, 1) ;
{ Il y a une négation? }
IF mot [2] = '#'
THEN
BEGIN
criter^. negation := TRUE ;
{ Le '#' ne fait pas partie de la clé. }
Delete (chaine, 1, 1);
END ;
{ On passe au paramètre suivant. }
Inc (pointeur) ;
Criter^. Champ := chaine+ LectureCle ;
END ;
PROCEDURE InsDelFichier (Mot: String) ;
PROCEDURE Scan (mot : String; etat : Boolean) ;
VAR temp : pfichier ;
BEGIN
maj (mot) ;
temp := Liste_Fichier ;
WHILE (temp <> NIL) AND (temp^. nom <> mot)
DO
temp := temp^. suiv ;
IF temp <> NIL
THEN
temp^. etat := etat ;
END ;
BEGIN
CASE mot [1] OF
'x', 'X' : Scan (Copy (chaine, 2, 12), FALSE) ;
'i', 'I' : BEGIN
IF ToutSel { Par défaut on sélectionne tout. }
THEN
BEGIN
ToutSel := FALSE ;
Bascule (1, FALSE) ;
Bascule (2, FALSE) ;
Bascule (3, FALSE) ;
END ;
Scan (Copy (chaine, 2, 12), TRUE) ;
END ;
ELSE Resultat := TRUE ;
END ;
END ;
BEGIN
Resultat := FALSE ;
ToutSel := TRUE ;
Pointeur := 1 ;
TeteCritere^. Champ := LectureCle ;
IF TeteCritere^. Champ = ''
THEN
resultat := TRUE ;
WHILE (Pointeur <= ParamCount) AND (NOT Resultat)
DO
BEGIN
Chaine := ParamStr (pointeur) ;
CASE Chaine [1] OF
'@' : BEGIN
Delete (chaine, 1, 1) ;
AffectationGroupe (Chaine) ;
Inc (pointeur) ;
END ;
'-' : BEGIN
Delete (Chaine, 1, 1) ;
InsDelFichier (Chaine) ;
Inc (pointeur) ;
END ;
'*', '+' : InsertCritere (chaine) ;
END ;
END ;
ParseCmdLine := NOT resultat ;
END ;
{ Comment que ca marche le truc... }
PROCEDURE Usage ;
BEGIN
WriteLn ('TROUVE v', version, ' par EVAIN Stéphane (c) 1994.') ;
WriteLn (' Usage: TROUVE CléDeRecherche [@ASC] [@VRAC] [@AUTRE] [/m]') ;
WriteLn (' [-xFichier] [-iFichier] [+[#]Clé] [*[#]Clé]');
WriteLn;
WriteLn ('@ASC, @VRAC, @AUTRE: étend la recherche sur les fichiers ASC, VRAC ...');
WriteLn ('-xFichier : exclut un fichier de la recherche.') ;
WriteLn ('-iFichier : inclut un fichier dans la recherche.') ;
WriteLn ('+[#]Clé : Ajoute un critère à la recherche avec la forme:') ;
WriteLn (' CléDeRecherche OU [NON] Clé le `#` représente la négation.') ;
WriteLn ('*[#]Clé : idem que au-dessus mais avec et un ET.') ;
WriteLn;
WriteLn ('/m : Déasctive la gestion de la souris.') ;
WriteLn;
WriteLn ('Exemple:');
WriteLn (' TROUVE Steph est le plus beau +|titi @AsC @Autre -xaSc1.asc -ivrAc1.bBs');
WriteLn (' Cherche "Steph est le plus beau" ou non "titi" dans les fichiers asc,');
WriteLn ('les autres et le fichier vrac1.bbs mais pas dans asc1.asc. Attention le');
WriteLn ('programme risque de trouver un paquet de descriptions car un OU NEGATIF va');
WriteLn ('afficher toutes les descriptions qui ne contiennent pas "titi" ou qui');
WriteLn ('contiennent "Steph est le plus beau" et là il y en a! (MEGALO!)') ;
Halt (1) ;
END ;
{ Si la ligne de commande est bonne, on lance la recherche, sinon on affiche
la grammaire pour l'utilisateur qui a fait une faute de frappe (forcement). }
PROCEDURE SearchCmdLine ;
BEGIN
IF ParseCmdLine
THEN
BEGIN
PrepareRecherche ;
Recherche ;
END
ELSE
Usage ;
END ;
{ Boucle principale de l'interface. }
PROCEDURE Contextuelle ;
BEGIN
{ Si on utilise la souris, on l'initialise. }
IF Souris
THEN
ASM
MOV AX, 0
Int 33h
END ;
{ Construction de la liste des critères. }
New (TeteCritere^. Suiv) ;
TeteCritere^. Suiv := InitCritere ;
TeteCritere^. Suiv^. Suiv := InitCritere ;
TeteCritere^. Suiv^. Suiv^. Suiv := InitCritere ;
{ Tant que l'on n'a pas quitté, on utilise l'interface. }
WHILE esc
DO
BEGIN
Inter ;
Recherche ;
END ;
END ;
{ On efface toutes les allocations mémoires et on force le retour en mode
texte que l'on normalement pas quitté, mais bon... }
PROCEDURE done ;
VAR temp : pfichier ;
tmp : pcritere ;
BEGIN
{ Dans la version 1.01 j'ai oublié de supprimer les listes chaînées...
Certes ça sert à rien car le DOS fait un joli ramasse miettes (garbage
collector, fuck the prolog), mais bon ça prouve que j'y ai pensé et
c'est déjà bien! }
temp := Liste_Fichier ;
WHILE (temp <> NIL)
DO
BEGIN
temp := temp^. suiv ;
Dispose (Liste_Fichier);
Liste_Fichier := temp ;
END ;
tmp := tetecritere ;
WHILE (tmp <> NIL)
DO
BEGIN
tmp := tmp^. suiv ;
Dispose (tetecritere) ;
tetecritere := tmp ;
END ;
{ On remet tout comme on l'a trouvé. }
TextColor (LightGray) ;
TextBackground (Black) ;
ShowCursor ;
ASM
mov AX, 3
Int $10
END ;
END ;
{ Détermine si le programme doit s'exécuter de manière contextuelle, ou
d'après les options définies en ligne de commande. }
FUNCTION EnLigne : Boolean ;
VAR temp : String ;
toto : Byte ;
BEGIN
Temp := ParamStr (1) ;
maj (temp) ;
IF temp = '/M'
THEN
souris := FALSE ;
IF ( (ParamCount = 1) AND (Temp = '/M') ) OR (ParamCount = 0)
THEN
EnLigne := FALSE
ELSE
EnLigne := TRUE ;
END ;
{
int main (int argc, char *argv[]) FUCK THE C! Object rulez the world..
en exclusivité mondiale, la version 3 sera (peut-être) en C++, mais pas en C!
Euh, en fait non, peut être en LISP ou en CAML, si quelqu'un connaît qu'il soit
bénit, heureux ceux qui ont débuter la programmation avec ce langage qui a
l'énorme avantage d'être français et d'une beauté aveuglante. Malheureusement
comme tout les langages de sa catégorie (fonctionnelle) il ne possède pas d'EDI
comme Borand Pascal... Car il tourne sur PC, Mac, Unix, Atari, Amiga bref tout
ce qui possède un semblant de sérieux (pour certaines de ces machines ce n'est
pas évident, à vous de trouver lesquelles!).
}
BEGIN
init ;
IF EnLigne
THEN
SearchCmdLine
ELSE
Contextuelle ;
done ;
END. { Et non je n'ai pas 2888 lignes mais c'était juste.. }