Turbo Toolbox/Turbo_Toolbox.iso/qpdemo/sortdemo.pas

Pascal/Delphi Source File | 1989-07-21 | 27.3 KB | 905 lines

PROGRAM sort_demo;
{========================================================================

   QuickPascal Sortier-Demo
   ------------------------
   Dieses Programm demonstriert grafisch 6 gebräuchliche Sortier-
   algorithmen. Es gibt horizontale Balken aus, die alle eine unter-
   schiedliche Länge haben, in zufälliger Reihenfolge vorliegen und
   der Länge nach sortiert werden.

   Außerdem verwendet das Programm sound-Anweisungen, um abhängig von
   der Position des auszugebenden Balkens unterschiedliche Tonhöhen zu
   erzeugen. Beachten Sie, daß die sound-Anweisungen die Geschwindigkeit
   jedes Sortieralgorithmus' verlangsamen, so daß Sie den Fortgang der
   Sortierung verfolgen können. Daher sind die gezeigten Zeiten nur zum
   Vergleich bestimmt. Sie sind keine genaue Messung der Sortier-
   geschwindigkeit.

   HINWEIS: Betätigen Sie STRG+UNTBR während des Sortierens innerhalb
   der QuickPascal-Umgebung, kann der Lautsprecher angeschaltet bleiben.
   Um ihn auszustellen, setzen Sie sort_demo fort (F5 drücken), oder
   gehen Sie zu einem Aufruf zu NoSound (F10 mehrfach drücken).

   Wenn Sie diese Sortierroutinen in eigenen Programmen verwenden,
   werden Sie vielleicht Unterschiede in deren relativen Geschwindig-
   keiten feststellen (zum Beispiel kann das Sortieren durch Austausch
   schneller sein als der Shellsort), abhängig von der Anzahl der zu
   sortierenden Elemente und wie "ungeordnet" diese zu Beginn des
   Sortiervorgangs vorliegen.

}
{$M 10000, 0, 0 }  { Heap wird nicht benutzt }
{$B-}              { Boolsche Bewertung }
{$R-}              { Bereichsüberprüfung aus }

USES
    Crt, Dos;

CONST

    block      = #223;
    esc        = #27;
    null_zchn  = #0;
    leer       = #32;

    ticks_pro_sek = 18.2;  { Uhrschlag pro Sekunde }

    maxmax_balk = 43; { Absolutes Maximum der Balkenanzahl }
    max_sort   =  6;  { Anzahl der Sortieralgorithmen }

    { Menüdimensionen }
    menu_top    =  1;
    menu_links  = 49;
    menu_hoehe  = 18;
    menu_breite = 80 - menu_links;

    { Vorgabefarben, geändert für Monochrom }
    bild_rueck     : Byte = Black;
    menu_rueck     : Byte = LightGray;
    menu_rahmen    : Byte = LightBlue;
    menu_text      : Byte = Black;
    menu_status    : Byte = LightCyan;
    menu_hervorghb : Byte = Yellow;

TYPE
    sort_art      = ( Einfuegen, Bubble, Heap, Austausch, Shell, Quick );
    sort_range    = First( sort_art )..Last( sort_art );
    sort_elemente = RECORD
    lng    : Byte;     { Balkenlänge (des Sortierelements) }
    Farbe  : Integer;  { Balkenfarbe }
    END;
    sort_arrays = ARRAY[1..maxmax_balk] OF sort_elemente;

VAR
    { Array von Sortierprozeduren }
    sort : ARRAY[sort_range] OF PROCEDURE;
    sort_array,               { zu sortierende Elemente }
    unsort_array              { Unsortierte Kopie des Arrays }
    : sort_arrays;
    max_balk,                 { Max. zu sortierende Balken }
    max_Farben  : Integer;    { Max. unterstützte Farben }
    start_zeit,               { Startzeit }
    end_zeit    : LongInt;    { Endzeit }
    pause       : Word;       { Länge der Pause }
    start_modus : Word;       { Start-Videomodus }
    ton_ein     : Boolean;    { Wahr, falls Ton ein }
    Balken         : STRING[maxmax_balk]; { String der Balkenzeichen }

    { Tonleiter-Frequenz für die Anzahl der zu sortierenden Zeilen }
    tonleiter_frequenz : Integer;

