home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol131 / tstqsort.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  1.6 KB  |  79 lines
  1. PROGRAM tstqsort;
  2. CONST
  3.   Max_N     = 5000;
  4.   control_c    = false;
  5. TYPE
  6.   index     = 0..Max_N;
  7.   Scalar     = REAL;
  8.   real_array    = ARRAY[index] OF scalar;
  9.   str8        = STRING 8;
  10. VAR
  11.   timestring    : str8;
  12.   answer    : char;
  13.   N,
  14.   i, ix        : INTEGER;
  15.   A        : real_array;
  16. Procedure readq(VAR a:char);external;
  17. Procedure time(VAR t:str8 );external;
  18. Procedure Show;
  19. var
  20.   i: index;
  21. begin
  22.   for i:=1 to N do
  23.     begin
  24.       write(A[i]:8:0);
  25.       if i mod 8 = 0 then writeln;
  26.     end;
  27.   writeln;
  28. end;
  29.  
  30. {$IB:QQSORTR.PAS }
  31.  
  32. BEGIN (* MAIN *)
  33. timestring := '  :  :  ';
  34.  REPEAT { until control_c }
  35.   repeat
  36.     writeln;
  37.     writeln('Enter number of items to sort');
  38.     writeln(' 10 <= n <= 10,000');
  39.     write('?');
  40.     readln(N);
  41.   until (N >= 10) and (N <= Max_N);
  42.  
  43.   writeln;
  44.   writeln('Please stand by while I set up.');
  45.   {$C-,M-,F- [ctrl-c OFF]}
  46.   ix := 113;
  47.   FOR i := 1 TO N DO
  48.     BEGIN
  49.       ix := (131*ix+1) mod 221;
  50.       A[i] := 1.0 * ix;
  51.       if (i mod 1000 = 0) then write(i);
  52.     END;
  53.   writeln;
  54.   A[0] := 1.0 *( -maxint);            {$C+,M+,F+ [ctrl-c ON]}
  55.   write('random array filled : do you want to see the unsorted version?');
  56.   readq(answer);
  57.   writeln;
  58.   IF answer IN ['y','Y'] then show;
  59.   writeln;
  60.   WRITE('Press return when ready to start');
  61.   readq(answer);
  62.   writeln;
  63.   write( CHR(7), 'START @ ');
  64.   time(timestring);
  65.   write(timestring,' ');
  66.   IF qqsort_real(A,1,N) THEN 
  67.    BEGIN
  68.     time(timestring);
  69.     writeln( CHR(7), 'DONE @ ' ,timestring);
  70.     writeln
  71.    END;
  72.   write('Print the array (Y/N)?');
  73.   readq(answer);
  74.   writeln;
  75.   If (answer='Y') or (answer='y') then Show;
  76.   readq(answer);
  77.  UNTIL control_c;
  78. END.
  79.