home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CMPLTPAS.ZIP / SORTTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-07-14  |  4.4 KB  |  169 lines
  1. {--------------------------------------------------------------}
  2. {                          SortTest                            }
  3. {                                                              }
  4. {               Data sort demonstration program                }
  5. {                                                              }
  6. {                             by Jeff Duntemann                }
  7. {                             Turbo Pascal V5.0                }
  8. {                             Last update 7/14/88              }
  9. {                                                              }
  10. {     From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann       }
  11. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  12. {--------------------------------------------------------------}
  13.  
  14. PROGRAM Sorttest;
  15.  
  16. USES CRT,DOS,BoxStuff;
  17.  
  18. CONST
  19.   HighLite   = True;
  20.   CR         = True;
  21.   NoHighlite = False;
  22.   NoCR       = False;
  23.   GetInteger = False;
  24.   Numeric    = True;
  25.   CapsLock   = True;
  26.   Shell      = True;
  27.   Quick      = False;
  28.  
  29.  
  30. TYPE
  31.   String255 = String[255];
  32.   String80  = String[80];
  33.   String30  = String[30];
  34.  
  35.   KeyRec = RECORD
  36.              Ref     : Integer;
  37.              KeyData : String30
  38.            END;
  39.  
  40.   KeyArray = ARRAY[0..500] OF KeyRec;
  41.  
  42.   KeyFile = FILE OF KeyRec;
  43.  
  44.  
  45. VAR
  46.   I,J,Error : Integer;
  47.   IVAL      : Integer;
  48.   R         : Real;
  49.   Ch        : Char;
  50.   Response  : String80;
  51.   Escape    : Boolean;
  52.   WorkArray : KeyArray;
  53.   Randoms   : KeyFile;
  54.  
  55.  
  56. {$I BEEP.SRC}       { Described in Section 16.13 }
  57. {$I UHUH.SRC}       { Described in Section 16.13 }
  58. {$I PULL.SRC }      { Described in Section 16.12 }
  59. {$I CLREGION.SRC}   { Described in Section 18.1 }
  60. {$I CURSON.SRC}     { Described in Section 18.4 }
  61. {$I CURSOFF.SRC}    { Described in Section 18.4 }
  62. {$I YES.SRC }       { Described in Section 18.3 }
  63. {$I WRITEAT.SRC}    { Described in Section 18.3 }
  64. {$I GETSTRIN.SRC}   { Described in Section 15.2 }
  65. {$I SHELSORT.SRC}   { Described in Section 14.2 }
  66. {$I QUIKSORT.SRC}   { Described in Section 14.4 }
  67.  
  68.  
  69.  
  70. PROCEDURE GenerateRandomKeyFile(KeyQuantity : Integer);
  71.  
  72. VAR WorkKey : KeyRec;
  73.     I,J     : Integer;
  74.  
  75. BEGIN
  76.   Assign(Randoms,'RANDOMS.KEY');
  77.   Rewrite(Randoms);
  78.   FOR I := 1 TO KeyQuantity DO
  79.     BEGIN
  80.       FillChar(WorkKey,SizeOf(WorkKey),0);
  81.       FOR J := 1 TO SizeOf(WorkKey.KeyData)-1 DO
  82.         WorkKey.KeyData[J] := Chr(Pull(65,91));
  83.       WorkKey.KeyData[0] := Chr(30);
  84.       Write(Randoms,WorkKey);
  85.     END;
  86.   Close(Randoms)
  87. END;
  88.  
  89.  
  90. PROCEDURE DisplayKeys;
  91.  
  92. VAR WorkKey : KeyRec;
  93.  
  94. BEGIN
  95.   Assign(Randoms,'RANDOMS.KEY');
  96.   Reset(Randoms);
  97.   Window(25,13,70,22);
  98.   GotoXY(1,1);
  99.   WHILE NOT EOF(Randoms) DO
  100.     BEGIN
  101.       Read(Randoms,WorkKey);
  102.       IF NOT EOF(Randoms) THEN Writeln(WorkKey.KeyData)
  103.     END;
  104.   Close(Randoms);
  105.   Writeln;
  106.   Writeln('        >>Press (CR)<<');
  107.   Readln;
  108.   ClrScr;
  109.   Window(1,1,80,25)
  110. END;
  111.  
  112.  
  113.  
  114. PROCEDURE DoSort(Shell : Boolean);
  115.  
  116. VAR Counter : Integer;
  117.  
  118. BEGIN
  119.   Assign(Randoms,'RANDOMS.KEY');
  120.   Reset(Randoms);
  121.   Counter := 1;
  122.   WriteAt(20,15,NoHighlite,NoCR,'Loading...');
  123.   WHILE NOT EOF(Randoms) DO
  124.     BEGIN
  125.       Read(Randoms,WorkArray[Counter]);
  126.       Counter := Succ(Counter)
  127.     END;
  128.   Close(Randoms);
  129.   Write('...sorting...');
  130.   IF Shell THEN ShellSort(WorkArray,Counter-1)
  131.     ELSE QuickSort(WorkArray,Counter-1);
  132.   Write('...writing...');
  133.   Rewrite(Randoms);
  134.   FOR I := 1 TO Counter-1 DO Write(Randoms,WorkArray[I]);
  135.   Close(Randoms);
  136.   Writeln('...done!');
  137.   WriteAt(-1,21,NoHighlite,NoCR,'>>Press (CR)<<');
  138.   Readln;
  139.   ClearRegion(2,15,77,22)
  140. END;
  141.  
  142.  
  143.  
  144. BEGIN
  145.   ClrScr;
  146.   CursorOff;
  147.   MakeBox(1,1,80,24,GrafChars);
  148.   WriteAt(24,3,HighLite,NoCR,'THE COMPLETE TURBO PASCAL SORT DEMO');
  149.   REPEAT
  150.     WriteAt(25,5,NoHighlite,NoCR,'[1] Generate file of random keys');
  151.     WriteAt(25,6,NoHighlite,NoCR,'[2] Display file of random keys');
  152.     WriteAt(25,7,NoHighlite,NoCR,'[3] Sort file via Shell sort');
  153.     WriteAt(25,8,NoHighlite,NoCR,'[4] Sort file via Quicksort');
  154.     WriteAt(30,10,NoHighlite,NoCR,'Enter 1-4: ');
  155.     Response := ''; IVal := 0;
  156.     GetString(46,10,Response,2,CapsLock,Numeric,GetInteger,
  157.               R,IVal,Error,Escape);
  158.     CASE IVal OF
  159.       0 :;
  160.       1 : GenerateRandomKeyFile(250);
  161.       2 : DisplayKeys;
  162.       3 : DoSort(Shell);
  163.       4 : DoSort(Quick);
  164.       ELSE
  165.     END; {CASE}
  166.   UNTIL (IVal = 0) OR Escape;
  167.   CursorOn
  168. END.
  169.