' ============================================================================
'                                 DEMOTRI
'   Ce programme d‚montre graphiquement six algorithmes de tri. Il affiche,
'   dans un ordre al‚atoire, 25 ou 43 bƒtonnets horizontaux de diff‚rentes
'   longueurs puis les trie, du plus petit au plus grand.
'
'   Le programme recourt aussi aux instructions SOUND pour g‚n‚rer des sons
'   de diff‚rentes densit‚s, selon la position du bƒtonnet affich‚. Vous
'   remarquerez que les instructions SOUND ralentissent la vitesse de chaque
'   algorithme de tri afin que vous puissiez suivre le d‚roulement du tri.
'   Les dur‚es ne sont donc indiqu‚es que pour servir … la comparaison.
'   Elles ne constituent pas une mesure pr‚cise de la vitesse de tri.
'
'   Si vous utilisez ces sous-programmes de tri dans vos propres programmes,
'   vous noterez peut-ˆtre une diff‚rence entre leurs vitesses relatives
'   exemple, le tri par ‚change peut ˆtre plus rapide que le tri Shell),
'   en fonction du nombre d'‚l‚ments … trier et du "m‚lange" initial.
' ============================================================================
DEFINT A-Z      ' Entier de type implicite.
' Declarer les proc‚dures FUNCTION et SUB, ainsi que le nombre et le type des
' arguments :
  DECLARE FUNCTION EntierAleat (Inferieur, Superieur)
  DECLARE SUB InitRect ()
  DECLARE SUB TriCles ()
  DECLARE SUB VerifEcran ()
  DECLARE SUB TraceCadre (CoteSup, CoteInf, CoteGauche, CoteDroit)
  DECLARE SUB TempsEcoule (LigneCourante)
  DECLARE SUB TriEchange ()
  DECLARE SUB TriEnPile ()
  DECLARE SUB Initialisation ()
  DECLARE SUB TriInsertion ()
  DECLARE SUB PassageBas (NiveauMax)
  DECLARE SUB PassageHaut (NiveauMax)
  DECLARE SUB AfficheUnBatonnet (Ligne)
  DECLARE SUB TriRapide (Bas, Haut)
  DECLARE SUB Reinitialisation ()
  DECLARE SUB TriShell ()
  DECLARE SUB MenuTri ()
  DECLARE SUB PermuteBatonnets (Ligne1, Ligne2)
  DECLARE SUB BasculeSon (Ligne, Colonne)
' D‚finir le type de donn‚e utilis‚ pour contenir les informations de chaque
' bƒtonnet de couleur :
  TYPE TypeTri
     longueur AS INTEGER            ' Longueur du bƒtonnet (l'‚lement compar‚
                                    ' dans les diff‚rents tris).
     ValCouleur AS INTEGER          ' Couleur du bƒtonnet.
     ChaineBatonnet AS STRING * 43  ' Le bƒtonnet (une chaŒne de 43
                                    ' caractŠres).
  END TYPE
' D‚clarer les constantes globales :
  CONST FAUX = 0, VRAI = NOT FAUX, COLONNEGAUCHE = 49
  CONST NBREOPTIONS = 11, NBRETRIS = 6
' D‚clarer les variables globales et leur affecter de l'espace m‚moire.
' TableauTri et SauveTri sont deux tableaux de type de donn‚e TypeTri d‚fini
' ci-dessus :
  DIM SHARED TableauTri(1 TO 43) AS TypeTri, SauveTri(1 TO 43) AS TypeTri
  DIM SHARED TitreOption(1 TO NBREOPTIONS) AS STRING * 13
  DIM SHARED HeureDebut AS SINGLE
  DIM SHARED PremierPlan, fond, PasSon, Pause
  DIM SHARED Selection, LigneMax, LigneInit, MaxCouleurs
' Instructions DATA pour les diff‚rentes options du menu de tri :
  DATA Insertion, Cles, Pile, Echange, Shell, Rapide,
  DATA Bascule son, , < Plus lent, > Plus rapide
' Commencer par l'en-tˆte du module :
  Initialisation        ' Initialiser les valeurs des donn‚es.
  MenuTri               ' Afficher le menu de tri.
  WIDTH 80, LigneInit   ' R‚tablir le nombre de lignes initial.
  CLS
  END
