home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPMHELP / PRINTHLP.LBR / PRINTHLP.PQS / PRINTHLP.PAS
Pascal/Delphi Source File  |  2000-06-30  |  7KB  |  238 lines
  1. {$V-}
  2. Program Print_Help;
  3.  
  4. { This program prints ZCPR V3.0 Help files on your printer. It will
  5.   strip off the eigth bit on help files processed by WordStar (TM
  6.   micropro) and recurse down the help tree to get all of the files.
  7.   If you define BF_On and BF_Off the portions of the help file in
  8.   standout mode (ie preceeded by ^A and trailed by ^B) will be printed
  9.   in with those two strings surrounding them.
  10.  
  11.   Written By: Chuck McManis, August 16th 1985
  12.   Do with it what you will but don't ask me to support your changes.
  13.   }
  14.  
  15. Const
  16.   MaxHelp  = 16;
  17. {
  18.   (* I use these for the Mannesmann Tally 160L *)
  19.   BF_On = ^['[=z';                (* Turn on Enhanced Print (BoldFace) *)
  20.   BF_Off = ^['[>z';               (* Turn off Enhanced Print (Boldface) *)
  21.   Lst_Init = ^['[1y'^['[5y';      (* Initialization String *)
  22.   Lst_Exit = ^['[0y'^['[4w';      (* Deinitialization String *)
  23.   UL_On = ^['[4m';                (* Start Underlining Characters *)
  24.   UL_Off = ^['[0m';               (* Stop Underlining Characters *)
  25. }
  26.   Lst_Init = '';      (* Initialization String *)
  27.   Lst_Exit = '';      (* Deinitialization String *)
  28.   BF_On = '';
  29.   BF_Off = '';
  30.   UL_On = '';
  31.   UL_Off = '';
  32.   Page_Length = 66;   (* Define these for your printer *)
  33.   CanFormFeed = False;
  34.   Left_Margin = 4;
  35.   Bottom_Margin = 5;
  36.   TabWidth = 8;
  37.  
  38. Type
  39.   AnyString = String[255];
  40.  
  41. Var
  42.   Line_Buf, Header : AnyString;
  43.   Helpfiles : Array [0..MaxHelp] of Text;
  44.   Page_Num,Current_Line,CurFile, I, J, K : Integer;
  45.   HelpFileName, TempName : String[20];
  46.   HasType : Boolean;
  47.  
  48. { Getfile will check the CP/M Command line to see if the user typed a filename
  49.   after the command that invoked us, if not a filename will be specifically
  50.   asked for. }
  51.  
  52. Procedure GetFile;
  53.  
  54.   Begin
  55.     For I := 1 to 15 do HelpFileName[I] := ' ';
  56.     If (Mem[$80]=0) or (Mem[$80]=$FF) Then
  57.       Begin
  58.         Write('Enter Help file to print : ');
  59.         Readln(HelpFileName);
  60.       End
  61.     Else
  62.     Begin
  63.       For I := 1 to Mem[$80] Do
  64.         HelpFileName[I] := Chr(Mem[I+$80]);
  65.       HelpFileName[0] := Chr(Mem[$80]);
  66.     End;
  67.     Assign(HelpFiles[0],HelpFileName);
  68.     Reset(HelpFiles[0]);
  69.     Writeln('Printing Help file ',HelpFileName:Length(HelpFileName));
  70.   End; (* GetFile *)
  71.  
  72. { This function does two things, first it checks to see if the input character
  73.   was a ^A (Boldface ON) or ^B (Boldface OFF) control, and if it is replace
  74.   it with the appropriate escape sequence. Second, if it is a <TAB> character
  75.   it inserts enough spaces to emulate the tab and throws the tab away.
  76. }
  77.  
  78. Function Format(Our_String : AnyString) : AnyString;
  79.  
  80. Var
  81.   I, Column : Integer;
  82.   Tmp_string : AnyString;
  83.   New_Char : Char;
  84.  
  85. Begin
  86.   Column := 0;
  87.   Tmp_String := '';
  88.   For I := 1 to Length(Our_String) do
  89.   Begin
  90.     Case Our_String[I] of
  91.       ^A : Tmp_String := Tmp_String + BF_On;
  92.       ^B : Tmp_String := Tmp_String + BF_Off;
  93.       ^I : Begin
  94.              Repeat
  95.                Tmp_String := Tmp_String + ' ';
  96.                Column := Column + 1;
  97.              Until ((Column Mod TabWidth) = 0);
  98.            End;
  99.       Else
  100.       Begin
  101.         Tmp_String := Tmp_String + Our_String[I];
  102.         Column := Column + 1;
  103.       End;
  104.     End; (* Case *)
  105.   End; (* For Loop *)
  106.   Format := Tmp_String;
  107. End;
  108.  
  109. { This routine gets data from the file. Since a lot of the help files have
  110.   been created using Wordstar (TM MicroPro) They have bit 7 set on some
  111.   characters. This can really confuse Turbo so this routine fills in for
  112.   what Readln should really be able to do. It gets single characters and
  113.   masks off Bit 7, then (if it detects a <CR>) it passes it on to the
  114.   main code.
  115. }
  116. Procedure GetLine(Var Line : AnyString);
  117.  
  118. Var
  119.   Next_Chr : Char;
  120.   Done : Boolean;
  121.  
  122. Begin
  123.   Line := '';
  124.   Done := False;
  125.   Repeat
  126.     Read(HelpFiles[CurFile],Next_Chr);
  127.     If Eoln(Helpfiles[CurFile]) Then
  128.     Begin
  129.       Readln(HelpFiles[CurFile]);
  130.       Done := True;
  131.     End;
  132.     Next_Chr := Chr(Ord(Next_Chr) And $7F);
  133.     If Next_Chr = ^M then
  134.     Begin
  135.       Done := True;
  136.       Read(HelpFiles[CurFile],Next_Chr); { Eat the Line feed }
  137.     End
  138.     Else
  139.       If (Next_Chr <> ^J) And (Next_Chr <> ^L) Then
  140.         Line := Line + Next_Chr;
  141.   Until Done or Eof(HelpFiles[CurFile]);
  142. End;
  143.  
  144. { Advance Printer to the Next Page. This actually advances the printer and
  145.   Prints the header. The header is composed of either the file name or the
  146.   latest information section that was processed. If you have set CanFormFeed
  147.   to FALSE above it will fake a form feed by printing enough <LF> characters
  148.   to make up a page.
  149. }
  150. Procedure Form_Feed;
  151.  
  152. Begin
  153.   If CanFormFeed Then
  154.     Writeln(LST,^L)
  155.   Else
  156.     While (Current_Line Mod Page_Length) <> 0 do
  157.     Begin
  158.       Writeln(LST);
  159.       Current_Line := Current_Line + 1;
  160.     End;
  161.   Current_Line := 4;
  162.   Writeln(LST);
  163.   Writeln(LST,' ':Left_Margin,Header,' ':60-(Length(Header)+Left_Margin),
  164.               'Page ',Page_Num:3);
  165.   Writeln(LST);
  166.   Writeln(LST);
  167.   Page_Num := Page_Num + 1;
  168. End;
  169.  
  170. { Print a line to the printer and add in the leftmargin if defined above. The
  171.   purpose of the left margin is to skip over holes in the paper that allow the
  172.   sheets to be stored in a 3 ring binder.
  173. }
  174. Procedure Print(Line : AnyString);
  175.  
  176. Begin
  177.   Writeln(LST,' ':Left_Margin,Line);
  178.   Current_Line := Current_Line + 1;
  179.   If (Current_Line Mod (Page_Length - Bottom_Margin)) = 0 Then Form_Feed;
  180. End;
  181.  
  182. { * * * * - -   M A I N   C O D E   - - * * * * }
  183. Begin
  184.   GetFile;
  185.   CurFile := 0;
  186.   Page_Num := 1;
  187.   Current_Line := 0;
  188.   Write(LST,Lst_Init);
  189.   Header := 'Helpfile ' + HelpfileName;
  190.   Form_Feed;
  191.   Repeat
  192.     If Eof(HelpFiles[CurFile]) Then
  193.     Begin
  194.       Close(HelpFiles[CurFile]);
  195.       CurFile := CurFile - 1;
  196.       If CurFile = -1 Then CurFile := 0;
  197.     End
  198.     Else
  199.       GetLine(Line_Buf);
  200.     Line_Buf := Format(Line_Buf);
  201.     If Length(Line_Buf) = 0 Then Print('')
  202.     Else
  203.     Begin
  204.       If Line_Buf[1] = ':' Then
  205.       Begin
  206.         J := 0;
  207.         For I := 2 to Length(Line_Buf) do
  208.           If (Line_Buf[I] = ':') And (J = 0) Then J := I;
  209.         If J <> 0 Then
  210.         Begin
  211.           CurFile := CurFile + 1;
  212.           HelpFileName := Copy(Line_Buf,J+1,20);
  213.           HasType := False;
  214.           For I := 1 to Length(HelpFileName) do
  215.             If HelpFileName[I] = '.' Then HasType := True;
  216.           If Not HasType Then HelpFileName := helpfilename + '.HLP';
  217.           Writeln('Opening file "',HelpFileName,'"');
  218.           Assign(HelpFIles[Curfile],HelpFIlename);
  219.           Reset(HelpFiles[CurFile]);
  220.           Header := 'Subfile ' + HelpFileName;
  221.           Form_Feed;
  222.         End (* If : J <> 0 *)
  223.         Else
  224.         Begin
  225.           Header := Copy(Line_Buf,2,40);
  226.           Print('');
  227.           Print(UL_On+Header+UL_Off);
  228.           Print('');
  229.         End; (* Else : Line_Buf[2] = ':' *)
  230.       End (* If Line_Buf[1] = ':' *)
  231.       Else
  232.       Begin
  233.         If Line_Buf <> ^L Then Print(Line_Buf);
  234.       End; (* Else *)
  235.     End; (* Else : Length > 0 *)
  236.   Until (CurFile = 0) And (Eof(HelpFIles[0]));
  237.   Writeln(LST,Lst_Exit);
  238. End.