CONST
    { Menüelemente }
    menu : ARRAY[1..menu_hoehe] OF CSTRING[30] =
    ( '  QuickPascal Sortier-Demo',
      ' ',
      'Einfügen',
      'Bubble',
      'Heap',
      'Austausch',
      'Shell',
      'Quick',
      ' ',
      'Ton ein/aus: ',
      ' ',
      'Pause: ',
      '<   (Langsamer)',
      '>   (Schneller)',
      ' ',
      'Erstes Zeichen eingeben',
      'Wahl ( EBHASQT<> )',
      'oder ESC, um abzubrechen: '
     );

{======================= zeit_vergangen =============================
   Gibt die Sekunden aus, die seit dem Start der angegebenen Sortier-
   routine vergangen sind.
   Beachten Sie, daß diese Zeit sowohl die Zeit zum Neuzeichnen der
   Balken, als auch die Pause, während der die SOUND-Anweisung eine
   Note spielt, beinhaltet, und daher keinen genauen Anhaltspunkt für
   die Sortiergeschwindigkeit darstellt.
}
PROCEDURE zeit_vergangen( akt_zeile : Integer;
              akt_sort  : sort_range );

    BEGIN

    { Liest Zeit von vordefiniertem Speicher-Array. }
    end_zeit := MemL[$40:$6C];

    TextColor( menu_status );
    TextBackground( menu_rueck );
    GotoXY( menu_links + 21, Ord(akt_sort) + menu_top + 3 );
    Write( ((end_zeit - start_zeit) / ticks_pro_sek ):7:2 );

    IF ton_ein THEN
    BEGIN
    Sound( akt_zeile * tonleiter_frequenz );
    Delay( pause );
    NoSound;
    END
    ELSE
    Delay( pause );

    TextBackground( bild_rueck );
    END;  { zeit_vergangen }

{======================= swap_sort_elemente ====================
    Austausch zweier Balken.
}
PROCEDURE swap_sort_elemente( VAR eins, zwei : sort_elemente );
    VAR
    temp : sort_elemente; { Austauschhilfe }
    BEGIN
    temp := eins;
    eins := zwei;
    zwei := temp;
    END; { swap_sort_elemente }

{======================= Balken_zeichnen ===============================
    Zeichnet einen Balken auf der vom Parameter zeile angegebenen Zeile.
}
PROCEDURE Balken_zeichnen( zeile : Integer );
    VAR
    Balken_end : Integer;
    BEGIN
    TextColor( sort_array[zeile].Farbe );

    Balken_end := sort_array[zeile].lng;
    FillChar( Balken[1],           Balken_end,            block );
    FillChar( Balken[Balken_end + 1], max_balk - Balken_end, leer );
    Balken[0] := Chr( max_balk );

    GotoXY( 1, zeile );
    Write( Balken );
    END; { Balken_zeichnen }

{==================== swap_Balken_zeichnen =======================
    Ruft Balken_zeichnen zweimal auf, um die zwei Balken in zeile1
    und zeile2 zu tauschen.
}
PROCEDURE swap_Balken_zeichnen( zeile1, zeile2 : Integer );
    BEGIN
    Balken_zeichnen( zeile1 );
    Balken_zeichnen( zeile2 );
    END; { swap_Balken_zeichnen }

{========================= rand_int ==============================
    Gibt eine Zufallszahl zurück, die größer oder gleich des
    kleineren und kleiner oder gleich des größeren Parameters ist.
}
FUNCTION rand_int( kleiner, groesser : Integer ) : Integer;
    BEGIN
    rand_int := Random( groesser - kleiner ) + kleiner;
    END; { rand_int }


{$F+} { Schaltet Aufrufe für Sortierprozeduren ein. }

