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 / ENTERPRS / CPM / UTILS / S / TPASPGM.ARC / SORTTEXT.PAS < prev    next >
Pascal/Delphi Source File  |  1989-09-27  |  4KB  |  126 lines
  1. PROGRAM SORTTEXT ;
  2.   { This program sorts a text file.  Each sort element must be
  3.     a standard text file line, ending with a carriage-return
  4.     and line-feed.  Maximum line length is 80, including the
  5.     <cr> & <lf>.  Maximum number of lines is set by MAXLINES.
  6.  
  7.     WPM -- 7/31/84 }
  8.  
  9. {$V- Turn off strict type checking for string length }
  10.  
  11. CONST
  12.     MAXLINES = 499 ;
  13.  
  14. TYPE
  15.     STR80 = STRING[80] ;
  16.     FILENAME = STRING[14] ;
  17.     LINE_ARRAY = ARRAY[0 .. MAXLINES] OF STR80 ;
  18.  
  19. VAR
  20.     IPT_NAME  : FILENAME ;
  21.     OUT_NAME  : FILENAME ;
  22.     IPT_FILE  : TEXT ;
  23.     OUT_FILE  : TEXT ;
  24.     LINES     : LINE_ARRAY ;
  25.     N         : INTEGER ;
  26.     NUM_LINES : INTEGER ;
  27.  
  28. { ------------------------------------------------------------------ }
  29.  
  30. PROCEDURE SORT_EM ;
  31.   { Sort the array using Shell sort }
  32.     VAR
  33.         D      : INTEGER ;      { Distance between elements }
  34.         N,M    : INTEGER ;
  35.         SORTED : BOOLEAN ;
  36.         SWAP   : STR80 ;
  37.     BEGIN
  38.         WRITELN ('Sorting') ;
  39.         D := NUM_LINES DIV 2 ;
  40.         WHILE D > 0 DO
  41.             BEGIN
  42.                 WRITE ('+') ;   { To show something happening }
  43.                 REPEAT
  44.                         SORTED := TRUE ;
  45.                         FOR N := 0 TO NUM_LINES - D DO
  46.                             BEGIN
  47.                                 M := N + D ;
  48.                                 IF LINES[N] > LINES[M] THEN
  49.                                     BEGIN
  50.                                         SWAP := LINES[M] ;
  51.                                         LINES[M] := LINES[N] ;
  52.                                         LINES[N] := SWAP ;
  53.                                         SORTED := FALSE
  54.                                     END
  55.                             END
  56.                 UNTIL SORTED ;
  57.                 D := D DIV 2
  58.             END ; { WHILE }
  59.             WRITELN ;
  60.     END ; { --- Procedure SORT_EM --- }
  61.  
  62. BEGIN  { --- MAIN -------------------------------------------------- }
  63.     WRITELN ;
  64.     WRITELN ('This program sorts a text file.') ;
  65.     WRITELN ;
  66.     WRITE  (' Input file? (d:filename.ext) ') ;
  67.     READLN (IPT_NAME) ;
  68.     WRITE  ('Output file? (d:filename.ext) ') ;
  69.     READLN (OUT_NAME) ;
  70.     IF IPT_NAME = OUT_NAME THEN
  71.         BEGIN
  72.             WRITELN ('Must be different file names.', CHR(7)) ;
  73.             HALT
  74.         END ;
  75.     ASSIGN  (IPT_FILE, IPT_NAME) ;
  76.     ASSIGN  (OUT_FILE, OUT_NAME) ;
  77.     {$I-}                              { Turn off auto I/O check }
  78.     RESET   (IPT_FILE) ;
  79.     IF NOT (IORESULT = 0) THEN
  80.         BEGIN
  81.             WRITELN (' Can''t find file ',IPT_NAME, CHR(7)) ;
  82.             HALT
  83.         END ;
  84.     REWRITE (OUT_FILE) ;
  85.     IF NOT (IORESULT = 0) THEN
  86.         BEGIN
  87.             WRITELN ('Can''t create file ',OUT_NAME) ;
  88.             WRITELN ('Maybe the directory is full.', CHR(7)) ;
  89.             HALT
  90.         END ;
  91.     {$I+}                              { Turn it back on }
  92.     N := 0 ;
  93.     WHILE NOT(EOF(IPT_FILE)) DO
  94.         BEGIN
  95.             READLN (IPT_FILE, LINES[N]) ;
  96.             IF NOT (LINES[N] = '') THEN
  97.                     N := N + 1 ;
  98.             IF N > MAXLINES THEN
  99.                 BEGIN
  100.                     WRITELN ('Too many lines in input file -- max is ',MAXLINES + 1) ;
  101.                     HALT ;
  102.                 END
  103.         END ;
  104.     NUM_LINES := N - 1 ;
  105.     SORT_EM ;
  106.     {$I-}                              { Turn off auto I/O check }
  107.     FOR N := 0 TO NUM_LINES DO
  108.         BEGIN
  109.             WRITELN (OUT_FILE, LINES[N]) ;
  110.             IF NOT (IORESULT = 0) THEN
  111.                 BEGIN
  112.                     WRITELN ('Can''t write file ', OUT_NAME) ;
  113.                     WRITELN ('Maybe the disk is full.', CHR(7)) ;
  114.                     HALT
  115.                 END
  116.         END ;
  117.     {$I+}                              { Turn it back on }
  118.     CLOSE (IPT_FILE) ;
  119.     CLOSE (OUT_FILE) ;
  120.     WRITELN ('Done!', CHR(7))
  121. END.
  122.             { Turn it back on }
  123.     N := 0 ;
  124.     WHILE NOT(EOF(IPT_FILE)) DO
  125.         BEGIN
  126.             READLN (IPT_F