PROGRAM Scan2Evaluation;
(*
 * PROGRAM TITLE:	Scan 2 Evaluation
 * WRITTEN BY:		Raymond E. Penley
 * DATE WRITTEN:	4 January 1980
 *			11 June 1980 slightly modified for
 *			Pascal/Z vers 3.0
 *
 * PURPOSE:
 *	This is an evaluation of a File read routine I call:
 *	"SCAN-2". SCAN-2 provides to the calling
 *	program TWO characters;
 *	   A current character (currchar) and
 *	   a look-ahead char (nextchar).
 *
 *)

CONST
  prompt = '?';
  space = ' ';
  fill = '    ';
  DisplayLines = 12;
  FID_LENGTH = 14;	{---Maximum length for a file name---}

TYPE
  charname = (lletter, uletter, digit, blank, quote, atab,
	      EndOfLine, FileMark, otherchar );
  charinfo = RECORD
		name : charname;
		valu : char
	     END;
  STR0	   = STRING 0;
  STR255   = STRING 255;
  STRING80 = STRING 80;
  FID      = STRING FID_LENGTH; {---FILE IDENTIFIER TYPE---}

VAR
  xeof,			(* EOF status AFTER a read *)
  xeoln    : boolean;	(* EOLN status AFTER a read *)
  count    : integer;	(* line counter *)
  LooK,			(* Look-ahead character *)
  Ch	   : CHAR;	(* temp usage char *)
  currchar,		(* Current operative character *)
  nextchar : CharInfo;	(* Next character to be operated on *)
  FileID   : FID;     	(* File IDentifier *)
  tab	   : char;	(* ASCII tab character *)
  ft	   : Text;	(* File Control Block <FCB> *)


FUNCTION LENGTH(X: STR255): INTEGER; EXTERNAL;
PROCEDURE SETLENGTH(VAR X: STR0; Y: INTEGER); EXTERNAL;

PROCEDURE GETID( Message : STRING80; VAR ID: FID );
CONST	SPACE = ' ';
begin
  SETLENGTH(ID,0);
  writeln;
  write(message);
  READLN(ID);
  WHILE LENGTH(ID)<FID_LENGTH DO APPEND(ID,SPACE);
end;

PROCEDURE GetC(	VAR nextchar : charinfo;
		VAR currchar : charinfo );
(* revised 4 Jan 80, rep *)
begin
(*	 Terminator status module
	Stores terminator status "AFTER" a read.
	NOTE this play on words - after one char is
	also "PRIOR TO" the next character
							*)
  xeoln := EOLN(ft);
  xeof  := EOF(ft);
	(* read byte module *)
  If NOT xeof then
    READ(ft, Look);
	(* current operative character module *)
  currchar := nextchar;
	(* Look-ahead character name module *)
  With NextChar do begin
    IF xeof then
      name := FileMark
    Else If xeoln then
	   name := EndOfLine
    Else If LooK IN ['a'..'z'] then (* lower case *)
	   name := lletter
    Else If LooK IN ['A'..'Z'] then (* upper case *)
	   name := uletter
    Else If LooK IN ['0'..'9'] then (* digit *)
	   name := digit
    Else If LooK = '''' then
	   name := quote
    Else If LooK = TAB then
	   name := atab
    Else If LooK = space then
	   name := blank
    Else name := otherchar;
	(* store character value module *)
    CASE name of
	EndOfLine,
	FileMark:	Valu := space;
	Else:		Valu := LooK
	end(* case name of *);
    end(* look-ahead name module *)
end(*---of GetC---*);

Procedure HEADER;
begin
writeln(' ':15,'STATUS      Cchar   Cchar',' ':11,'Nchar    Nchar');
writeln('    LooK     EOLN  EOF     VAL    Name ',
		' ':11,' VAL     Name');
end;

Procedure DISPLAY;
begin
{-----FIRST LINE---}
  write(count:3, fill);
  If ord(LooK)=26 then
     write('^Z', ' ':5)
  Else
    write(LooK, ' ':6);
  If xeoln then write('T') else write('F'); write('   ');
  If Xeof then write('T') else write('F');
  Writeln(' ':30, nextchar.valu, ' ':6, nextchar.name );
{-----SECOND LINE-----}
  Writeln(' ':26, currchar.valu, ' ':5 , currchar.name );
end;

Procedure PAUSE;
VAR
  dummy : char;
begin
  write(prompt);readln(dummy);
end;

Procedure Initialize;
begin
  TAB := chr(9);  (* ASCII Tab character *)
	(*** INITIALIZE look-ahead char ***)
  nextchar.name := blank;
  nextchar.valu := space;
end;

BEGIN(* SCAN-2 main *)
  GETID('Enter File Name: ', FileID);
  RESET(FileID, ft);
  If EOF(ft) then
    begin
    writeln('File not found');
    end
  ELSE
    begin
      Initialize;
      writeln;writeln;
      GetC(nextchar, currchar);(* attempt to read *)
      While (CurrChar.name<>filemark) do
	begin(* processing char *)
 	count := 0;
	Header;
	  REPEAT
	    count := count +1;
	    Display;
	    GetC(nextchar, currchar);
	  UNTIL (count=DisplayLines) or (CurrChar.name=filemark);
	PAUSE;
	writeln;
	end(* of processing *);
      writeln('Normal file termination');
    end(* else *);
    WRITELN('That''S all!');
end(*---of SCAN-2 eval---*).

.