' CherchLigne, IntercepteMono et IntercepteLigne sont des sous-programmes de
' traitement d'erreurs appel‚s au moyen de la proc‚dure SUB VerifEcran.
' CherchLigne d‚termine si le programme a commenc‚ avec 25, 43 ou 50 lignes.
' IntercepteMono d‚termine si la carte d'affichage courante est monochrome.
' IntercepteLigne fixe le nombre maximum de lignes possibles (43 ou 25).
CherchLigne:
   IF LigneInit = 50 THEN
      LigneInit = 43
      RESUME
   ELSE
      LigneInit = 25
      RESUME NEXT
   END IF
IntercepteMono:
   MaxCouleurs = 2
   RESUME NEXT
IntercepteLigne:
   LigneMax = 25
   RESUME

' =========================== AfficheUnBatonnet ==============================
'    Affiche TableauTri(Ligne).ChaineBatonnet … la ligne sp‚cifi‚e par le
'    paramŠtre Ligne, en utilisant la couleur de TableauTri(Ligne).ValCouleur.
' ============================================================================
'
SUB AfficheUnBatonnet (Ligne) STATIC
   LOCATE Ligne, 1
   COLOR TableauTri(Ligne).ValCouleur
   PRINT TableauTri(Ligne).ChaineBatonnet;
END SUB

' ============================== BasculeSon ==================================
'    Inverse la valeur courante de PasSon, puis affiche cette valeur … c“t‚
'    de l'option "Commutation du son" du menu de tri.
' ============================================================================
'
SUB BasculeSon (Ligne, Colonne) STATIC
   PasSon = NOT PasSon
   LOCATE Ligne, Colonne
   IF PasSon THEN
      PRINT ": DESACTIVE";
   ELSE
      PRINT ":  ACTIVE  ";
   END IF
END SUB

' ============================== EntierAleat =================================
'   Fournit un entier al‚atoire sup‚rieur ou ‚gal au paramŠtre Inferieur et
'   inf‚rieur ou ‚gal au paramŠtre Superieur.
' ============================================================================
'
FUNCTION EntierAleat (Inferieur, Superieur) STATIC
   EntierAleat = INT(RND * (Superieur - Inferieur + 1)) + Inferieur
END FUNCTION

' ============================ Initialisation ================================
'    Initialise les tableaux SauveTri et TitreOption. Appelle ‚galement les
'    proc‚dures VerifEcran, InitRect et EntierAleat.
' ============================================================================
'
SUB Initialisation STATIC
   DIM TableauTemp(1 TO 43)
   VerifEcran                   ' V‚rifier s'il s'agit d'un ‚cran monochrome
                                ' ou EGA et d‚finir le nombre de lignes de
                                ' texte.
   FOR I = 1 TO LigneMax
      TableauTemp(I) = I
   NEXT I
   IndexMax = LigneMax
   RANDOMIZE TIMER              ' Alimenter le g‚n‚rateur de nombres
                                ' al‚atoires.
   FOR I = 1 TO LigneMax
      ' Appeler EntierAleat pour trouver dans TableauTemp un ‚l‚ment al‚atoire
      ' compris entre 1 et IndexMax, puis affecter la valeur de cet ‚l‚ment …
      ' LongueurBatonnet:
      Index = EntierAleat(1, IndexMax)
      LongueurBatonnet = TableauTemp(Index)
      ' Ecraser la valeur contenue dans TableauTemp(Index) et la remplacer par
      ' la valeur contenue dans TableauTemp(IndexMax) afin que la valeur
      ' contenue dans TableauTemp(Index) ne soit choisie qu'une seule fois :
      TableauTemp(Index) = TableauTemp(IndexMax)
      ' Diminuer la valeur de IndexMax afin que TableauTemp(IndexMax) ne
      ' puisse pas ˆtre choisi lors du passage suivant … travers la boucle :
      IndexMax = IndexMax - 1
      ' Affecter la valeur de LongueurBatonnet … l'‚l‚ment .Longueur, puis
      ' stocker dans l'‚l‚ment ChaineBatonnet une chaŒne des caractŠres du
      ' bloc LongueurBatonnet (ASCII 223: ß):
      SauveTri(I).longueur = LongueurBatonnet
      SauveTri(I).ChaineBatonnet = STRING$(LongueurBatonnet, 223)
      ' Stocker la valeur de la couleur appropri‚e dans l'‚l‚ment .ValCouleur:
      IF MaxCouleurs > 2 THEN
         SauveTri(I).ValCouleur = (LongueurBatonnet MOD MaxCouleurs) + 1
      ELSE
         SauveTri(I).ValCouleur = MaxCouleurs
      END IF
   NEXT I
   FOR I = 1 TO NBREOPTIONS    ' Lire les options du menu
      READ TitreOption(I)      ' DEMONSTRATION DE TRI et les stocker
   NEXT I                      ' dans le tableau TitreOption.
   CLS
   Reinitialisation     ' Affecter … TableauTri des valeurs contenues dans
                        ' SauveTri et tracer … l'‚cran des bƒtonnets non
                        ' tri‚s.
   PasSon = FAUX
   Pause = 2            ' Initialiser Pause … 2 mouvements de balancier
                        ' (… 1/9 seconde).
   InitRect             ' Tracer le cadre du menu de tri et afficher
                        ' les options.
