home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol080 / sort.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  3.4 KB  |  131 lines
  1. program sort(0);
  2. {insertion sort.  This program is designed to follow the
  3.  data input section.  It sorts the transaction file
  4. into ascending order which is necessary for the merge
  5. program to work correctly.    }
  6.  
  7. TYPE
  8.   subje = record
  9.     subj        : array[1..45]of char;
  10.     ssic        : array [1..5] of char;
  11.     action        : array [1..6] of char;
  12.     info        : array [1..16] of char;
  13.     acct_number    : array [1..4] of char
  14.       end;
  15.   ItemRecords  = record
  16.            item  :subje;
  17.            Next  :^ItemRecords
  18.          end;
  19.   ItemPointers = ^ItemRecords;
  20.   str4    = array [1..4] of char;
  21.   str5    = array [1..5] of char;
  22.  
  23. VAR
  24.   ListHead  :ItemPointers;
  25.   Newitem   :subje;
  26.   done,
  27.   error        :boolean;
  28.   fin,fout  :file of subje;
  29.   infilename,
  30.   outfilename:string 14;
  31.   i,
  32.   count    : integer;
  33.  
  34. PROCEDURE Rjust(VAR ssic:str5);
  35. {ssic is a numeric field stored as a string.  In order for a
  36. sort to work properly, it must be right justified.  Any
  37. alphabetics sneaking into the field will be sorted below the
  38. numbers in accordance with the ASCII collating sequence.}
  39. var
  40.   temp    : str5;
  41.   i    : integer;
  42. begin
  43.   temp := '     ';
  44.   while ssic[5] = ' ' do
  45.     begin
  46.     for i := 2 to 5 do
  47.     begin
  48.     temp[i] := ssic[(i-1)];
  49.     end;    {for loop}
  50.     ssic := '     ';    {gotta clear out the string before rewriting}
  51.     ssic := temp;
  52.     end;    {while}
  53. end;    {Rjust}
  54.  
  55. PROCEDURE Convert(acct_number:str4; VAR count:integer);
  56. begin
  57. count := (((ord(acct_number[1])-48)*1000)+
  58.       ((ord(acct_number[2])-48)*100 )+
  59.       ((ord(acct_number[3])-48)*10  )+
  60.       ((ord(acct_number[4])-48)    ));
  61. end;    {convert procedure}
  62.  
  63. PROCEDURE InsertItem( Newitem  :subje);
  64. VAR
  65.   entry,
  66.   PriorEntry,
  67.   Newentry     :ItemPointers;
  68.   Searching    :boolean;
  69. begin
  70.   (* FIND the position where the New item will be Inserted *)
  71.   entry := ListHead;
  72.   Searching := TRUE;
  73.   While Searching and (entry <> NIL) DO
  74.     WITH entry^ DO
  75. {the following IF statement may be changed to sort on any field
  76. of the record     }
  77.       IF Newitem.ssic < item.ssic then
  78.     Searching := FALSE
  79.       Else
  80.     begin
  81.     PriorEntry := entry;
  82.     entry := Next
  83.     end;
  84. (* CREATE the New entry and Insert it in position *)
  85.   New(Newentry);
  86.   Newentry^.item := Newitem;
  87.   Newentry^.Next := entry;
  88.   IF entry = ListHead then
  89.     ListHead := Newentry
  90.   Else PriorEntry^.Next := Newentry;
  91. end;  (* InsertItem *)
  92.  
  93. PROCEDURE WriteItems;external;
  94.  
  95. begin  (* MAIN PROGRAM *)
  96.   ListHead := NIL;  (* MAKE the LIST EMPTY *)
  97.   Writeln(' ':12,'Insertion Sort Using a Linked List');
  98.   writeln;writeln;writeln;
  99.   write(' INPUT FILE: ');
  100.   readln(infilename);
  101.   write(' OUTPUT FILE: ');
  102.   readln(outfilename);
  103.   reset(infilename,fin);
  104.   reset(outfilename,fout);
  105.   if not (eof(fout)) then
  106.     begin
  107.     writeln(' ':12,'        FILE ALREADY EXISTS');
  108.     writeln(' ':12,' Erase it or choose another name');
  109.     end
  110.   else rewrite(outfilename,fout);
  111.   writeln;writeln;writeln;
  112.  
  113.     Read(fin,Newitem); (* READ the First Item *)
  114.     Convert(Newitem.acct_number,count);
  115.     for i := 2 to count do
  116.     begin
  117.     read(fin,Newitem);
  118.     if (Newitem.ssic <> '     ') and (Newitem.ssic <> 'ZZZZZ')
  119.       then
  120.       begin
  121.       Rjust(newitem.ssic);
  122.       insertitem(Newitem);
  123.       end;    {if}
  124.     end;    {for loop}
  125.     (* Insert the New item in its correct position *)
  126.   Writeln(' ':12,'The Sorted List');
  127.   writeln(' ':12,'is being written into ',outfilename);
  128.   (* Write all the Items in order *)
  129.   WriteItems
  130. end. (* SORTLIST *)
  131.