home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-386-Vol-2of3.iso
/
b
/
bioprn.zip
/
BIOSPRN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-09-30
|
10KB
|
295 lines
{$IFDEF Windows}
!! ERROR - This unit is not compatible with Windows !!
{$ENDIF}
{$S-,R-,V-,I-,F+,O+,A-}
{$I OPDEFINE.INC} {!!.13}
{*********************************************************}
{* BIOSPRN.PAS 1.01 *}
{* Copyright (c) TurboPower Software 1989. *}
{* All rights reserved. *}
{*********************************************************}
{
This unit supplements the BiosPrinter support in OPPRNLOW. It implements the
object type BiosPrinterWithRetry. This object enhances BiosPrinter's error
handling by maintaining seperate printer test and success mask values for
printer status and put character calls. It also adds retry and timeout
capabilities. See BIOSPRN.DOC for more information.
BiosPrinterWithRetry is derived from BiosPrinter (and therefore
FlexiblePrinter and BasePrinter).
}
Unit BiosPrn;
interface
uses
Dpmi, {!!.20}
Dos,
OpConst, {!!.20}
OpRoot,
OpPrnLow;
type
BiosPrinterWithRetryPtr = ^BiosPrinterWithRetry; {!!.13}
BiosPrinterWithRetry =
object(BiosPrinter)
bpwrPutTest : Byte;
bpwrPutMask : Byte;
bpwrRetries : Word;
bpwrTimeOut : LongInt;
constructor Init(LPTNumber : LPTType);
constructor InitCustom(LPTNumber : LPTType;
PrinterTestNumber, SuccessMask : Byte);
constructor InitDeluxe(LPTNumber : LPTType;
StatusTestNumber, StatusMask,
PutTestNumber, PutMask : Byte;
Retries : Word;
TimeOut : LongInt);
{-Create a BiosPrinterWithRetry instance with custom parameters}
procedure PrnPutChar(Character : Char); Virtual;
{-Puts a character to the output device}
procedure SetTestAndMaskCustom(StatusTestNo, StatusMask,
PutTestNo, PutMask : Byte);
{-Set the printer test and success mask for Status and Put calls}
procedure GetTestAndMaskCustom(var StatusTestNo, StatusMask,
PutTestNo, PutMask : Byte);
{-Return the printer test and success mask for Status and Put calls}
procedure SetRetryAndTimeOut(Retries : Word; TimeOut : LongInt);
{-Set Retry and timeout values}
procedure GetRetryAndTimeOut(var Retries : Word; var TimeOut : LongInt);
{-Return Retry and timeout values}
function PrnXlatErrorCode(Call : PrnCallType;
ErrorCode : Word) : Word; Virtual;
{-translate a raw error code into appropriate user error code}
{$IFDEF UseStreams} {!!.13}
{...Streams...}
constructor Load(var S : IdStream);
{-Load a BiosPrinter from a stream}
procedure Store(var S : IdStream);
{-Store a BiosPrinter in a stream}
{$ENDIF} {!!.13}
end;
implementation
const
TicsPerDay = 1573038; {Assumes 18.20646 tics/sec}
type
{For calculating timeouts}
EventTimer = record
StartTics : LongInt;
ExpireTics : LongInt;
end;
var
BiosTics : ^LongInt {absolute $40:$6C}; {!!.20}
procedure NewEvent(var ET : EventTimer; Ticks : LongInt);
{-Returns a set EventTimer}
begin
with ET do begin
StartTics := BiosTics^; {!!.20}
ExpireTics := StartTics + Ticks;
end;
end;
function CheckEvent(ET : EventTimer) : Boolean;
{-Returns True if ET has expired}
var
CurTics : LongInt;
begin
with ET do begin
{Get current tics; assume timer has expired}
CurTics := BiosTics^; {!!.20}
CheckEvent := False;
{Check normal expiration}
if CurTics > ExpireTics then
Exit;
{Check wrapped CurTics}
if (CurTics < StartTics) and ((CurTics + TicsPerDay) > ExpireTics) then
Exit;
{If we get here, timer hasn't expired yet}
CheckEvent := True;
end;
end;
constructor BiosPrinterWithRetry.Init(LPTNumber : LPTType);
begin
if not BiosPrinter.Init(LPTNumber) then
Fail;
bpwrPutTest := bpPrinterTest;
bpwrPutMask := bpSuccessMask;
bpwrRetries := 0;
bpwrTimeOut := 0;
end;
constructor BiosPrinterWithRetry.InitCustom(LPTNumber : LPTType;
PrinterTestNumber,
SuccessMask : Byte);
begin
if not BiosPrinter.InitCustom(LPTNumber, PrinterTestNumber,
SuccessMask) then
Fail;
bpwrPutTest := bpPrinterTest;
bpwrPutMask := bpSuccessMask;
bpwrRetries := 0;
bpwrTimeOut := 0;
end;
constructor BiosPrinterWithRetry.InitDeluxe(LPTNumber : LPTType;
StatusTestNumber, StatusMask,
PutTestNumber, PutMask : Byte;
Retries : Word;
TimeOut : LongInt);
begin
if not BiosPrinter.InitCustom(LPTNumber, StatusTestNumber,
StatusMask) then
Fail;
bpwrPutTest := PutTestNumber;
bpwrPutMask := PutMask;
bpwrRetries := Retries;
bpwrTimeOut := TimeOut;
end;
{$IFDEF UseStreams}
constructor BiosPrinterWithRetry.Load(var S : IdStream);
begin
if not BiosPrinter.Load(S) then
Fail;
S.Read(bpwrPutTest, (SizeOf(Byte) * 2) + SizeOf(Word) + SizeOf(LongInt));
end;
procedure BiosPrinterWithRetry.Store(var S : IdStream);
begin
BiosPrinter.Store(S);
if S.PeekStatus <> 0 then
Exit;
S.Write(bpwrPutTest, (SizeOf(Byte) * 2) + SizeOf(Word) + SizeOf(LongInt));
end;
{$ENDIF}
procedure BiosPrinterWithRetry.GetTestAndMaskCustom(var StatusTestNo,
StatusMask,
PutTestNo,
PutMask : Byte);
begin
BiosPrinter.GetTestAndMask(StatusTestNo, StatusMask);
PutTestNo := bpwrPutTest;
PutMask := bpwrPutMask;
end;
procedure BiosPrinterWithRetry.SetTestAndMaskCustom(StatusTestNo,
StatusMask,
PutTestNo,
PutMask : Byte);
begin
BiosPrinter.SetTestAndMask(StatusTestNo, StatusMask);
bpwrPutTest := PutTestNo;
bpwrPutMask := PutMask;
end;
procedure BiosPrinterWithRetry.SetRetryAndTimeOut(Retries : Word;
TimeOut : LongInt);
{-Set Retry and timeout values}
begin
bpwrRetries := Retries;
bpwrTimeOut := TimeOut;
end;
procedure BiosPrinterWithRetry.GetRetryAndTimeOut(var Retries : Word;
var TimeOut : LongInt);
{-Return Retry and timeout values}
begin
Retries := bpwrRetries;
TimeOut := bpwrTimeOut;
end;
function BiosPrinterWithRetry.PrnXlatErrorCode(Call : PrnCallType;
ErrorCode : Word) : Word;
{-translate a raw error code into appropriate user error code}
begin
if @fpXlatPrim <> Nil then begin
PrnXlatErrorCode := fpXlatPrim(Call, ErrorCode);
Exit;
end;
PrnXlatErrorCode := 0;
case Call of
StatusCall :
case bpPrinterTest of
0 : begin end; {always succeed}
1 : if not PrnTest1Prim(ErrorCode) then {test 1}
PrnXlatErrorCode := PrinterNotReady;
2 : if not PrnTest2Prim(ErrorCode) then {test 2}
PrnXlatErrorCode := PrinterNotReady;
3 : if PrnTest3Prim(ErrorCode) then
PrnXlatErrorCode := PrinterNotReady;
4 : {test 4}
if (Byte(ErrorCode) and bpSuccessMask) <> bpSuccessMask then
PrnXlatErrorCode := PrinterNotReady;
else
PrnXlatErrorCode := 255; {special code indicating invalid test}
end;
PutCall :
case bpwrPutTest of
0 : begin end; {always succeed}
1 : if not PrnTest1Prim(ErrorCode) then {test 1}
PrnXlatErrorCode := PrinterNotReady;
2 : if not PrnTest2Prim(ErrorCode) then {test 2}
PrnXlatErrorCode := PrinterNotReady;
3 : if PrnTest3Prim(ErrorCode) then
PrnXlatErrorCode := PrinterNotReady;
4 : {test 4}
if (Byte(ErrorCode) and bpwrPutMask) <> bpwrPutMask then
PrnXlatErrorCode := PrinterNotReady;
else
PrnXlatErrorCode := 255; {special code indicating invalid test}
end;
end;
end;
procedure BiosPrinterWithRetry.PrnPutChar(Character : Char);
{-Puts a character to the output device}
var
I : Word;
ErrorCode : Word;
Timer : EventTimer;
begin
{if number of retries = 0 then use Timeout value instead}
if bpwrRetries = 0 then begin
NewEvent(Timer, bpwrTimeOut);
repeat
ErrorCode := PrnStatus;
until (ErrorCode = 0) or (not CheckEvent(Timer));
end
else begin
if bpwrRetries = $FFFF then
I := bpwrRetries
else
I := Succ(bpwrRetries);
ErrorCode := 1;
while (I > 0) and (ErrorCode <> 0) do begin
ErrorCode := PrnStatus;
Dec(I);
end;
end;
{if printer is ready then send the character}
if ErrorCode = 0 then
FlexiblePrinter.PrnPutChar(Character);
end;
begin {!!.20}
BiosTics := Ptr(BiosDataSele, $6C); {!!.20}
end.