{--------------------------------------------------------------}
{                          SortTest                            }
{                                                              }
{               Data sort demonstration program                }
{                                                              }
{                             by Jeff Duntemann                }
{                             Turbo Pascal V3.0                }
{                             Last update 5/5/86               }
{                                                              }
{    From the book, COMPLETE TURBO PASCAL, by Jeff Duntemann   }
{    Scott, Foresman & Co. (c) 1986,1987  ISBN 0-673-18600-8   }
{--------------------------------------------------------------}

PROGRAM Sorttest;


CONST
  HighLite   = True;
  CR         = True;
  NoHighlite = False;
  NoCR       = False;
  GetInteger = False;
  Numeric    = True;
  CapsLock   = True;
  Shell      = True;
  Quick      = False;


TYPE
  String255 = String[255];
  String80  = String[80];
  String30  = String[30];

  KeyRec = RECORD
             Ref     : Integer;
             KeyData : String30
           END;

  KeyArray = ARRAY[0..500] OF KeyRec;

  KeyFile = FILE OF KeyRec;

{$I GRAFREC.DEF}    { Definition file for GrafRec record type }


VAR
  I,J,Error : Integer;
  IVAL      : Integer;
  R         : Real;
  Ch        : Char;
  Response  : String80;
  Escape    : Boolean;
  WorkArray : KeyArray;
  Randoms   : KeyFile;
  GrafChars : GrafRec;


{$I BEEP.SRC}       { "Deedle-deedle" beeper procedure }
{$I UHUH.SRC}       { "Uh-uh" sound for errors }
{$I MONOTEST.SRC}   { Test for presence of monochrome display }
{$I CURSON.SRC}     { Turns IBM PC text cursor back on again }
{$I CURSOFF.SRC}    { Turns off IBM PC text cursor }
{$I KEYSTAT.SRC}    { KEYSTAT non-echo keyboard input function }
{$I YES.SRC }       { YES function }
{$I WRITEAT.SRC}    { WRITEAT function for X/Y String display }

{$I BOXSTUFF.SRC}   { MAKEBOX procedure and associated definitions }
{$I GETSTRIN.SRC}   { GetString formatted String input procedure }
{$I SHELSORT.SRC}   { Shell sort routine }
{$I QUIKSORT.SRC}   { Quicksort routine }
{$I PULL.SRC }      { PULL random number within a given range function }


PROCEDURE ClearRegion(X1,Y1,X2,Y2 : Integer);

BEGIN
  Window(X1,Y1,X2,Y2);
  ClrScr;
  Window(1,1,80,25)
END;


PROCEDURE GenerateRandomKeyFile(KeyQuantity : Integer);

VAR WorkKey : KeyRec;
    I,J     : Integer;

BEGIN
  Assign(Randoms,'RANDOMS.KEY');
  Rewrite(Randoms);
  FOR I := 1 TO KeyQuantity DO
    BEGIN
      FillChar(WorkKey,SizeOf(WorkKey),0);
      FOR J := 1 TO SizeOf(WorkKey.KeyData)-1 DO
        WorkKey.KeyData[J] := Chr(Pull(65,91));
      WorkKey.KeyData[0] := Chr(30);
      Write(Randoms,WorkKey);
    END;
  Close(Randoms)
END;


PROCEDURE DisplayKeys;

VAR WorkKey : KeyRec;

BEGIN
  Assign(Randoms,'RANDOMS.KEY');
  Reset(Randoms);
  Window(25,13,70,22);
  GotoXY(1,1);
  WHILE NOT EOF(Randoms) DO
    BEGIN
      Read(Randoms,WorkKey);
      IF NOT EOF(Randoms) THEN Writeln(WorkKey.KeyData)
    END;
  Close(Randoms);
  Writeln;
  Writeln('        >>Press (CR)<<');
  Readln;
  ClrScr;
  Window(1,1,80,25)
END;



PROCEDURE DoSort(Shell : Boolean);

VAR Counter : Integer;

BEGIN
  Assign(Randoms,'RANDOMS.KEY');
  Reset(Randoms);
  Counter := 1;
  WriteAt(20,15,NoHighlite,NoCR,'Loading...');
  WHILE NOT EOF(Randoms) DO
    BEGIN
      Read(Randoms,WorkArray[Counter]);
      Counter := Succ(Counter)
    END;
  Close(Randoms);
  Write('...sorting...');
  IF Shell THEN ShellSort(WorkArray,Counter-1)
    ELSE QuickSort(WorkArray,Counter-1);
  Write('...writing...');
  Rewrite(Randoms);
  FOR I := 1 TO Counter-1 DO Write(Randoms,WorkArray[I]);
  Close(Randoms);
  Writeln('...done!');
  WriteAt(-1,21,NoHighlite,NoCR,'>>Press (CR)<<');
  Readln;
  ClearRegion(2,15,77,22)
END;



BEGIN
  ClrScr;
  CursorOff;
  DefineChars(GrafChars);
  MakeBox(1,1,80,24,GrafChars);
  WriteAt(24,3,HighLite,NoCR,'THE COMPLETE TURBO PASCAL SORT DEMO');
  REPEAT
    WriteAt(25,5,NoHighlite,NoCR,'[1] Generate file of random keys');
    WriteAt(25,6,NoHighlite,NoCR,'[2] Display file of random keys');
    WriteAt(25,7,NoHighlite,NoCR,'[3] Sort file via Shell sort');
    WriteAt(25,8,NoHighlite,NoCR,'[4] Sort file via Quicksort');
    WriteAt(30,10,NoHighlite,NoCR,'Enter 1-4: ');
    Response := ''; IVal := 0;
    GetString(46,10,Response,2,CapsLock,Numeric,GetInteger,
              R,IVal,Error,Escape);
    CASE IVal OF
      0 :;
      1 : GenerateRandomKeyFile(250);
      2 : DisplayKeys;
      3 : DoSort(Shell);
      4 : DoSort(Quick);
      ELSE
    END; {CASE}
  UNTIL (IVal = 0) OR Escape;
  CursorOn
END.