program PRINT;

{ This program is released to the public domain for }
{ non-commercial use only }

{ Author:  Robert J. Rubin : rjr                  }

{ History: 03-Jan-1986:rjr - Release version 1.00 }
{          03-Feb-1986:rjr - version 1.01 fixed bug in }
{                            initialization: Init_Print}
{                            before defining Footer    }
{          05-Mar-1986:rjr - version 1.10 modified for }
{                            for TURBO 3.0             }
{          17-May-1986:rjr - version 1.11 change Page_Column }
{                            default. Add BP dot cmd.        }
{          31-May-1986:rjr - version 1.20 .PC now resets the }
{                            footer_text.                    }

{$i-  -- Disable I/O Error Handling}

const
    version     = '1.20';
    date         = '31-May-1986';
    PrinterType = 'Gemini 10x';
    on          = true;
    off         = false;
    Page_Marker = '#';
    Line_Num_X  = 37;
    Line_Num_Y  =  9;
    Soft_Hyphen = $1f;
    Uniprt      = 21; {uni-directional print toggle}

type
    cmdlinetype = string[127];
    TextLine    = string[255];
    FlagBank    = array[1..26] of boolean;

var
   FileName                              : cmdlinetype;
   ComLine                               : cmdlinetype absolute $0081;
   ComLine_Length                        : byte absolute $0080;
   TwoLine_Ctrl                          : cmdlinetype;
   InFile                                : text;
   symbol                                : char;
   docLine, Header_Text, Footer_Text     : TextLine;
   Def_Status, Status, HE_status,
   FO_status                             : FlagBank;
   Page_Length, Top_Margin,
   Bottom_Margin, Header_Margin,
   Footer_Margin, Line_Spacing,
   Page_Col_Num, Page_Num, Line_Num,
   Page_Offset, i                        : integer;

{$i config1.pas  --  Printer Configuration with Configuration include file}
{$i initial.pas  --  Initializing Procedures include file}

procedure Update_Status_Line(flag : FlagBank);
var
   i : integer;

begin
   GotoXY(1,13);
   for i := 1 to 26 do
      if flag[i] then
         write('* ')
      else
         write('  ');
end;


procedure Load_Print_Style(InFlag, OutFlag : FlagBank);
{ This procedure will send the necessary commands to
  the printer such that it is set up like OutFlag.  InFlag
  is included to eliminate redundant codes sent to printer }

var
   i : integer;

begin
   for i := 1 to 26 do
      if (InFlag[i] <> OutFlag[i]) and (Pos(chr(i),TwoLine_Ctrl) = 0) then
         Ctrl_Printer(i, OutFlag[i], OutFlag);
   Update_Status_Line(OutFlag);
end;


Function NewWord(C2,C1:Char) : boolean;
     { Returns TRUE if at First Character of Word }
begin
   if (ord(c1) <> $20) and (ord(c2) = $20) then
      NewWord := true
   else
      NewWord := false;
end;

Function EndWord(C2,C1:Char) : boolean;
     { Returns TRUE if at Last Character of Word }
begin
   if (ord(c1) = $20) and (ord(c2) <> $20) then
      EndWord := true
   else
      EndWord := false;
end;


procedure PrintLine(msg : TextLine; var flag : FlagBank);
     { This procedure prints MSG to the printer }
var
   i : integer;


   procedure PrintLine1(Line1 : TextLine; var Flag : FlagBank);
   var
      i       : integer;
      LastChr : char;
      dummyFlag : FlagBank;


   begin
      dummyFlag := flag;
      LastChr := ' ';
      for i := 1 to length(Line1) do
         if ord(Line1[i]) in [1..26] then
            begin
               if ord(Line1[i]) <> 19 then
                  Ctrl_Printer(ord(Line1[i]), not(flag[ord(Line1[i])]), flag)
               else
                  begin
                     Flag[19] := not(Flag[19]);
                     Ctrl_Printer(19,off,flag);
                  end;
               if not(ord(Line1[i]) in [$0A, $0D]) then
                  Update_Status_Line(flag);
            end
         else
            begin
               if NewWord(LastChr,Line1[i]) and flag[19] then
                  Ctrl_Printer(19,on,dummyFlag);
               if EndWord(Lastchr,Line1[i]) and flag[19] then
                  Ctrl_Printer(19,off,dummyFlag);
               LastChr := Line1[i];
              write(lst,Line1[i]);
            end;
   end;


   procedure PrintLine2(var Line1 : TextLine; var flag : FlagBank; Prtr_Ctrl : integer);
      var
         Line2    : TextLine;
         i        : integer;
         TempFlag : FlagBank;

   begin
      Line2 := '';
      i := 1;
      while i <= length(Line1) do
         begin
              if ord(Line1[i]) = Prtr_Ctrl then
                 begin
                    flag[Prtr_Ctrl] := not(flag[Prtr_Ctrl]);
                    delete(Line1,i,1);
                 end
              else
                 begin
                    if flag[Prtr_Ctrl] and (ord(Line1[i]) <> $0A) then
                       case Prtr_Ctrl of
                          18 : begin
                                  Line2  := Line2 + Line1[i];
                                  if ord(Line1[i]) >= 32 then Line1[i] := ' ';
                               end;

                          24 : if ord(Line1[i]) > 32 then
                                  Line2 := Line2 + 'X'
                               else
                                  Line2 := Line2 + Line1[i];
                       end
                    else
                       if ord(Line1[i]) >= 32 then
                          Line2 := Line2 + ' '
                       else if ord(Line1[i]) <> $0A then
                          Line2 := Line2 + Line1[i];
                 i := i + 1;
                 end;
         end;
      TempFlag := Flag;
      Ctrl_Printer(Prtr_Ctrl,on,Tempflag);
      PrintLine1(Line2, TempFlag);
      Load_Print_Style(TempFlag, flag);
      Ctrl_Printer(Prtr_Ctrl,off,flag);
   end;


