Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/NKTOOLS.ZIP/EPSON.PAS

Pascal/Delphi Source File | 1990-07-02 | 23.6 KB | 656 lines

unit Epson;
(*====================================================================,,
|| MODULE NAME:  Epson                                                ||
|| DEPENDENCIES: System                                               ||
|| LAST MOD ON:  9007.02                                              ||
|| PROGRAMMER:   Naoto Kimura                                         ||
||                                                                    ||
||     This unit was developed for doing graphics on the Epson FX-850 ||
|| series of printers.  Most of the functions in this unit emulate    ||
|| many of the functions of the Graph unit.  Since this is really an  ||
|| experimental unit, many of the details are still fluid on how this ||
|| unit will operate.                                                 ||
``====================================================================*)

interface

const
    MaxPoints        = 500;
    EpsonOk        = 0;
    EpsonOpenFail    = 1;
    EpsonNotOpen    = 2;
    EpsonBounds        = 3;

type
    PointType    = record
            X,Y    :Integer
        end;

(*---------------------------------------------------------------------.
| NAME: EpsonStatus                                                    |
|                                                                      |
|     This function returns the status of the Epson unit.  A call to   |
| this function will reset the status of the Epson unit.               |
`---------------------------------------------------------------------*)
function EpsonStatus : Integer;

(*---------------------------------------------------------------------.
| NAME: OpenPlot                                                       |
|                                                                      |
|     This procedure opens the graphics device.  The FileName          |
| parameter specifies the DOS file or device to send the graphics      |
| output.  The HighDensity parameter selects the high-density plotter  |
| mode if the value of True is passed, otherwise the output is set to  |
| the regular density plotter mode (1:1 pixel size).  This procedure   |
| sets up any memory buffers necessary to store the graphics before    |
| they are output to the printer.                                      |
`---------------------------------------------------------------------*)
procedure OpenPlot (
        HighDensity    : Boolean;
        FileName    : String );

(*---------------------------------------------------------------------.
| NAME: ClosePlot                                                      |
|                                                                      |
|     This procedure closes the graphics device.  Any memory buffers   |
| to store the image are deallocated.                                  |
`---------------------------------------------------------------------*)
procedure ClosePlot;

(*---------------------------------------------------------------------.
| NAME: DotMaxX                                                        |
|                                                                      |
|     This function returns the maximum horizontal plotting coordinate |
| of the graphics device.  It is assumed that the minimum plotting     |
| coordinate is assumed to be 0.                                       |
`---------------------------------------------------------------------*)
function DotMaxX : Integer;

(*---------------------------------------------------------------------.
| NAME: DotMaxY                                                        |
|                                                                      |
|     This function returns the maximum vertical plotting coordinate   |
| of the graphics device.  It is assumed that the minimum plotting     |
| coordinate is assumed to be 0.                                       |
`---------------------------------------------------------------------*)
function DotMaxY : Integer;

(*---------------------------------------------------------------------.
| NAME: GetPlotAspectRatio                                             |
|                                                                      |
|     This procedure returns the effective resolution of the graphics  |
| screen from which the aspect ratio (Xasp:Yasp) can be computed.      |
`---------------------------------------------------------------------*)
procedure GetPlotAspectRatio (var Xasp,Yasp : Word);

(*---------------------------------------------------------------------.
| NAME: GetPlotX                                                       |
|                                                                      |
|     This function returns the X coordinate of the current plotting   |
| location.                                                            |
`---------------------------------------------------------------------*)
function GetPlotX : Integer;

(*--------------------------------------------------------------------*\
| NAME: GetPlotY                                                       |
|                                                                      |
|     This function returns the Y coordinate of the current plotting   |
| location.                                                            |
`---------------------------------------------------------------------*)
function GetPlotY : Integer;

(*---------------------------------------------------------------------.
| NAME: MoveTo                                                         |
|                                                                      |
|     This procedure changes coordinate of the current plotting        |
| location.                                                            |
`---------------------------------------------------------------------*)
procedure MoveTo ( x,y : Integer );

(*---------------------------------------------------------------------.
| NAME: ClearBitMap                                                    |
|                                                                      |
|     This clears out the memory buffer for storing the graphics.      |
`---------------------------------------------------------------------*)
procedure ClearBitMap;

