Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/MISC.ZIP/TUFPRT.PAS

Pascal/Delphi Source File | 1986-02-09 | 6.2 KB | 210 lines

PROGRAM Printer;
 {-demonstrate print error control}

 {***********************************************************************
 the following can be included verbatim into a program}

TYPE
 Printers = (LPT1, LPT2, LPT3, LPT4, NoPrinter);
CONST
 ActivePrinter : Printers = NoPrinter;
VAR
 SavePrintTimeOut : Byte;
 {
 the following bytes normally equal $14, providing 20 retries on printer
 busy calls. Set to 1 for a single retry (timeout takes about 2 seconds).
 Do not set to 0 or system will retry forever.
 }
 PrintTimeOut : ARRAY[Printers] OF Byte ABSOLUTE $40 : $78;


 PROCEDURE PrintChar(ch : Char);
  {-print the character ch, handle errors and loop when busy}
  {
  **********************************************************************
  CANNOT USE TURBO I/O FUNCTIONS INSIDE HERE DUE TO RE-ENTRANCY PROBLEMS
  **********************************************************************
  }

 TYPE
  PrintErrors =
  (TimeOut, unused1, unused2, IOerror, Selected,
   OutOfPaper, Acknowledge, Busy, NoError);

  DisplayString = STRING[80];

  registers =
  RECORD
   CASE Integer OF
    1 : (ax, bx, cx, dx, bp, si, di, ds, es, flags : Integer);
    2 : (al, ah, bl, bh, cl, ch, dl, dh : Byte);
  END;

 CONST
  PrintErrorMsg : ARRAY[PrintErrors] OF DisplayString =
  ('Printer Timeout Error', '', '', 'Printer Not Selected',
   'Printer Not Selected', 'Printer Out of Paper',
   'Printer Acknowledge Error', 'Printer Busy', '');

  EndStr : DisplayString = #13#10#36;

  {maximum number of replies with busy before calling it a timeout error.
  may need to be adjusted empirically to avoid false timeouts}
  BusyMax = 100;

 VAR
  reg : registers;
  Error : PrintErrors;
  BusyCount : Integer;
  err : Byte;

  PROCEDURE writestring(s : DisplayString);
   {-write string to standard output}
  VAR
   reg : registers;
  BEGIN
   reg.ah := 9;
   reg.ds := Seg(s);
   reg.dx := Ofs(s[1]);
   MsDos(reg);
  END;                        {displaystring}

  PROCEDURE getchar(VAR response : Char);
   {-get a character from the keyboard}
  VAR
   reg : registers;
  BEGIN
   reg.ah := 0;
   Intr($16, reg);
   response := Chr(reg.al);
  END;                        {getchar}

  FUNCTION AnyError(VAR Error : PrintErrors)
   : Boolean;
   {-check all the possible printer errors}
   {-return TRUE and error if any found}

   FUNCTION SingleError(check : PrintErrors; VAR Error : PrintErrors)
    : Boolean;
    {-return true if specified error was found, setting error}
   BEGIN
    SingleError := ((1 SHL Ord(check)) AND err) <> 0;
    Error := check;
   END;                       {singleerror}

  BEGIN
   AnyError := True;
   IF SingleError(Busy, Error) THEN Exit;
   IF SingleError(OutOfPaper, Error) THEN Exit;
   IF SingleError(IOerror, Error) THEN Exit;
   {polarity of "selected" flag is opposite of others}
   IF NOT(SingleError(Selected, Error)) THEN Exit;
   {made it through with no errors}
   Error := NoError;
   AnyError := False;
  END;                        {anyerror}

  PROCEDURE HandleError(VAR Error : PrintErrors);
   {-handle user-oriented error conditions}
  VAR
   response : Char;
  BEGIN
   IF (Error = NoError) THEN Exit;
   IF (Error = Busy) THEN BEGIN
    BusyCount := Succ(BusyCount);
    IF BusyCount < BusyMax THEN Exit;
    {busy too long, call it a timeout}
    Error := TimeOut;
   END;
   {
   prompt user to correct the error condition. screen handling could
   be much fancier here but it cannot use Turbo I/O functions.
   }
   writestring(PrintErrorMsg[Error]+EndStr);
   writestring('Correct condition and then press <ENTER> '+#36);
   REPEAT
    getchar(response);
   UNTIL (response IN [#13, #3]);
   writestring(EndStr);
   IF response = #3 THEN Halt; {Ctrl-C}
   BusyCount := 0;
  END;                        {handleerror}

  PROCEDURE int17(printer : printers; func : Byte; chartoprint : Byte; VAR err : Byte);
   {-call the printer interrupt and return error information}
  BEGIN
   INLINE(
    $8B/$56/$0C/              {MOV    DX,[BP+0C] - get printer number}
    $8A/$66/$0A/              {MOV    AH,[BP+0A] - get printer function}
    $8A/$46/$08/              {MOV    AL,[BP+08] - get character to print}
    $CD/$17/                  {INT    17}
    $C4/$7E/$04/              {LES    DI,[BP+04] - get address of error}
    $26/                      {ES:    }
    $88/$25                   {MOV    [DI],AH - return error if any}
    );
  END;                        {int17}

 BEGIN
  IF ActivePrinter = NoPrinter THEN BEGIN
   writestring('program error: no printer is selected'+EndStr);
   Exit;
  END;
  reg.dx := Ord(ActivePrinter); {equals 0..3}
  BusyCount := 0;

  REPEAT
   {check printer status}
   int17(activeprinter, 2, 0, err);

   {check for errors}
   IF AnyError(Error) AND (Error <> Busy) THEN
    HandleError(Error)
   ELSE BEGIN
    {print the character}
    int17(activeprinter, 0, Ord(ch), err);
    {check for errors again}
    IF AnyError(Error) THEN
     HandleError(Error);
   END;
  UNTIL Error = NoError;

 END;                         {printchar}

 PROCEDURE ProtectPrinter(Printer : Printers);
  {-define the Lst device to print to the specified printer}
 BEGIN
  IF ActivePrinter = NoPrinter THEN BEGIN
   ActivePrinter := Printer;
   LstOutPtr := Ofs(PrintChar);
   {save current printer timeout}
   SavePrintTimeOut := PrintTimeOut[Printer];
   {set to minimum timeout period}
   PrintTimeOut[Printer] := 1;
  END ELSE
   WriteLn(Con,
   'program error: only one printer can be protected at a time');
 END;                         {protectprinter}

 PROCEDURE RestorePrinter;
  {-deassign the Lst device and restore the printer timeout}
 BEGIN
  IF ActivePrinter <> NoPrinter THEN BEGIN
   PrintTimeOut[ActivePrinter] := SavePrintTimeOut;
   ActivePrinter := NoPrinter;
  END;
 END;                         {restoreprinter}

 {end of include portion
 ***********************************************************************}

 {demonstration follows}
VAR
 i : Integer;
BEGIN
 ProtectPrinter(LPT1);
 FOR i := 1 TO 5 DO
  {any writes to the Lst device are now protected}
  WriteLn(Lst, 'hello hello hello hello');
 RestorePrinter;
END.