home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / p / xprint.lbr / XPRINT.PZS / XPRINT.PAS
Encoding:
Pascal/Delphi Source File  |  1993-10-25  |  7.3 KB  |  213 lines
  1. PROGRAM CROSSPRINT;  {Print document sideways}
  2.  
  3. {                  Released to the Public Domain
  4.                          by Gary Bohn, 1985
  5.       CROSSPRINT is written in TURBO PASCAL, Ver 2.0, for the Epson
  6.   MX-80 printer with GRAFTRAX.
  7.       CROSSPRINT prints text files sideways on the paper, thus al-
  8.   lowing long lines (ie spreadsheets and PERT charts) to be printed
  9.   as continuous lines (up to 255 characters/line).  The left-to-right
  10.   document is printed top-to-bottom on the paper so that the top of
  11.   the document is printed to the right side of the printer.  ASCII
  12.   values in the file which are outside the range [32..127] are set
  13.   to space (ASCII 32) before printing.
  14.       The normal 5 x 9 matrix used for the character set becomes a
  15.   10 x 5 matrix.  (One extra dot for interline spacing.)  Only 5 of
  16.   the 8 pins addressable by dot graphics are used.  The paper is
  17.   moved up by 2/216" to print "dots between dots" to form characters
  18.   with angles (N, X, etc).  The normal LF/CR sequence becomes a
  19.   paper shift of 17/216".
  20.       The low density graphics mode (480 dots/8" line) creates charac-
  21.   ters slightly taller than the normal print mode.  The pitch of the
  22.   sideways characters is slightly less than 10 characters/inch.
  23.   Printing is slow since the printer prints in only one direction and
  24.   requires two passes for each character.  The program does eliminate
  25.   needless head movement by detecting the lowest line not containing
  26.   a space.
  27.       The file containing the character data base (XPRINT.FNT) must
  28.   reside on the default disk drive.
  29.       CROSSPRINT may be altered for other dot matrix printers by
  30.   changing the printer graphics commands in Procedure Xprint.
  31.       CROSSPRINT is self-prompting.  Printing may be interrupted at
  32.   any time with Cntl-C.
  33. }
  34. {$R+}             {Set Range checking active}
  35. {$U+}             {Allow Cntl-C interrupt at any time}
  36.  
  37. CONST
  38.   ClrScrn= #26;                        {Clear screen, ADM-3A terminal}
  39.   Escape= #27;
  40.   LineFeed= ^J;
  41.   FormFeed= ^L;
  42.   LinesPerPage= 48;                    {8.5" paper, 8" print line}
  43.   MaxLength= 255;                      {Max of 255 characters per line}
  44.   Printer= 'Epson MX-80';
  45.   Reset= '@';                 {Reset printer to power-on state (MX-80)}
  46.  
  47. VAR
  48.   Line: Array [1..LinesPerPage] of String[MaxLength];
  49.   LineNo, LongLine, I, J: Byte;
  50.   FilVar: Text;
  51.   Resp: Char;
  52.   Ltrs: Array[32..127, 1..20] of Byte;
  53.  
  54. PROCEDURE GETFONT;    {Read data base to create sideways letters}
  55.  
  56. TYPE
  57.   CharData= Record
  58.               PinCode: 0..127;
  59.             End;  {CharData}
  60.  
  61. VAR
  62.   I, J: Byte;
  63.   K: Integer;
  64.   FontData: File of CharData;
  65.   Letter: CharData;
  66.   OK: Boolean;
  67.  
  68. Begin
  69.   Assign(FontData, 'XPRINT.FNT');
  70.   Repeat
  71.     {$I-}                          {Turn off I/O error handling}
  72.     Reset(FontData);
  73.     {$I+}                          {Turn it back on}
  74.     OK:= (IOResult= 0);            {Find file?}
  75.     If Not OK Then
  76.     Begin
  77.       Writeln(LineFeed,'Can''t find file ''XPRINT.FNT'' on default drive.':63);
  78.       Write(LineFeed, 'Press RETURN when ready.  ':52);
  79.       Readln(Resp);
  80.     End;  {If Not OK}
  81.   Until OK;
  82.  
  83.   K:= 0;
  84.   For I:= 32 to 127 Do            {ASCII values from 32 to 127}
  85.     For J:= 1 to 20 Do            {20 bytes per character}
  86.     Begin
  87.       Seek(FontData, K);
  88.       Read(FontData, Letter);
  89.       Ltrs[I,J]:= Letter.PinCode;
  90.       K:= K + 1;
  91.     End; {For J ...}
  92.   Close(FontData);
  93. End;  {Procedure GetFont}
  94.  
  95. PROCEDURE XPRINT;  {Print sideways}
  96.  
  97. VAR
  98.   Ascii, I, J, K, L: Byte;
  99.   DotPrint, HeadShift, LineSpace: String[4];
  100.   NumDots, NumDot1, NumDot2, LastChar: Integer;
  101.  
  102. Begin                             {Printer - Unique ---- Epson MX-80}
  103.   HeadShift:= Escape + '3' + CHR(2);   {Shift 2/216" for second pass}
  104.   LineSpace:= Escape + '3' + CHR(17);  {Shift 17/216" for next line}
  105.  
  106.   For I:= 1 to LongLine Do
  107.   Begin
  108.     LastChar:= 1;                {Don't move head for spaces}
  109.     While ((Line[LastChar][I] = ' ') And (LastChar < LinesPerPage)) Do
  110.       LastChar:= LastChar + 1;
  111.  
  112. {    60 dot/inch graphics & proper number of dots per pass
  113.      Printer - Unique ---- Epson MX-80
  114. }
  115.     NumDots:= 10 * (LinesPerPage - LastChar + 1);    {10 Dots/Character}
  116.     NumDot1:= NumDots Mod 256;                       {Need remainder}
  117.     NumDot2:= NumDots Div 256;                       {Integer part}
  118.     DotPrint:= Escape + 'K' + CHR(NumDot1) + CHR(NumDot2);
  119.  
  120.   For J:= 0 to 1 Do              {Two passes per character}
  121.     Begin
  122.       Write(Lst, DotPrint);                 {Set printer for dot graphics}
  123.       For L:= LinesPerPage DownTo LastChar Do
  124.       Begin
  125.         Ascii:= Ord(Line[L][I]);
  126.         If Ascii > 127 Then Ascii:= Ascii - 128;       {Don't want Bit 7}
  127.         If Not (Ascii In [32..127]) Then Ascii:= 32;
  128.         For K:= 1 to 10 Do                {Print dots forming characters}
  129.           Write(Lst, CHR(Ltrs[Ascii, K + J * 10]));
  130.       End; {For L ...}
  131.       Writeln(Lst, HeadShift);                {Move head for second pass}
  132.     End; {For J ...}
  133.     Writeln(Lst, LineSpace);                    {Move head for next line}
  134.   End; {For I ...}
  135.   Write(Lst, FormFeed);
  136. End; {XPrint}
  137.  
  138. PROCEDURE CLRPAGE;  {Set array elements to 'Space'}
  139.  
  140. VAR
  141.   I, J: Byte;
  142.  
  143. Begin
  144.   For I:= 1 to LineNo Do
  145.     For J:= 1 to LongLine Do
  146.       Line[I][J]:= ' ';
  147. End; {ClrPage}
  148.  
  149. PROCEDURE GETNAME;  {Get name of file to be printed}
  150.  
  151. VAR
  152.   FileName, Newname: String[14];
  153.   OK: Boolean;
  154.  
  155. Begin
  156.   Repeat
  157.     Write('Enter name of file to be listed (ex: A:FileName.Ext): ');
  158.     Readln(FileName);
  159.  
  160.     NewName:= '';                 {Set FileName to uppercase}
  161.     For I:= 1 to Length(FileName) Do
  162.       NewName:= NewName + UpCase(Copy(FileName, I, 1));
  163.     FileName:= NewName;
  164.  
  165.     Assign(FilVar, FileName);
  166.     {$I-}                        {Turn off I/O error handling}
  167.     Reset(FilVar);
  168.     {$I+}                        {Turn it back on}
  169.     OK:= (IOResult = 0);         {Find File?}
  170.     If Not OK Then
  171.       Writeln(LineFeed, LineFeed, 'File ', FileName, ' not found.', LineFeed);
  172.   Until OK;
  173.  
  174.   Writeln(ClrScrn, 'Printing file ', FileName, ' sideways.');
  175.  
  176. End;  {GetName}
  177.  
  178. PROCEDURE READFILE;  {Read lines from file to be printed}
  179.  
  180. Begin
  181.   LineNo:= 0;
  182.   While ((LineNo < LinesPerPage) and (Not EOF(FilVar))) Do
  183.   Begin
  184.     LineNo:= LineNo + 1;
  185.     Readln(FilVar, Line[LineNo]);
  186.   End; {While LineNo < LinesPerPage and Not EOF}
  187.  
  188.   LongLine:= 0;                 {What is longest line?}
  189.   For I:= 1 to LineNo Do
  190.     If Length(Line[I]) > LongLine Then
  191.       LongLine:=  Length(Line[I]);
  192.  
  193. End; {ReadFile}
  194.  
  195. Begin
  196.   Writeln(ClrScrn, 'CROSSPRINT':45);
  197.   Writeln(Printer:(40 + Length(Printer) Div 2), LineFeed);
  198.   LongLine:= MaxLength;   {To initialize entire array to 'space'}
  199.   LineNo:= LinesPerPage;  {Ditto}
  200.  
  201.   GetFont;                {Read sideways character data base}
  202.   GetName;                {Get name of file to be printed}
  203.  
  204.   Repeat
  205.     ClrPage;              {Clear array to 'space'}
  206.     ReadFile;             {Read lines from file}
  207.     XPrint;               {Print sideways}
  208.   Until EOF(FilVar);
  209.  
  210.   Write(Lst, Escape, Reset);      {Reset printer to power-on state.}
  211.   Write(ClrScrn);
  212. End.  {CrossPrint}
  213.