END SUB

' =============================== InitRect ===================================
'    Appelle la proc‚dure TraceCadre pour tracer le cadre autour du menu de
'    tri, puis affiche les diff‚rentes options stock‚es dans le tableau
'    TitreOption.
' ============================================================================
'
SUB InitRect STATIC
   TraceCadre 1, 22, COLONNEGAUCHE - 3, 79
   LOCATE 3, COLONNEGAUCHE: PRINT "DEMO DE TRI AVEC QUICKBASIC";
   LOCATE 5
   FOR I = 1 TO NBREOPTIONS - 1
      LOCATE , COLONNEGAUCHE: PRINT TitreOption(I)
   NEXT I
   ' Ne pas afficher la derniŠre option (> PlusRapide) si la longueur de
   ' la Pause est ramen‚e … un mouvement de balancier :
   IF Pause > 1 THEN LOCATE , COLONNEGAUCHE: PRINT TitreOption(NBREOPTIONS);
   ' Basculer le son puis afficher la valeur courante de PasSon :
   PasSon = NOT PasSon
   BasculeSon 12, COLONNEGAUCHE + 12
   LOCATE NBREOPTIONS + 6, COLONNEGAUCHE
   PRINT "Entrez votre choix (premiŠre"
   LOCATE , COLONNEGAUCHE
   PRINT "lettre : I C P E S R B < > )"
   LOCATE , COLONNEGAUCHE
   PRINT "ou appuyez sur ANNULATION"
   LOCATE , COLONNEGAUCHE
   PRINT "pour terminer le programme: ";
END SUB