(*---------------------------------------------------------------------.
| NAME: PrintBitMap                                                    |
|                                                                      |
|     This dumps out the contents of the memory buffer for storing the |
| graphics to the printer.                                             |
`---------------------------------------------------------------------*)
procedure PrintBitMap;

(*---------------------------------------------------------------------.
| NAME: SetPlotColor                                                   |
|                                                                      |
|     This procedure sets the plotting color for subsequent plotting   |
| output to the graphics device.                                       |
`---------------------------------------------------------------------*)
procedure SetPlotColor ( C : Word );

(*---------------------------------------------------------------------.
| NAME: GetPlotColor                                                   |
|                                                                      |
|     This function returns the plotting color for the graphics        |
| device.                                                              |
`---------------------------------------------------------------------*)
function GetPlotColor : Word;

(*---------------------------------------------------------------------.
| NAME: PutDot                                                         |
|                                                                      |
|     This procedure puts the pixel value of B at the coordinate (X,Y) |
| on the pixel map.                                                    |
`---------------------------------------------------------------------*)
procedure PutDot ( X,Y : Integer; B : Word );

(*---------------------------------------------------------------------.
| NAME: GetDot                                                         |
|                                                                      |
|     This function returns the pixel value at the coordinate (X,Y) on |
| the pixel map.                                                       |
`---------------------------------------------------------------------*)
function GetDot ( X,Y : Integer ) : Integer;

(*---------------------------------------------------------------------.
| NAME: Line                                                           |
|                                                                      |
|      This procedure draws a line from (x1,y1) to (x2,y2).            |
`---------------------------------------------------------------------*)
procedure Line ( x1,y1, x2,y2 : Integer );

(*---------------------------------------------------------------------.
| NAME: LineTo                                                         |
|                                                                      |
|      This procedure draws a line from the current point to (x,y).    |
`---------------------------------------------------------------------*)
procedure LineTo ( x,y : Integer );

(*---------------------------------------------------------------------.
| NAME: PlotRectangle                                                  |
|                                                                      |
|     This procedure draws a rectangle whose opposite corners are at   |
| the coordinates (x1,y1) and (x2,y2).                                 |
`---------------------------------------------------------------------*)
procedure PlotRectangle( x1,y1,x2,y2 : integer );

(*---------------------------------------------------------------------.
| NAME: DrawPoly                                                       |
|                                                                      |
|     This procedure draws a polygon defined by the NumPoints points   |
| in PolyPoints.                                                       |
`---------------------------------------------------------------------*)
procedure DrawPoly( NumPoints : Word; var PolyPoints );

implementation

const
    Xdim    = 8;
    Ydim    = 10;
    MaxHorzDots    = 576;        (* 72 dpi * Xdim = 576 *)
    MaxVertDots    = 720;        (* 72 dpi * Ydim = 720 *)

    MaxHorzValue= 575;        (* MaxHorzDots - 1         *)
    MaxVertValue=  89;        (* (MaxVertDots) div 8 - 1 *)

type
    BitMap    = array [0..MaxHorzValue,0..MaxVertValue] of byte;
        (* 576 * 720 / 8 = 51840 *)

const
    IsDouble    : Boolean    = False;

var
    HorzDPI,
    VertDPI    : Integer;
    CurrentX,
    CurrentY    : Integer;
    BitMapFile    : Text;
    StatusCode    : Integer;
    DevIsOpen    : Boolean;
    EvenCols,
    OddCols    : ^BitMap;

(*---------------------------------------------------------------------.
| NAME: EpsonStatus                                                    |
`---------------------------------------------------------------------*)
function EpsonStatus : Integer;
    begin
    EpsonStatus := StatusCode;
    StatusCode := EpsonOk
    end;    (* ErrorStatus *)