{ ========================= Bubble_sort ===============================
    Der "BubbleSort"-Algorithmus durchläuft sort_array, vergleicht auf-
    einanderfolgende Elemente und vertauscht Paare, die nicht in der
    richtigen Reihenfolge vorliegen. Er fährt damit fort, bis keine
    Paare mehr getauscht wurden.
}
PROCEDURE Bubble_sort;
    VAR zeile,              { Element zeile wird mit zeile + 1 verglichen }
    tausch,             { Zeile, wo Elemente getauscht werden }
    grenze   : Integer; { Letztes zu vergleichendes Element - 1 }

    BEGIN
    grenze := max_balk;
    REPEAT
    tausch := 0;
    FOR zeile := 1 TO grenze - 1 DO
        { Zwei aufeinanderfolgende Elemente liegen nicht in der richtigen
          Reihenfolge vor, also tausche deren Werte und zeichne ihre
          Balken neu:
        }
        IF (sort_array[zeile].lng > sort_array[zeile + 1].lng) THEN
        BEGIN
        swap_sort_elemente( sort_array[zeile], sort_array[zeile + 1] );
        swap_Balken_zeichnen( zeile, zeile + 1 );
        zeit_vergangen( zeile, Bubble );
        tausch := zeile;
        END;

    { Sortiere im nächsten Schritt nur bis dahin, wo der letzte Tausch
      vorgenommen wurde:
    }
    grenze := tausch;

    UNTIL (tausch = 0);
    END; { Bubble_sort }


{======================= Austausch_sort ==========================
    Der Algorithmus "Sortieren durch Austauschen" vergleicht jedes
    Element in sort_array - beginnend mit dem ersten Element - mit
    jedem folgenden Element. Wenn eines der nachfolgenden Elemente
    kleiner ist als das aktuelle Element, wird es mit dem aktuellen
    Element getauscht, und der Ablauf wird mit dem nächsten Element
    in sort_array wiederholt.
}
PROCEDURE Austausch_sort;
    VAR zeile,                  { Zeile, die verglichen wird }
    kl_zeile,               { Kleinste, gefundene Zeile }
    j      : Integer;
    BEGIN
    FOR zeile := 1 TO max_balk - 1 DO
    BEGIN
    kl_zeile := zeile;
    FOR j := zeile + 1 TO max_balk DO
        BEGIN
        IF (sort_array[j].lng < sort_array[kl_zeile].lng) THEN
        BEGIN
        kl_zeile := j;
        zeit_vergangen( j, Austausch );
        END;
        END;
    IF (kl_zeile > zeile) THEN
        { Zeile gefunden, die kleiner als die aktuelle Zeile
          ist, also vertausche diese beiden Datenfeldelemente:
        }
        BEGIN
        swap_sort_elemente( sort_array[zeile], sort_array[kl_zeile] );
        swap_Balken_zeichnen( zeile, kl_zeile );
        zeit_vergangen( zeile, Austausch );
        END;
    END;
    END;  { Austausch_sort }


{============================== Heap_sort ==============================
    Die Prozedur HeapSort funktioniert, indem sie zwei andere Prozeduren
    aufruft - filtern_aufw und filtern_abw. filtern_aufw wandelt
    sort_array in einen "Heap" um, dessen Eigenschaften das unten
    gezeigte Diagramm verdeutlicht:

                sort_array(1)
               /            \
          sort_array(2)                sort_array(3)
           /       \                   /       \
    sort_array(4)    sort_array(5)   sort_array(6)  sort_array(7)
       /  \            /  \           /  \          /  \
     ...  ...        ...  ...       ...  ...      ...  ...

    wobei jeder "Eltern-Knoten" größer ist als jeder seiner "Kind-Knoten";
    zum Beispiel ist sort_array(1) größer als sort_array(2) oder
    sort_array(3), sort_array(3) ist größer als sort_array(6) oder
    sort_array(7) und so weiter.

    Nachdem die erste for-Schleife in Heap_sort beendet ist, befindet
    sich das größte Element daher in sort_array(1).

    Die zweite for-Schleife in Heap_sort vertauscht das Element in
    sort_array(1) mit dem Element in max_ebene, bildet den Heap erneut
    (mit filtern_abw) für max_ebene - 1, vertauscht anschließend das
    Element in sort_array(1) mit dem Element in max_ebene - 1, bildet
    den Heap erneut für max_ebene - 2 und fährt in dieser Art und Weise
    fort, bis das Array sortiert ist.
 }
