home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / OPBONUS.ZIP / BIOSPRN.LZH / BIOSPRN.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-04-09  |  9.4 KB  |  280 lines
  1. {$S-,R-,V-,I-,F+,O+,A-}
  2.  
  3. {*********************************************************}
  4. {*                  BIOSPRN.PAS 1.01                     *}
  5. {*        Copyright (c) TurboPower Software 1989.        *}
  6. {*                 All rights reserved.                  *}
  7. {*********************************************************}
  8.  
  9. {
  10.  This unit supplements the BiosPrinter support in OPPRNLOW. It implements the
  11.  object type BiosPrinterWithRetry. This object enhances BiosPrinter's error
  12.  handling by maintaining separate printer test and success mask values for
  13.  printer status and put character calls. It also adds retry and timeout
  14.  capabilities.  See BIOSPRN.DOC for more information.
  15.  
  16.  BiosPrinterWithRetry is derived from BiosPrinter (and therefore
  17.  FlexiblePrinter and BasePrinter).
  18. }
  19. Unit BiosPrn;
  20. interface
  21.  
  22. uses
  23.   Dos,
  24.   OpRoot,
  25.   OpPrnLow;
  26.  
  27. type
  28.   BiosPrinterWithRetry =
  29.     object(BiosPrinter)
  30.       bpwrPutTest   : Byte;
  31.       bpwrPutMask   : Byte;
  32.       bpwrRetries   : Word;
  33.       bpwrTimeOut   : LongInt;
  34.       constructor Init(LPTNumber : LPTType);
  35.       constructor InitCustom(LPTNumber : LPTType;
  36.                              PrinterTestNumber, SuccessMask : Byte);
  37.       constructor InitDeluxe(LPTNumber : LPTType;
  38.                              StatusTestNumber, StatusMask,
  39.                              PutTestNumber, PutMask : Byte;
  40.                              Retries : Word;
  41.                              TimeOut : LongInt);
  42.         {-Create a BiosPrinterWithRetry instance with custom parameters}
  43.       procedure PrnPutChar(Character : Char); Virtual;
  44.         {-Puts a character to the output device}
  45.  
  46.       procedure SetTestAndMaskCustom(StatusTestNo, StatusMask,
  47.                                      PutTestNo, PutMask : Byte);
  48.         {-Set the printer test and success mask for Status and Put calls}
  49.       procedure GetTestAndMaskCustom(var StatusTestNo, StatusMask,
  50.                                      PutTestNo, PutMask : Byte);
  51.         {-Return the printer test and success mask for Status and Put calls}
  52.       procedure SetRetryAndTimeOut(Retries : Word; TimeOut : LongInt);
  53.         {-Set Retry and timeout values}
  54.       procedure GetRetryAndTimeOut(var Retries : Word; var TimeOut : LongInt);
  55.         {-Return Retry and timeout values}
  56.       function PrnXlatErrorCode(Call : PrnCallType;
  57.                              ErrorCode : Word) : Word; Virtual;
  58.         {-translate a raw error code into appropriate user error code}
  59.  
  60.       {...Streams...}
  61.       constructor Load(var S : IdStream);
  62.         {-Load a BiosPrinter from a stream}
  63.       procedure Store(var S : IdStream);
  64.         {-Store a BiosPrinter in a stream}
  65.     end;
  66.  
  67. implementation
  68.  
  69. const
  70.   TicsPerDay = 1573038;      {Assumes 18.20646 tics/sec}
  71.  
  72. type
  73.   {For calculating timeouts}
  74.   EventTimer = record
  75.     StartTics : LongInt;
  76.     ExpireTics : LongInt;
  77.   end;
  78.  
  79. var
  80.   BiosTics : LongInt absolute $40:$6C;
  81.  
  82.   procedure NewEvent(var ET : EventTimer; Ticks : LongInt);
  83.     {-Returns a set EventTimer}
  84.   begin
  85.     with ET do begin
  86.       StartTics := BiosTics;
  87.       ExpireTics := StartTics + Ticks;
  88.     end;
  89.   end;
  90.  
  91.   function CheckEvent(ET : EventTimer) : Boolean;
  92.     {-Returns True if ET has expired}
  93.   var
  94.     CurTics : LongInt;
  95.   begin
  96.     with ET do begin
  97.       {Get current tics; assume timer has expired}
  98.       CurTics := BiosTics;
  99.       CheckEvent := False;
  100.  
  101.       {Check normal expiration}
  102.       if CurTics > ExpireTics then
  103.         Exit;
  104.       {Check wrapped CurTics}
  105.       if (CurTics < StartTics) and ((CurTics + TicsPerDay) > ExpireTics) then
  106.         Exit;
  107.  
  108.       {If we get here, timer hasn't expired yet}
  109.       CheckEvent := True;
  110.     end;
  111.   end;
  112.  
  113.   constructor BiosPrinterWithRetry.Init(LPTNumber : LPTType);
  114.  
  115.   begin
  116.     if not BiosPrinter.Init(LPTNumber) then
  117.       Fail;
  118.     bpwrPutTest := bpPrinterTest;
  119.     bpwrPutMask := bpSuccessMask;
  120.     bpwrRetries := 0;
  121.     bpwrTimeOut := 0;
  122.   end;
  123.  
  124.   constructor BiosPrinterWithRetry.InitCustom(LPTNumber : LPTType;
  125.                                            PrinterTestNumber,
  126.                                            SuccessMask : Byte);
  127.   begin
  128.     if not BiosPrinter.InitCustom(LPTNumber, PrinterTestNumber,
  129.                                   SuccessMask) then
  130.       Fail;
  131.     bpwrPutTest         := bpPrinterTest;
  132.     bpwrPutMask         := bpSuccessMask;
  133.     bpwrRetries := 0;
  134.     bpwrTimeOut := 0;
  135.   end;
  136.  
  137.   constructor BiosPrinterWithRetry.InitDeluxe(LPTNumber : LPTType;
  138.                                            StatusTestNumber, StatusMask,
  139.                                            PutTestNumber, PutMask : Byte;
  140.                                            Retries : Word;
  141.                                            TimeOut : LongInt);
  142.   begin
  143.     if not BiosPrinter.InitCustom(LPTNumber, StatusTestNumber,
  144.                                   StatusMask) then
  145.       Fail;
  146.     bpwrPutTest   := PutTestNumber;
  147.     bpwrPutMask   := PutMask;
  148.     bpwrRetries   := Retries;
  149.     bpwrTimeOut   := TimeOut;
  150.   end;
  151.  
  152.   constructor BiosPrinterWithRetry.Load(var S : IdStream);
  153.  
  154.   begin
  155.     if not BiosPrinter.Load(S) then
  156.       Fail;
  157.     S.Read(bpwrPutTest, (SizeOf(Byte) * 2) + SizeOf(Word) + SizeOf(LongInt));
  158.   end;
  159.  
  160.   procedure BiosPrinterWithRetry.GetTestAndMaskCustom(var StatusTestNo,
  161.                                                        StatusMask,
  162.                                                        PutTestNo,
  163.                                                        PutMask : Byte);
  164.   begin
  165.     BiosPrinter.GetTestAndMask(StatusTestNo, StatusMask);
  166.     PutTestNo := bpwrPutTest;
  167.     PutMask   := bpwrPutMask;
  168.   end;
  169.  
  170.   procedure BiosPrinterWithRetry.SetTestAndMaskCustom(StatusTestNo,
  171.                                                    StatusMask,
  172.                                                    PutTestNo,
  173.                                                    PutMask : Byte);
  174.   begin
  175.     BiosPrinter.SetTestAndMask(StatusTestNo, StatusMask);
  176.     bpwrPutTest := PutTestNo;
  177.     bpwrPutMask := PutMask;
  178.   end;
  179.   procedure BiosPrinterWithRetry.SetRetryAndTimeOut(Retries : Word;
  180.                                                     TimeOut : LongInt);
  181.     {-Set Retry and timeout values}
  182.   begin
  183.     bpwrRetries := Retries;
  184.     bpwrTimeOut := TimeOut;
  185.   end;
  186.  
  187.   procedure BiosPrinterWithRetry.GetRetryAndTimeOut(var Retries : Word;
  188.                                                     var TimeOut : LongInt);
  189.     {-Return Retry and timeout values}
  190.   begin
  191.     Retries := bpwrRetries;
  192.     TimeOut := bpwrTimeOut;
  193.   end;
  194.  
  195.   procedure BiosPrinterWithRetry.Store(var S : IdStream);
  196.  
  197.   begin
  198.     BiosPrinter.Store(S);
  199.     if S.PeekStatus <> 0 then
  200.       Exit;
  201.     S.Write(bpwrPutTest, (SizeOf(Byte) * 2) + SizeOf(Word) + SizeOf(LongInt));
  202.   end;
  203.  
  204.   function BiosPrinterWithRetry.PrnXlatErrorCode(Call : PrnCallType;
  205.                                               ErrorCode : Word) : Word;
  206.     {-translate a raw error code into appropriate user error code}
  207.   begin
  208.     if @fpXlatPrim <> Nil then begin
  209.       PrnXlatErrorCode := fpXlatPrim(Call, ErrorCode);
  210.       Exit;
  211.     end;
  212.     PrnXlatErrorCode := 0;
  213.     case Call of
  214.       StatusCall :
  215.         case bpPrinterTest of
  216.           0 : begin end;                            {always succeed}
  217.           1 : if not PrnTest1Prim(ErrorCode) then       {test 1}
  218.                 PrnXlatErrorCode := PrinterNotReady;
  219.           2 : if not PrnTest2Prim(ErrorCode) then       {test 2}
  220.                 PrnXlatErrorCode := PrinterNotReady;
  221.           3 : if PrnTest3Prim(ErrorCode) then
  222.                 PrnXlatErrorCode := PrinterNotReady;
  223.           4 :                                       {test 4}
  224.               if (Byte(ErrorCode) and bpSuccessMask) <> bpSuccessMask then
  225.                 PrnXlatErrorCode := PrinterNotReady;
  226.           else
  227.             PrnXlatErrorCode := 255;  {special code indicating invalid test}
  228.         end;
  229.       PutCall :
  230.         case bpwrPutTest of
  231.           0 : begin end;                            {always succeed}
  232.           1 : if not PrnTest1Prim(ErrorCode) then       {test 1}
  233.                 PrnXlatErrorCode := PrinterNotReady;
  234.           2 : if not PrnTest2Prim(ErrorCode) then       {test 2}
  235.                 PrnXlatErrorCode := PrinterNotReady;
  236.           3 : if PrnTest3Prim(ErrorCode) then
  237.                 PrnXlatErrorCode := PrinterNotReady;
  238.           4 :                                       {test 4}
  239.               if (Byte(ErrorCode) and bpwrPutMask) <> bpwrPutMask then
  240.                 PrnXlatErrorCode := PrinterNotReady;
  241.  
  242.           else
  243.             PrnXlatErrorCode := 255;  {special code indicating invalid test}
  244.         end;
  245.     end;
  246.   end;
  247.  
  248.   procedure BiosPrinterWithRetry.PrnPutChar(Character : Char);
  249.     {-Puts a character to the output device}
  250.   var
  251.     I : Word;
  252.     ErrorCode : Word;
  253.     Timer : EventTimer;
  254.  
  255.   begin
  256.     {if number of retries = 0 then use Timeout value instead}
  257.     if bpwrRetries = 0 then begin
  258.       NewEvent(Timer, bpwrTimeOut);
  259.       repeat
  260.         ErrorCode := PrnStatus;
  261.       until (ErrorCode = 0) or (not CheckEvent(Timer));
  262.     end
  263.     else begin
  264.       if bpwrRetries = $FFFF then
  265.         I := bpwrRetries
  266.       else
  267.         I := Succ(bpwrRetries);
  268.       ErrorCode := 1;
  269.       while (I > 0) and (ErrorCode <> 0) do begin
  270.         ErrorCode := PrnStatus;
  271.         Dec(I);
  272.       end;
  273.     end;
  274.     {if printer is ready then send the character}
  275.     if ErrorCode = 0 then
  276.       FlexiblePrinter.PrnPutChar(Character);
  277.   end;
  278.  
  279. end.
  280.