{++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{+							+}
{+  PROGRAM TITLE:	Copy With Prefixed Char Count	+}
{+							+}
{+  WRITTEN BY:		George W. Cherry [1]		+}
{+							+}
{+  Modified by Raymond E. Penley, 7 Oct 1980		+}
{+	The program reads in whole lines instead	+}
{+  of single characters then prints the whole		+}
{+  linked list of "lines".				+}
{+							+}
{+  [1] "Pascal Programming Structures", pgs 232-237	+}
{+    Reston Publishing Company, Inc.			+}
{++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
PROGRAM CopyWithPrefixedCharCount;

CONST
  default = 80;
  input = 0;	{Pascal/Z needs this crutch}

TYPE
  items		= string default;
  P_pointer	= ^queuecell;
  queuecell	= record
		    line : items;
		    next : P_pointer
		  end;
  S$0	= string 0;
  S$255	= string 255;

VAR
  charcount	: integer;
  currentline	: items;	{the current line}
  FrntPtr,
  RearPtr	: P_pointer;
  ch		: char;
  linecount	: integer;
  EndOfLine,
  EndOfFile,
  done		: boolean;
  ix		: integer;

Function  length(x: S$255): integer; external;

Procedure setlength(var x: S$0; y: integer); external;

Procedure KEYIN(VAR cix: char); EXTERNAL;

Procedure InitializeQueue;
begin
  FrntPtr := NIL;
  RearPtr := NIL;
end {of InitializeQueue};

Procedure Queue( currentline : items );
VAR
  new_ptr : P_pointer;
begin
  NEW(new_ptr);			{reserve a new queuecell }
  new_ptr^.line := currentline;
  new_ptr^.next := NIL;
  If FrntPtr = NIL then
    FrntPtr := new_ptr
  Else
    RearPtr^.next := new_ptr;
  RearPtr := new_ptr;		{complete the circular queue}
end {of Queue};

Function QueueIsEmpty : BOOLEAN;
begin
  QueueIsEmpty := (FrntPtr = NIL);
end {of queueIsEmpty};

Procedure Serve(var current: items);
VAR
  curitem : P_pointer;
begin
  If QueueIsEmpty then
    {nothing to do the queue is empty}
  Else
    begin
      curitem := FrntPtr;
      current := curitem^.line;
      FrntPtr := FrntPtr^.next;
      If FrntPtr = NIL then
	RearPtr := NIL;
    end;
end {of serve};

Procedure Read_a_chunck;
VAR
  done_reading_lines : BOOLEAN;

   Procedure GetC(VAR ch: char);
   { Recognizes "control-E" as End of File on the console. }
   begin
     KEYIN(ch);write(ch);
     endofline := ( ord(ch)=13 );
     endoffile := ( ord(ch)=5 );
     If ( endofline ) OR ( endoffile ) then ch := ' ';
   end;

   Procedure GetL(var LINE: items);
   begin
     setlength(LINE,0);
     GetC(ch);
     while not( EndOfLine OR EndOfFile ) DO
       begin
         charcount := charcount + 1;
         append(line,ch);
         GetC(ch);
       end;
   end; {GetLine}

begin {of Read_a_chunck}
  done_reading_lines := FALSE;
  while not done_reading_lines do
    begin
      write('?');
      GetL(currentline);Writeln;
      If (length(currentline)=0) OR ( EndOfFile ) then
         done_reading_lines := TRUE
      Else
        Queue(currentline)
    end;
end;{of Read_a_chunck}

Procedure Process_chunck;
begin
  linecount := 0;
  while not QueueIsEmpty do
    begin
      linecount := linecount + 1;
      write(linecount:3, ': ');
      Serve(currentline);
      Writeln(currentline);
    end;{while not queueisempty}
  Writeln;
end;{of Process_chunck}

BEGIN {Main Program}
  for ix:=1 to 25 Do writeln;	{ clear the crt }
  InitializeQueue;
  EndOfFile := FALSE;
  while not EndOfFile do
    begin
      { INITIALIZE }
      charcount := 0;
      MARK(chunck);
      Read_a_chunck;
      Process_chunck;
      RELEASE(chunck);
    end;{while not EndOfFile}
END.