PROCEDURE Heap_sort;

    {=================== filtern_abw =================================
    Die Prozedur FilternAbw erzeugt mit den Elementen aus sort_array
    von 1 bis max_ebene erneut einen "Heap" (siehe das Diagramm in der
    Prozedur HeapSort).
    }
    PROCEDURE filtern_abw( max_ebene : Integer );
    VAR
        i,
        kind   : Integer;  { Kind des zu vergleichenden Elements }
        fertig : Boolean;  { Wahr, wenn beendet }
    BEGIN
    i := 1;
    fertig := False;

    { Bewege den Wert in sort_array(1) im Heap solange nach unten, bis
      dieser seinen richtigen Knoten erreicht hat (das heißt, bis der
      Wertkleiner als sein Eltern-Knoten ist, oder bis er max_ebene,
      die unterste Ebene des aktuellen Heaps, erreicht hat):
    }
    WHILE (NOT fertig) DO
        BEGIN
        { Index des Kind-Knoten ermitteln. }
        kind := 2 * i;
        IF (kind > max_ebene) THEN
        fertig := True  { Unterste Ebene des Heaps erreicht,
                  also Prozedur verlassen. }
        ELSE
        BEGIN
        { Bei 2 Kind-Knoten den Größeren ermitteln. }
        IF (kind + 1 <= max_ebene) THEN
            IF (sort_array[kind + 1].lng >
            sort_array[kind    ].lng) THEN
            kind := kind + 1;
        { Bewege den Wert nach unten, solange er noch nicht
          größer als irgendeines seiner Kinder ist:
        }
        IF (sort_array[i].lng < sort_array[kind].lng) THEN
            BEGIN
            swap_sort_elemente( sort_array[i], sort_array[kind] );
            swap_Balken_zeichnen( i, kind );
            zeit_vergangen( i, Heap );
            i := kind;
            END
        ELSE
            { Andernfalls ist sort_array erneut als Heap von 1 bis
              max_ebene aufgebaut, also beenden:
            }
            fertig := True;
        END;
        END;
    END;  { filtern_abw }

    {======================= filtern_aufw ==============================
    Die Prozedur filtern_aufw überträgt die Elemente von 1 bis max_ebene
    in sort_array in einen "Heap" (siehe das Diagramm in der Prozedur
    Heap_sort).
    }
    PROCEDURE filtern_aufw( max_ebene : Integer );
    VAR
        i,
        eltern : Integer;  { Eltern des zu vergleichenden Elements }
    BEGIN
    i := max_ebene;

    { Bewege den Wert in sort_array(max_ebene) solange durch den Heap
      nach oben, bis er seinen richtigen Knoten erreicht hat (das heißt,
      bis der Wert größer als irgendeiner seiner Kind-Knoten ist, oder
      er 1, die Spitze des Heaps, erreicht hat):
    }
    WHILE (i <> 1) DO
        BEGIN
        eltern := i DIV 2;  { Index des Eltern-Knoten lesen }
        IF (sort_array[i].lng > sort_array[eltern].lng) THEN
        { Der Wert des aktuellen Knotens ist noch größer als der
          Wert seines Eltern-Knotens, also vertausche diese beiden
          Array-Elemente:
        }
        BEGIN
        swap_sort_elemente( sort_array[eltern], sort_array[i] );
        swap_Balken_zeichnen( eltern, i );
        zeit_vergangen( eltern, Heap );
        i := eltern;
        END
        ELSE
        { Andernfalls hat das Element in dem Heap seine richtige
          Position erreicht, also verlasse diese Prozedur:
        }
        i := 1;
        END;
    END; { filtern_aufw }

    { ====================================================
      Deklarationen und Code für Heap_sort
    }
    VAR
    i : Integer;
    BEGIN
    FOR i := 2 TO max_balk DO filtern_aufw( i );
    FOR i := max_balk DOWNTO 2 DO
    BEGIN
    swap_sort_elemente( sort_array[1], sort_array[i] );
    swap_Balken_zeichnen( 1, i );
    zeit_vergangen( 1, Heap );
    filtern_abw( i - 1 );
    END;
    END;  { Heap_sort }

{============================ Einfuegen_sort ===========================
    Die Prozedur Einfuegen_sort vergleicht nacheinander die Länge jedes
    Elementes in sort_array mit der Länge aller vorhergehenden Elemente.
    Nachdem die Prozedur die entsprechende Position für das neue Element
    gefunden hat, fügt es das Element an seinem neuen Platz ein und
    bewegt alle anderen Elemente um eine Position nach unten.
}
PROCEDURE Einfuegen_sort;
    VAR
    j,
    zeile,                  { Einzufügende Zeile }
    temp_Laenge : Integer;  { Länge der aktuellen Zeile }
    temp : sort_elemente;   { Aktueller Zeilenwert }
    BEGIN
    FOR zeile := 2 TO max_balk DO
    BEGIN
    temp := sort_array[zeile];
    temp_Laenge := temp.lng;
    j := zeile;
    WHILE ((j >= 2) AND (sort_array[j - 1].lng > temp_Laenge)) DO
        BEGIN
        sort_array[j] := sort_array[j - 1];
        Balken_zeichnen( j );            { Neuen Balken zeichnen. }
        zeit_vergangen( j, Einfuegen );  { Verstrichene Zeit ausgeben. }
        Dec( j );
        END;

    { Ursprünglichen Wert von sort_array(zeile)
      in sort_array(j) einfügen. }
    sort_array[j] := temp;
    Balken_zeichnen( j );                { Neuen Balken zeichnen. }
    zeit_vergangen( j, Einfuegen );      { Verstrichene Zeit ausgeben. }
    END;
    END;  { Einfuegen_sort }

