home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug027.arc / SORT.INC < prev    next >
Text File  |  1979-12-31  |  2KB  |  85 lines
  1. overlay PROCEDURE sort_file;
  2. CONST
  3.   Max_N = 1000;
  4. TYPE
  5.   Animal_sort = RECORD
  6.                   rec_no         : INTEGER;
  7.                   Ear_No         : str5;
  8.                 END;
  9.   arraytype   = ARRAY[1..Max_N] OF Animal_sort;
  10.  
  11. VAR
  12.   Ch            : CHAR;
  13.   k,i           : INTEGER;
  14.   Old_File,
  15.   New_File,
  16.   test          : FILE OF Animal_rec;
  17.   x             : arraytype;
  18.   Animal        : Animal_rec;
  19.   found         : BOOLEAN;
  20.   ear           : str5;
  21.   ptr           : INTEGER;
  22.  
  23.  
  24. PROCEDURE bubble(VAR x : arraytype);
  25. VAR
  26.   pass,n,j : INTEGER;
  27.   intchange : BOOLEAN;
  28.   hold     : Animal_sort;
  29. BEGIN
  30.   intchange := TRUE;
  31.   pass := 1;
  32.   n := filesize(Old_File);
  33.   WHILE (pass <= n-1) AND (intchange) DO
  34.     BEGIN
  35.       intchange := FALSE;
  36.       FOR j := 1 TO n - pass DO
  37.         IF x[j].ear_no > x[j+1].ear_no THEN
  38.             BEGIN
  39.               intchange := TRUE;
  40.               hold      := x[j];
  41.               x[j]      := x[j+1];
  42.               x[j+1]    := hold;
  43.             END;
  44.       pass := pass + 1;
  45.     END;
  46. END;
  47.  
  48. BEGIN (* MAIN *)
  49.   ASSIGN(old_file,InFileName +'.DAT');
  50.   ASSIGN(new_file,'SORTED.DAT');
  51.   RESET(old_file);
  52.   REWRITE(new_file);
  53.   k := 0;
  54.   REPEAT
  55.     Read(Old_File,Animal);
  56.     k := k + 1;
  57.     x[k].rec_no := k -1;
  58.     x[k].ear_no := Animal.ear_no;
  59.   UNTIL EOF(Old_File) OR (k = Max_N);
  60.   bubble(x);
  61.   RESET(Old_File);
  62.   ptr := 0;
  63.   FOR i := 1 TO k DO
  64.     BEGIN
  65.       seek(Old_File,x[i].rec_no );
  66.       Read(Old_File,Animal);
  67.       IF Animal.Ear_No <> 'CLEAR' THEN
  68.           BEGIN
  69.             Animal.rec_no := ptr;
  70.             Write(New_File,Animal);
  71.             ptr := ptr + 1;
  72.           END;
  73.     END;
  74.    close(old_file);
  75.    close(new_file);
  76.    ASSIGN(test,InFileName +'.BAK');
  77.    IF EXIST(InFileName +'.BAK') THEN erase(test);
  78.    rename(old_file,InFileName +'.BAK');
  79.    rename(new_file,InFileName +'.DAT');
  80.    ASSIGN(Old_File,InFileName +'.DAT');
  81.    RESET(Old_File);
  82.    FOR i := 1 TO 6 DO Animal_table[i].ear_no := '';
  83.    f_table;
  84. END;
  85.