' =============================== MenuTri ===================================
'   La proc‚dure MenuTri appelle d'abord la proc‚dure Reinitialisation pour
'   s'assurer que TableauTri n'est pas tri‚, puis demande … l'utilisateur de
'   s‚lectionner un des choix suivants :
'
'               * Un des algorithmes de tri
'               * Commutation du son
'               * Augmentation ou diminution de la vitesse
'               * Fin du programme
' ============================================================================
'
SUB MenuTri STATIC
   Echap$ = CHR$(27)
   ' Cr‚er une chaŒne compos‚e de tous les choix corrects :
   Option$ = "ICPESR><B" + Echap$
   DO
      ' Rendre le curseur visible :
      LOCATE NBREOPTIONS + 9, COLONNEGAUCHE + 27, 1
      Choix$ = UCASE$(INPUT$(1))          ' Rechercher le choix de
      Selection = INSTR(Option$, Choix$)  ' l'utilisateur et v‚rifier s'il
                                          ' est repris dans le menu.
      ' L'utilisateur a choisi une des proc‚dures ci-dessous :
      IF (Selection >= 1) AND (Selection <= NBRETRIS) THEN
         Reinitialisation                 ' Rem‚langer les bƒtonnets.
         LOCATE , , 0                     ' Rendre le curseur invisible.
         PremierPlan = 0                  ' D‚finir les valeurs de la vid‚o
         fond = 7                         ' inverse.
         HeureDebut = TIMER               ' Enregistrer l'heure de d‚but.
      END IF
      ' R‚aliser le branchement vers la proc‚dure ad‚quate, en fonction de la
      ' touche frapp‚e :
      SELECT CASE Choix$
         CASE "I"
            TriInsertion
         CASE "C"
            TriCles
         CASE "P"
            TriEnPile
         CASE "E"
            TriEchange
         CASE "S"
            TriShell
         CASE "R"
            TriRapide 1, LigneMax
         CASE ">"
            ' R‚duire la dur‚e de la pause afin d'acc‚l‚rer le tri, puis
            ' retracer le menu pour effacer toute indication de temps (‚tant
            ' donn‚ qu'elle ne pourra ˆtre compar‚e aux r‚sultats futurs) :
            Pause = (2 * Pause) / 3
            InitRect
         CASE "<"
            ' Augmenter la dur‚e de la pause afin de ralentir le tri, puis
            ' retracer le menu pour effacer toute indication de temps (‚tant
            ' donn‚ qu'elle ne pourra ˆtre compar‚e aux r‚sultats futurs) :
            Pause = (3 * Pause) / 2
            InitRect
         CASE "B"
            BasculeSon 12, COLONNEGAUCHE + 12
         CASE Echap$
            ' Comme l'utilisateur a appuy‚ sur la touche ANNULATION (ESC),
            ' quitter cette proc‚dure et revenir … l'en-tˆte du module :
            EXIT DO
         CASE ELSE
            ' Touche incorrecte.
      END SELECT
      IF (Selection >= 1) AND (Selection <= NBRETRIS) THEN
         PremierPlan = MaxCouleurs         ' D‚sactiver la vid‚o inverse.
         fond = 0
         TempsEcoule 0                     ' Afficher le temps final.
      END IF
   LOOP
END SUB