{ ========================= Quick_sort ================================
  Der "QuickSort"-Algorithmus funktioniert, indem er ein zufälliges
  "Pivot"- Element aus sort_array herausnimmt, anschließend jedes
  Element, das größer ist, auf eine Seite des Pivot-Elementes bewegt,
  und jedes Element, das kleiner ist, auf die andere Seite bewegt.
  QuickSort wird dann mit den beiden Unterabteilungen, die von dem
  Pivot-Element erzeugt wurden, rekursiv aufgerufen. Nachdem die Anzahl
  der Elemente in einer Untermenge einmal zwei erreicht hat, enden
  die rekursiven Aufrufe, und das Datenfeld ist sortiert.
}
PROCEDURE Quick_sort;


    PROCEDURE qsort( klein, gross : Integer );
    VAR
        i, j, pivot : Integer;
    BEGIN
    IF (klein < gross) THEN
        BEGIN
        { Nur zwei Elemente in dieser Unterabteilung; vertausche diese,
          wenn sie nicht in der richtigen Reihenfolge vorliegen und
          beende anschließend die rekursiven Aufrufe:
        }
        IF (gross - klein = 1) THEN
        BEGIN
        IF (sort_array[klein].lng > sort_array[gross].lng) THEN
            BEGIN
            swap_sort_elemente( sort_array[klein], sort_array[gross] );
            swap_Balken_zeichnen( klein, gross );
            zeit_vergangen( klein, Quick );
            END;
        END
        ELSE
        BEGIN
        pivot := sort_array[gross].lng;
        i := klein;
        j := gross;
        WHILE (i < j)   DO
            BEGIN
            { Hinbewegung von beiden Seiten auf das Pivot-Element zu. }
            WHILE ((i < j) AND (sort_array[i].lng <= pivot)) DO
            Inc( i );
            WHILE ((j > i) AND (sort_array[j].lng >= pivot)) DO
            Dec( j );
            { Wird das Pivot-Element nicht erreicht, bedeutet dies,
              daß zwei Elemente auf einer Seite nicht in der rich-
              tigen Reihenfolge vorliegen, also vertausche diese
              Elemente.
            }
            IF (i < j) THEN
            BEGIN
            swap_sort_elemente( sort_array[i], sort_array[j] );
            swap_Balken_zeichnen( i, j );
            zeit_vergangen( i, Quick );
            END;
            END;

        { Bewege das Pivot-Element zurück auf seinen richtigen
          Platz im Array.
        }
        swap_sort_elemente( sort_array[i], sort_array[gross] );
        swap_Balken_zeichnen( i, gross );
        zeit_vergangen( i, Quick );

        { Rufe die Prozedur Quick_sort rekursiv auf (übergib die
          kleinere Unterabteilung zuerst, um weniger Stapelplatz
          zu verwenden).
        }
        IF ((i - klein) < (gross - i)) THEN
            BEGIN
            qsort( klein, i - 1 );
            qsort( i + 1, gross );
            END
        ELSE
            BEGIN
            qsort( i + 1, gross );
            qsort( klein, i - 1 );
            END;
        END;
        END;
    END;  { qsort }

    { =========================================================
      Code für Quick_sort
    }
    BEGIN
    qsort( 1, max_balk );
    END;