begin    { procedure PrintLine }
   i := 1;
   repeat
      if (ord(msg[i]) = Soft_Hyphen) then
         if not(ord(msg[i+1]) in [$0D, $0A]) then
            delete(msg,i,1)
         else
            msg[i] := '-';
      i := i + 1;
   until i >= length(msg);

   for i := 1 to length(TwoLine_Ctrl) do
      if flag[ord(TwoLine_Ctrl[i])] or (Pos(TwoLine_Ctrl[i], msg) > 0) then
         PrintLine2(msg, flag, ord(TwoLine_Ctrl[i]));
   PrintLine1(msg, flag);
end;


procedure Insert_Page_Num(Line1 : TextLine; var Line2 : TextLine);
{ This procedure replaces the Page_Marker character with the
  current Page_Num.}

var
   i        : integer;
   str_page : string[5];

begin
   i := 1;
   Line2 := chr($0D);
   while i <= length(Line1) do
      begin
         if Line1[i] = Page_Marker then
            begin
               Str(Page_Num, str_page);
               Line2 := Line2 + str_page;
            end
         else
            Line2 := Line2 + Line1[i];
         i := i + 1;
      end;
end;


procedure Advance_Page;
begin
   Ctrl_Printer(13,on,Status);
   Ctrl_Printer(10,on,Status);
end;


procedure EndPage;
var
   OutLine : TextLine;

begin
   while Line_Num < Page_Length - Bottom_Margin + Footer_Margin do
      Advance_Page;
   if length(Footer_Text) > 0 then
      begin
         Load_Print_Style(Status, FO_Status);
         Insert_Page_Num(Footer_Text, OutLine);
         PrintLine(OutLine, FO_Status);
         Load_Print_Style(FO_Status, Status);
      end;
   while Line_Num <= Page_Length do
      Advance_Page;
   Line_Num := 1;
end;


procedure StartPage;
var
   OutLine : TextLine;

begin
   Page_Num := Page_Num + 1;
   GotoXY(18, 9);
   write(Page_Num:4);
   GotoXY(Line_Num_X, Line_Num_Y);
   write(Line_Num:3);
   if Status[3] then
      Ctrl_Printer(3,on,Status);
   while Line_Num < Top_Margin - Header_Margin - 1 do
      Advance_Page;
   if length(Header_Text) > 0 then
      begin
         Load_Print_Style(Status, HE_Status);
         Insert_Page_Num(Header_Text, OutLine);
         PrintLine(OutLine, HE_Status);
         Load_Print_Style(HE_Status, Status);
      end;
   while Line_Num <= Top_Margin  do
      Advance_Page;
end;

{$i dotcmd.pas  -- Dot Commands include file}



begin                         { ******* M A I N   P R O G R A M ******** }
   writeln;
   writeln('PRINT ',version,'   ',date);
   writeln('copyright (c) 1986 by Robert J. Rubin');
   writeln;


   FileName := '';

   { The following is for reading parameters in Turbo 3.0 }
   { Comment this out is using TURBO 2.0, and use code below }
{   if paramcount <> 0 then
      FileName := paramstr(1) ;}

   { This is for reading parameters in TURBO 2.0 (CP/M only) }
   { ComLine is an absolute string at $0081, with ComLine_Length }
   { being at $0080.  This is a method to read the command line. }

   i := 0;
   while i < ComLine_Length do
      begin
         i := i + 1;
         if ComLine[i] <> ' ' then
            FileName := FileName + ComLine[i];
      end;


   if length(FileName) = 0 then begin
      write('_filename: ');
      readln(FileName);
   end;

   Assign(InFile,FileName);
   Reset(Infile);
   if IOresult <> 0 then begin
      writeln('File not found');
      halt;
      end;

   Initialize;
   InitScreen(filename);
   Update_Status_Line(Status);

   while not eof(InFile) do
      begin
         docLine := '';
         repeat
            read(InFile, symbol);
            symbol := chr(ord(symbol) and $7f);
            docLine := docLine + symbol;
         until (ord(symbol) = $0A) or (length(docLine) = 255) or eof(Infile);
         if docLine[1] = '.' then
            ExecDot
         else
            begin
               if Line_Num > Page_Length - Bottom_Margin then EndPage;
               if Line_Num = 1 then StartPage;
               PrintLine(docLine, Status);
            end;
      end;
   if Line_Num <> 1 then EndPage;

   close(InFile);
   UnInit_Print;
   writeln;
   writeln;
   writeln;
   writeln;
   writeln;

end.