PROGRAM SORTTEST;


CONST HIGHLITE    = TRUE;
      CR          = TRUE;
      NO_HIGHLITE = FALSE;
      NO_CR       = FALSE;
      GET_INTEGER = FALSE;
      NUMERIC     = TRUE;
      CAPSLOCK    = TRUE;
      SHELL       = TRUE;
      QUICK       = FALSE;


TYPE STRING255 = STRING[255];
     STRING80  = STRING[80];
     STRING30  = STRING[30];

     KEYREC = RECORD
                REF : INTEGER;
                KEY : STRING30
              END;

     KEYARRAY = ARRAY[0..500] OF KEYREC;

     KEYFILE = FILE OF KEYREC;


VAR I,J,ERROR : INTEGER;
    IVAL      : INTEGER;
    R         : REAL;
    CH        : CHAR;
    RESPONSE  : STRING80;
    ESCAPE    : BOOLEAN;
    WORKARRAY : KEYARRAY;
    RANDOMS   : KEYFILE;


{$I BEEP.SRC}       { "Deedle-deedle" beeper procedure }
{$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.PC}     { KEYSTAT non-echo keyboard input function }
{$I YES.SRC }       { YES function }
{$I WRITEAT.SRC}    { WRITE_AT function for X/Y string display }
{$I BOXSTUFF.SRC}   { MAKE_BOX procedure and associated definitions }
{$I DISKFREE.SRC}   { FREE_BYTES function }
{$I GETSTRIN.SRC}   { GET_STRING 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 CLEAR_REGION(X1,Y1,X2,Y2 : INTEGER);

BEGIN
  WINDOW(X1,Y1,X2,Y2);
  CLRSCR;
  WINDOW(1,1,80,25)
END;


PROCEDURE GENERATE_RANDOM_KEYFILE(KEY_QUANTITY : INTEGER);

VAR WORKKEY : KEYREC;
    SPACE   : REAL;
    I,J     : INTEGER;

BEGIN
  ASSIGN(RANDOMS,'RANDOMS.KEY');
  REWRITE(RANDOMS);
  FOR I := 1 TO KEY_QUANTITY DO
    BEGIN
      FILLCHAR(WORKKEY,SIZEOF(WORKKEY),0);
      FOR J := 1 TO SIZEOF(WORKKEY.KEY)-1 DO
        WORKKEY.KEY[J] := CHR(PULL(65,91));
      WORKKEY.KEY[0] := CHR(30);
      WRITE(RANDOMS,WORKKEY);
    END;
  CLOSE(RANDOMS)
END;


PROCEDURE DISPLAY_KEYS;

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);
      WRITELN(WORKKEY.KEY)
    END;
  CLOSE(RANDOMS);
  WRITELN;
  WRITELN('        >>Press (CR)<<');
  READLN;
  CLRSCR;
  WINDOW(1,1,80,25)
END;



PROCEDURE DO_SORT(SHELL : BOOLEAN);

VAR COUNTER : INTEGER;

BEGIN
  ASSIGN(RANDOMS,'RANDOMS.KEY');
  RESET(RANDOMS);
  COUNTER := 1;
  WRITE_AT(20,15,NO_HIGHLITE,NO_CR,'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)
    ELSE QUIKSORT(WORKARRAY,COUNTER);
  WRITE('...writing...');
  REWRITE(RANDOMS);
  FOR I := 1 TO COUNTER DO WRITE(RANDOMS,WORKARRAY[I]);
  CLOSE(RANDOMS);
  WRITELN('...done!');
  WRITE_AT(-1,21,NO_HIGHLITE,NO_CR,'>>Press (CR)<<');
  READLN;
  CLEAR_REGION(2,15,77,22)
END;



BEGIN
  CLRSCR;
  CURSOR_OFF;
  DEFINE_CHARS(GRAFCHARS);
  MAKE_BOX(1,1,80,24,GRAFCHARS);
  WRITE_AT(24,3,HIGHLITE,NO_CR,'THE COMPLETE TURBO PASCAL SORT DEMO');
  REPEAT
    WRITE_AT(25,5,NO_HIGHLITE,NO_CR,'[1] Generate file of random keys');
    WRITE_AT(25,6,NO_HIGHLITE,NO_CR,'[2] Display file of random keys');
    WRITE_AT(25,7,NO_HIGHLITE,NO_CR,'[3] Sort file via Shell sort');
    WRITE_AT(25,8,NO_HIGHLITE,NO_CR,'[4] Sort file via Quicksort');
    WRITE_AT(30,10,NO_HIGHLITE,NO_CR,'Enter 1-4: ');
    RESPONSE := ''; IVAL := 0;
    GETSTRING(46,10,RESPONSE,2,CAPSLOCK,NUMERIC,GET_INTEGER,
              R,IVAL,ERROR,ESCAPE);
    CASE IVAL OF
      0 :;
      1 : GENERATE_RANDOM_KEYFILE(250);
      2 : DISPLAY_KEYS;
      3 : DO_SORT(SHELL);
      4 : DO_SORT(QUICK);
      ELSE
    END; {CASE}
  UNTIL (IVAL = 0) OR ESCAPE;
  CURSOR_ON
END.