{$NOMAIN}
{+ Procedure to write lines to a RUNOFF file
+L
	Prog. Name	: GETRNO
	File Name	: OUTRNO.PAS
	Programmer	: S. G. Smith
			  E Systems
			  Melpar Division
			  7700 Arlington Blvd
			  Falls Church VA  22046
			  (703) 560 5000 X2390

	Version		: 1
	Rev 0 Date	: 10 September 1982

	Current Rev	: 1
	Date		: 1 December 1982
-L
 Description
	This procedure takes lines from a source file (opened by the main
	program), formats them as appropriate, and sends them, along with
	any other required data, to a RUNOFF source file (which has also
	been opened by the main program.
 Declaration :
PROCEDURE  Write_Runoff_File(FUNCTION Strip_Com(VAR S : String) : BOOLEAN);


The FUNCTION passed to this procedure takes a raw line of the source file
and truncates it so that it contains only the "comment" portion of the line.
If there was any comment portion to return, it returns the value TRUE;
otherwise it returns the value FALSE.
 Compile Time Resources :
	SRC:GETGLO.PAS		Global Declarations
	SRC:STRING.DEC		Declare string functions

 Bugs :
The handling of blank lines is awkward
 Changes : 
+h
 ^&1 December 1982\&
Removed special RUNOFF characters from literals as well as normal text.

Changed to do auto header levels only if output is enabled (Out_Flag is TRUE).
-h
-}
%INCLUDE SRC:GETGLO.PAS;		{Global Declarations}
%INCLUDE SRC:STRING.DEC;		{Declare string functions}


PROCEDURE  Write_Runoff_File(FUNCTION Strip_Com(VAR S : String) : BOOLEAN);
								     EXTERNAL;
PROCEDURE  Write_Runoff_File;

CONST	On_Ch = '+';		{Turn On Option}
	Off_Ch = '-';		{Turn Off Option}
	Comd = '!';		{General Command Flag}
	Imm_Lit = ';';		{Immediate Literal Flag}
	R_Fl = '.';		{RUNOFF Flag}

	LitC = 'L';		LitL = 'l';	{Literal Flag}
	NstC = 'N';		NstL = 'n';	{Nest Level Flag}
	HdrC = 'H';		HdrL = 'h';	{Change Header Level}
	FrcC = 'F';		FrcL = 'f';	{force out ;;}
	Out = ' ';

VAR	Inp, Srch : String;
	Nest_Level, Header, Space : INTEGER;
	Out_Flag, Force, Literal, Space_Flag : BOOLEAN;


    PROCEDURE  Turn_On_Option(VAR S : String);

	PROCEDURE  Start_Output;

	VAR	I : INTEGER;
		Empty : BOOLEAN;	

	BEGIN
	    Out_Flag := TRUE;
	    Delete(S, 1, 1);	{Delete "+"}

	    Empty := TRUE;
	    FOR  I := 1 TO S.Len  DO  Empty := Empty AND (S.Ch[I] = ' ');
	    IF  NOT Empty  THEN
	       BEGIN
		WRITE(Out_File, '.ST ');	{Subtitle}
		WriteString(Out_File, S);
		WRITELN(Out_File);

		WRITELN(Out_File, '.PG');	{Page}
	       END;
	END;


	PROCEDURE  Literal_On;

	BEGIN
	    Literal := TRUE;
	    WRITELN(Out_File, '.LIT');
	END;


	PROCEDURE  Inc_Header;

	BEGIN
	    Header := Header + 1;
	    IF  Header > 5  THEN Header := 5;
	END;

    BEGIN
	CASE  S.Ch[2]  OF

Out:	    Start_Output;
LitC,LitL:  Literal_On;
HdrC,HdrL:  Inc_Header;
FrcC,FrcL:  Force := TRUE;

OTHERWISE   ;	{Unknown option - do nothing}
	END;

	Clear(Inp);
    END;



    PROCEDURE  Turn_Off_Option(VAR S : String);


	PROCEDURE  Literal_Off;

	BEGIN
	    Literal := FALSE;
	    WRITELN(Out_File, '.ELI');
	END;


	PROCEDURE  Dec_Header;

	BEGIN
	    Header := Header - 1;
	    IF  Header < 1  THEN  Header := 1;
	END;

    BEGIN
	CASE  S.Ch[2]  OF

Out:	    Out_Flag := FALSE;
LitC,LitL:  Literal_Off;
HdrC,HdrL:  Dec_Header;
FrcC,FrcL:  Force := FALSE;

OTHERWISE   ;
	END;

	Clear(Inp);
    END;


    PROCEDURE  Immediate_Literal(VAR S : String);

    VAR     I : INTEGER;

    BEGIN
	Delete(S, 1, 1);	{Delete ";" char}
	IF  Force OR Out_Flag  THEN
	   BEGIN
	    IF  NOT Literal  THEN  WRITELN(Out_File, '.LIT');
	    WriteString(Out_File, S);
	    WRITELN(Out_File);
	    IF  NOT Literal  THEN  WRITELN(Out_File, '.ELI');
	    Clear(S);
	   END;
    END;


    PROCEDURE  Auto_Head(VAR S : String);

    BEGIN
	IF  S.Ch[2] <> ' '  THEN	{Auto Header Command}
	   BEGIN
	    WRITE(Out_File, '.HL ', Header : 1);
	    WriteString(Out_File, S);
	    WRITELN(Out_File);

	    Clear(S);
	   END;
    END;


    PROCEDURE  Command(VAR S : String);

	PROCEDURE  New_Header;

	VAR	Level : INTEGER;

	BEGIN
	    Level := ORD(S.Ch[3]) - ORD('0');
	    IF  Level IN [1..5]  THEN		{Otherwise ignore it}
		Header := Level;		{Set Header Level}
	END;


	PROCEDURE  Runoff;

	VAR	I : INTEGER;

	BEGIN
	    Delete(S, 1, 1);
	    WriteString(Out_File, S);
	    WRITELN(Out_File);
	    Clear(S);
	END;


    BEGIN
	IF  S.Ch[2] IN ['a'..'z']
	    THEN  S.Ch[2] := CHR(ORD(S.Ch[2]) - 32);

	CASE  S.Ch[2]  OF

HdrC:	    New_Header;
R_Fl:	    Runoff;

OTHERWISE   ;		{Ignore unknown command}
	END;

	Clear(S);
    END;


    PROCEDURE  Output_Code(VAR S : String);

	PROCEDURE  Flag_Chars(VAR S : String);

	VAR     T : String;
		I, J : INTEGER;

	BEGIN
	    Clear(T);
	    J := 1;
	    FOR  I := 1 TO S.Len  DO
	       BEGIN
		IF  S.Ch[I] IN ['&', '#', '_', '^', '\', '<', '=']  THEN
		   BEGIN
		    T.Ch[J] := Lit_Ch;
		    J := J + 1;
		   END;
		T.Ch[J] := S.Ch[I];
		J := J + 1;
	       END;

	    S.Len := J - 1;
	    FOR  I := 1 TO S.Len  DO  S.Ch[I] := T.Ch[I]; 
	END;


    BEGIN
	IF  NOT Literal  THEN
	   BEGIN
	    IF  Empty(S)  THEN
	       BEGIN
		Space_Flag := TRUE;
		Space := Space + 1;
	       END
	    ELSE
	       BEGIN
		IF  Space_Flag  THEN
		   BEGIN
		    WRITELN(Out_File, '.S ', Space : 1);
		    Space_Flag := FALSE;
		    Space := 0;
		   END;
	       END;
	   END;

	Flag_Chars(Inp);
	WriteString(Out_File, Inp);
	WRITELN(Out_File);
    END;


BEGIN
    Comment_Flag := FALSE;
    Out_Flag := FALSE;		{Do Not Output}
    Literal := FALSE;		{Modify Text}
    Force := TRUE;		{Force out ;;}
    Space_Flag := FALSE;
    Nest_Level := 0;		{Start at the left margin}
    Header := 1;		{Header Level 1}
    Space := 0;

    WHILE  NOT EOF(Inp_File)  DO
       BEGIN
	ReadString(Inp_File, Inp);
	IF  Strip_Com(Inp)  THEN		{Line is a comment}
	   BEGIN

	    CASE  Inp.Ch[1]  OF
On_Ch:		Turn_On_Option(Inp);
Off_Ch:		Turn_Off_Option(Inp);
Imm_Lit:	Immediate_Literal(Inp);
' ':		IF  Out_Flag  THEN  Auto_Head(Inp);
Comd:		Command(Inp);

OTHERWISE	;
	    END;	{Case}

	    IF  Out_Flag AND (Inp.Len > 0)  THEN	{Continue}
		    Output_Code(Inp);		{Possibly modify}
	   END;
       END;
END;