home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / TP-UTIL.ARK / SORTTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1986-01-06  |  4KB  |  165 lines
  1.  
  2. PROGRAM SORTTEST;
  3.  
  4.  
  5. CONST HIGHLITE    = TRUE;
  6.       CR          = TRUE;
  7.       NO_HIGHLITE = FALSE;
  8.       NO_CR       = FALSE;
  9.       GET_INTEGER = FALSE;
  10.       NUMERIC     = TRUE;
  11.       CAPSLOCK    = TRUE;
  12.       SHELL       = TRUE;
  13.       QUICK       = FALSE;
  14.  
  15.  
  16. TYPE STRING255 = STRING[255];
  17.      STRING80  = STRING[80];
  18.      STRING30  = STRING[30];
  19.  
  20.      KEYREC = RECORD
  21.                 REF : INTEGER;
  22.                 KEY : STRING30
  23.               END;
  24.  
  25.      KEYARRAY = ARRAY[0..500] OF KEYREC;
  26.  
  27.      KEYFILE = FILE OF KEYREC;
  28.  
  29.  
  30. VAR I,J,ERROR : INTEGER;
  31.     IVAL      : INTEGER;
  32.     R         : REAL;
  33.     CH        : CHAR;
  34.     RESPONSE  : STRING80;
  35.     ESCAPE    : BOOLEAN;
  36.     WORKARRAY : KEYARRAY;
  37.     RANDOMS   : KEYFILE;
  38.  
  39.  
  40. {$I BEEP.SRC}       { "Deedle-deedle" beeper procedure }
  41. {$I MONOTEST.SRC}   { Test for presence of monochrome display }
  42. {$I CURSON.SRC}     { Turns IBM PC text cursor back on again }
  43. {$I CURSOFF.SRC}    { Turns off IBM PC text cursor }
  44. {$I KEYSTAT.PC}     { KEYSTAT non-echo keyboard input function }
  45. {$I YES.SRC }       { YES function }
  46. {$I WRITEAT.SRC}    { WRITE_AT function for X/Y string display }
  47. {$I BOXSTUFF.SRC}   { MAKE_BOX procedure and associated definitions }
  48. {$I DISKFREE.SRC}   { FREE_BYTES function }
  49. {$I GETSTRIN.SRC}   { GET_STRING formatted string input procedure }
  50. {$I SHELSORT.SRC}   { Shell sort routine }
  51. {$I QUIKSORT.SRC}   { Quicksort routine }
  52. {$I PULL.SRC }      { PULL random number within a given range function }
  53.  
  54.  
  55. PROCEDURE CLEAR_REGION(X1,Y1,X2,Y2 : INTEGER);
  56.  
  57. BEGIN
  58.   WINDOW(X1,Y1,X2,Y2);
  59.   CLRSCR;
  60.   WINDOW(1,1,80,25)
  61. END;
  62.  
  63.  
  64. PROCEDURE GENERATE_RANDOM_KEYFILE(KEY_QUANTITY : INTEGER);
  65.  
  66. VAR WORKKEY : KEYREC;
  67.     SPACE   : REAL;
  68.     I,J     : INTEGER;
  69.  
  70. BEGIN
  71.   ASSIGN(RANDOMS,'RANDOMS.KEY');
  72.   REWRITE(RANDOMS);
  73.   FOR I := 1 TO KEY_QUANTITY DO
  74.     BEGIN
  75.       FILLCHAR(WORKKEY,SIZEOF(WORKKEY),0);
  76.       FOR J := 1 TO SIZEOF(WORKKEY.KEY)-1 DO
  77.         WORKKEY.KEY[J] := CHR(PULL(65,91));
  78.       WORKKEY.KEY[0] := CHR(30);
  79.       WRITE(RANDOMS,WORKKEY);
  80.     END;
  81.   CLOSE(RANDOMS)
  82. END;
  83.  
  84.  
  85. PROCEDURE DISPLAY_KEYS;
  86.  
  87. VAR WORKKEY : KEYREC;
  88.  
  89. BEGIN
  90.   ASSIGN(RANDOMS,'RANDOMS.KEY');
  91.   RESET(RANDOMS);
  92.   WINDOW(25,13,70,22);
  93.   GOTOXY(1,1);
  94.   WHILE NOT EOF(RANDOMS) DO
  95.     BEGIN
  96.       READ(RANDOMS,WORKKEY);
  97.       WRITELN(WORKKEY.KEY)
  98.     END;
  99.   CLOSE(RANDOMS);
  100.   WRITELN;
  101.   WRITELN('        >>Press (CR)<<');
  102.   READLN;
  103.   CLRSCR;
  104.   WINDOW(1,1,80,25)
  105. END;
  106.  
  107.  
  108.  
  109. PROCEDURE DO_SORT(SHELL : BOOLEAN);
  110.  
  111. VAR COUNTER : INTEGER;
  112.  
  113. BEGIN
  114.   ASSIGN(RANDOMS,'RANDOMS.KEY');
  115.   RESET(RANDOMS);
  116.   COUNTER := 1;
  117.   WRITE_AT(20,15,NO_HIGHLITE,NO_CR,'Loading...');
  118.   WHILE NOT EOF(RANDOMS) DO
  119.     BEGIN
  120.       READ(RANDOMS,WORKARRAY[COUNTER]);
  121.       COUNTER := SUCC(COUNTER)
  122.     END;
  123.   CLOSE(RANDOMS);
  124.   WRITE('...sorting...');
  125.   IF SHELL THEN SHELLSORT(WORKARRAY,COUNTER)
  126.     ELSE QUIKSORT(WORKARRAY,COUNTER);
  127.   WRITE('...writing...');
  128.   REWRITE(RANDOMS);
  129.   FOR I := 1 TO COUNTER DO WRITE(RANDOMS,WORKARRAY[I]);
  130.   CLOSE(RANDOMS);
  131.   WRITELN('...done!');
  132.   WRITE_AT(-1,21,NO_HIGHLITE,NO_CR,'>>Press (CR)<<');
  133.   READLN;
  134.   CLEAR_REGION(2,15,77,22)
  135. END;
  136.  
  137.  
  138.  
  139. BEGIN
  140.   CLRSCR;
  141.   CURSOR_OFF;
  142.   DEFINE_CHARS(GRAFCHARS);
  143.   MAKE_BOX(1,1,80,24,GRAFCHARS);
  144.   WRITE_AT(24,3,HIGHLITE,NO_CR,'THE COMPLETE TURBO PASCAL SORT DEMO');
  145.   REPEAT
  146.     WRITE_AT(25,5,NO_HIGHLITE,NO_CR,'[1] Generate file of random keys');
  147.     WRITE_AT(25,6,NO_HIGHLITE,NO_CR,'[2] Display file of random keys');
  148.     WRITE_AT(25,7,NO_HIGHLITE,NO_CR,'[3] Sort file via Shell sort');
  149.     WRITE_AT(25,8,NO_HIGHLITE,NO_CR,'[4] Sort file via Quicksort');
  150.     WRITE_AT(30,10,NO_HIGHLITE,NO_CR,'Enter 1-4: ');
  151.     RESPONSE := ''; IVAL := 0;
  152.     GETSTRING(46,10,RESPONSE,2,CAPSLOCK,NUMERIC,GET_INTEGER,
  153.               R,IVAL,ERROR,ESCAPE);
  154.     CASE IVAL OF
  155.       0 :;
  156.       1 : GENERATE_RANDOM_KEYFILE(250);
  157.       2 : DISPLAY_KEYS;
  158.       3 : DO_SORT(SHELL);
  159.       4 : DO_SORT(QUICK);
  160.       ELSE
  161.     END; {CASE}
  162.   UNTIL (IVAL = 0) OR ESCAPE;
  163.   CURSOR_ON
  164. END.
  165.