{============================= Shell_sort =============================
  Die Prozedur Shell_sort ist ähnlich zu der Prozedur Bubble_Sort.
  Shell_sort startet jedoch damit, daß sie weit auseinanderliegende
  Elemente vergleicht (getrennt durch den Wert der Variablen offset,
  der zu Beginn die Hälfte des Abstandes zwischen dem ersten und
  letzten Element ist) und anschließend Elemente vergleicht, die näher
  zusammenliegen (wenn offset eins ist, ist die letzte Iteration dieser
  Prozedur gleich der Prozedur Bubble_Sort).
}
PROCEDURE Shell_sort;
    VAR
    offset,            { Vergleichsoffset }
    tausch,            { Zeile, wo letzter Tausch auftrat }
    grenze,            { Anzahl der Elemente, die jedesmal verglichen
                         werden }
    zeile   : Integer; { Aktuelle Zeile }
    BEGIN
    { Setze den Vergleichsoffset auf die Hälfte der Satzzahl in
      sort_array }
    offset := max_balk DIV 2;

    WHILE (offset > 0) DO
    BEGIN
    { Schleife, bis offset Null wird. }
    grenze := max_balk - offset;
    REPEAT
        tausch := 0; { Kein Tausch bei diesem Offset }
        { Elemente vergleichen und diejenigen vertauschen,
          die nicht in der Reihenfolge liegen. }
        FOR zeile := 1 TO grenze DO
        IF (sort_array[zeile].lng >
            sort_array[zeile + offset].lng) THEN
            BEGIN
            swap_sort_elemente( sort_array[zeile],
                    sort_array[zeile + offset] );
            swap_Balken_zeichnen( zeile, zeile + offset );
            zeit_vergangen( zeile, Shell );
            tausch := zeile;
            END;

        { Sortiere im nächsten Schritt nur bis dahin, wo der letzte
          Tausch durchgeführt wurde.
        }
        grenze := tausch - offset;
    UNTIL (tausch = 0);
    { Kein Tausch beim letzten Offset, versuche es mit dem
      halbierten Offset.
    }
    offset := offset DIV 2;
    END;
    END;  { Shell_sort }
{$F-} { Schaltet FAR-Aufrufe aus. }

{======================= Monitor =========================
 Setzt die Ausgabe auf die höchste Anzahl von verfügbaren
 Textzeilen und die Anzahl der Farben
}
PROCEDURE Monitor;
    BEGIN
    IF LastMode = Mono THEN
    BEGIN
    max_Farben     := 1;
    TextMode( Mono );
    bild_rueck     := Black;
    menu_rueck     := Black;
    menu_rahmen    := LightGray;
    menu_text      := LightGray;
    menu_status    := LightGray;
    menu_hervorghb := White;
    END
    ELSE
    BEGIN
    max_Farben := 15;
    TextMode( CO80 + Font8x8 );
    END;
    max_balk := Hi( WindMax );  { Ermittelt Anzahl der Textzeilen. }
    IF max_balk > maxmax_balk THEN
    max_balk := maxmax_balk;
    END;  { Monitor }

