home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
MADTRB21.ZIP
/
SORTTEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-08-15
|
4KB
|
165 lines
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.