home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
NKTOOLS.ZIP
/
EPSON.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-07-02
|
24KB
|
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.
