[inherit ('SYS$LIBRARY:STARLET')]

Module PDPSubs(Output, Terminal);

const
  NUL = chr(0);
  LF = chr(10);
  CR = chr(13);
  ControlU = chr(21);

  MaxStrings = 20;
  StringMax = 40;
  NoAnswer = 0;

type
  Word = [WORD] -32768 .. 32767;
  StringSet = set of 1..MaxStrings;
  String = packed array [1..StringMax] of char;

var
  Terminal: text;
  ProgramName: packed array [1..8] of char;
  DSW: Word;
  Channel: Word;
  Status: [QUAD] record
		   Stat: Word;
		   Count: Word;
		   Junk: integer;
		 end;
  Strings: array [1..MaxStrings] of record
				      Str: String;
				      Len: 0..StringMax;
				      Pos: integer;
				    end;
  NumStrings: 0..MaxStrings;
  Line: packed array [1..80] of char;
  Start, Len: integer;
  Term: char;
  TimeOut: boolean;
  I: integer;


[INITIALIZE]
procedure Init;

  begin
    open(Terminal, File_Name := 'TERM$PDP11', Carriage_Control := NONE);
    rewrite(Terminal);

    DSW := $Assign (DevNam := 'TERM$PDP11', Chan := Channel);
    if DSW <> SS$_Normal then
      writeln(output, 'Assign Error -- DSW = ', DSW:1);
  end { InitTimed };


procedure TimedRead(MaxTime: integer;
		var Line: packed array [LMin..LMax: integer] of char;
		var LineLength: integer;
		var Terminator: char;
		var TimeOut: boolean);

  var
    LineSize: integer;

  begin
    LineSize := LMax - LMin;
    DSW := $QIOW (EFN := 1,
		  Chan := Channel,
		  Func := IO$_ReadVBlk + IO$M_NoEcho + IO$M_Timed,
		  IOSB := Status,
		  P1 := Line,
		  P2 := LineSize,
		  P3 := MaxTime);

    if DSW <> SS$_Normal then
      begin
	writeln(Output, ProgramName, ' -- Read directive error, DSW = ', DSW:1);
	halt;
      end
    else
      with Status do
	if Stat = SS$_Normal then
	  begin
	    TimeOut := false;   LineLength := Count;
	    if Count = LineSize
	      then Terminator := NUL
	      else Terminator := Line[Count + 1];
	  end
	else if Stat = SS$_TimeOut then
	  begin
	    TimeOut := true;   LineLength := Count;   Terminator := NUL;
	  end
	else
	  begin
	    writeln(Output, ProgramName, ' -- Read error, DSW = ', DSW:1);
	    halt;
	  end;
  end { TimedRead };


procedure PutString(Str: packed array [Min..Max: integer] of char;
		    Len: integer;   Flush, ShowOutput, EOL: boolean);

  var
    Last, I: integer;

  begin
    if Flush then writeln(Terminal, ControlU);
    if Len < 0
      then Last := Max
      else Last := Min + Len - 1;

    if ShowOutput then
      for I := Min to Last do write(output, Str[I]);
    if EOL then writeln(output);

    for I := Min to Last do write(Terminal, Str[I]);
    if EOL then write(Terminal, CR);
    writeln(Terminal);
  end { PutString };


procedure EnterString(Index, Position: integer;
		      String: packed array [Min..Max: integer] of char);
  var
    I: integer;

  begin
    with Strings[Index] do
      if Position < 0 then
	begin
	  Pos := - Position;   Len := 1;   Str[1] := String[Min];
	end
      else
	begin
	  Pos := Position;   Len := 0;
	  for I := Min to Max do
	    begin
	      Len := Len + 1;   Str[Len] := String[I];
	    end;
	end;
  end { EnterString };


function WaitFor(SSet: StringSet;  MaxTime: integer): integer;

  var
    S: integer;
    Found: boolean;

  function Equal(Line: packed array [LMin..LMax: integer] of char;
		 Strng: packed array [SMin..SMax: integer] of char;
		 Start, Len: integer): boolean;
    var
      Last, L, S: integer;

    begin
      Last := Start + Len - 1;
      if Last > LMax then Equal := false
      else
	begin
	  L := Start;   S := SMin;
	  while (Line[L] = Strng[S]) and (S < Len) do
	    begin
	      L := L + 1;   S := S + 1;
	    end;
	  Equal := Line[L] = Strng[S];
	end;
    end { Equal };


  begin { WaitFor }
    repeat
      TimedRead(MaxTime, Line, Len, Term, TimeOut);
      if Line[1] = LF  then Start := 2  else Start := 1;
      for I := Start to Len do write(output, Line[I]);
      if Term <> NUL then writeln(output);

      S := 0;
      repeat
	S := S + 1;
	if S in SSet then
	  with Strings[S] do
	    Found := Equal(Line, Str, Start + Pos - 1, Len)
	else Found := false;
      until Found or (S = NumStrings);
    until Found or TimeOut;
    if Found then WaitFor := S else WaitFor := NoAnswer;
  end { WaitFor };


end { PDPSubs }.