(*---------------------------------------------------------------------.
| NAME: OpenPlot                                                       |
`---------------------------------------------------------------------*)
procedure OpenPlot (
        HighDensity    : Boolean;
        FileName    : String );
    begin
    if DevIsOpen then
        Close(BitMapFile);
    Assign(BitMapFile,FileName);
    {$I-}
    ReWrite(BitMapFile);
    {$I+}
    if IOResult <> 0 then
        StatusCode := EpsonOpenFail
    else begin
        IsDouble := HighDensity;
        if not DevIsOpen then begin
        New(EvenCols);
        if HighDensity then
            New(OddCols);
          end;
        VertDPI := 72;
        if HighDensity then
        HorzDPI := 144
        else
        HorzDPI := 72;
        DevIsOpen := True;
        ClearBitMap
      end
    end;    (* OpenPlot *)

(*---------------------------------------------------------------------.
| NAME: ClosePlot                                                      |
`---------------------------------------------------------------------*)
procedure ClosePlot;
    begin
    if not DevIsOpen then begin
        StatusCode := EpsonNotOpen;
        Exit
      end;
    Close(BitMapFile);
    Dispose(EvenCols);
    if IsDouble then
        Dispose(OddCols);
    DevIsOpen := False;
    StatusCode := EpsonOk
    end;    (* ClosePlot *)

(*---------------------------------------------------------------------.
| NAME: DotMaxX                                                        |
`---------------------------------------------------------------------*)
function DotMaxX : Integer;
    begin
    if not DevIsOpen then
        StatusCode := EpsonNotOpen;
    if IsDouble then
        DotMaxX := (MaxHorzDots * 2) - 1
    else
        DotMaxX := MaxHorzDots - 1;
    StatusCode := EpsonOk
    end;    (* DotMaxX *)

(*---------------------------------------------------------------------.
| NAME: DotMaxY                                                        |
`---------------------------------------------------------------------*)
function DotMaxY : Integer;
    begin
    if not DevIsOpen then
        StatusCode := EpsonNotOpen;
    DotMaxY := MaxVertDots - 1;
    StatusCode := EpsonOk
    end;    (* DotMaxY *)

(*---------------------------------------------------------------------.
| NAME: GetPlotX                                                       |
`---------------------------------------------------------------------*)
function GetPlotX : Integer;
    begin
    GetPlotX := CurrentX
    end;    (* GetPlotX *)

(*---------------------------------------------------------------------.
| NAME: GetPlotY                                                       |
`---------------------------------------------------------------------*)
function GetPlotY : Integer;
    begin
    GetPlotY := CurrentY
    end;    (* GetPlotX *)

(*---------------------------------------------------------------------.
| NAME: MoveTo                                                         |
`---------------------------------------------------------------------*)
procedure MoveTo ( x,y : Integer );
    begin
    CurrentX := X;
    CurrentY := Y
    end;    (* MoveTo *)

(*---------------------------------------------------------------------.
| NAME: GetPlotAspectRatio                                             |
`---------------------------------------------------------------------*)
procedure GetPlotAspectRatio (var Xasp,Yasp : Word);
    begin
    if not DevIsOpen then begin
        StatusCode := EpsonNotOpen;
        Exit
      end;
    Xasp := 7200 div HorzDPI;
    Yasp := 7200 div VertDPI
    end;    (* GetPlotAspectRatio *)

