Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/TUFPRINT.ZIP/TUFPRINT.PAS

Pascal/Delphi Source File | 1985-12-28 | 6.2 KB | 197 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;

    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 reg.ah) <> 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}

    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}
        reg.ah := 2;
        Intr($17, reg);

        {check for errors}
        IF AnyError(Error) AND (Error <> Busy) THEN
          HandleError(Error)
        ELSE BEGIN
          {print the character}
          reg.ax := Ord(ch);
          Intr($17, reg);
          {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.