home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / printer / sideways.pas < prev    next >
Pascal/Delphi Source File  |  1994-03-05  |  4KB  |  112 lines

  1. {$line+,$symtab-,$linesize:131,$pagesize:65}
  2. program sideways(input,output,infile);
  3.  
  4. {COPYRIGHT @ 1983
  5.       Jim Holtman
  6.       35 Dogwood Trail
  7.       Randolph, NJ 07869
  8.       (201) 361-3396}
  9.  
  10. {This program will print the `infile' sideways on an EPSON MX-80 Printer.
  11.  It makes use of the characters in the PC's ROM for the graphics mode of
  12.  the CRT. The characters in the file are `looked up' and then the graphics
  13.  mode of the printer is used for output.}
  14.  
  15. { The DEBUG statements will output on the CRT the current line being printed.
  16.   The line will appear vertically. }
  17.  
  18. type
  19.     vstr = super array[0..*] of char;
  20.     CHAR_PER_LINE = 0..2000;        {Maximum input line size}
  21.  
  22. const
  23.     EOF = chr(26);            {TEXT EOF character}
  24.     EOL = chr(13);
  25.     TAB = chr(9);            {expand TABs}
  26.     IGNORE = [chr(0)..chr(8),chr(10)..chr(#1f),chr(#80)..chr(#FF)];
  27.     MAX_LINES = 48;            {Lines/Page}
  28.     SPACES_PER_LINE = 2;        {2/72th inch space between lines}
  29.     SPACES_PER_LETTER = 8;        {DOT size of characters}
  30.  
  31. var
  32.     lptr : array[1..MAX_LINES] of ^vstr; {input lines}
  33.     inbuf : array[CHAR_PER_LINE] of char;
  34.     linesize : CHAR_PER_LINE;
  35.     indx : 0..MAX_LINES;
  36.     line : 0..MAX_LINES+1;
  37.     infile : file of char;
  38.     printer : text;
  39.     col : CHAR_PER_LINE;
  40.     pchar : integer;
  41.     ichar : 0..7;
  42.     max : CHAR_PER_LINE;
  43.     rom : ads of array[0..32000] of char;
  44.  
  45. value
  46.   {NOTE!!!!
  47.      The following declarations define the segment and offset values
  48.      for the characters in the PC version of the ROM. For the XT, check
  49.      the TECH MANUAL for the correct values.}
  50.  
  51.     rom.s := #F000; {address of the CRT character generation}
  52.     rom.r := #FA6E; {matrix in the ROM -- for non-XT versions of PC}
  53.  
  54. begin
  55.     assign(printer,'lpt1:');            {open the printer}
  56.     rewrite(printer);
  57.     reset(infile);
  58.     repeat
  59.     max := 0;
  60.     linesize := 0;
  61.     line := 1;
  62.     while (line <= MAX_LINES) do begin
  63.         if infile^ = EOL then begin {check for End-of-Line}
  64.         new(lptr[line],linesize+1);  {allocate string storage}
  65.         movel(adr inbuf[0],adr lptr[line]^[0],wrd(linesize+1)); {save}
  66.         if linesize > max then max := linesize;
  67.         linesize := 0;
  68.         line := line+1;
  69.         get(infile);
  70.         writeln(output,'<<');   {--DEBUG--}
  71.         cycle;
  72.         end;
  73.         if infile^ = EOF then break;
  74.         if not(infile^ in IGNORE) then begin
  75.         if infile^ = TAB then
  76.             repeat        {Expand TABs}
  77.             linesize := linesize+1;
  78.             inbuf[linesize] := ' ';
  79.             until (linesize mod 8) = 0
  80.         else begin
  81.             linesize := linesize+1;
  82.             inbuf[linesize] := infile^;
  83.         end;
  84.         write(output,infile^);    {--DEBUG--}
  85.         end;
  86.         get(infile);
  87.     end;
  88.     writeln(output,'line=',line,' max=',max);  {--DEBUG--}
  89.     if infile^ <> EOF then line := MAX_LINES
  90.     else line := line-1;
  91.     for col := 1 to max do begin    {Output collected lines}
  92.         write(printer,chr(27)*'A'*chr(SPACES_PER_LETTER)*chr(27)*'K',
  93.              chr((line*(8+SPACES_PER_LINE)) mod 256),
  94.              chr((line*(8+SPACES_PER_LINE)) div 256));
  95.         for indx := line downto 1 do begin    {Scan next column}
  96.         {if column pointer is larger than string, output BLANK}
  97.         if col > upper(lptr[indx]^) then pchar := ord(' ')
  98.         else pchar := ord(lptr[indx]^[col]);
  99.         write(output,chr(pchar));  {--DEBUG--}
  100.         pchar := pchar*8;
  101.         for ichar := 7 downto 0 do {Pickup character, a line at a time}
  102.             write(printer,rom^[pchar+ichar]); {from ROM}
  103.         for ichar := 1 to SPACES_PER_LINE do write(printer,chr(0));
  104.         end;
  105.         writeln(printer);
  106.         writeln(output);        {--DEBUG--}
  107.     end;
  108.     for indx := 1 to line do dispose(lptr[indx]);  {Free up space on HEAP}
  109.     page(printer);
  110.     until infile^ = EOF;
  111. end.
  112.