{========================= zeichne_menu =============================
    Ruft die Prozedur zeichne_rahmen auf, um einen Rahmen um das Menü
    zu zeichnen, danach wird die "Menüauswahl" ausgegeben.
}
PROCEDURE zeichne_menu;

    {======================= zeichne_rahmen =========================
    Zeichnet mit den ASCII-Zeichen höherer Ordnung ╔ (201), ╗ (187),
    ╚ (200), ╝ (188) , ║ (186) und ═ (205) einen rechteckigen Rahmen.
    Die Parameter SeiteOben, SeiteUnten, SeiteLinks und SeiteRechts
    sind die Zeilen- bzw. Spaltenargumente der oberen linken bzw.
    unteren rechten Ecke des Rahmens.
    }
    PROCEDURE zeichne_rahmen( top, left, menu_breite, height : Integer );
    CONST
        olinks     = #201;  { Größeres linkes Zeichen }
        orechts    = #187;  { Größeres rechtes Zeichen }
        ulinks     = #200;  { Kleineres linkes Zeichen }
        urechts    = #188;  { Kleineres rechtes Zeichen }
        vertikal   = #186;  { Vertikales Linienzeichen }
        horizontal = #205;  { Horizontales Linienzeichen }
    VAR
        linie : CSTRING[80]; { Horizontales Stück der Box }
        i     : Integer;
    BEGIN

    FillChar( linie[2], menu_breite - 2, horizontal );
    linie[menu_breite + 1] := null_zchn;

    linie[1] := olinks;
    linie[menu_breite] := orechts;
    GotoXY( left, top );
    Write( linie );

    linie[1] := ulinks;
    linie[menu_breite] := urechts;
    GotoXY( left, top + height );
    Write( linie );

    FillChar( linie[2], menu_breite - 2, leer );
    linie[1] := vertikal;
    linie[menu_breite] := vertikal;

    FOR i := top + 1 TO top + height - 1 DO
        BEGIN
        GotoXY( left, i );
        Write( linie );
        END;
    END;  { zeichne_rahmen }

    { ==========================================================
      Deklarationen und Code für zeichne_menu
    }
    CONST
    ein_aus : ARRAY[Boolean] OF STRING[3] = ('AUS', 'EIN');
    VAR
    i : Integer;
    BEGIN
    TextBackground( menu_rueck );
    TextColor( menu_rahmen );
    zeichne_rahmen( 1, menu_links - 3, menu_breite + 3, 20 );

    TextColor( menu_text );
    FOR i := 1 TO menu_hoehe DO
    BEGIN
    GotoXY( menu_links, menu_top + i );
    Write( menu[i] );

    IF (i IN [3..10, 13, 14]) THEN
        BEGIN
        TextColor( menu_hervorghb );
        GotoXY( menu_links, menu_top + i );
        Write( menu[i][1] );
        TextColor( menu_text );
        END;

    END; { FOR }

    TextColor( menu_status );
    { Aktuelle ton_ein-Werte ausgeben. }
    GotoXY( menu_links + 14, 11 );
    Write( ein_aus[ton_ein] );

    { Pause-Wert ausgeben. }
    GotoXY( menu_links + 13, 13 );
    Write( (pause DIV 20):3 );

    { Option für Geschwindigkeit löschen, falls die Pausenlänge
      ihre Grenze erreicht. }
    IF (pause = 900) THEN
    BEGIN
    GotoXY( menu_links, 14 );
    Write( '':12 );
    END
    ELSE IF (pause = 0) THEN
    BEGIN
    GotoXY( menu_links, 15 );
    Write( '':12 );
    END;
    TextBackground( bild_rueck );
    END;  { zeichne_menu }

{======================= initialisieren ============================
     unsort_array initialisieren.
}
PROCEDURE initialisieren;
    VAR
    i,
    index,
    max_index,                { Maximaler Index für Initialisierung }
    Balken_Laenge : Integer;  { Länge des initialisierten Balkens }
    temp : ARRAY[1..maxmax_balk] OF Integer;  { Balken-Array }
    BEGIN

    Randomize;
    FOR i := 1 TO max_balk DO temp[i] := i;
    max_index := max_balk;
    FOR i := 1 TO max_balk DO
    BEGIN
    { Zufallselement in temp zwischen 1 und max_index finden,
      dann Wert des Elementes Balken_Laenge zuweisen.
    }
    index := rand_int( 1, max_index );
    Balken_Laenge := temp[index];
    { Den Wert in temp[index] mit dem Wert in temp[max_index]
      überschreiben, so daß der Wert in temp[index] nur einmal
      gewählt wird.
    }
    temp[index] := temp[max_index];
    { Den Wert von max_index verkleinern, so daß temp[max_index]
      beim nächsten Schritt durch die Schleife nicht gewählt
      werden kann.
    }
    Dec( max_index );

    unsort_array[i].lng := Balken_Laenge;
    IF (max_Farben = 1) THEN
        unsort_array[i].Farbe := LightGray
    ELSE
        unsort_array[i].Farbe := (Balken_Laenge MOD max_Farben) + 1;
    END;

    END;  { initialisieren }


{======================= reinitialisieren ===========================
    Überführt sort_array wieder in seinen ursprünglichen unsortierten
    Zustand und gibt anschließend die unsortierten Farbbalken aus.
}
PROCEDURE reinitialisieren;
    VAR
    zeile      : Integer;  { Indizierung des Balken-Array }
    BEGIN

    FOR zeile := 1 TO max_balk DO
    BEGIN
    sort_array[zeile] := unsort_array[zeile];
    Balken_zeichnen( zeile );
    END;

    { Startzeit von vordefiniertem Speicher-Array einlesen. }
    start_zeit := MemL[$40:$6C];
    END; { Reinitialisieren }


