{+++
	This module is helpful when producing listing files from Pascal
	programs.  A user-supplied header routine is called to start each
	page.  Output is buffered until an `end-of-group' signal is given,
	which allows a block of text to be printed without spanning a page
   	break.

	Bob Langford
	MCV Academic Computing
	Medical College of Virginia
	March 1986
---}

[inherit('sys$library:rtl'), environment('listings'), ident('V1.1')]
module Listings;

[hidden] const
    MAX_WIDTH = 133;	  { This is the record length of the output file. }
    MAX_HELD_LINES = 60;  { This is the number of lines the buffer will hold. }
    FOOTING_LINES = 3;    { This is the size of the bottom margin. }
type			  { This structure is used to hold all necessary
			    information about the listing, including the
			    buffered text and housekeeping data. }
    aListingControlBlock = [volatile] record
	OutFile : text;
	CurrentLine : integer;
	PageLength : integer;
	BufferPointer : integer;
	HeaderAddr : integer;
	NullFileFlag : boolean;
        Buffer : array [1..MAX_HELD_LINES] of varying [MAX_WIDTH] of char
	end;

[global] procedure OpenListing (
    var lcb : aListingControlBlock;
        FileSpec : varying [a] of char;
        HeadingProcedureAddr : integer;
        PageSize : integer := 0
	);
{+++
Functional Description:	Opens a new listing file, and initializes the data
	structure required (a Listing Control Block).

Calling Sequence:	See above.

Formal Arguments:	LCB - a Listing Control Block.  Allocated by caller,
				of type `aListingControlBlock' (defined in
				this file).
			FileSpec - a standard VMS file-spec.  This is the
				name of the file to be created.  A default
				file-spec of `.lis' is used to supply
				any missing fields.  If a null string is
				given for FileSpec, no listing file will
				be created; all further calls will be
				ignored for this listing.
			HeadingProcedureAddr - address of a procedure that
				will be called each time a new page is started
				on the listing file.  This procedure should
				have no arguments, and should return (as
				a function value) an integer indicating
				exactly how many lines the header procedure
				wrote to the listing file.  This parameter
				is an integer, passed by reference, and
				is saved in the LCB.  The heading procedure
				may use global or static variables, and
				must be declared with the `asynchronous'
				attribute.
			PageSize - the number of lines desired per page.
				If you specify 0 for this parameter, the
				system default (see LIB$LP_LINES) (minus
				three lines for bottom margin) is used.

Implicit Inputs:		None.

Implicit Outputs:		Sets several fields in the LCB.

Completion status or returned value:	None.

Side Effects:			Opens the listing file.
---}
begin
if length(FileSpec) = 0 then		{ Check for null file spec. }
    lcb.NullFileFlag := TRUE
else with lcb do begin
    open (OutFile, FileSpec, history := NEW, default := '.lis',
		record_length := MAX_WIDTH);	{ Open the file.  }
    rewrite (OutFile);
    if PageSize <= 0 then                       { Calc. page size. }
 	PageLength := LIB$LP_LINES - FOOTING_LINES
    else
	PageLength := PageSize;
    CurrentLine := PageLength + 1;
    BufferPointer := 0;
    HeaderAddr := HeadingProcedureAddr;         { save addr. of header rtn. }
    NullFileFlag := FALSE
    end
end;	{ OpenListing }

[global] procedure FlushListing (
    var lcb : aListingControlBlock
	);
var i : integer;
    arglist : integer;
{+++
Functional Description:	This procedure writes all of the text currently
			buffered to the listing file.

Calling Sequence:	See above.

Formal Arguments:	the LCB for this listing file.

Implicit Inputs:	None.

Implicit Outputs:	None.

Completion status or returned value:	None.

Side Effects:		Writes to the listing file.  Will call user's
			page heading routine when necessary.
---}
begin
if not lcb.NullFileFlag then begin
    if (lcb.CurrentLine + lcb.BufferPointer) > lcb.PageLength then
        begin	{ Call header routine. }
        arglist := 0;
        lcb.CurrentLine := lib$callg (%ref arglist, %immed lcb.HeaderAddr)
        end;
    for i := 1 to lcb.BufferPointer do begin
        writeln (lcb.OutFile, lcb.Buffer[i]);
        lcb.CurrentLine := lcb.CurrentLine + 1
        end;
    lcb.BufferPointer := 0
    end
end;	{ FlushListing }

[global] procedure WriteListing (
    var lcb : aListingControlBlock;
        data : varying [a] of char
	);
{+++
Functional Description:	This procedure adds a line of text to the buffer
			for the listing file specified.  If there is no
			room in the buffer, it is flushed first.

Calling Sequence:	See above.

Formal Arguments:	lcb - The listing control block for this listing.
			data - a character string containing the line of
			       data for this file.

Implicit Inputs:	None.

Implicit Outputs:	None.

Completion status or returned value:	None.

Side Effects:		May call FlushListing if necessary.
---}
begin
if not lcb.NullFileFlag then begin
    if (lcb.BufferPointer >= MAX_HELD_LINES)
           or (lcb.BufferPointer >= lcb.PageLength) then begin
        FlushListing (lcb);
        end;
    if length(data) > 0 then begin		      { If there's data... }
        if substr(data,1,1) = chr(12) then begin  { ...and it starts with a <FF>... }
            FlushListing (lcb);                   { start a new page }
            if length(data) > 1 then begin        { and print data if any left. }
    	        lcb.BufferPointer := lcb.BufferPointer + 1;
	        lcb.Buffer[lcb.BufferPointer] := substr(data,2,length(data)-1)
    	        end
            end
        else begin					{ did not have leading <FF> }
            lcb.BufferPointer := lcb.BufferPointer + 1;
            lcb.Buffer[lcb.BufferPointer] := data
            end
        end
    else begin					{ `data' is empty. }
        lcb.BufferPointer := lcb.BufferPointer + 1;
        lcb.Buffer[lcb.BufferPointer] := data
        end
    end
end;	{ WriteListing }

end.
