COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	{$NOMAIN	Page Printer routines (used by everything) }
C00009 00003	{ Externally defined routines from elsewhere: }
C00010 00004	(* Line allocation routines: getLine, relLine *)
C00015 00005	(* Page Printer routines: ppGlitch, ppChar, ppOutNow, ppLine *)
C00019 00006	(* Page Printer routines: pp5, pp10(L), pp20(L), ppInt, ppReal, ppStrng, ppDelChar, ppDtype *)
C00023 ENDMK
C⊗;
{$NOMAIN	Page Printer routines (used by everything) }

const
	(* Constants from EDIT *)
      	maxLines = 28;		(* smaller on the 11 than on the 10 *)
      	maxPPLines = 18;
      	maxBpts = 25;
      	maxTBpts = 20;	(* max could be exceeded by huge case stmnt *)
	listinglength = 2000;	(* Length of Listingarray *)


(* Random type declarations for OMSI/SAIL compatibility *)

type

  byte = 0..255;	(* doesn't really belong here, but... *)
  ascii = char; 
  atext = text;

strngp = ↑strng;
linerecp = ↑linerec;
dump = ↑integer;
token = array[1..4] of integer;
cursorp = array[1..4] of integer;

cstring = packed array [1..10] of ascii;
c4str = packed array [1..4] of ascii;
c5str = packed array [1..5] of ascii;
c20str = packed array [1..20] of ascii;
linestr = packed array [1..130] of ascii;

datatypes = (pconstype, varitype, svaltype, vectype, rottype, transtype,
	     frametype, eventtype, strngtype, labeltype, proctype, arraytype,
	     reftype, valtype, cmontype, nulltype, undeftype,
	     dimensiontype, mactype, macargtype, freevartype);

scalar = real;

strng = record
	  next: strngp;
	  ch: cstring;
	end;

linerec = record
	next: linerecp;
	start,length: integer
       end;


(* Global variables *)

var 
	(* From ALMAIN *)
    b:boolean;		
    ch:ascii;
    ltime: real;

	(* From PARSE *)
    reswords: array [0..26] of dump;
    idents: array [0..26] of dump;
    macrostack: array [1..10] of dump;
    curmacstack: array [1..10] of dump;
    macrodepth: integer;
    curchar, maxchar, curline: integer;
    curBlock,newDeclarations: dump;
    curProc: dump;
    pnode: dump;
    nodim, distancedim, timedim, angledim,
      forcedim, torquedim, veldim, angveldim: dump;
    fvstiffdim, mvstiffdim: dump;
    filedepth: integer;
    curpage: integer;
    sysVars,unVars: dump;
    errcount: integer;
    outerBlock: dump;
    curVariable: dump;
    curMotion: dump;
    endOk,coendOk: integer;
    moveLevel: integer;
    curErrhandler, curCmon: dump;
    endOfLine, backup, expandmacros, flushcomments, dimCheck: boolean;
    semiseen, shownline: boolean;
    eofError: boolean;
    inMove,inCoblock: boolean;
    curtoken: token;	
    file1,file2,file3,file4,file5: atext;
    line: linestr;

	(* From INTERP *)
    curInt, activeInts, readQueue, allPdbs: dump;
    curEnv, sysEnv: dump;
    clkQueue: dump;
    allEvents: dump;
    STLevel: integer;		(* set by GO *)
    etime: integer;		(* used by eval *)
    curtime: integer; 		(* Time of day, in ticks *)
    stime: integer;		(* used for clock queue on 10 *)
    msg: dump;			(* for AL-ARM interaction *)
    inputp: integer;		(* current offset into inputLine array above *)
    debugLevel: integer;
    tSingleThreadMode: boolean;
    resched, running, escapeI, singleThreadMode: boolean;
    msgp: boolean;		(* flag set if any messages pending *)
    inputReady: boolean;
    inputLine: array [1..20] of ascii;

	(* From EDIT *)
    lines: array [1..maxLines] of linerecp; 
    ppLines: array [1..maxPPLines] of linerecp;	
    marks: array [1..20] of integer;
    cursorStack: array [1..15] of cursorp;
    bpts: array [1..maxBpts] of dump;
    tbpts: array [1..maxTBpts] of dump;
    debugPdbs: array [0..10] of dump;
    screenheight,dispHeight: integer;
    ppBufp,oppBufp,ppOffset,ppSize,nmarks: integer;
    lbufp,cursor,ocur,cursorLine,fieldnum,lineNum,findLine,pcLine: integer;
    firstDline,topDline,botDline,firstLine,lastLine: integer;
    freeLines,oldLines: linerecp;
    findStmnt: dump;
    nbpts,ntbpts: integer;
    eCurInt: dump;
    dProg: dump;	
    smartTerminal: boolean; 
    setUp,setExpr,setCursor,dontPrint,outFilep,newVarOk,collect: boolean;
    eBackup: boolean;			
    eSingleThreadMode: boolean;	
    listing: packed array [0..listinglength] of ascii;
    lbuf: array [1..160] of ascii;
    ppBuf: array [1..100] of ascii;
    outFile: atext;
    eCurToken: token;

	(* Various device & variable pointers *)
    speedfactor: dump;
    barm: dump;

	(* Various constant pointers *)
    xhat,yhat,zhat,nilvect: dump;
    niltrans: dump;
    bpark, ypark, gpark, rpark: dump;

{ Externally defined routines from elsewhere: }

	(* From EPUT *)
procedure putReal(s: real); 					external;

	(* From DISP *)
procedure outLine(line,col,start,length: integer); 		external;
procedure delLine(line,num: integer); 				external;
procedure beep; 						external;

(* Line allocation routines: getLine, relLine *)

function getLine(length: integer): linerecp; external;
function getLine;
 var f,fo,fp: linerecp; b: boolean;
 begin
 if length < 10 then length := 10;	(* so we don't get too fragmented *)
 f := freeLines;
 fo := nil;
 b := false;
 while not b do 			(* Find a long enough free line *)
  if f = nil then b := true
   else if f↑.length >= length then b := true
   else begin fo := f; f := f↑.next end;
 if f <> nil then 
   begin
   if f↑.length < (length + 8) then
     begin				(* use entire free line *)
     if fo = nil then freeLines := f↑.next	(* splice out old free line *)
      else fo↑.next := f↑.next;
     fp := f;
     end
    else
     begin				(* split free line in two parts *)
     if oldLines = nil then new(fp)	(* get a new line *)
      else begin fp := oldLines; oldLines := fp↑.next; end;
     fp↑.start := f↑.start;
     fp↑.length := length;
     f↑.start := f↑.start + length;
     f↑.length := f↑.length - length;
     end;
   end
  else
   begin
(* *** compact screen array??? *** *)
   beep; writeln('Gack - no more room in listing array!!!'); break(output); beep;
(* *** do something intelligent here??? *** *)
   if oldLines = nil then new(fp)	(* get a new line *)
    else begin fp := oldLines; oldLines := fp↑.next; end;
   fp↑.start := 1;		(* this will clobber line editor, but... *)
   fp↑.length := length;
   beep;
   end;
 fp↑.next := nil;
 getLine := fp;
 end;

procedure relLine(l: linerecp); external;
procedure relLine;
 var f,fo: linerecp; b: boolean;
 begin
 if l <> nil then
  if l↑.length > 0 then
   begin
   f := freeLines;
   fo := nil;
   b := false;
   while not b do 			(* Find a long enough free line *)
    if f = nil then b := true
     else if f↑.start >= l↑.start then b := true
     else begin fo := f; f := f↑.next end;
   b := true;
   if fo <> nil then
    with fo↑ do				(* try to merge with last line *)
     if (start + length) = l↑.start then
       begin length := length + l↑.length; b := false end;
   if f <> nil then
    if (l↑.start + l↑.length) = f↑.start then (* try to merge with next line *)
     if b then
       begin				(* merge with next line *)
       f↑.start := l↑.start;
       f↑.length := f↑.length + l↑.length;
       b := false
       end
      else
       begin				(* can merge last & next now *)
       fo↑.length := fo↑.length + f↑.length;
       fo↑.next := f↑.next;
       f↑.next := oldLines;		(* add it to free line queue *)
       oldLines := f;
       end;
   if b then
     begin				(* need to add to free line list *)
     l↑.next := f;
     if fo <> nil then fo↑.next := l else freeLines := l;
     end
    else begin l↑.next := oldLines; oldLines := l end;	(* release line pntr *)
   end;
 end;

(* Page Printer routines: ppGlitch, ppChar, ppOutNow, ppLine *)

procedure ppGlitch; external;
procedure ppGlitch;
 var i,j: integer;

    procedure clearLine(i: integer);	(* Copied from EAUX1A *)
     begin
     listing[1] := ' ';
     outLine(i,1,1,1);
     end;

 begin
 if ppbufp > 0 then	(* If anything in buffer *)
   begin
   ppLines[ppOffset] := getLine(ppBufp);	(* get a line to store chars in *)
   with ppLines[ppOffset]↑ do
    begin
    for i := 1 to ppBufp do listing[start+i-1] := ppBuf[i];	(* copy line *)
    for i := ppBufp to length-1 do listing[start+i] := chr(0);
    outLine(dispHeight+ppOffset+1,oppBufp+1,start+oPPbufp,ppBufp-oppBufp);
    end
   end
  else
   begin
   ppLines[ppOffset] := nil;
   clearLine(dispHeight+ppOffset+1);
   end;
 PPbufp := 0;
 oPPbufp := 0;
 if ppOffset >= ppSize then
   begin				(* need to glitch page printer *)
   relLine(ppLines[1]);
   for i := 2 to ppSize do ppLines[i-1] := ppLines[i];
   ppLines[ppSize] := nil;
   if smartTerminal then delLine(dispHeight+2,1)
    else
     begin
     for i := 1 to ppSize-1 do
      if ppLines[i] <> nil then
	with ppLines[i]↑ do
	 outLine(dispHeight+i+1,1,start,length)	(* re-draw top lines *)
       else clearLine(dispHeight+i+1);
     clearLine(dispHeight+ppSize+1);
     end;
   end
  else ppOffset := ppOffset + 1;		(* just move to next line *)
 end;

procedure ppChar(ch: ascii); external;
procedure ppChar;
 begin
 if ch = chr(15B) then ppGlitch		(* scroll up page printer *)
  else if ch <> chr(12B) then		(* flush linefeeds *)
   begin				(* add character to pp buffer *)
   if ppBufp >= 80 then ppGlitch;
   ppBufp := ppBufp + 1;
   ppBuf[ppBufp] := ch;
   end;
 end;

procedure ppOutNow; external;
procedure ppOutNow;
 var i: integer;
 begin
 for i := oppBufp+1 to ppBufp do listing[i-oppBufp] := ppBuf[i];
 outLine(dispHeight+ppOffset+1,oppBufp+1,1,ppBufp-oppBufp);
 oppBufp := ppBufp;
 end;

procedure ppLine; external;	(* Does the same as ppGlitch *)
procedure ppLine;	
 begin
 ppChar(chr(15B));		(* cr *)
 end;

(* Page Printer routines: pp5, pp10(L), pp20(L), ppInt, ppReal, ppStrng, ppDelChar, ppDtype *)

procedure pp5(ch: c5str; length: integer); external;
procedure pp5;
 var i: integer;
 begin
 for i := 1 to length do ppChar(ch[i]);
 end;

procedure pp10(ch: cstring; length: integer); external;
procedure pp10;
 var i: integer;
 begin
 for i := 1 to length do ppChar(ch[i]);
 end;

procedure pp10L(ch: cstring; length: integer); external;
procedure pp10L;
 begin
 if ppBufp > 0 then ppLine;
 pp10(ch,length);
 end;

procedure pp20(ch: c20str; length: integer); external;
procedure pp20;
 var i: integer;
 begin
 for i := 1 to length do ppChar(ch[i]);
 end;

procedure pp20L(ch: c20str; length: integer); external;
procedure pp20L;
 begin
 if ppBufp > 0 then ppLine;
 pp20(ch,length);
 end;

procedure ppInt(i: integer); external;
procedure ppInt;
 var j,k: integer; n: array [1..9] of integer;
 begin
 for j := 1 to 9 do		(* get individual digits *)
  begin n[j] := i mod 10; i := i div 10 end;
 j := 9;
 while (j > 1) and (n[j] = 0) do j := j - 1;	(* ignore leading zeros *)
 for k := j downto 1 do ppChar(chr(ord('0')+n[k]));	(* print it *)
 end;

procedure ppReal(r: real); external;
procedure ppReal;
 var i,j: integer;
 begin
 j := lbufp;
 putReal(r);
 ppChar(' ');
 for i := j+1 to lbufp do ppChar(lbuf[i]);	(* print it *)
 lbufp := j;					(* restore old line buf pntr *)
 end;

procedure ppStrng(length: integer; s: strngp); external;
procedure ppStrng;
 var i,j: integer;
 begin
 j := 1;
 for i := 1 to length do
  begin
  ppChar(s↑.ch[j]);
  if j = 10 then begin j := 1; s := s↑.next; end
   else j := j + 1;
  end;
 end;

procedure ppDelChar; external; 	(* for use by INTERP *) 
procedure ppDelChar;
 begin
 if ppBufp > 0 then
   begin
   ppBuf[ppBufp] := ' ';
   listing[1] := ' ';
   outLine(dispHeight+ppOffset+1,ppBufp,1,1);
   ppBufp := ppBufp - 1;
   oppBufp := ppBufp;
   end;
 end;

procedure ppDtype(d: datatypes); external;
procedure ppDtype;
 begin
 case d of
svaltype:  pp10('scalar    ',6);
vectype:   pp10('vector    ',6);
rottype:   pp5('rot  ',3);
transtype: pp5('trans',5);
frametype: pp5('frame',5);
eventtype: pp5('event',5);
strngtype: pp10('string    ',6);
otherwise {do nothing - should not happen};
  end;
 end;