{======================= sort_menu ===========================
    Fordert den Benutzer auf:
    - Einen der Sortier-Algorithmen zu wählen
    - Ton ein- bzw. auszuschalten
    - Geschwindigkeit zu erhöhen bzw. vermindern
    - Das Programm zu beenden
}
PROCEDURE sort_menu;

    {======================= sortieren ========================
     Array initialisieren und gewählten Algorithmus auszuführen,
     ausgeführte Zeit ausgeben.
    }
    PROCEDURE sortieren( sort_art : sort_range );

    {======================= cursor_schalten =======================
     Sichtbarkeit des Cursors wechseln.
     Ergibt Wahr, falls der Cursor nach dem Umschalten sichtbar ist.
     Annahme der Videoseite 0.
    }
    FUNCTION cursor_schalten : Boolean;
        VAR
        r : Registers;
        BEGIN
        r.AH := 3;  { Cursorfunktion einlesen }
        r.BH := 0;  { Annahme der Videoseite 0 }
        Intr( 16, r );
        r.AH := 1;
        r.CH := r.CH XOR $20; { Sichtbares Bit umschalten }
        cursor_schalten := ( r.CH AND $20 ) = 0;
        Intr( 16, r );
        END; { cursor_schalten }

    { ==================================================
      Deklarationen und Code für sortieren
    }
    VAR
        b : Boolean;    {  Dummy für cursor_schalten }
    BEGIN
    reinitialisieren;   { Array reinitialieren (zum unsort. Status). }
    IF cursor_schalten THEN       { Überprüfen, ob Schalter aus ist. }
        b := cursor_schalten ;
    sort[sort_art];               { Sortieren. }
    zeit_vergangen( 0, sort_art );{ Ausführungszeit ausgeben. }
    b := cursor_schalten;         { Cursor einschalten. }
    END; { sortieren }

    { =======================================================
       Deklarationen und Code für sort_menu
    }
    VAR
    zch   : Char;     { Zeichen von Tastatur einlesen }
    fertig : Boolean; { Wahr, falls ESC gedrückt wurde }
    BEGIN
    fertig := False;
    WHILE NOT fertig DO
    BEGIN
    GotoXY( menu_links + Length( menu[menu_hoehe] ),
        menu_top + menu_hoehe );
    zch := UpCase( ReadKey );
    CASE zch OF
        'E' : sortieren( Einfuegen );
        'B' : sortieren( Bubble );
        'H' : sortieren( Heap );
        'A' : sortieren( Austausch );
        'S' : sortieren( Shell );
        'Q' : sortieren( Quick );
        '>',
        '.' :  { Pause verringeren. }
        IF (pause > 0) THEN
            BEGIN
            pause := pause - 20;
            zeichne_menu;  { Alte Zeiten löschen - nicht mehr gültig. }
            END;
        '<',
        ',' :  { Pause erhöhen. }
        IF (pause < 900) THEN
            BEGIN
            pause := pause + 20;
            zeichne_menu;  { Alte Zeiten löschen - nicht mehr gültig. }
            END;
        'T' :   { Ton umschalten. }
        BEGIN
        ton_ein := NOT ton_ein;
        zeichne_menu;
        END;
        esc : fertig := True;
        #0  : zch := ReadKey;
        ELSE  { Jede andere Eingabe ignorieren. }
        END;
    END;
    END;  { sort_menu }


{===================== Hauptprogramm ============================}
BEGIN

    { Array der Sortier-Prozeduren initialisieren. }
    sort[Einfuegen] := Einfuegen_sort;
    sort[Bubble]    := Bubble_sort;
    sort[Heap]      := Heap_sort;
    sort[Austausch] := Austausch_sort;
    sort[Shell]     := Shell_sort;
    sort[Quick]     := Quick_sort;

    start_modus     := LastMode;  { Start-Videomodus speichern. }
    Monitor; { Monitor einrichten, max_balk und max_Farben ermitteln. }

    tonleiter_frequenz := 5000 DIV max_balk; { Tonleiter-Faktor }
    ton_ein         := True;                 { Ton ist nach Vorgabe ein }
    pause           := 60;                   { Vorgabewert für Pause }

    initialisieren;   { Datenwerte initialisieren }
    { Werte in unsort_array auf sort_array zuweisen
      und unsortierte Balken ausgeben.
    }
    reinitialisieren;
    zeichne_menu;
    sort_menu;    { Menü aktivieren }

    TextMode( start_modus );  { Videomodus wiederherstellen }

END.