' ============================= PassageBas ===================================
'  La proc‚dure PassageBas r‚tablit les ‚l‚ments de TableauTri compris entre
'  1 et NiveauMax en une "pile" (voir le sch‚ma repris … la proc‚dure
'  TriEnPile).
' ============================================================================
'
SUB PassageBas (NiveauMax) STATIC
   I = 1
   ' D‚placer la valeur de TableauTri(1) vers le bas de la pile jusqu'… ce
   ' qu'il atteigne son propre noeud (c-…-d jusqu'… ce qu'il soit inf‚rieur
   ' … son noeud pŠre ou jusqu'… ce qu'il atteigne NiveauMax, qui constitue
   ' le bas de la pile courante) :
   DO
      Fils = 2 * I             ' Rechercher l'indice du noeud fils.
      ' Quand le bas de la pile est atteint, sortir de cette proc‚dure :
      IF Fils > NiveauMax THEN EXIT DO
      ' S'il y a deux noeuds fils, chercher le plus grand :
      IF Fils + 1 <= NiveauMax THEN
         IF TableauTri(Fils + 1).longueur > TableauTri(Fils).longueur THEN
            Fils = Fils + 1
         END IF
      END IF
      ' D‚placer la valeur vers le bas si elle n'est toujours pas sup‚rieure
      ' … l'un ou l'autre de ses fils :
      IF TableauTri(I).longueur < TableauTri(Fils).longueur THEN
         SWAP TableauTri(I), TableauTri(Fils)
         PermuteBatonnets I, Fils
         I = Fils
      ' Sinon, TableauTri a ‚t‚ r‚tabli en une pile allant de 1 … NiveauMax.
      ' Quitter :
      ELSE
         EXIT DO
      END IF
   LOOP
END SUB

' ============================== PassageHaut =================================
'       La proc‚dure PassageHaut convertit en une "pile" les ‚l‚ments de
'       TableauTri compris entre 1 et NiveauMax (voir le sch‚ma repris … la
'       proc‚dure TriEnPile).
' ============================================================================
'
SUB PassageHaut (NiveauMax) STATIC
   I = NiveauMax
   ' D‚placer la valeur de TableauTri(NiveauMax) vers le haut de la pile
   ' jusqu'… ce qu'il atteigne son propre noeud (c-…-d jusqu'… ce qu'il soit
   ' sup‚rieur … un de ses noeuds fils ou jusqu'… ce qu'il atteigne 1, qui
   ' constitue le sommet de la pile) :
   DO UNTIL I = 1
      Pere = I \ 2            ' Rechercher l'indice du noeud pŠre.
      ' Comme la valeur du noeud courant est encore sup‚rieure … la valeur
      ' de son noeud pŠre, permuter ces ‚l‚ments de tableau :
      IF TableauTri(I).longueur > TableauTri(Pere).longueur THEN
         SWAP TableauTri(Pere), TableauTri(I)
         PermuteBatonnets Pere, I
         I = Pere
      ' Sinon, l'‚l‚ment a trouv‚ la place qui lui convient dans la pile.
      '  Quitter alors la proc‚dure :
      ELSE
         EXIT DO
      END IF
   LOOP
END SUB

' =========================== PermuteBatonnets ===============================
'   Appelle AfficheUnBatonnet … deux reprises pour intervertir les
'   deux bƒtonnets en Ligne1 et Ligne2, puis appelle la proc‚dure
'   TempsEcoule.
' ============================================================================
'
SUB PermuteBatonnets (Ligne1, Ligne2) STATIC
   AfficheUnBatonnet Ligne1
   AfficheUnBatonnet Ligne2
   TempsEcoule Ligne1
END SUB

' ============================ Reinitialisation ==============================
'      R‚tablit le tableau TableauTri dans son ‚tat initial non tri‚ puis
'      affiche les bƒtonnets de couleur non tri‚s.
' ============================================================================
'
SUB Reinitialisation STATIC
   FOR I = 1 TO LigneMax
      TableauTri(I) = SauveTri(I)
   NEXT I
   FOR I = 1 TO LigneMax
      LOCATE I, 1
      COLOR TableauTri(I).ValCouleur
      PRINT TableauTri(I).ChaineBatonnet;
   NEXT I
   COLOR MaxCouleurs, 0
END SUB

' ============================= TempsEcoule ==================================
'   Affiche le nombre de secondes ‚coul‚es depuis le d‚but du sous-programme
'   de tri sp‚cifi‚. Ce laps de temps couvre … la fois le temps n‚cessaire
'   au retra‡age des bƒtonnets et la pause marqu‚e lorsque l'instruction
'   SOUND joue une note. Il ne s'agit donc pas d'une mesure pr‚cise de la
'   vitesse de tri.
' ============================================================================
'
SUB TempsEcoule (LigneCourante) STATIC
   CONST FORMAT = "  &###.### secondes "
   ' Afficher en vid‚o inverse la s‚lection courante et le nombre de secondes
   ' ‚coul‚es :
   COLOR PremierPlan, fond
   LOCATE Selection + 4, COLONNEGAUCHE - 2
   PRINT USING FORMAT; TitreOption(Selection), TIMER - HeureDebut;
   IF PasSon THEN
      SOUND 30000, Pause               ' Pas de son, une simple pause.
   ELSE
      SOUND 60 * LigneCourante, Pause  ' Son, donc jouer une note pendant
   END IF                              ' la pause.
   COLOR MaxCouleurs, 0                ' R‚tablir les couleurs normales du
                                       ' premier plan et du fond.
END SUB

' ============================== TraceCadre ==================================
'   Trace un cadre rectangulaire au moyen des caractŠres ASCII de haut rang
'   É (201) , » (187) , È (200) , ¼ (188) , º (186) et Í (205). Les
'   paramŠtres CoteSup, CoteInf, CoteGauche et CoteDroit sont les arguments
'   de ligne et de colonne des coins sup‚rieur gauche et inf‚rieur droit du
'   cadre.
' ============================================================================
'
SUB TraceCadre (CoteSup, CoteInf, CoteGauche, CoteDroit) STATIC
   CONST SGAUCHE = 201, SDROIT = 187, IGAUCHE = 200, IDROIT = 188
   CONST VERTICAL = 186, HORIZONTAL = 205
   LargeurCadre = CoteDroit - CoteGauche - 1
   LOCATE CoteSup, CoteGauche
   PRINT CHR$(SGAUCHE); STRING$(LargeurCadre, HORIZONTAL); CHR$(SDROIT);
   FOR Ligne = CoteSup + 1 TO CoteInf - 1
      LOCATE Ligne, CoteGauche
      PRINT CHR$(VERTICAL); SPC(LargeurCadre); CHR$(VERTICAL);
   NEXT Ligne
   LOCATE CoteInf, CoteGauche
   PRINT CHR$(IGAUCHE); STRING$(LargeurCadre, HORIZONTAL); CHR$(IDROIT);
END SUB

' =============================== TriCles ====================================
'     L'algorithme TriCles parcourt TableauTri en comparant les ‚l‚ments
'     adjacents et en permutant les paires qui ne sont pas class‚es dans
'     le bon ordre. Il continue ainsi jusqu'… ce qu'il ne reste plus de
'     paire … permuter.
' ============================================================================
'
SUB TriCles STATIC
   Limite = LigneMax
   DO
      Interversion = FAUX
      FOR Ligne = 1 TO (Limite - 1)
         ' Deux ‚l‚ments adjacents sont mal class‚s, permuter leurs valeurs
         ' et retracer ces deux bƒtonnets :
         IF TableauTri(Ligne).longueur > TableauTri(Ligne + 1).longueur THEN
            SWAP TableauTri(Ligne), TableauTri(Ligne + 1)
            PermuteBatonnets Ligne, Ligne + 1
            Interversion = Ligne
         END IF
      NEXT Ligne
      ' Lors du passage suivant, ne pas trier au-del… de la derniŠre
      ' Interversion :
       Limite = Interversion
   LOOP WHILE Interversion
END SUB

' ============================= TriEchange ==================================
'   TriEchange compare chaque ‚l‚ment de TableauTri - en commen‡ant par le
'   premier ‚l‚ment - avec chacun des ‚l‚ments suivants. Si l'un de ceux-ci
'   est inf‚rieur … l'‚l‚ment courant, il est ‚chang‚ avec ce dernier. Ce
'   mˆme processus est ensuite r‚p‚t‚ pour l'‚l‚ment suivant de TableauTri.
' ============================================================================
'
SUB TriEchange STATIC
   FOR Ligne = 1 TO LigneMax
      PlusCourteLigne = Ligne
      FOR J = Ligne + 1 TO LigneMax
         IF TableauTri(J).longueur < TableauTri(PlusCourteLigne).longueur THEN
            PlusCourteLigne = J
            TempsEcoule J
         END IF
      NEXT J
      ' D‚couverte d'une ligne plus courte que la ligne courante. Permuter
      ' ces deux ‚l‚ments du tableau :
      IF PlusCourteLigne > Ligne THEN
         SWAP TableauTri(Ligne), TableauTri(PlusCourteLigne)
         PermuteBatonnets Ligne, PlusCourteLigne
      END IF
   NEXT Ligne
END SUB

' =============================== TriEnPile ===================================
'    La proc‚dure TriEnPile appelle deux autres proc‚dures - PassageHaut et
'    PassageBas. PassageHaut transforme TableauTri en une "pile" qui se
'    pr‚sente de la maniŠre illustr‚e ci-dessous :
'
'                               TableauTri(1)
'                               /          \
'                   TableauTri(2)           TableauTri(3)
'                   /          \            /          \
'         TableauTri(4)  TableauTri(5)   TableauTri(6) TableauTri(7)
'          /      \       /       \       /      \      /      \
'        ...      ...   ...       ...   ...      ...  ...      ...
'
'
'    dans laquelle chaque "noeud pŠre" est sup‚rieur … chacun de ses "noeuds
'    fils". Par exemple, TableauTri(1) est sup‚rieur … TableauTri(2) ou …
'    TableauTri(3), TableauTri(3) est sup‚rieur … TableauTri(6) ou …
'    TableauTri(7), et ainsi de suite.
'
'    Ainsi, une fois que la premiŠre boucle FOR...NEXT de TriEnPile a ‚t‚
'    ex‚cut‚e, le plus grand ‚l‚ment se trouve dans TableauTri(1).
'
'    La deuxiŠme boucle FOR...NEXT de TriEnPile permute l'‚l‚ment contenu
'    dans TableauTri(1) et l'‚l‚ment contenu dans LigneMax, reconstitue la
'    pile (avec PassageBas) pour LigneMax - 1, puis permute l'‚l‚ment
'    contenu dans TableauTri(1) et l'‚l‚ment contenu dans LigneMax - 1,
'    reconstitue enfin la pile pour LigneMax - 2, et poursuit ainsi jusqu'…
'    ce que le tableau soit tri‚.
' ============================================================================
'
SUB TriEnPile STATIC
   FOR I = 2 TO LigneMax
      PassageHaut I
   NEXT I
   FOR I = LigneMax TO 2 STEP -1
      SWAP TableauTri(1), TableauTri(I)
      PermuteBatonnets 1, I
      PassageBas I - 1
   NEXT I
END SUB

' ============================= TriInsertion =================================
'  La proc‚dure TriInsertion compare la longueur de chaque ‚l‚ment successif
'  de TableauTri aux longueurs de tous les ‚l‚ments pr‚c‚dents. Quand la
'  proc‚dure d‚couvre la place qui convient au nouvel ‚l‚ment, elle l'y
'  insŠre et repousse tous les autres ‚l‚ments d'une place vers le bas.
' ============================================================================
'
SUB TriInsertion STATIC
   DIM ValTemp AS TypeTri
   FOR Ligne = 2 TO LigneMax
      ValTemp = TableauTri(Ligne)
      LongueurTemp = ValTemp.longueur
      FOR J = Ligne TO 2 STEP -1
         ' Aussi longtemps que la longueur de l'‚l‚ment J-1 est sup‚rieure …
         ' la longueur de l'‚l‚ment initial contenu dans TableauTri(Ligne),
         ' continuer … d‚caler les ‚l‚ments du tableau vers le bas :
         IF TableauTri(J - 1).longueur > LongueurTemp THEN
            TableauTri(J) = TableauTri(J - 1)
            AfficheUnBatonnet J         ' Afficher le nouveau bƒtonnet.
            TempsEcoule J               ' Afficher le temps ‚coul‚.
         ' Sinon, quitter la boucle FOR...NEXT :
         ELSE
            EXIT FOR
         END IF
      NEXT J
      ' Ins‚rer la valeur initiale de TableauTri(Ligne) dans TableauTri(J):
      TableauTri(J) = ValTemp
      AfficheUnBatonnet J
      TempsEcoule J
   NEXT Ligne
END SUB

' ============================== TriRapide ===================================
'    TriRapide prend un ‚l‚ment "pivot" al‚atoire dans TableauTri, puis
'    place d'un c“t‚ du pivot tous les ‚l‚ments qui lui sont sup‚rieurs, et
'    de l'autre tous ceux qui lui sont inf‚rieurs. TriRapide est ensuite
'    appel‚ de maniŠre r‚cursive avec les deux subdivisions cr‚‚es par le
'    pivot. Quand le nombre d'‚l‚ments d'une subdivision est ‚gal … deux,
'    les appels r‚cursifs cessent et le tableau est tri‚.
' ============================================================================
'
SUB TriRapide (Bas, Haut)
   IF Bas < Haut THEN
      ' Seulement deux ‚l‚ments dans cette subdivision; les permuter s'ils
      ' ne sont pas class‚s dans le bon ordre, puis mettre fin aux appels
      ' r‚cursifs :
      IF Haut - Bas = 1 THEN
         IF TableauTri(Bas).longueur > TableauTri(Haut).longueur THEN
            SWAP TableauTri(Bas), TableauTri(Haut)
            PermuteBatonnets Bas, Haut
         END IF
      ELSE
         ' S‚lectionne un ‚l‚ment de pivot, de maniŠre al‚atoire, puis le
         ' d‚place jusqu'… la fin :
         IndexAleat = EntierAleat(Bas, Haut)
         SWAP TableauTri(Haut), TableauTri(IndexAleat)
         PermuteBatonnets Haut, IndexAleat
         Partition = TableauTri(Haut).longueur
         DO
            ' Ramener des c“t‚s vers l'‚l‚ment pivot :
            I = Bas: J = Haut
            DO WHILE (I < J) AND (TableauTri(I).longueur <= Partition)
               I = I + 1
            LOOP
            DO WHILE (J > I) AND (TableauTri(J).longueur >= Partition)
               J = J - 1
            LOOP
            ' Si l'‚l‚ment pivot n'a pas ‚t‚ atteint, cela signifie que deux
            ' ‚l‚ments situ‚s de part et d'autre de l'‚l‚ment pivot sont mal
            ' class‚s. Il faut alors les permuter :
            IF I < J THEN
               SWAP TableauTri(I), TableauTri(J)
               PermuteBatonnets I, J
            END IF
         LOOP WHILE I < J
         ' Remettre l'‚l‚ment pivot … sa place correcte dans le tableau :
         SWAP TableauTri(I), TableauTri(Haut)
         PermuteBatonnets I, Haut
         ' Appeler de maniŠre r‚cursive la proc‚dure TriRapide (passer
         ' d'abord la plus petite subdivision afin d'‚conomiser l'espace
         ' dans la pile) :
         IF (I - Bas) < (Haut - I) THEN
            TriRapide Bas, I - 1
            TriRapide I + 1, Haut
         ELSE
            TriRapide I + 1, Haut
            TriRapide Bas, I - 1
         END IF
      END IF
   END IF
END SUB

' =============================== TriShell ==================================
'   La proc‚dure TriShell est semblable … la proc‚dure TriCles . Toutefois,
'   TriShell commence par comparer les ‚l‚ments ‚loign‚s (ceux qui sont
'   s‚par‚s par la valeur de la variable Decalage, qui correspond initialement
'   … la moiti‚ de la distance s‚parant le premier ‚l‚ment du dernier), avant
'   de comparer les ‚l‚ments les plus rapproch‚s (quand Decalage est ‚gale …
'   un, la derniŠre it‚ration de cette proc‚dure n'est plus tout simplement
'   qu'un tri par ‚change de paires de cl‚s).
' ============================================================================
'
SUB TriShell STATIC
   ' D‚finir la valeur du d‚calage … la moiti‚ du nombre d'enregistrements
   ' contenus dans TableauTri :
   Decalage = LigneMax \ 2
   DO WHILE Decalage > 0             ' It‚rer jusqu'… ce que le d‚calage
                                     ' soit ‚gal … z‚ro.
      Limite = LigneMax - Decalage
      DO
         Interversion = FAUX         ' Pr‚sumer qu'il n'y a aucune
                                     ' interversion pour ce d‚calage.
         ' Comparer les ‚l‚ments et intervertir ceux qui ne sont pas class‚s
         ' dans le bon ordre :
         FOR Ligne = 1 TO Limite
            IF TableauTri(Ligne).longueur > TableauTri(Ligne + Decalage).longueur THEN
               SWAP TableauTri(Ligne), TableauTri(Ligne + Decalage)
               PermuteBatonnets Ligne, Ligne + Decalage
               Interversion = Ligne
            END IF
         NEXT Ligne
         ' Lors du passage suivant, ne pas trier au-del… de la derniŠre
         ' interversion :
         Limite = Interversion - Decalage
      LOOP WHILE Interversion
      ' Si pas d'interversion au dernier d‚calage, essayer un autre, plus
      ' petit de moiti‚ :
      Decalage = Decalage \ 2
   LOOP