(*---------------------------------------------------------------------.
| NAME: ClearBitMap                                                    |
`---------------------------------------------------------------------*)
procedure ClearBitMap;
    begin
    if not DevIsOpen then begin
        StatusCode := EpsonNotOpen;
        Exit
      end;
    CurrentX := 0;
    CurrentY := 0;
    FillChar(EvenCols^,sizeof(EvenCols^),0);
    if IsDouble then
        FillChar(OddCols^,sizeof(OddCols^),0);
    StatusCode := EpsonOk
    end;    (* ClearBitMap *)

(*---------------------------------------------------------------------.
| NAME: PrintBitMap                                                    |
`---------------------------------------------------------------------*)
procedure PrintBitMap;
    var
    i,j    : Integer;
    begin
    if not DevIsOpen then begin
        StatusCode := EpsonNotOpen;
        Exit
      end;
    Write(BitMapFile,#27'A'#8);    (* set to 8/72" spacing *)
    for i := (MaxVertDots div 8)-1 downto 0 do begin
        if IsDouble then begin
        Write(BitMapFile,#27'*'#7,
            Chr(lo(MaxHorzDots*2)),Chr(hi(MaxHorzDots*2)) );
        for j := 0 to MaxHorzDots-1 do
            Write(BitMapFile,
            Chr(EvenCols^[j,i]),Chr(OddCols^[j,i]))
          end
        else begin
        Write(BitMapFile,#27'*'#5,
            Chr(lo(MaxHorzDots)),Chr(hi(MaxHorzDots)));
        for j := 0 to MaxHorzDots-1 do
            Write(BitMapFile,Chr(EvenCols^[j,i]))
          end;
        WriteLn(BitMapFile)
      end;
    Write(BitMapFile,#12#27'@');    (* Form feed & reset printer *)
    StatusCode := EpsonOk
    end;    (* PrintBitMap *)

var
    PlotColor    : Word;

(*---------------------------------------------------------------------.
| NAME: SetPlotColor                                                   |
`---------------------------------------------------------------------*)
procedure SetPlotColor ( C : Word );
    begin
    PlotColor := C
    end;    (* SetPlotColor *)

(*---------------------------------------------------------------------.
| NAME: GetPlotColor                                                   |
`---------------------------------------------------------------------*)
function GetPlotColor : Word;
    begin
    GetPlotColor := PlotColor
    end;    (* GetPlotColor *)

(*---------------------------------------------------------------------.
| NAME: PutDot                                                         |
`---------------------------------------------------------------------*)
procedure PutDot ( X,Y : Integer; B : Word );
    var
    i,j,k    : Integer;
    begin
    if not DevIsOpen then begin
        StatusCode := EpsonNotOpen;
        Exit
      end;
    CurrentX := X;
    CurrentY := Y;
    if not IsDouble then
        X := X * 2;
    if (X < 0) or (X >= MaxHorzDots*2)
      or (Y < 0) or (Y >= MaxVertDots) then
        Exit;
    i := X div 2;
    j := Y div 8;
    if B<>0 then begin
        k := 1 shl (Y mod 8);
        if Odd(X) then
        OddCols^[i,j] := lo(OddCols^[i,j] or k)
        else
        EvenCols^[i,j] := lo(EvenCols^[i,j] or k)
      end
    else begin
        k := not (1 shl (Y mod 8));
        if Odd(X) then
        OddCols^[i,j] := lo(OddCols^[i,j] and k)
        else
        EvenCols^[i,j] := lo(EvenCols^[i,j] and k)
      end;
    StatusCode := EpsonOk
    end;    (* PutDot *)

(*---------------------------------------------------------------------.
| NAME: GetDot                                                         |
`---------------------------------------------------------------------*)
function GetDot ( X,Y : Integer ) : Integer;
    var
    i,j,k    : Integer;
    begin
    if not DevIsOpen then begin
        StatusCode := EpsonNotOpen;
        Exit
      end;
    if not IsDouble then
        X := X * 2;
    if (X < 0) or (X >= MaxHorzDots*2)
      or (Y < 0) or (Y >= MaxVertDots) then
        GetDot := 0
    else begin
        i := X div 2;
        j := Y div 8;
        k := 1 shl (Y mod 8);
        if Odd(X) then
        if (OddCols^[i,j] and k) <> 0
        then GetDot := 1
        else GetDot := 0
        else
        if (EvenCols^[i,j] and k) <> 0
        then GetDot := 1
        else GetDot := 0;
      end;
    StatusCode := EpsonOk
    end;    (* GetDot *)

(*---------------------------------------------------------------------.
| NAME: HorzLine                                                       |
`---------------------------------------------------------------------*)
procedure HorzLine ( x1,x2,y : Integer );
    var
    i    : Integer;
    begin
    if x1>x2 then
        for i := x2 to x1 do
        PutDot(i,y,PlotColor)
    else
        for i := x1 to x2 do
        PutDot(i,y,PlotColor)
    end;    (* HorzLine *)

(*---------------------------------------------------------------------.
| NAME: VertLine                                                       |
`---------------------------------------------------------------------*)
procedure VertLine ( x,y1,y2 : Integer );
    var
    i    : Integer;
    begin
    if y1>y2 then
        for i := y2 to y1 do
        PutDot(x,i,PlotColor)
    else
        for i := y1 to y2 do
        PutDot(x,i,PlotColor)
    end;    (* VertLine *)

(*---------------------------------------------------------------------.
| NAME: Line_XY                                                        |
`---------------------------------------------------------------------*)
procedure Line_XY ( x1,y1, x2,y2 : Integer );
    var
    d,dx,dy,
    Aincr,Bincr,Yincr,
    x,y            : Integer;
    begin
    if x1>x2 then begin
        x := x1;    x1 := x2;    x2 := x;
        x := y1;    y1 := y2;    y2 := x
      end;
    if y2>y1 then
        Yincr := 1
    else
        Yincr := -1;
    dx := x2-x1;
    dy := abs(y2-y1);
    d := 2*dy-dx;

    Aincr := 2 * (dy-dx);
    Bincr := 2 * dy;

    x := x1;
    y := y1;

    PutDot(x,y,PlotColor);

    for x:= x1+1 to x2 do begin
        if d < 0 then
        Inc(d,Bincr)
        else begin
        Inc(y,Yincr);
        Inc(d,Aincr)
          end;
        PutDot(x,y,PlotColor)
      end
    end;    (* Line_XY *)

(*---------------------------------------------------------------------.
| NAME: Line_YX                                                        |
`---------------------------------------------------------------------*)
procedure Line_YX ( x1,y1, x2,y2 : Integer );
    var
    d,dx,dy,
    Aincr,Bincr,Xincr,
    x,y            : Integer;
    begin
    if y1>y2 then begin
        x := x1;    x1 := x2;    x2 := x;
        x := y1;    y1 := y2;    y2 := x
      end;
    if x2>x1 then
        Xincr := 1
    else
        Xincr := -1;
    dy := y2-y1;
    dx := abs(x2-x1);
    d := 2*dx-dy;

    Aincr := 2 * (dx-dy);
    Bincr := 2 * dx;

    x := x1;
    y := y1;

    PutDot(x,y,PlotColor);

    for y:= y1+1 to y2 do begin
        if d < 0 then
        Inc(d,Bincr)
        else begin
        Inc(x,Xincr);
        Inc(d,Aincr)
          end;
        PutDot(x,y,PlotColor)
      end
    end;    (* Line_YX *)

(*---------------------------------------------------------------------.
| NAME: Line                                                           |
`---------------------------------------------------------------------*)
procedure Line ( x1,y1, x2,y2 : Integer );
    begin
    if x1=x2 then VertLine(x1,y1,y2)
    else if y1=y2 then HorzLine(x1,x2,y1)
    else if Abs(x1-x2) >= Abs(y1-y2) then Line_XY(x1,y1,x2,y2)
    else Line_YX(x1,y1,x2,y2);
    CurrentX := x2;
    CurrentY := y2
    end;

(*---------------------------------------------------------------------.
| NAME: LineTo                                                         |
`---------------------------------------------------------------------*)
procedure LineTo ( x,y : Integer );
    begin
    Line(CurrentX,CurrentY, X,Y)
    end;

(*---------------------------------------------------------------------.
| NAME: PlotRectangle                                                  |
`---------------------------------------------------------------------*)
procedure PlotRectangle( x1,y1,x2,y2 : integer );
    var
    i    : Integer;
    begin
    HorzLine(x1,x2,y1);
    HorzLine(x1,x2,y2);
    VertLine(x1,y1,y2);
    VertLine(x2,y1,y2)
    end;    (* PlotRectangle *)

(*---------------------------------------------------------------------.
| NAME: DrawPoly                                                       |
`---------------------------------------------------------------------*)
procedure DrawPoly( NumPoints : Word; var PolyPoints );
    var
    i    : integer;
    PtTbl    : array [0..MaxPoints] of PointType absolute PolyPoints;
    begin
    with PtTbl[0] do
        MoveTo(x,y);
    for i := 1 to NumPoints-1 do
        with PtTbl[i] do
        LineTo(x,y);
    with PtTbl[0] do
        LineTo(x,y);
    end;    (* DrawPoly *)

{$F+}
var
    OldExitProc    : Pointer;

(*---------------------------------------------------------------------.
| NAME: CleanUp                                                        |
`---------------------------------------------------------------------*)
procedure CleanUp;
    begin
    ExitProc := OldExitProc;
    if DevIsOpen then
        ClosePlot
    end;    (* CleanUp *)
{$F-}

begin
    IsDouble := False;
    DevIsOpen := False;
    OldExitProc := ExitProc;
    ExitProc := @CleanUp
end.