PROGRAM InsertionSortLinked;
(************************************************
 *						*
 *	Insertion Sort with Linked List		*
 *						*
 *	From the book - PASCAL An Introduction  *
 *	to Methodical Programming		*
 *	Authors:				*
 *	W. Findlay and D.A. Watt		*
 *						*
 * 	Entered by Ray Penley - 8 Dec 79	*
 *						*
 *	Heavely modified entire program to	*
 *	be interactive with the console.	*
 *						*
 ************************************************)
(* NOTE - This program can be eaisly adapted to sort single *
 * characters, integer numbers, real numbers, months, or any*
 * other items which can be ordered! It is only necessary to*
 * change the definition of the type identifier ITEMS, the  *
 * body of the procedure ReadItem, and possibly the body of *
 * WriteItems.						    *)

CONST
  NameLength	= 10;
  INPUT = 0;	(* PASCAL/Z ver 2.0 *)
  space = ' ';

TYPE
  Items  = PACKED ARRAY[1..NameLength] OF CHAR;
  ItemRecords  = record
		   item  :Items;
		   Next  :^ItemRecords
		 end;
  ItemPointers = ^ItemRecords;

VAR
  ListHead  :ItemPointers;
  Newitem   :Items;
  EndOfList,
  done,
  error	    :boolean;

PROCEDURE ReadItem(VAR  item  :Items);
(*	Valid Alphanumeric chars are:
	 the space - CHR(32) to
	 the tilde - CHR(126)   *)
VAR
 pos  :0..NameLength;
 dummy,
 ch   :Char;

      Procedure ClearReadItem;
      begin
	FOR pos:=1 TO NameLength DO item[ pos ]:= space;
	pos := 0
      end;

begin
  ClearReadItem;
  EndOfList := FALSE;
  error := FALSE;
  REPEAT
    IF pos < NameLength THEN  (* GET VALID INPUTS *)
      begin
      READ( CH );
      If ch = '$' then
	EndOfList := true
      Else
	begin
	IF CH IN [' ' .. '~'] THEN (* valid character *)
	  begin
          pos := pos +1;
          item [pos] := CH
          end(* if *)
	Else
	  begin
          WRITELN(' Alphanumerics only - TURKEY');
	  ClearReadItem;
	  ERROR:=TRUE
          end(* else *)
        end(* else *)
      end(* If *)
    Else	(*   ERROR   *)
      begin
      READLN( dummy );
      WRITELN(' Maximum of ', NameLength:4, ' characters please!');
      ClearReadItem;
      ERROR:=TRUE
      end(* Else *)
  UNTIL EOLN(Input) OR EndOfList;
end(* SCANNER *);

PROCEDURE InsertItem( Newitem  :Items);
VAR
  entry,
  PriorEntry,
  Newentry 	:ItemPointers;
  Searching	:boolean;
begin
  (* FIND the position where the New item will be Inserted *)
  entry := ListHead;
  Searching := TRUE;
  While Searching and (entry <> NIL) DO
    WITH entry^ DO
      IF Newitem < item then
	Searching := FALSE
      Else
	begin
	PriorEntry := entry;
	entry := Next
	end;
(* CREATE the New entry and Insert it in position *)
  New(Newentry);
  Newentry^.item := Newitem;
  Newentry^.Next := entry;
  IF entry = ListHead then
    ListHead := Newentry
  Else PriorEntry^.Next := Newentry;
end;  (* InsertItem *)

PROCEDURE WriteItems;
VAR
  entry  :ItemPointers;
begin
  entry := ListHead;
  While entry <> NIL DO
    WITH entry^ DO
      begin
      Writeln(item);
      entry := Next
      end
end; (* WriteItems *)

begin  (* MAIN PROGRAM *)
  ListHead := NIL;  (* MAKE the LIST EMPTY *)
  Writeln(' ':12,'Insertion Sort Using a Linked List');
  writeln;writeln;writeln;
  writeln('Enter your list after the prompt.');
  writeln('Enter a dollar sign <$> when complete.');
  writeln;writeln;writeln;

  REPEAT
    write('>>');
    ReadItem(Newitem); (* READ the First Item *)
    If NOT error then
      If NOT EndOfList then
	(* Insert the New item in its correct position *)
	InsertItem(Newitem);
  UNTIL EndOfList;

  Writeln(' ':12,'The Sorted List');
  writeln;
  (* Write all the Items in order *)
  WriteItems
end. (* SORTLIST *)

.