home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / sigmv022.ark / ISORTV1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  3.7 KB  |  157 lines
  1. PROGRAM InsertionSortLinked;
  2. (************************************************
  3.  *                        *
  4.  *    Insertion Sort with Linked List        *
  5.  *                        *
  6.  *    From the book - PASCAL An Introduction  *
  7.  *    to Methodical Programming        *
  8.  *    Authors:                *
  9.  *    W. Findlay and D.A. Watt        *
  10.  *                        *
  11.  *     Entered by Ray Penley - 8 Dec 79    *
  12.  *                        *
  13.  *    Heavely modified entire program to    *
  14.  *    be interactive with the console.    *
  15.  *                        *
  16.  ************************************************)
  17. (* NOTE - This program can be eaisly adapted to sort single *
  18.  * characters, integer numbers, real numbers, months, or any*
  19.  * other items which can be ordered! It is only necessary to*
  20.  * change the definition of the type identifier ITEMS, the  *
  21.  * body of the procedure ReadItem, and possibly the body of *
  22.  * WriteItems.                            *)
  23.  
  24. CONST
  25.   NameLength    = 10;
  26.   INPUT = 0;    (* PASCAL/Z ver 2.0 *)
  27.   space = ' ';
  28.  
  29. TYPE
  30.   Items  = PACKED ARRAY[1..NameLength] OF CHAR;
  31.   ItemRecords  = record
  32.            item  :Items;
  33.            Next  :^ItemRecords
  34.          end;
  35.   ItemPointers = ^ItemRecords;
  36.  
  37. VAR
  38.   ListHead  :ItemPointers;
  39.   Newitem   :Items;
  40.   EndOfList,
  41.   done,
  42.   error        :boolean;
  43.  
  44. PROCEDURE ReadItem(VAR  item  :Items);
  45. (*    Valid Alphanumeric chars are:
  46.      the space - CHR(32) to
  47.      the tilde - CHR(126)   *)
  48. VAR
  49.  pos  :0..NameLength;
  50.  dummy,
  51.  ch   :Char;
  52.  
  53.       Procedure ClearReadItem;
  54.       begin
  55.     FOR pos:=1 TO NameLength DO item[ pos ]:= space;
  56.     pos := 0
  57.       end;
  58.  
  59. begin
  60.   ClearReadItem;
  61.   EndOfList := FALSE;
  62.   error := FALSE;
  63.   REPEAT
  64.     IF pos < NameLength THEN  (* GET VALID INPUTS *)
  65.       begin
  66.       READ( CH );
  67.       If ch = '$' then
  68.     EndOfList := true
  69.       Else
  70.     begin
  71.     IF CH IN [' ' .. '~'] THEN (* valid character *)
  72.       begin
  73.           pos := pos +1;
  74.           item [pos] := CH
  75.           end(* if *)
  76.     Else
  77.       begin
  78.           WRITELN(' Alphanumerics only - TURKEY');
  79.       ClearReadItem;
  80.       ERROR:=TRUE
  81.           end(* else *)
  82.         end(* else *)
  83.       end(* If *)
  84.     Else    (*   ERROR   *)
  85.       begin
  86.       READLN( dummy );
  87.       WRITELN(' Maximum of ', NameLength:4, ' characters please!');
  88.       ClearReadItem;
  89.       ERROR:=TRUE
  90.       end(* Else *)
  91.   UNTIL EOLN(Input) OR EndOfList;
  92. end(* SCANNER *);
  93.  
  94. PROCEDURE InsertItem( Newitem  :Items);
  95. VAR
  96.   entry,
  97.   PriorEntry,
  98.   Newentry     :ItemPointers;
  99.   Searching    :boolean;
  100. begin
  101.   (* FIND the position where the New item will be Inserted *)
  102.   entry := ListHead;
  103.   Searching := TRUE;
  104.   While Searching and (entry <> NIL) DO
  105.     WITH entry^ DO
  106.       IF Newitem < item then
  107.     Searching := FALSE
  108.       Else
  109.     begin
  110.     PriorEntry := entry;
  111.     entry := Next
  112.     end;
  113. (* CREATE the New entry and Insert it in position *)
  114.   New(Newentry);
  115.   Newentry^.item := Newitem;
  116.   Newentry^.Next := entry;
  117.   IF entry = ListHead then
  118.     ListHead := Newentry
  119.   Else PriorEntry^.Next := Newentry;
  120. end;  (* InsertItem *)
  121.  
  122. PROCEDURE WriteItems;
  123. VAR
  124.   entry  :ItemPointers;
  125. begin
  126.   entry := ListHead;
  127.   While entry <> NIL DO
  128.     WITH entry^ DO
  129.       begin
  130.       Writeln(item);
  131.       entry := Next
  132.       end
  133. end; (* WriteItems *)
  134.  
  135. begin  (* MAIN PROGRAM *)
  136.   ListHead := NIL;  (* MAKE the LIST EMPTY *)
  137.   Writeln(' ':12,'Insertion Sort Using a Linked List');
  138.   writeln;writeln;writeln;
  139.   writeln('Enter your list after the prompt.');
  140.   writeln('Enter a dollar sign <$> when complete.');
  141.   writeln;writeln;writeln;
  142.  
  143.   REPEAT
  144.     write('>>');
  145.     ReadItem(Newitem); (* READ the First Item *)
  146.     If NOT error then
  147.       If NOT EndOfList then
  148.     (* Insert the New item in its correct position *)
  149.     InsertItem(Newitem);
  150.   UNTIL EndOfList;
  151.  
  152.   Writeln(' ':12,'The Sorted List');
  153.   writeln;
  154.   (* Write all the Items in order *)
  155.   WriteItems
  156. end. (* SORTLIST *)
  157.