home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1996 September / Simtel-MSDOS-Sep1996-CD2.iso / disc2 / turbopas / grafdump.pas < prev    next >
Pascal/Delphi Source File  |  1990-09-08  |  7KB  |  255 lines
  1. Unit grafdump;
  2.  
  3. Interface
  4.  
  5.    Uses
  6.       dos, graph;
  7.  
  8.    Procedure hardcopy(inverse: boolean;
  9.                       gmode, gdevice: integer);
  10.  
  11.    { MGA, CGA, Herc, EGA, VGA Graphics screen dump routine
  12.      for EPSON  compatible printers. Turbo Pascal, v4 or better
  13.  
  14.      Any non black screen pixel (in first page) is printed. }
  15.  
  16.  
  17. Implementation
  18.  
  19.    Procedure hardcopy(inverse: boolean;
  20.                       gmode, gdevice: integer);
  21.  
  22.     { Inverse true produces an inverse image.
  23.       Gmode and gdevice are the arguments returned from Turbo's
  24.            InitGraph procedure.
  25.  
  26.       Dot spacing (mode) and multiples of each byte across the page
  27.           are manipulated to give the 'best' aspect ratio on the print.
  28.  
  29.       Mode: 1 = Double-Density 120 dpi,        2 = High-Speed D-D 120 dpi
  30.             3 = Quad-Density 240 dpi,          4 = 80 dpi
  31.             5 = 72 dpi,                        6 = 90 dpi
  32.             0 = 60 dpi.
  33.  
  34.       Pre-FX series of EPSON printers should only use Mode 1.
  35.  
  36.       This routine uses mode 2 for VGAHi (ymaxglbl=479) and CGACn
  37.            (xmaxglb=319), -  mode 6 for all other gmodes.
  38.            CGACn print is 1/2 page and crude, rest are full page
  39.  
  40.       Nb. Uses ReadMode 1 for EGA & VGA to cmp black with all bit planes.
  41.  
  42.       Reference : "Programmers guide to PC & PS/2 Video System"
  43.                    R Wilton, MicroSoft Press, 1987
  44.            Graft:  Gordon Findlay, Christchurch School of Medicine
  45.                     (gordon%chmeds.ac.nz@cunyvm.cuny.edu)
  46.                    Mac McLennan, Forest Research Institute
  47.                                  Christchurch, New Zealand
  48.     }
  49.  
  50.       Const
  51.          esc = 27;
  52.          lptportnum = 1; { Defaults to LPT1. 2 = LPT2 }
  53.  
  54.       Var
  55.          regs: registers;
  56.          boff: integer;
  57.          mode, pbyte, sb, i, j, n1, n2: byte;
  58.          pwide, grafbase, ymaxglb, xmaxglb: word;
  59.  
  60.  
  61.       Function nextpbyte(x, y: word): byte;
  62.  
  63.  
  64.          Begin
  65.          Case gdevice Of
  66.             cga:
  67.                If (gmode = cgahi) Then
  68.                   pbyte := mem[grafbase: (y shr 1) * 80 + (y And
  69.                            1) * $2000 + (x shr 3)]
  70.                Else
  71.                   Begin
  72.                   pbyte := 0;
  73.                   i := 0;
  74.                   boff := (y shr 1) * 80 + (y And 1) * $2000 + (x shr 2);
  75.                   Repeat
  76.                      sb := mem[grafbase: boff + i];
  77.                      j := 0;
  78.                      Repeat
  79.                         pbyte := pbyte shl 1;
  80.                         If ((sb And $c0) > 0) Then
  81.                            inc(pbyte);
  82.                         sb := sb shl 2;
  83.                         inc(j);
  84.                      Until (j > 3);
  85.                      inc(i);
  86.                   Until (i > 1);
  87.                   End;
  88.  
  89.             vga, ega, ega64, egamono:
  90.                pbyte := Not mem[grafbase: (y * 80 + (x shr 3))];
  91.  
  92.             hercmono:
  93.                pbyte := mem[grafbase: (y And
  94.                         3)shl 13 + 90 * (y shr 2) + (x shr 3)];
  95.  
  96.             Else
  97.                pbyte := 0 { should never happen }
  98.             End;
  99.  
  100.          If inverse Then
  101.             nextpbyte := Not pbyte
  102.          Else
  103.             nextpbyte := pbyte;
  104.          End;
  105.  
  106.  
  107.       Procedure sendbyte(pb: byte);
  108.        { Send one byte to the printer }
  109.  
  110.          Begin
  111.          regs.ah := 0;
  112.          regs.al := pb;
  113.          regs.dx := pred(lptportnum);
  114.          intr($17, regs);
  115.          End; { SendByte }
  116.  
  117.  
  118.       Procedure dumpgraf;
  119.  
  120.          Var
  121.             xi, yi: integer; { Pixel coordinates }
  122.  
  123.  
  124.          Procedure printaline;
  125.  
  126.             Begin
  127.             { Select 8-Pin graphics print mode for each line }
  128.             sendbyte(esc);
  129.             sendbyte(ord('*'));
  130.             sendbyte(mode);
  131.             sendbyte(n1);
  132.             sendbyte(n2); { dots on line }
  133.  
  134.            { Get the next print line off the screen, bottom of screen
  135.              is the lh side of the paper.  Each byte is 8 pixels in the
  136.              X coordinate and 1 in the Y, and is printed twice to improve
  137.              aspect ratio (except where ymaxglb = 199 - printed 3x).      }
  138.  
  139.             yi := ymaxglb;
  140.             Repeat
  141.                pbyte := nextpbyte(xi, yi); { Each byte is 1 pixel (Y axis)}
  142.                sendbyte(pbyte);
  143.                sendbyte(pbyte);
  144.                If (ymaxglb < 200) Then
  145.                   sendbyte(pbyte);
  146.                dec(yi);
  147.             Until (yi < 0);
  148.             sendbyte(10); { Send LF }
  149.             End;
  150.  
  151.  
  152.          Begin
  153.          xi := 0;
  154.          Repeat
  155.             printaline; { Each printed line is 8 pixels deep (X axis) }
  156.             inc(xi, 8);
  157.          Until (xi > xmaxglb);
  158.          sendbyte(13);
  159.          sendbyte(12); { Send CR & FF }
  160.          End; { DumpGraf }
  161.  
  162.  
  163.       Function checkprt: boolean;
  164.        { Check Printer connected, online and has paper, If not then BEEP }
  165.  
  166.          Begin
  167.          regs.ax := $200;
  168.          regs.dx := pred(lptportnum);
  169.          intr($17, regs);
  170.          regs.ah := regs.ah xor $80;
  171.          regs.ah := regs.ah And $A9;
  172.          If (regs.ah <> 0) Then
  173.             Begin
  174.             writeln(#7,#7);
  175.             checkprt := false;
  176.             End
  177.          Else
  178.             checkprt := true;
  179.          End;
  180.  
  181.  
  182.       Begin { HardCopy }
  183.       If Not checkprt Then
  184.          exit; { and beep }
  185.       Case gdevice Of
  186.          cga:
  187.             Begin
  188.             grafbase := $B800;
  189.             ymaxglb := 199;
  190.             If (gmode = cgahi) Then
  191.                xmaxglb := 639
  192.             Else
  193.                xmaxglb := 319;
  194.             End;
  195.          ega, ega64, egamono:
  196.             Begin
  197.             grafbase := $A000;
  198.             xmaxglb := 639;
  199.             ymaxglb := 349;
  200.             portw[$3CE] := $805; { Set ReadMode = 1 - all bit planes cmpd.}
  201.             { Defaults assumed:- Color Don't Care register = $0F }
  202.             {                  - Color Compare    register = $00 }
  203.             End;
  204.          vga:
  205.             Begin
  206.             grafbase := $A000;
  207.             xmaxglb := 639;
  208.             portw[$3CE] := $805;
  209.             Case gmode Of
  210.                vgalo:
  211.                   ymaxglb := 199;
  212.                vgamed:
  213.                   ymaxglb := 349;
  214.                vgahi:
  215.                   ymaxglb := 479;
  216.                End;
  217.             End;
  218.          hercmono:
  219.             Begin
  220.             grafbase := $B000;
  221.             xmaxglb := 719;
  222.             ymaxglb := 347
  223.             End;
  224.          Else
  225.             exit
  226.          End;
  227.  
  228.       sendbyte(esc); { Select 24/216-inch line spacing }
  229.       sendbyte(ord('3'));
  230.       sendbyte(24);
  231.  
  232.       If ((xmaxglb < 320) Or (ymaxglb = 479)) Then
  233.          mode := 2
  234.       Else
  235.          mode := 6;
  236.       pwide := ymaxglb + 1;
  237.       If (ymaxglb < 200) Then
  238.          pwide := pwide * 3
  239.       Else
  240.          pwide := pwide shl 1;
  241.       n1 := lo(pwide); { Determine 2 byte control code for }
  242.       n2 := hi(pwide); { the number of dots per print line }
  243.  
  244.       dumpgraf;
  245.  
  246.       If (gdevice In [vga, ega, ega64, egamono]) Then
  247.          portw[$3CE] := 5;
  248.  
  249.       sendbyte(esc);
  250.       sendbyte(2); { Reset to 1/6-inch line spacing }
  251.       End; { HardCopy }
  252.  
  253.  
  254. End.
  255.