home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 31 / CDASC_31_1996_juillet_aout.iso / index / source / trouve.pas < prev    next >
Pascal/Delphi Source File  |  1996-06-14  |  60KB  |  1,819 lines
  1. (****************************************************************************)
  2. (*                                   TROUVE                                 *)
  3. (*--------------------------------------------------------------------------*)
  4. (* Le but de ce programme est de permettre la recherche d'archives suivant  *)
  5. (* de nombreux critères dans un ensemble de fichiers de descriptions de     *)
  6. (* CD-ROM. Il peut être lancé soit en ligne de commande, soit par une       *)
  7. (* interface contextuelle (dans ce cas l'utilisateur sera limité à quatre   *)
  8. (* critères de recherche.                                                   *)
  9. (*--------------------------------------------------------------------------*)
  10. (* Auteur          : Stéphane EVAIN.                                        *)
  11. (* Création        : Octobre 1993.                                          *)
  12. (* Dernière modif. : 14/06/96                                               *)
  13. (****************************************************************************)
  14.  
  15. PROGRAM cd_rom ;
  16.  
  17. USES crt, DOS ;
  18.  
  19.  
  20. {========================= Quelques constantes ==============================}
  21. CONST delim1     = '  ═'  ;
  22.       delim2     = '  ■'  ;
  23.       Ctrl_E     = #255   ;
  24.       Ctrl_O     = #254   ;
  25.       Ctrl_N     = #253   ;
  26.       version    = '2.6'  ;
  27.       Type_asc   = 1      ;
  28.       Type_Vrac  = 2      ;
  29.       Type_Autre = 3      ;
  30.  
  31.  
  32. {============================ Quelques types ================================}
  33. TYPE pLigne = ^tLigne ;                    { Ce type stocke une description. }
  34.      tLigne = RECORD
  35.                     ligne : String ;
  36.                     suiv  : pLigne ;
  37.               END ;
  38.  
  39.      pFichier = ^tFichier ;        { Ce type contient la liste des fichiers. }
  40.      tFichier = RECORD
  41.                       nom  : String   ;
  42.                       tipe : Byte     ;
  43.                       etat : Boolean  ;
  44.                       suiv : pFichier ;
  45.                 END ;
  46.  
  47.      pCritere = ^tCritere ;        { Ce type contient la liste des critères. }
  48.      tCritere = RECORD
  49.                       decalage   : ARRAY [0..255] OF Byte ;
  50.                       champ      : String   ;
  51.                       transition : Byte     ; { 0-rien, 1-et, 2-ou. }
  52.                       negation   : Boolean  ;
  53.                       suiv       : pCritere ;
  54.                 END ;
  55.  
  56.      pelt = ^telt ;                { Ce type contient une liste de fichiers. }
  57.      telt = RECORD                          { elle est utilisée dans l'objet }
  58.                   elt  : pfichier ;         { liste de l'interface.          }
  59.                   suiv : pelt     ;
  60.             END ;
  61.  
  62. {========================= Très peu de variables globales ===================}
  63.  
  64. VAR fichier : Boolean  ;   { Pour sauter un fichier.                   }
  65.     section : Boolean  ;   { Pour sauter une section.                  }
  66.     esc     : Boolean  ;   { Pour tout sauter (quelle santé!)          }
  67.     menu    : Boolean  ;   { Indique que l'on veut retourner au menu.. }
  68.     Souris  : Boolean  ;   { Doît-on géré la souris.                   }
  69.     MAJmin  : Boolean  ;
  70.     cherche : String   ;   { Chaine principale recherchée.             }
  71.  
  72.     taille,                { Pour la gestion de la progression.        }
  73.     SectionAsc,
  74.     SectionVrac,
  75.     EnsFichier,
  76.     Total,
  77.     nblu    : LongInt  ;
  78.     Liste_Fichier
  79.             : pFichier ;   { Pour les listes de fichiers.              }
  80.  
  81.     tetecritere            { Pointe sur la tête de liste (pour les     }
  82.             : pCritere ;   { élections?) des critêres.                 }
  83.  
  84.  
  85.  
  86.  
  87. { ENSEMBLES DES PROCEDURES FACILEMENT PORTABLES SUR D'AUTRES SYSTEMES. }
  88.  
  89. {====================== Manipulations de curseurs =====================}
  90.  
  91. PROCEDURE HideCursor ; ASSEMBLER ;
  92.  
  93. ASM
  94.    mov AH , $01    { Et si je veux porter sur mon PET de Commodore je fais }
  95.    mov CX , $2020  { comment surtout que j'ai 4Ko et pas de souris....     }
  96.    Int $10
  97. END ;
  98.  
  99.  
  100.  
  101.  
  102. PROCEDURE ShowCursor ; ASSEMBLER ;
  103.  
  104. ASM
  105.    mov AH , $01
  106.    mov CX , $0708
  107.    Int $10
  108. END ;
  109.  
  110.  
  111.  
  112. {====================== Ecritures directes à l'écran ======================}
  113.  
  114. { Efface l'écran, étonnant non? }
  115. PROCEDURE Cls ; ASSEMBLER ;
  116.  
  117. ASM
  118.    mov  AX , $0B800 { Clrscr encore plus de la mort qu'avant }
  119.    mov  ES , AX     { mais beaucoup plus rapide et plus      }
  120.    mov  CX , 1000   { compact, vive l'ASM, fuck the C!       }
  121.    XOR  DI , DI
  122.    db   $66         { xor eax, eax                           }
  123.    XOR  AX, AX
  124.    db   $f3
  125.    db   $66
  126.    db   $ab         { rep stosd (d = double word!)           }
  127. END ;
  128.  
  129.  
  130.  
  131. { Cette procédure ecrit en mémoire vidéo à partir de l'adresse D, la chaîne
  132.   dont l'adresse est S et la taille n. }
  133. PROCEDURE toScrA (VAR s; D, n: Word); ASSEMBLER;
  134.  
  135. ASM
  136.    mov CX, n
  137.    jcxz @X         { Si la chaîne est vide, on ne l'écrit pas. }
  138.    push DS
  139.    mov AX, $0B800
  140.    mov ES, AX
  141.    mov DI, D
  142.    SHL DI, 1
  143.    mov AL, TextAttr
  144.    lds SI, s       { ALERT, DS modified, fucking bug! }
  145.    cld
  146.   @L:
  147.    movsb           { Ne modifie pas AL, heureusement... }
  148.    stosb           { On charge le caractère suivant. }
  149.    loop @L
  150.    pop DS
  151.    @X:
  152. END;
  153.  
  154.  
  155.  
  156. { Calcul les paramètres pour l'appel de ToScrA (écriture directe en mem vidéo:
  157.   win 95 Suxxxx.... }
  158. PROCEDURE qWrite (Row, Col: Byte; S: String);
  159.  
  160. VAR NbCol : Word ABSOLUTE $0040 : $004A;
  161.  
  162. BEGIN
  163.      toScrA (MemW [Seg (S): Succ (Ofs (S) ) ],
  164.              Pred (Row) * NbCol + Pred (Col), Length (S) );
  165. END;
  166.  
  167.  
  168.  
  169. { Centrage d'une chaîne. }
  170. PROCEDURE centre ( s : String ; ligne : Word ) ;
  171.  
  172. BEGIN
  173.      ASM
  174.         mov AX, ligne
  175.         Dec AX
  176.         mov BX, AX
  177.         mov AX, 160
  178.         mul BX
  179.         mov DI, AX
  180.         mov AX , $0B800   { Remplissage de la ligne. }
  181.         mov ES , AX
  182.         mov CX , 80
  183.         mov AH , TextAttr
  184.         mov AL , 32
  185.         rep stosw
  186.      END ;
  187.  
  188.      QWrite (ligne, (80 - Length (s) ) DIV 2, s) ;
  189. END ;
  190.  
  191.  
  192.  
  193. { Passe une chaîne en majuscule. Version archi-tiny-fast. }
  194. PROCEDURE Maj (VAR S: String); ASSEMBLER;
  195.  
  196. ASM
  197.    push    DS              { Sauve DS sur la pile.                         }
  198.    lds     SI, S           { Charge DS:SI avec le pointeur de S.           }
  199.    cld                     { Pour le parcours des chaînes il faut avancer? }
  200.    lodsb                   { Charge la longueur de S.                      }
  201.    sub     AH, AH          { Efface le poids fort de AX.                   }
  202.    mov     CX, AX          { Transfert AX dans CX.                         }
  203.    jcxz    @Done           { Si la longueur est nulle alors on a fini.     }
  204.    mov     AX, DS          { ES=DS en deux instructions car on n'est pas   }
  205.    mov     ES, AX          { en mode flat (386 required).                  }
  206.    mov     DI, SI          { DI=SI qui pointent sur le premier caractère.  }
  207.                            { donc lodsb charge une lettre, stosb la sauve. }
  208.  @UpCase:
  209.    lodsb                   { Charge une lettre.                            }
  210.    cmp     AL, 'a'
  211.    jb      @notLower       { inférieur à 'a' -- on fait rien.              }
  212.    cmp     AL, 'z'
  213.    ja      @notLower       { supérieur à 'z' -- on fait toujours rien.     }
  214.    sub     AL, ('a' - 'A') { convertit la lettre en majuscule.             }
  215.  @notLower:
  216.    stosb                   { Sauve la lettre.                              }
  217.    loop    @UpCase         { Et on boucle sur toute la chaîne.             }
  218.  @Done:
  219.    pop     DS              { Retablit DS de la pile.                       }
  220. END ;
  221.  
  222.  
  223.  
  224. {=============================================================}
  225. {    G E S T I O N   D E S   L I S T E S   C H A I N E E S    }
  226. {=============================================================}
  227.  
  228. { Insère une ligne dans la liste chaînée représentant la description d'un
  229.   fichier.... }
  230. PROCEDURE ajoute ( VAR l : pLigne ; s : String ) ;
  231.  
  232. VAR temp : pLigne ;
  233.  
  234. BEGIN
  235.      IF l = NIL
  236.         THEN
  237.             BEGIN
  238.                  { Insertion en tête. }
  239.                  New (l) ;
  240.                  { On suppose que l'heureux possesseur d'un lecteur cdrom }
  241.                  { possède suffisamment de mémoire pour allouer au moins  }
  242.                  { une ligne (300 octets en comptant large).              }
  243.                  temp := l ;
  244.             END
  245.         ELSE
  246.             BEGIN
  247.                  { Suffisamment de mémoire ??? }
  248.                  IF MaxAvail < SizeOf (tligne)
  249.                     THEN
  250.                         BEGIN
  251.                              {Cls;}
  252.                              WriteLn ('Bigre pas assez de mémoire...');
  253.                              Halt (1);
  254.                              { Le test de mémoire a été mis surtout pour la  }
  255.                              { phase de débogage du programme et au cas ou   }
  256.                              { l'utilisateur essayerais le programme sur un  }
  257.                              { fichier ne suppportant pas la grammaire       }
  258.                              { indiquée dans la documentation (petit         }
  259.                              { sacripant).                                   }
  260.                         END ;
  261.                  { On cherche la queue, sans arrière pensée! }
  262.                  temp := l ;
  263.                  WHILE temp^. suiv <> NIL DO
  264.                        temp := temp^. suiv ;
  265.                  { Insertion en pas tête... toi y'en a être français? }
  266.                  New (temp^. suiv) ;
  267.                  temp := temp^. suiv ;
  268.             END ;
  269.      temp^. ligne := s ;
  270.      temp^. suiv := NIL ;
  271. END ;
  272.  
  273.  
  274.  
  275. { Destruction d'une description. }
  276. PROCEDURE detruit ( l : pLigne ) ;
  277.  
  278. VAR temp : pLigne ;
  279.  
  280. BEGIN
  281.      temp := l ;                     { Cette procédure est tellement bateau  }
  282.                                      { que je la commente uniquement pour    }
  283.      WHILE l <> NIL                  { faire gonfler artificiellement la     }
  284.            DO                        { taille du source.                     }
  285.              BEGIN                   { ┌────┤ ├──┬──┤ ┌───┤  ┌────┐ ─┬─  ─┬─ }
  286.                   l := l^. suiv ;    { │         │    │      │    │  │    │  }
  287.                   Dispose (temp) ;   { └────┐    │    ├─┤    ├────┘  ├────┤  }
  288.                   temp := l ;        {      │    │    │      │       │    │  }
  289.              END ;                   { ├────┘   ─┴─   └───┤ ─┴─     ─┴─  ─┴─ }
  290. END ;                                {            Pas mal pour un militaire? }
  291.  
  292.  
  293.  
  294.  
  295. {==================================================================}
  296. {    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    }
  297. {==================================================================}
  298.  
  299. { Affichage des bannières en haut et en bas de l'écran de l'interface. }
  300. PROCEDURE banniere ;
  301.  
  302. BEGIN
  303.      TextColor (Yellow) ;
  304.      centre ('Cherche et trouve ' + version + '  EVAIN Stéphane (C) 1994', 1) ;
  305.      centre ('Greetings to PAT, TAF, WRB & NANOUK...', 2) ;
  306.      centre ('Tab, Shift-Tab : changement de champ  -   Esc : Quitter   -   Entrée : Valider', 25) ;
  307.      TextColor (LightGray) ;
  308.      QWrite (4, 4, 'Saisie') ;
  309.      QWrite (11, 60, 'Fichiers:') ;
  310.      QWrite (4, 60, 'Sélection rapide:') ;
  311. END ;
  312.  
  313.  
  314.  
  315. { Convertit une chaîne en nombre. }
  316. FUNCTION Val2 (chaine : String) : Byte ;
  317. VAR i, code : Integer ;
  318. BEGIN
  319.      FOR i := 1 TO Length (chaine) DO
  320.          IF NOT (chaine [i] IN ['0'..'9'] ) THEN
  321.             Delete (chaine, i, 1) ;
  322.      Val (Chaine, I, Code);
  323.      Val2 := i ;
  324. END ;
  325.  
  326.  
  327. { Tri les noms dans la liste pour les mettre dans l'ordre chronologique
  328.   inverse. Offset indique le décalage des mots 3 pour ASC, 4 pour VRAC,
  329.   debut et fin donne les indices dans la liste des sections asc et vrac. }
  330. PROCEDURE tri ( OFFSET, tipescan : Byte ) ;
  331.  
  332. VAR fin, next,
  333.     start, Pred,
  334.     debut, preced,
  335.     dernier     : PFichier ;
  336.     permutation : Boolean ;
  337.     ind_deb     : Word ;
  338.     Valeur, valeur2 : Byte ;
  339.  
  340.  FUNCTION elt_i (num: Word) : pfichier ;
  341.  VAR i : Word ;
  342.      res : pfichier ;
  343.  BEGIN
  344.       i := 0 ;
  345.       res := Liste_Fichier ;
  346.       WHILE (i <> num) DO
  347.       BEGIN
  348.            res := res^. suiv ;
  349.            Inc (i) ;
  350.       END ;
  351.       elt_i := res ;
  352.  END ;
  353.  
  354.  
  355. BEGIN
  356.      Permutation := TRUE ;
  357.      { On parcours la liste pour trouver le premier fichier à traiter.
  358.        Dans preced on sauve le précédent de la tête de la recherche pour les
  359.        permutations, si =Nil alors on commence en tête. }
  360.      debut := Liste_Fichier ;
  361.      preced := NIL ;
  362.      ind_deb := 0 ;
  363.      { La il y avait un bug jusqu'à la 2.51! }
  364.      WHILE (debut <> NIL) AND (debut^. tipe <> tipescan) DO
  365.      BEGIN
  366.           preced := debut ;
  367.           debut := debut^. suiv ;
  368.           Inc (ind_deb) ;
  369.      END ;
  370.      fin := debut ;
  371.      WHILE (fin <> NIL) AND (fin^. tipe = tipescan) DO
  372.            fin := fin^. suiv ;
  373.      WHILE Permutation
  374.            DO BEGIN
  375.               { On doit reparcourir la liste depuis le début à chaque fois
  376.                 car on peut avoir modifié plusieurs fois la tête. }
  377.               start := elt_i (ind_deb) ;
  378.               Pred := Preced ;
  379.               dernier := NIL ;
  380.               next := start^. Suiv ;
  381.               permutation := FALSE ;
  382.  
  383.               WHILE (next <> fin) AND (next <> NIL)
  384.                     DO BEGIN
  385.                        Valeur := Val2 (Copy (start^. nom, OFFSET, 2) ) ;
  386.                        Valeur2 := Val2 (Copy (next^. nom, OFFSET, 2) );
  387.                        IF (Valeur < Valeur2)
  388.                           THEN BEGIN
  389.                               { Echange de start et next. }
  390.                               { On saute Next. }
  391.                               Start^. Suiv := Next^. Suiv ;
  392.                               { On rebranche next. }
  393.                               Next^. Suiv := Start ;
  394.                               { Si on n'est pas sur la tête }
  395.                               IF Pred <> NIL
  396.                                  THEN
  397.                                      Pred^. Suiv := Next
  398.                                  ELSE
  399.                                      Liste_Fichier := Next ;
  400.                               { On a effectué une permutation. }
  401.                               permutation := TRUE ;
  402.                               { On s'est arrêté ici. }
  403.                               dernier := start ;
  404.                               { On passe au suivant. }
  405.                               Pred := Next ;
  406.                               Next := Start^. Suiv ;
  407.                           END
  408.                           ELSE BEGIN
  409.                                Pred := Start ;
  410.                                start := next ;
  411.                                next := start^. Suiv ;
  412.                           END ;
  413.                     END ;
  414.               IF permutation
  415.                  THEN { Tout est trié après dernier. }
  416.                       fin := dernier ;
  417.            END ;
  418. END ;
  419.  
  420.  
  421.  
  422. { Tris les noms de fichiers 'ascXX.asc' et 'vracXX.bbx'. }
  423. PROCEDURE trie ;
  424. BEGIN
  425.      { tri les asc. }
  426.      tri (4, type_asc) ;
  427.      { tri les vrac. }
  428.      tri (5, type_vrac) ;
  429. END ;
  430.  
  431.  
  432.  
  433. { Bascule tous les fichiers d'un certain type pour les valider ou non, cette
  434.   procédure est surtout utilisé par les boutons à cocher. }
  435. PROCEDURE Bascule (num : Byte; nouveau : Boolean );
  436.  
  437. VAR temp : pFichier ;
  438.  
  439. BEGIN
  440.      temp := Liste_Fichier ;
  441.      WHILE temp <> NIL
  442.            DO
  443.              BEGIN
  444.                   IF temp^. tipe = num
  445.                      THEN
  446.                          temp^. etat := nouveau ;
  447.                   temp := temp^. suiv ;
  448.              END ;
  449. END ;
  450.  
  451.  
  452. {$i interfac.pas} {???, bravo you found the secret part! }
  453.  
  454. {=============================================================================
  455.           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
  456.  ============================================================================}
  457.  
  458.  
  459. { Affichage du titre (nom du fichier, section si on est dans un fichier ASC. }
  460. PROCEDURE titre (nom : String; categ : String) ;
  461.  
  462. BEGIN
  463.      { On efface l'écran. }
  464.      Cls ;
  465.      { On affiche la bannière en haut et on précise, si on le peut, la section
  466.        où l'on a trouvé la description (NEWS ou VRAC). }
  467.      TextBackground (Blue) ;
  468.      TextColor (Yellow) ;
  469.      categ := Copy (categ, 1, 3) ;
  470.      IF categ = delim1
  471.         THEN
  472.             centre (nom + ' NEWS', 1) ;
  473.      IF categ = delim2
  474.         THEN
  475.             centre (nom + ' MAJ', 1) ;
  476.      IF (categ <> delim1) AND (categ <> delim2)
  477.         THEN
  478.             centre (nom, 1) ;
  479.      { On se prépare à afficher la description. }
  480.      TextColor (LightGray) ;
  481.      TextBackground (Black) ;
  482.      GotoXY (1, 2);
  483. END ;
  484.  
  485.  
  486.  
  487.  
  488. { Cette procédure cherche si la clé de recherche est dans la phrase et la
  489.   colorie si il la trouve sachant que phrase se trouve sur la ligne ligne! }
  490. PROCEDURE couleur (phrase : String; ligne : Byte) ;
  491.  
  492. CONST EnsCoul : ARRAY [0..3] OF Byte =
  493.                 (LightRed, LightGreen, LightBlue, Magenta) ;
  494.  
  495. VAR temp   : pcritere ;
  496.     cle    : String   ;
  497.     posit,
  498.     i, j,
  499.     indice : Byte     ;
  500.  
  501. BEGIN
  502.      { On prépare la coloration, on va parcourir tous les critères. }
  503.      temp := tetecritere ;
  504.      indice := 0 ;
  505.      { L'écran commence à l'adresse 0 et non à l'adresse 80! }
  506.      Dec (ligne) ;
  507.      { Tant qu'il reste  des champs à inspecter. }
  508.      WHILE (temp <> NIL) AND (temp^. champ <> '')
  509.            DO
  510.              BEGIN
  511.                   { On met la clé en majuscule. }
  512.                   cle := temp^. champ ;
  513.                   maj (cle) ;
  514.                   { On cherche la clé dans la phrase. }
  515.                   Posit := Pos (cle, phrase) ;
  516.                   { Si on a trouvé la couleur... }
  517.                   IF posit <> 0 THEN
  518.                     BEGIN
  519.                          { On passe par une variable locale car on ne peut pas
  520.                            accédé facilement directement au tableau par BASM.}
  521.                          j := enscoul [indice] ;
  522.                          { Pour tous les caractères de la clé. }
  523.                          FOR i := posit TO Pred (Length (cle) + posit)
  524.                              DO
  525.                                ASM
  526.                                   mov AX, 0b800h {                           }
  527.                                   mov ES, AX     { mov es,0B800h             }
  528.                                   mov AX, 160    { ax := 160                 }
  529.                                   XOR BX, BX     { bx := 0 (surtout bh).     }
  530.                                   mov BL, ligne  { bl := ligne               }
  531.                                   mul BX         { ax := 160*ligne           }
  532.                                   mov BL, i      { bl := i                   }
  533.                                   Dec BX         { bl := i-1                 }
  534.                                   SHL BX, 1      { bl := 2*(i-1)             }
  535.                                   Inc BX         { bl := 2*(i-1)+1           }
  536.                                   add AX, BX     { ax := 160*ligne+2*(i-1)+1 }
  537.                                   mov DI, AX     { di := ax                  }
  538.                                   mov AL, j      { al := j (enscoul[indice]) }
  539.                                   stosb          { [$b800:160*ligne+2*(i-1)+1}
  540.                                END ;             {                        :=j}
  541.                                {
  542.                                C'est l'équivalent de:
  543.                                mem[$B800:160*ligne+2*(i-1)+1] :=
  544.                                                              EnsCoul[indice] ;
  545.                                }
  546.                     END ;
  547.                   { On passe au critère suivant. }
  548.                   temp := temp^. suiv ;
  549.                   { On passe à la couleur suivante. }
  550.                   Inc (indice) ;
  551.                   IF indice = 4 { Quatre couleurs différentes.... }
  552.                      THEN
  553.                          indice := 0 ;
  554.              END ;
  555. END;
  556.  
  557.  
  558.  
  559. { Affichage d'une description, avec gestion du clavier. }
  560. PROCEDURE affiche (l : pligne) ;
  561.  
  562. VAR toto    : Integer ;
  563.     modif,
  564.     suivant : Boolean ;
  565.     temp,
  566.     debut   : pligne  ;
  567.  
  568.  { Gestion du clavier. }
  569.  PROCEDURE attente ;
  570.  
  571.  VAR CH     : Char ;
  572.      chaine : String ;
  573.  
  574.  BEGIN
  575.       TextBackground (Blue) ;
  576.       TextColor (Yellow) ;
  577.       IF modif
  578.          THEN
  579.              BEGIN
  580.                   { Construit l'aide en ligne }
  581.                   chaine := '<ESC> = FIN' ;
  582.                   IF temp <> NIL
  583.                      THEN
  584.                          IF debut <> l
  585.                             THEN
  586.                                 chaine := chaine+ ' - <> = Défilement'
  587.                             ELSE
  588.                                 chaine := chaine+ ' - < > = Défilement'
  589.                      ELSE
  590.                          IF debut <> l
  591.                             THEN
  592.                                 chaine := chaine+ ' - < > = Défilement' ;
  593.                   chaine := chaine + ' - <M> = Menu - <F> = Fic Suiv - <S> = Sec Suiv' ;
  594.                   { Centre la chaîne sur la ligne courante. }
  595.                   centre (chaine, WhereY);
  596.              END ;
  597.  
  598.       modif := FALSE ;
  599.       CASE ReadKey OF
  600.        #27 : esc := FALSE ;
  601.        's',
  602.        'S' : Section := FALSE ;
  603.        'f',
  604.        'F' : Fichier := FALSE ;
  605.        'm',
  606.        'M' : menu := FALSE ;
  607.        #0  : CASE ReadKey OF
  608.                    'P' : IF (temp <> NIL)                     { Bas }
  609.                             THEN
  610.                                 BEGIN
  611.                                      modif := TRUE ;
  612.                                      debut := debut^. suiv ;
  613.                                 END ;
  614.                    'H' : IF debut <> l                        { Haut }
  615.                             THEN
  616.                                 BEGIN { Recherche du précédent. }
  617.                                      temp := l ;
  618.                                      WHILE temp^. suiv <> debut
  619.                                            DO
  620.                                              temp := temp^. suiv ;
  621.                                      debut := temp ;
  622.                                      modif := TRUE ;
  623.                                 END ;
  624.                    #71, #73 : IF (debut <> l)                  { PgUp, Home }
  625.                                  THEN
  626.                                      BEGIN
  627.                                           modif := TRUE ;
  628.                                           debut := l ;
  629.                                      END ;
  630.                    #81, #79 : IF (temp <> NIL)                { PgDn, End }
  631.                                  THEN
  632.                                      BEGIN
  633.                                           modif := TRUE ;
  634.                                           WHILE (temp <> NIL)
  635.                                                 DO
  636.                                                   BEGIN
  637.                                                        temp := temp^. suiv ;
  638.                                                        debut := debut^. suiv ;
  639.                                                   END ;
  640.                                      END ;
  641.              END ;
  642.        ELSE suivant := FALSE ;
  643.       END;
  644.       IF modif
  645.          THEN
  646.              BEGIN
  647.                   ASM
  648.                      { Wait For Retrace }
  649.                      MOV DX, $3DA
  650.                      @RT:
  651.                       IN   AL, DX
  652.                       Test AL, 8
  653.                      JZ @RT
  654.  
  655.                      { Efface l'écran sauf la première et la dernière ligne. }
  656.                      push ES
  657.                      mov AX , $0B800
  658.                      mov ES , AX
  659.                                        { On parle sérieux ici pas du word du }
  660.                      mov CX , (2000 - 160) / 2{ double word alors on divise. }
  661.                      mov DI , 160
  662.                      db  $66           { idem }
  663.                      XOR AX , AX
  664.                      db   $f3
  665.                      db   $66
  666.                      db   $ab          { rep stosd (d = double word!) }
  667.                      pop ES
  668.                   END ;
  669.  
  670.                   temp := debut ;
  671.              END ;
  672.       GotoXY (1, 2) ; { On se positionne au début de la description. }
  673.  END ;
  674.  
  675.  
  676.  { Dessin de la description. }
  677.  PROCEDURE redraw ;
  678.  
  679.  VAR li    : Integer ;
  680.      up,
  681.      upper : String  ;
  682.  
  683.  BEGIN
  684.       li := 1 ;
  685.       TextBackground (Black) ;
  686.       TextColor (LightGray) ;
  687.       WHILE ( temp <> NIL ) AND ( li <> 24 )
  688.             DO
  689.               BEGIN
  690.                    Inc (li) ;
  691.                    upper := temp^. ligne ;
  692.                    { On affiche la ligne. }
  693.                    QWrite (li, 1, temp^. ligne) ;
  694.                    maj (upper) ;
  695.                    { On colorise la ligne si nécessaire. }
  696.                    Couleur (upper, li );
  697.                    temp := temp^. suiv ;
  698.               END ;
  699.       { On rafraichit la position du curseur, car avant on effectue des
  700.         écritures directement en mémoire. }
  701.       GotoXY (1, li + 1);
  702.  END ;
  703.  
  704.  
  705. BEGIN
  706.      debut := l ;
  707.      temp := l ;
  708.      modif := TRUE ;
  709.      redraw ;
  710.      suivant := TRUE ;
  711.      { S'il ne reste plus de lignes à afficher, on ne gère pas le scrolling. }
  712.      IF temp = NIL
  713.         THEN
  714.             attente
  715.         ELSE
  716.             BEGIN
  717.                  { Gestion du scrolling... }
  718.                  WHILE (esc) AND (suivant) AND (Fichier) AND (Section)
  719.                        AND (menu)
  720.                        DO
  721.                          BEGIN
  722.                               attente ;
  723.                               { On ne redessine que si on a appuyé sur une
  724.                                 flêche. }
  725.                               IF modif
  726.                                  THEN
  727.                                      redraw ;
  728.                          END ;
  729.             END ;
  730. END ;
  731.  
  732.  
  733.  
  734.  
  735. { Recherche les différents critères de recherche dans une description. }
  736. FUNCTION Chercher (l : pligne) : Boolean ;
  737.  
  738. VAR res1,
  739.     resultat : Boolean  ;
  740.     critere  : pcritere ;
  741.  
  742.  
  743.  { Recherche d'une chaîne dans une autre selon l'algo de Boyer Moore, il
  744.    faudrait le passer en ASM car il va aussi vite que le pos standard. }
  745.  FUNCTION Pos2 ( chaine : String ) : Byte ;
  746.  VAR i, j,
  747.      m     : Byte ;
  748.      found : Boolean ;
  749.  BEGIN
  750.       m := Length (critere^. champ) ;
  751.       j := m ;
  752.       found := FALSE ;
  753.       (*
  754.       WHILE (NOT found) AND (j <= Length (chaine) ) DO
  755.       *)
  756.       ASM
  757.          @WHILE1:
  758.          cmp Byte Ptr [BP - 106h], 0
  759.          je @suite1
  760.          jmp @wend
  761.          @suite1:
  762.          mov AL, [BP - 104h]
  763.          cmp AL, [BP - 102h]
  764.          jbe @DO
  765.          jmp @wend
  766.          @DO:
  767.  
  768.          { i := m ; }
  769.          mov AL, [BP - 105h]
  770.          mov [BP - 103h], AL
  771.  
  772.          { WHILE (i > 0) AND (chaine [j - m + i] = critere^. champ [i] ) }
  773.          @WHILE2:
  774.          cmp Byte Ptr [BP - 103h], 0
  775.          jbe @wend2
  776.          mov AL, [BP - 103h]
  777.          XOR AH, AH
  778.          mov DI, [BP + 4]
  779.          les DI, ss: [DI - 08]
  780.          add DI, AX
  781.          mov BL, ES: [DI + 100h]
  782.          mov AL, [BP - 103h]
  783.          { xor ah,ah - stupid compiler... }
  784.          mov CX, AX
  785.          mov AL, [BP - 105h]
  786.          { xor ah,ah }
  787.          mov DX, AX
  788.          mov AL, [BP - 104h]
  789.          { xor ah,ah }
  790.          sub AX, DX
  791.          add AX, CX
  792.          mov DI, AX
  793.          mov AL, [BP + DI - 102h]
  794.          cmp AL, BL
  795.          jne @wend2
  796.  
  797.          { Dec(i); }
  798.          Dec Byte Ptr [BP - 103h]
  799.          jmp @WHILE2
  800.          @wend2:
  801.  
  802.          { IF i = 0 THEN }
  803.          db  80h, 0beh, 0fdh, 0feh, 00h {cmp byte Ptr [BP - 103h]}
  804.          jne @ELSE
  805.  
  806.          { found := TRUE }
  807.          mov Byte Ptr [BP - 106h], 1
  808.          jmp @WHILE1 { On évite un jmp en plus (on ne rebondit pas!). }
  809.  
  810.          { ELSE
  811.                j := j + critere^. decalage [Ord (chaine [j] ) ] ; }
  812.          @ELSE:
  813.          mov AL, [BP - 104h]
  814.          XOR AH, AH
  815.          mov DI, AX
  816.          mov AL, [BP + DI - 102h]
  817.          { xor ah, ah }
  818.          mov DI, [BP + 4]
  819.          les DI, ss: [DI - 8]
  820.          add DI, AX
  821.          mov AL, ES: [DI]
  822.          { xor ah,ah }
  823.          mov DX, AX
  824.          mov AL, [BP - 104h]
  825.          { xor ah,ah }
  826.          add AX, DX
  827.          mov DI, AX
  828.          mov AL, [BP + DI - 102h]
  829.          XOR AH, AH
  830.          mov DI, [BP + 4]
  831.          les DI, ss: [DI - 8]
  832.          add DI, AX
  833.          mov AL, ES: [DI]
  834.          { xor ah,ah }
  835.          mov DX, AX
  836.          mov AL, [BP - 104h]
  837.          { xor ah,ah }
  838.          add AX, DX
  839.          mov [BP - 104h], AL
  840.          jmp @WHILE1
  841.          @wend:
  842.       END ;
  843.       { Si on a trouvé la chaîne on renvoie l'offset, sinon 0. }
  844.       IF found
  845.          THEN
  846.              Pos2 := j - m + 1  { <-- Another shity bug! }
  847.          ELSE
  848.              Pos2 := 0 ;
  849.  END ;
  850.  
  851.  
  852.  
  853.  { La phrase recherchée est-elle dans la description? }
  854.  FUNCTION recherche : Boolean ;
  855.  
  856.  VAR temp  : pligne ;
  857.      Upper : String ;
  858.  
  859.  BEGIN
  860.       temp := l ;
  861.       Upper := temp^. ligne ;
  862.       if not MAJmin then
  863.          maj (Upper) ;
  864.       WHILE (temp <> NIL) AND ( Pos2 ( Upper ) = 0 )
  865.             DO
  866.               BEGIN
  867.                    temp := temp^. suiv ;
  868.                    Upper := temp^. ligne ;
  869.                    if not MAJmin then
  870.                       maj (Upper) ;
  871.               END ;
  872.       recherche := temp <> NIL ;
  873.  END ;
  874.  
  875.  
  876.  { Je sais pas si vous allez me croire mais cette procédure récursive à
  877.    marché du premier coup, il faut dire que mon projet de fin d'année en
  878.    maîtrise était un programme en CAML, alors les trucs récursifs, euh...
  879.    facile pour moi, ok, allez les petits gars retournez jouer aux billes. }
  880.  PROCEDURE RetireCRLF ( VAR ligne : pligne) ;
  881.  
  882.  BEGIN
  883.      IF ligne = NIL { Si on est rendu au fond de la récursion, on remonte. }
  884.          THEN
  885.              Exit
  886.          ELSE
  887.              RetireCRLF (ligne^. suiv) ; { sinon on descend. }
  888.      { En remontant, on regarde si la ligne est vide, si elle est vide on la
  889.        supprime et on continue de remonter, ce qu'il faut garder à l'esprit
  890.        c'est l'ordre d'exécution de cette procédure: c'est une fois que l'on
  891.        est rendu à la dernière ligne que l'on commence à regarder si la ligne
  892.        est vide! }
  893.      IF (ligne^. ligne = '') AND (ligne^. suiv = NIL)
  894.         THEN
  895.             BEGIN
  896.                  Dispose (ligne) ;
  897.                  ligne := NIL ;
  898.             END ;
  899.  END ;
  900.  
  901.  
  902. BEGIN
  903.      critere := TeteCritere ;
  904.      WHILE (Critere <> NIL) AND (critere^. champ <> '')
  905.            DO
  906.              BEGIN
  907.                   res1 := Recherche ;
  908.                   IF Critere^. Negation
  909.                      THEN
  910.                          res1 := NOT res1 ;
  911.                   { Le premier critère doit toujours avoir comme type de
  912.                     transition, la transition 0 pour initialiser la
  913.                     recherche. }
  914.                   CASE Critere^. transition OF
  915.                    0 : resultat := res1 ;
  916.                    1 : resultat := resultat AND res1 ;
  917.                    2 : resultat := resultat OR res1 ;
  918.                   END ;
  919.                   critere := critere^. suiv ;
  920.              END ;
  921.      { Si la description est bonne alors on prépare la description pour son
  922.        affichage. }
  923.      IF resultat
  924.         THEN
  925.             RetireCRLF (l) ;
  926.      Chercher := resultat ;
  927. END ;
  928.  
  929.  
  930.  
  931. { Affichage des barres de progression. }
  932. PROCEDURE progression ( nom : String ) ;
  933.  
  934. VAR i, j : Word ;
  935.  
  936. BEGIN
  937.      TextColor ( Yellow ) ;
  938.      TextBackground ( Blue ) ;
  939.      { Dessin du cadre supérieur. }
  940.      GotoXY (12, 8) ;
  941.      Write ('╔') ;
  942.      FOR i := 1 TO 55
  943.          DO
  944.            Write ('═') ;
  945.      Write ('╗') ;
  946.      { Dessin du cadre intérieur. }
  947.      FOR i := 9 TO 17
  948.          DO BEGIN
  949.               GotoXY (12, i) ;
  950.               Write ('║') ;
  951.               FOR j := 1 TO 55
  952.                   DO
  953.                     Write (' ') ;
  954.               Write ('║') ;
  955.          END ;
  956.      { Dessin du cadre inférieur. }
  957.      QWrite (18, 12, '╚═ F : Fichier suivant ═ S : Section suivante ═ M : Menu╝') ;
  958.      { Remplissage du cadre avec les informations qui vont bien. }
  959.      TextColor ( LightRed ) ;
  960.      QWrite ( 10, (80 - Length (nom) ) DIV 2, nom) ;
  961.      TextColor ( LightCyan ) ;
  962.      QWrite ( 12, (80 - Length (cherche) ) DIV 2, cherche) ;
  963.      { Dessin du fond des barres de progression. }
  964.      TextColor (Green) ;
  965.      TextBackground (White) ;
  966.      GotoXY (15, 14) ;
  967.      FOR i := 1 TO 50
  968.          DO
  969.            Write ('░') ;
  970.      GotoXY (15, 16) ;
  971.      FOR i := 1 TO 50
  972.          DO
  973.            Write ('░') ;
  974.      TextBackground (Black) ;
  975. END ;
  976.  
  977.  
  978.  
  979. { Mise à jour des barres de progression. }
  980. PROCEDURE MiseAJourBarre ( pourcent : Byte ) ;
  981.  
  982. VAR i : Word ;
  983.  
  984. BEGIN
  985.      TextBackground ( White ) ;
  986.      TextColor ( Green ) ;
  987.      GotoXY (15, 14) ;
  988.  
  989.      { Mise à jour de la barre de progression du fichier. }
  990.      FOR i := 1 TO PourCent DIV 2
  991.          DO
  992.            Write ('█') ;
  993.  
  994.      TextColor (Green) ;
  995.      TextBackground (White) ;
  996.      GotoXY (15, 16) ;
  997.      { Mise à jour de la barre de progression du total. }
  998.      FOR i := 1 TO Round ( (Total + NbLu) * 100 / EnsFichier) DIV 2
  999.          DO
  1000.            Write ('█') ;
  1001. END ;
  1002.  
  1003.  
  1004.  
  1005. {=============================================================================
  1006.                   P A R C O U R S   D E S   F I C H I E R S
  1007.  ============================================================================}
  1008.  
  1009. { Parcours d'un fichier contenant un ensemble de description. }
  1010. PROCEDURE parcours ( nom : String ) ;
  1011.  
  1012. VAR f       : Text    ; { Fichier qu'il faut analyser. }
  1013.     fic     : File    ; { Pour connaitre la taille du fichier. }
  1014.     l       : pligne  ; { Contient la description. }
  1015.     s       : String  ; { Phrase lu dans le fichier. }
  1016.     tipe    : Boolean ; { Vrai, on est dans NEWs sinon on est dans MAJ. }
  1017.  
  1018. BEGIN
  1019.      { On détermine la taille du fichier (pour les barres de progression). }
  1020.      Assign ( fic , nom ) ;
  1021.      {$I-}
  1022.      Reset (fic, 1) ;
  1023.      { S'il y a une erreur lors de l'ouverture on considère que le fichier
  1024.        est scruté mais on ne peut pas répercuté sa taille dans la barre de
  1025.        progression d'où un décalage possible, mais bon....}
  1026.      IF IOResult <> 0
  1027.         THEN
  1028.             Exit ;
  1029.  
  1030.      taille := FileSize ( fic ) ;
  1031.      Close (fic);
  1032.  
  1033.      { On ouvre le fichier. }
  1034.      Assign ( f , nom ) ;
  1035.      Reset (f) ;
  1036.  
  1037.      { On initialise la recherche. }
  1038.      l := NIL ;
  1039.      ReadLn (f, s) ;
  1040.      IF IOResult <> 0
  1041.         THEN
  1042.             BEGIN
  1043.                  Total := Total + taille ;
  1044.                  Exit ;
  1045.             END ;
  1046.  
  1047.      nblu := Length (s) + 2; { 2 pour CRLF. }
  1048.  
  1049.      tipe := (Copy (nom, 1, 3) = 'ASC') ;
  1050.  
  1051.      Progression (Nom ) ;
  1052.      fichier := TRUE ;
  1053.  
  1054.      { Tant que non fini et non interrompu. }
  1055.      WHILE ( NOT EoF (f) ) AND (esc) AND (section) AND (fichier) AND (menu) DO
  1056.            BEGIN
  1057.                 IF tipe
  1058.                    THEN
  1059.                        ajoute ( l , s )
  1060.                    ELSE
  1061.                        BEGIN
  1062.                             ajoute ( l , Copy (s, 1, 31) ) ;
  1063.                             ajoute ( l, Copy (s, 32, Length (s) - 30) ) ;
  1064.                        END ;
  1065.                 ReadLn (f, s) ;
  1066.                 IF IOResult <> 0
  1067.                    THEN
  1068.                        BEGIN
  1069.                             Total := Total + taille ;
  1070.                             Exit ;
  1071.                        END ;
  1072.  
  1073.                 nblu := nblu + Length (s) + 2;
  1074.                 IF tipe
  1075.                    THEN
  1076.                        { Lecture d'une description de type ASC. }
  1077.                        WHILE (Copy (s, 1, 3) <> delim1) {Fin de description. }
  1078.                              AND
  1079.                              (Copy (s, 1, 3) <> delim2) {Passage de new à maj}
  1080.                              AND
  1081.                              NOT EoF (f)                { Fin de fichier. }
  1082.                             DO
  1083.                               BEGIN
  1084.                                    ajoute (l, s) ; { On insère dans la liste }
  1085.                                    ReadLn (f, s) ; { et on passe au suivant. }
  1086.                                    IF IOResult <> 0
  1087.                                       THEN
  1088.                                           BEGIN
  1089.                                                Total := Total + taille ;
  1090.                                                Exit ;
  1091.                                           END ;
  1092.                                    nblu := nblu + Length (s) + 2;
  1093.                               END
  1094.                    ELSE
  1095.                        { Lecture d'une description de type BBS. }
  1096.                        WHILE (s [1] = ' ') { Fin de description. }
  1097.                              AND
  1098.                              NOT EoF (f)              { Fin de fichier. }
  1099.                             DO
  1100.                               BEGIN
  1101.                                    { Les 34 premiers caractères sont des
  1102.                                      espaces alors pourquoi ne pas en couper
  1103.                                      une partie??? }
  1104.                                    ajoute (l, Copy (s, 32, Length (s) - 30) ) ;
  1105.                                    ReadLn (f, s) ;    { on passe au suivant. }
  1106.                                    IF IOResult <> 0
  1107.                                       THEN
  1108.                                           BEGIN
  1109.                                                Total := Total + taille ;
  1110.                                                Exit ;
  1111.                                           END ;
  1112.                                    nblu := nblu + Length (s) + 2;
  1113.                               END ;
  1114.  
  1115.                 IF EoF (f)
  1116.                    THEN
  1117.                        ajoute (l, s) ;        { The last but not the least. }
  1118.                 { Si on a trouvé l'élément alors on affiche la description. }
  1119.                 IF chercher (l)
  1120.                    THEN
  1121.                        BEGIN
  1122.                             titre (nom, l^. ligne) ;
  1123.                             affiche (l) ;
  1124.                             Progression (nom) ;
  1125.                        END ;
  1126.  
  1127.                 { Mise à jour de la progression. }
  1128.                 MiseAJourBarre ( Round (nblu * 100 / taille) );
  1129.                 { On efface la description. }
  1130.                 detruit (l);
  1131.                 { Interruption user? }
  1132.                 IF KeyPressed
  1133.                    THEN
  1134.                        CASE ReadKey OF
  1135.                         #27 : esc := FALSE ; { Oui. }
  1136.                         's',
  1137.                         'S' : section := FALSE ;
  1138.                         'f',
  1139.                         'F' : fichier := FALSE ;
  1140.                         'm',
  1141.                         'M' : menu := FALSE ;
  1142.                        END ;
  1143.            END ;
  1144.      Total := Total + Taille ;
  1145.      Close (f) ;
  1146. END ;
  1147.  
  1148.  
  1149.  
  1150. { Insertion d'un fichier dans la liste. }
  1151. PROCEDURE ajouteFichier (nom : String; VAR elt : pfichier) ;
  1152.  
  1153. BEGIN
  1154.      IF elt = NIL
  1155.         THEN
  1156.             New (elt)
  1157.         ELSE
  1158.             BEGIN
  1159.                  New (elt^. suiv) ;
  1160.                  elt := elt^. suiv ;
  1161.             END ;
  1162.      elt^. nom := nom ;
  1163.      elt^. suiv := NIL ;
  1164.      elt^. etat := TRUE ;
  1165. END ;
  1166.  
  1167.  
  1168. { Création de la liste des fichiers et détermination de la taille totale des
  1169.   fichiers. }
  1170. PROCEDURE CalculeTaille ;
  1171.  
  1172. VAR temp : pfichier ;
  1173.     toto : SearchRec ;
  1174.  
  1175. BEGIN
  1176.      temp    := NIL ;
  1177.      Liste_Fichier := NIL ;
  1178.  
  1179.      FindFirst ('*.asc', Archive, toto) ;
  1180.  
  1181.      WHILE (DosError = 0)
  1182.            DO
  1183.              BEGIN
  1184.                   ajouteFichier (toto. Name, temp) ;
  1185.                   temp^. tipe := type_asc ;
  1186.                   IF Liste_Fichier = NIL
  1187.                      THEN
  1188.                          Liste_Fichier := temp ;
  1189.                   FindNext (toto) ;
  1190.              END ;
  1191.  
  1192.      FindFirst ('vrac*.bbs', Archive, toto) ;
  1193.  
  1194.      WHILE (DosError = 0)
  1195.            DO
  1196.              BEGIN
  1197.                   ajouteFichier (toto. Name, temp) ;
  1198.                   temp^. tipe := type_vrac ;
  1199.                   IF Liste_Fichier = NIL
  1200.                      THEN
  1201.                          Liste_Fichier := temp ;
  1202.                   FindNext (toto) ;
  1203.              END ;
  1204.  
  1205.      FindFirst ('*.bbs', Archive, toto) ;
  1206.  
  1207.      WHILE (DosError = 0)
  1208.            DO
  1209.              BEGIN
  1210.                   IF Copy (toto. Name, 1, 4) <> 'VRAC'
  1211.                      THEN
  1212.                          BEGIN
  1213.                               ajouteFichier (toto. Name, temp) ;
  1214.                               temp^. tipe := type_autre ;
  1215.                               IF Liste_Fichier = NIL
  1216.                                  THEN
  1217.                                      Liste_Fichier := temp ;
  1218.                          END ;
  1219.                   FindNext (toto) ;
  1220.              END ;
  1221. END ;
  1222.  
  1223.  
  1224.  
  1225. { Alloue l'espace pour un critère puis affecte les différents champs avec les
  1226.   valeurs par défaut: chaine= '', transition = Et, négation = false. }
  1227. FUNCTION InitCritere : PCritere ;
  1228.  
  1229. VAR temp : pCritere ;
  1230.  
  1231. BEGIN
  1232.      New (temp) ;
  1233.      WITH temp^ DO
  1234.           BEGIN
  1235.                Negation   := FALSE ;
  1236.                champ      := ''    ;
  1237.                transition := 1     ;
  1238.                suiv       := NIL   ;
  1239.           END ;
  1240.      InitCritere := temp ;
  1241. END ;
  1242.  
  1243.  
  1244.  
  1245. { Cette procédure calcul les décalages pour l'algo de recherche de Boyer
  1246.   Moore. }
  1247. PROCEDURE CalculDecalage ;
  1248.  
  1249. VAR critere : pcritere ;
  1250.     i       : Byte ;
  1251.  
  1252. BEGIN
  1253.      critere := teteCritere ;
  1254.      WHILE (critere <> NIL) AND (critere^. champ <> '') DO
  1255.      WITH critere^ DO
  1256.      BEGIN
  1257.           if not MAJmin then
  1258.              maj (critere^. champ) ; { <-- Shity bug! }
  1259.           { Par défaut on saute tout le critère. }
  1260.           FOR i := 0 TO 255 DO
  1261.               decalage [i] := Length (champ) ;
  1262.           { Pour tous les caractères de la clé }
  1263.           FOR i := Length (champ) DOWNTO 1 DO
  1264.               { on calcul le décalage que si le caractère n'est pas déjà
  1265.                 apparu (dans august, le décalage sur le 'u' est 2 et non 4
  1266.                 à l'informatique.... another shity bug!) }
  1267.               IF decalage [Ord (champ [i] ) ] = Length (champ) THEN
  1268.                  decalage [Ord (champ [i] ) ] := Length (champ) - i ;
  1269.           { Si le dernier caractère de la clé est répété alors il faut faire
  1270.             un décalage de 1: another shity bug! Boyer moore, pfff.... }
  1271.           IF decalage [Ord (champ [Length (champ) ] ) ] = 0
  1272.              THEN
  1273.                  decalage [Ord (champ [Length (champ) ] ) ] := 1 ;
  1274.           critere := critere^. suiv ;
  1275.      END ;
  1276. END ;
  1277.  
  1278.  
  1279.  
  1280.  
  1281. { Recalcul de la taille totale des fichiers + calcul décalage des clés de
  1282.   recherche. }
  1283. PROCEDURE PrepareRecherche ;
  1284.  
  1285. VAR fic  : File OF Byte ;
  1286.     temp : pfichier     ;
  1287.  
  1288. BEGIN
  1289.      { Détermination de la nouvelle taille. }
  1290.      temp := Liste_Fichier ;
  1291.      SectionAsc := 0 ;
  1292.      SectionVrac := 0 ;
  1293.      EnsFichier := 0 ;
  1294.      Total := 0 ;
  1295.      WHILE temp <> NIL
  1296.            DO
  1297.              BEGIN
  1298.                   IF temp^. etat
  1299.                      THEN
  1300.                          BEGIN
  1301.                               Assign (fic , temp^. nom) ;
  1302.                               Reset (fic) ;
  1303.                               EnsFichier := EnsFichier + FileSize (fic) ;
  1304.                               CASE temp^. tipe OF
  1305.                                Type_asc  : SectionAsc := SectionAsc + FileSize (fic) ;
  1306.                                Type_vrac : SectionVrac := SectionVrac + FileSize (fic) ;
  1307.                               END ;
  1308.                               Close (fic) ;
  1309.                          END ;
  1310.                   temp := temp^. suiv ;
  1311.              END ;
  1312.      IF Souris
  1313.         THEN
  1314.             HideMouse ;
  1315.      HideCursor ;
  1316.      CalculDecalage ;
  1317. END ;
  1318.  
  1319.  
  1320.  
  1321. { Détermination des options de recherche par l'interface. }
  1322. PROCEDURE Inter ;
  1323.  
  1324. VAR CH      : Char             ;
  1325.     Numero  : Byte             ;
  1326.     courant : PObjet           ;
  1327.     saisie  : PSaisie          ;
  1328.     fini    : Boolean          ;
  1329.     bureau  : PBureau          ;
  1330.     temp    : pFichier         ;
  1331.     fic     : File OF Byte     ;
  1332.     Critere3,
  1333.     Critere2,
  1334.     Critere : PGroupeCritere   ;
  1335.     Majuscule,
  1336.     asc,
  1337.     vrac,
  1338.     autre   : PBoutonCocherBis ;
  1339.  
  1340. BEGIN
  1341.      {====================== Préparation de l'écran =========================}
  1342.      { Préparation de l'écran de fond. }
  1343.      TextBackground (Blue) ;
  1344.      ClS ;
  1345.  
  1346.      ASM
  1347.         mov AX , 0B800h  { Remplis le milieu de l'écran. }
  1348.         mov ES , AX
  1349.         mov AX , 07B2h   { Caractère B2h en couleur 7 sur fond 0. }
  1350.         mov DI , 320     { Saute les 2 premières lignes. }
  1351.         mov CX , 2000 - 320 + 80
  1352.         rep stosw
  1353.      END ;
  1354.  
  1355.      banniere ;
  1356.  
  1357.      {========================= Création du bureau ==========================}
  1358.      { Déclaration des objets du bureau. }
  1359.      saisie   := New ( PSaisie, init (4, 5, 40) ) ;
  1360.      liste    := New ( PListe, init (60, 12, 18, 10) ) ;
  1361.      asc      := New ( PBoutonCocherBis, init (60, 5, 'ASC', TRUE) );
  1362.      vrac     := New ( PBoutonCocherBis, init (60, 6, 'VRAC', TRUE) );
  1363.      autre    := New ( PBoutonCocherBis, init (60, 7, 'AUTRES', TRUE) );
  1364.      Majuscule := New ( PBoutonCocherBis, init (60, 9, 'MAJ/min', FALSE) );
  1365.      Critere  := New ( PGroupeCritere, init (4, 9, TeteCritere^. Suiv) ) ;
  1366.      Critere2 := New ( PGroupeCritere, init (4, 14, TeteCritere^. Suiv^.
  1367.                                                     Suiv) ) ;
  1368.      Critere3 := New ( PGroupeCritere, init (4, 19, TeteCritere^. Suiv^.
  1369.                                                     Suiv^. Suiv) ) ;
  1370.  
  1371.      saisie^. chaine := tetecritere^. champ ;
  1372.  
  1373.      asc^. num := 1 ;
  1374.      vrac^. num := 2 ;
  1375.      autre^. num := 3 ;
  1376.  
  1377.      { Tri des fichiers du plus récent au plus ancien pour les ASC et les
  1378.        VRAC. }
  1379.      trie ;
  1380.  
  1381.      { Transfert des fichiers dans la liste. }
  1382.      temp := Liste_Fichier ;
  1383.  
  1384.      WHILE (temp <> NIL)
  1385.            DO
  1386.              BEGIN
  1387.                   liste^. ajoute (temp) ;
  1388.                   temp := temp^. suiv ;
  1389.              END ;
  1390.  
  1391.      { Définition du bureau. }
  1392.      Bureau := New (PBureau, init) ;
  1393.      Bureau^. ajoute (Saisie)    ;
  1394.      Bureau^. ajoute (Critere)   ;
  1395.      Bureau^. ajoute (Critere2)  ;
  1396.      Bureau^. ajoute (Critere3)  ;
  1397.      Bureau^. ajoute (Asc)       ;
  1398.      Bureau^. ajoute (Vrac)      ;
  1399.      Bureau^. ajoute (Autre)     ;
  1400.      Bureau^. ajoute (Majuscule) ;
  1401.      Bureau^. ajoute (Liste)     ;
  1402.  
  1403.      {================================== Exécution ==========================}
  1404.      Bureau^. Exec ;
  1405.  
  1406.      { Normalement on utilise plus la souris à partir de maintenant jusqu'à
  1407.        un hypothétique retour dans l'interface. }
  1408.      IF Souris
  1409.         THEN
  1410.             HideMouse ;
  1411.  
  1412.      { Récupération du premier critère pour savoir si on veut faire une
  1413.        recherche. }
  1414.      TeteCritere^. Champ := Saisie^. Chaine ;
  1415.      IF TeteCritere^. Champ = ''
  1416.         THEN
  1417.             esc := FALSE ;
  1418.  
  1419.      { NEW - récupération du booléen de la distinction MAJUSCULE/minuscule. }
  1420.      MAJmin := Majuscule^. etat ;
  1421.  
  1422.      { Libération de la mémoire. }
  1423.      Dispose (bureau, done) ;
  1424.  
  1425.      { On prépare la recherche, ah bon? je croyais qu'on allait au pêche aux
  1426.        moules derrière le pont de Beslon. }
  1427.      PrepareRecherche ;
  1428. END ;
  1429.  
  1430.  
  1431.  
  1432. { Scanne les fichiers de descriptions + réservation du premier critère. }
  1433. PROCEDURE init ;
  1434.  
  1435. BEGIN
  1436.      ASM
  1437.         mov AX, 3 { On passe en mode texte. }
  1438.         Int 10h
  1439.      END ;
  1440.      FileMode := 0 ; { Passe en mode lecture seule pour l'utilisation à
  1441.                        partir d'un CD-ROM. }
  1442.  
  1443.      { Préparation du programme. }
  1444.      Souris := TRUE ;
  1445.      esc := TRUE ;
  1446.      MAJmin := FALSE ;
  1447.      CalculeTaille ;
  1448.      IF Liste_Fichier = NIL
  1449.         THEN
  1450.             BEGIN
  1451.                  ClrScr ;
  1452.                  WriteLn ('Aucun fichier de description...') ;
  1453.                  Halt ;
  1454.             END ;
  1455.      New (TeteCritere) ;
  1456.      TeteCritere^. champ := '' ;
  1457.      TeteCritere^. Transition := 0 ;
  1458.      TeteCritere^. Negation := FALSE ;
  1459.      TeteCritere^. suiv := NIL ;
  1460. END ;
  1461.  
  1462.  
  1463. { Procédure de recherche principale, elle est commune à la recherche
  1464.   contextuelle ou en ligne de commande. }
  1465. PROCEDURE Recherche ;
  1466.  
  1467. VAR prog : Byte     ;
  1468.     temp : pFichier ;
  1469.  
  1470. BEGIN
  1471.      temp := Liste_Fichier ;
  1472.      prog := 1 ;
  1473.      section := TRUE ;
  1474.      menu := TRUE ;
  1475.      WHILE (temp <> NIL) AND (menu) AND (esc)
  1476.            DO
  1477.              BEGIN
  1478.                   IF temp^. etat
  1479.                      THEN
  1480.                          parcours (temp^. nom) ;
  1481.                   temp := temp^. suiv ;
  1482.                   IF NOT section
  1483.                      THEN
  1484.                          BEGIN
  1485.                               { On saute la section courante. }
  1486.                               CASE prog OF
  1487.                                type_asc : Total := SectionAsc ;
  1488.                                type_vrac : Total := SectionAsc + SectionVrac ;
  1489.                               END ;
  1490.                               WHILE temp^. tipe = prog
  1491.                                     DO
  1492.                                       temp := temp^. suiv ;
  1493.                               prog := temp^. tipe ;
  1494.                          END ;
  1495.                   section := TRUE ;
  1496.              END ;
  1497. END ;
  1498.  
  1499.  
  1500.  
  1501. { Fonction d'analyse de la ligne de commande. }
  1502. FUNCTION ParseCmdLine : Boolean ;
  1503.  
  1504. VAR Pointeur : Byte    ;
  1505.     Chaine   : String  ;
  1506.     Resultat,
  1507.     ToutSel  : Boolean ;
  1508.  
  1509.  { Sélectionne tout un groupe, ASC, VRAC ou Autre. Attention si c'est la
  1510.    première fois que l'on sélectionne un groupe il faut déselectionner tous
  1511.    les autres. }
  1512.  PROCEDURE AffectationGroupe (Groupe: String) ;
  1513.  
  1514.  BEGIN
  1515.       Maj (Groupe) ;
  1516.       IF ToutSel
  1517.          THEN
  1518.              { On teste si on a bien saisi le groupe, pour n'avoir qu'à
  1519.                tester le deuxième caractère, optim quand tu nous tiens... }
  1520.              IF ( (Groupe = 'ASC') OR (Groupe = 'VRAC') OR (Groupe = 'AUTRE') )
  1521.              THEN
  1522.              BEGIN
  1523.                   ToutSel := FALSE ;
  1524.                   Bascule (1, FALSE);
  1525.                   Bascule (2, FALSE);
  1526.                   Bascule (3, FALSE);
  1527.              END
  1528.              ELSE
  1529.                  Resultat := TRUE ; { Il y a un problème. }
  1530.       { Pourquoi on ne peut pas faire un case avec des chaînes en pascal? }
  1531.       CASE Groupe [2] OF
  1532.        'S' : Bascule (1, TRUE) ; { ASC }
  1533.        'R' : Bascule (2, TRUE) ; { VRAC }
  1534.        'U' : Bascule (3, TRUE) ; { AUTRE }
  1535.       END ;
  1536.  END ;
  1537.  
  1538.  
  1539.  FUNCTION LectureCle : String ;
  1540.  
  1541.  VAR Chaine,
  1542.      Mot    : String ;
  1543.  
  1544.  BEGIN
  1545.       Mot := ParamStr (Pointeur) + ' ' ;
  1546.       Chaine := '';
  1547.       WHILE NOT (Mot [1] IN ['/', '-', '+', '*', '@'] )
  1548.             AND (Pointeur <= ParamCount)
  1549.             DO
  1550.               BEGIN
  1551.                    Chaine := Chaine + Mot ;
  1552.                    Inc (Pointeur) ;
  1553.                    Mot := ParamStr (Pointeur) + ' ' ;
  1554.               END ;
  1555.       IF Chaine <> ''
  1556.          THEN
  1557.              Delete (Chaine, Length (Chaine), 1) ;
  1558.       LectureCle := Chaine ;
  1559.  END ;
  1560.  
  1561.  
  1562.  PROCEDURE InsertCritere (Mot: String) ;
  1563.  
  1564.  VAR criter : pcritere ;
  1565.  
  1566.  BEGIN
  1567.       criter := TeteCritere ;
  1568.       { On se positionne sur le dernier critère. }
  1569.       WHILE criter^. suiv <> NIL
  1570.             DO
  1571.               criter := criter^. suiv ;
  1572.       criter^. suiv := InitCritere ;   { on alloue. }
  1573.       Criter := criter^. suiv ;
  1574.       CASE mot [1] OF
  1575.        '+' : Criter^. transition := 2; { ou. }
  1576.        '*' : Criter^. transition := 1; { et. }
  1577.       END ;
  1578.       { Le '+' et le '*' ne font pas partie de la clé. }
  1579.       Delete (chaine, 1, 1) ;
  1580.       { Il y a une négation? }
  1581.       IF mot [2] = '#'
  1582.          THEN
  1583.              BEGIN
  1584.                   criter^. negation := TRUE ;
  1585.                   { Le '#' ne fait pas partie de la clé. }
  1586.                   Delete (chaine, 1, 1);
  1587.              END ;
  1588.       { On passe au paramètre suivant. }
  1589.       Inc (pointeur) ;
  1590.       Criter^. Champ := chaine+ LectureCle ;
  1591.  END ;
  1592.  
  1593.  
  1594.  PROCEDURE InsDelFichier (Mot: String) ;
  1595.  
  1596.   PROCEDURE Scan (mot : String; etat : Boolean) ;
  1597.  
  1598.   VAR temp : pfichier ;
  1599.  
  1600.   BEGIN
  1601.        maj (mot) ;
  1602.        temp := Liste_Fichier ;
  1603.        WHILE (temp <> NIL) AND (temp^. nom <> mot)
  1604.              DO
  1605.                temp := temp^. suiv ;
  1606.        IF temp <> NIL
  1607.           THEN
  1608.               temp^. etat := etat ;
  1609.   END ;
  1610.  
  1611.  BEGIN
  1612.       CASE mot [1] OF
  1613.        'x', 'X' : Scan (Copy (chaine, 2, 12), FALSE) ;
  1614.        'i', 'I' : BEGIN
  1615.                        IF ToutSel { Par défaut on sélectionne tout. }
  1616.                           THEN
  1617.                               BEGIN
  1618.                                    ToutSel := FALSE ;
  1619.                                    Bascule (1, FALSE) ;
  1620.                                    Bascule (2, FALSE) ;
  1621.                                    Bascule (3, FALSE) ;
  1622.                               END ;
  1623.                        Scan (Copy (chaine, 2, 12), TRUE) ;
  1624.                   END ;
  1625.        ELSE Resultat := TRUE ;
  1626.       END ;
  1627.  END ;
  1628.  
  1629.  
  1630. BEGIN
  1631.      Resultat := FALSE ;
  1632.      ToutSel  := TRUE ;
  1633.      Pointeur := 1 ;
  1634.      TeteCritere^. Champ := LectureCle ;
  1635.      IF TeteCritere^. Champ = ''
  1636.         THEN
  1637.             resultat := TRUE ;
  1638.      WHILE (Pointeur <= ParamCount) AND (NOT Resultat)
  1639.            DO
  1640.              BEGIN
  1641.                   Chaine := ParamStr (pointeur) ;
  1642.                   CASE Chaine [1] OF
  1643.                    '@' : BEGIN
  1644.                               Delete (chaine, 1, 1) ;
  1645.                               AffectationGroupe (Chaine) ;
  1646.                               Inc (pointeur) ;
  1647.                          END ;
  1648.                    '-' : BEGIN
  1649.                               Delete (Chaine, 1, 1) ;
  1650.                               InsDelFichier (Chaine) ;
  1651.                               Inc (pointeur) ;
  1652.                          END ;
  1653.                    '*', '+' : InsertCritere (chaine) ;
  1654.                   END ;
  1655.              END ;
  1656.      ParseCmdLine := NOT resultat ;
  1657. END ;
  1658.  
  1659.  
  1660.  
  1661. { Comment que ca marche le truc... }
  1662. PROCEDURE Usage ;
  1663.  
  1664. BEGIN
  1665.      WriteLn ('TROUVE v', version, ' par EVAIN Stéphane (c) 1994.') ;
  1666.      WriteLn (' Usage: TROUVE CléDeRecherche [@ASC] [@VRAC] [@AUTRE] [/m]') ;
  1667.      WriteLn ('               [-xFichier] [-iFichier] [+[#]Clé] [*[#]Clé]');
  1668.      WriteLn;
  1669.      WriteLn ('@ASC, @VRAC, @AUTRE: étend la recherche sur les fichiers ASC, VRAC ...');
  1670.      WriteLn ('-xFichier          : exclut un fichier de la recherche.') ;
  1671.      WriteLn ('-iFichier          : inclut un fichier dans la recherche.') ;
  1672.      WriteLn ('+[#]Clé            : Ajoute un critère à la recherche avec la forme:') ;
  1673.      WriteLn ('                     CléDeRecherche OU [NON] Clé le `#` représente la négation.') ;
  1674.      WriteLn ('*[#]Clé            : idem que au-dessus mais avec et un ET.') ;
  1675.      WriteLn;
  1676.      WriteLn ('/m                 : Déasctive la gestion de la souris.') ;
  1677.      WriteLn;
  1678.      WriteLn ('Exemple:');
  1679.      WriteLn ('    TROUVE Steph est le plus beau +|titi @AsC @Autre -xaSc1.asc -ivrAc1.bBs');
  1680.      WriteLn ('           Cherche "Steph est le plus beau" ou non "titi" dans les fichiers asc,');
  1681.      WriteLn ('les autres et le fichier vrac1.bbs mais pas dans asc1.asc. Attention le');
  1682.      WriteLn ('programme risque de trouver un paquet de descriptions car un OU NEGATIF va');
  1683.      WriteLn ('afficher toutes les descriptions qui ne contiennent pas "titi" ou qui');
  1684.      WriteLn ('contiennent "Steph est le plus beau" et là il y en a! (MEGALO!)') ;
  1685.      Halt (1) ;
  1686. END ;
  1687.  
  1688.  
  1689.  
  1690. { Si la ligne de commande est bonne, on lance la recherche, sinon on affiche
  1691.   la grammaire pour l'utilisateur qui a fait une faute de frappe (forcement). }
  1692. PROCEDURE SearchCmdLine ;
  1693.  
  1694. BEGIN
  1695.      IF ParseCmdLine
  1696.         THEN
  1697.             BEGIN
  1698.                  PrepareRecherche ;
  1699.                  Recherche ;
  1700.             END
  1701.         ELSE
  1702.             Usage ;
  1703. END ;
  1704.  
  1705.  
  1706.  
  1707. { Boucle principale de l'interface. }
  1708. PROCEDURE Contextuelle ;
  1709.  
  1710. BEGIN
  1711.      { Si on utilise la souris, on l'initialise. }
  1712.      IF Souris
  1713.         THEN
  1714.             ASM
  1715.                MOV AX, 0
  1716.                Int 33h
  1717.             END ;
  1718.  
  1719.      { Construction de la liste des critères. }
  1720.      New (TeteCritere^. Suiv) ;
  1721.      TeteCritere^. Suiv := InitCritere ;
  1722.      TeteCritere^. Suiv^. Suiv := InitCritere ;
  1723.      TeteCritere^. Suiv^. Suiv^. Suiv := InitCritere ;
  1724.  
  1725.      { Tant que l'on n'a pas quitté, on utilise l'interface. }
  1726.      WHILE esc
  1727.            DO
  1728.              BEGIN
  1729.                   Inter ;
  1730.                   Recherche ;
  1731.              END ;
  1732. END ;
  1733.  
  1734.  
  1735.  
  1736.  
  1737. { On efface toutes les allocations mémoires et on force le retour en mode
  1738.   texte que l'on normalement pas quitté, mais bon... }
  1739. PROCEDURE done ;
  1740.  
  1741. VAR temp : pfichier ;
  1742.     tmp  : pcritere ;
  1743.  
  1744. BEGIN
  1745.      { Dans la version 1.01 j'ai oublié de supprimer les listes chaînées...
  1746.        Certes ça sert à rien car le DOS fait un joli ramasse miettes (garbage
  1747.        collector, fuck the prolog), mais bon ça prouve que j'y ai pensé et
  1748.        c'est déjà bien! }
  1749.      temp := Liste_Fichier ;
  1750.      WHILE (temp <> NIL)
  1751.            DO
  1752.              BEGIN
  1753.                   temp := temp^. suiv ;
  1754.                   Dispose (Liste_Fichier);
  1755.                   Liste_Fichier := temp ;
  1756.              END ;
  1757.  
  1758.      tmp := tetecritere ;
  1759.      WHILE (tmp <> NIL)
  1760.            DO
  1761.              BEGIN
  1762.                   tmp := tmp^. suiv ;
  1763.                   Dispose (tetecritere) ;
  1764.                   tetecritere := tmp ;
  1765.              END ;
  1766.      { On remet tout comme on l'a trouvé. }
  1767.      TextColor (LightGray) ;
  1768.      TextBackground (Black) ;
  1769.      ShowCursor ;
  1770.      ASM
  1771.         mov AX, 3
  1772.         Int $10
  1773.      END ;
  1774. END ;
  1775.  
  1776.  
  1777. { Détermine si le programme doit s'exécuter de manière contextuelle, ou
  1778.   d'après les options définies en ligne de commande. }
  1779. FUNCTION EnLigne : Boolean ;
  1780.  
  1781. VAR temp : String ;
  1782.     toto : Byte ;
  1783.  
  1784. BEGIN
  1785.      Temp := ParamStr (1) ;
  1786.      maj (temp) ;
  1787.      IF temp = '/M'
  1788.         THEN
  1789.             souris := FALSE ;
  1790.      IF ( (ParamCount = 1) AND (Temp = '/M') ) OR (ParamCount = 0)
  1791.         THEN
  1792.             EnLigne := FALSE
  1793.         ELSE
  1794.             EnLigne := TRUE ;
  1795. END ;
  1796.  
  1797.  
  1798.  
  1799. {
  1800. int main (int argc, char *argv[])   FUCK THE C! Object rulez the world..
  1801. en exclusivité mondiale, la version 3 sera (peut-être) en C++, mais pas en C!
  1802. Euh, en fait non, peut être en LISP ou en CAML, si quelqu'un connaît qu'il soit
  1803. bénit, heureux ceux qui ont débuter la programmation avec ce langage qui a
  1804. l'énorme avantage d'être français et d'une beauté aveuglante. Malheureusement
  1805. comme tout les langages de sa catégorie (fonctionnelle) il ne possède pas d'EDI
  1806. comme Borand Pascal... Car il tourne sur PC, Mac, Unix, Atari, Amiga bref tout
  1807. ce qui possède un semblant de sérieux (pour certaines de ces machines ce n'est
  1808. pas évident, à vous de trouver lesquelles!).
  1809. }
  1810.  
  1811. BEGIN
  1812.      init ;
  1813.      IF EnLigne
  1814.         THEN
  1815.             SearchCmdLine
  1816.         ELSE
  1817.             Contextuelle ;
  1818.      done ;
  1819. END. { Et non je n'ai pas 2888 lignes mais c'était juste.. }