Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/MURUTIL.ZIP/SORT80.PAS

Pascal/Delphi Source File | 1986-12-10 | 6.1 KB | 260 lines

PROGRAM SORT80;

{  This Turbo Pascal program sorts an input file of up to 6000
   80-character records and writes a sorted output file.

   Note:  The maximum number of input records is declared in
          MAXNINP.   The value of 6000 is appropriate for  a
          computer with 640 Kilobytes.   For computers  with
          smaller memory, this figure should be reduced.

   Program by Harry M. Murphy,  18 August 1986.
   Revised by H.M.M. on 21 Oct 1986 to check for record overflow.
   Revised by H.M.M. on 29 Oct 1986 to simplify the pointers and
   to trim possible trailing blanks.

                                NOTICE

       Copyright 1986, Harry M. Murphy.

       A general license is hereby  granted  for  non-commercial
       use,  copying and free exchange of this  program  without
       payment of any royalties,  provided that  this  copyright
       notice is not altered nor deleted.   All other rights are
       reserved.  }


  CONST
        LENSPEC = 65;
        LINELEN = 80;
        MAXNINP = 6000;

  TYPE
       FILESPEC = STRING[LENSPEC];
       TEXTLINE = STRING[LINELEN];
       LINEP    = ^TEXTLINE;

  VAR
      FREE0  : REAL;
      FREE1  : REAL;
      FREE   : REAL;
      INP    : TEXT[2048];
      INPNAME: FILESPEC;
      NINP   : INTEGER;
      OUT    : TEXT[2048];
      OUTNAME: FILESPEC;
      LINPA  : ARRAY [1..MAXNINP] OF LINEP;


PROCEDURE GETINPFIL(VAR INPNAME: FILESPEC);

{  This file gets an input file, either as the first parameter
   on the command line or by requesting it from the user.

   Procedure by Harry M. Murphy,  22 February 1986.  }

  VAR
      L: INTEGER;

  BEGIN
    IF PARAMCOUNT = 0
      THEN
        BEGIN
          WRITE('Input  file: ');
          READLN(INPNAME)
        END
      ELSE
        INPNAME := PARAMSTR(1);
    FOR L:=1 TO LENGTH(INPNAME) DO INPNAME[L] := UPCASE(INPNAME[L]);
    ASSIGN(INP,INPNAME);
    {$I-} RESET(INP); {$I+}
    IF IORESULT <> 0
      THEN
        BEGIN
          CLOSE(INP);
          WRITELN('ERROR!  Can''t find file ',INPNAME,'!');
          HALT
        END;
  END {Procedure GETINPFIL};


PROCEDURE GETOUTFIL(VAR OUTNAME: FILESPEC);

{  This file gets an output file, either as the second parameter
   on the command line or by requesting it from the user.

   Procedure by Harry M. Murphy,  22 February 1986.  }

 VAR
     L: INTEGER;

  BEGIN
    IF PARAMCOUNT < 2
      THEN
        BEGIN
          WRITE('Output file: ');
          READLN(OUTNAME)
        END
      ELSE
        OUTNAME := PARAMSTR(2);
    FOR L:=1 TO LENGTH(OUTNAME) DO OUTNAME[L] := UPCASE(OUTNAME[L]);
    ASSIGN(OUT,OUTNAME);
    {$I-} REWRITE(OUT); {$I-}
    IF IORESULT <> 0
      THEN
        BEGIN
          CLOSE(OUT);
          WRITELN('ERROR!  Can''t open ',OUTNAME,'!');
          HALT
        END
  END {Procedure GETOUTFIL};


FUNCTION KBYTFREE: REAL;

{  This Turbo Pascal function returns the size of the largest
   consecutive block of free space, in Kilobytes, on the heap
   as a REAL number.

   Function by Harry M. Murphy,  18 August 1986.  }

  CONST
        CON = 0.016;  {Kilobytes per "paragraph" of 16 bytes.}

  VAR
      MAXA : INTEGER;

  BEGIN
    MAXA := MAXAVAIL;
    IF MAXA < 0
      THEN
        KBYTFREE := CON*(65536.0+MAXA)
      ELSE
        KBYTFREE := CON*MAXA
  END {Function KBYTFREE};


  PROCEDURE GETTEXT;

  {  This routine reads the input file, updates the pointer array,
     LINPA and stores the input records in LINE^. }

  VAR
      L    : 0..LINELEN;
      LINE : LINEP;

  BEGIN
    NINP := 0;
    LINE := NIL;
    WHILE (NOT EOF(INP)) AND (KBYTFREE > 10.0) DO
      BEGIN
        NINP:=NINP+1;
        IF NINP <= MAXNINP
          THEN
            BEGIN
              NEW(LINE);
              LINPA[NINP] := LINE
            END;
          READLN(INP,LINE^);
          L := LENGTH(LINE^);
          LINE^[0] := CHR(0);
          WHILE LINE^[L] = ' ' DO
            BEGIN
              L := L-1;
              LINE^[0] := CHR(L)
            END
      END
  END {Procedure GETTEXT};


  PROCEDURE PUTTEXT;

   {  This procedure writes the sorted output file. }

  VAR
      I    : INTEGER;
      LINE : LINEP;

  BEGIN
    FOR I:=1 TO NINP DO
      BEGIN
         LINE := LINPA[I];
         WRITELN(OUT,LINE^)
      END
  END {Procedure PUTTEXT};


  PROCEDURE SRTTEXT;

  {  This procedure sorts the data, using a Shell pointer sort. }

  VAR
      I   : INTEGER;
      J   : INTEGER;
      M   : INTEGER;
      SRT : BOOLEAN;
      SWAP: LINEP;

  BEGIN
    I := 1;
    WHILE I <= NINP DO I := I+I;
    M := I-1;
    WHILE M > 1 DO
      BEGIN
        M := M DIV 2;
        REPEAT
          SRT := TRUE;
          FOR J:=1 TO NINP-M DO
            BEGIN
              I := J+M;
              IF LINPA[J]^ > LINPA[I]^
                THEN
                  BEGIN
                    SWAP := LINPA[I];
                    LINPA[I] := LINPA[J];
                    LINPA[J] := SWAP;
                    SRT := FALSE
                  END
            END
        UNTIL SRT
      END
  END {Procedure SRTTEXT};


  BEGIN {Program SORT80}
    LOWVIDEO;
    GETINPFIL(INPNAME);
    GETOUTFIL(OUTNAME);
    WRITELN;
    WRITELN('SORT80 sorting ',INPNAME,' ==> ',OUTNAME,':');
    WRITELN;
    FREE0 := KBYTFREE;
    GETTEXT;
    CLOSE(INP);
    FREE1 := KBYTFREE;
    FREE := FREE0-FREE1;
    WRITELN(NINP:8,' records read from ',INPNAME,'.');
    IF NINP > MAXNINP
      THEN
        BEGIN
          NORMVIDEO;
          WRITELN('This exceeds the maximum of',MAXNINP:6,' records.');
          WRITELN('This run is aborted.');
          LOWVIDEO;
          CLOSE(OUT);
          ERASE(OUT)
        END
      ELSE
        BEGIN
          WRITELN(FREE:8:3,' Kilobytes used.');
          WRITELN(FREE1:8:3,' Kilobytes free.');
          WRITE(' Sorting the records now.',CHR(13));
          SRTTEXT;
          WRITELN(' Writing',NINP:6,' records to ',OUTNAME,'.');
          PUTTEXT;
          CLOSE(OUT);
          WRITELN;
          WRITELN('SORT80 is done.')
        END
END.