END SUB

' ============================== VerifEcran ==================================
'       V‚rifie le type de moniteur (VGA, EGA, CGA, ou monochrome) et le
'       nombre initial de lignes d'‚cran (50, 43 ou 25).
' ============================================================================
'
SUB VerifEcran STATIC
   ' Tenter de localiser la 50Šme ligne, sinon essayer la 43Šme ligne. Si
   ' cette deuxiŠme tentative ‚choue elle aussi, l'utilisateur est en
   ' mode 25 lignes :
   LigneInit = 50
   ON ERROR GOTO CherchLigne
   LOCATE LigneInit, 1
   ' Essayer une instruction SCREEN 1 pour voir si la carte courante est en
   ' mesure d'afficher des graphiques en couleurs. Si cette tentative
   ' entraŒne une erreur, ramener MaxCouleurs … 2 :
   MaxCouleurs = 15
   ON ERROR GOTO IntercepteMono
   SCREEN 1
   SCREEN 0
   ' V‚rifier si le mode 43 lignes est accept‚. Si ce n'est pas le cas,
   ' ex‚cuter ce programme en mode 25 lignes :
   LigneMax = 43
   ON ERROR GOTO IntercepteLigne
   WIDTH 80, LigneMax
   ON ERROR GOTO 0              ' D‚sactiver l'interception d'erreurs.
END SUB