home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BAKLPT.ZIP / BAKLPTST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-03  |  4.5 KB  |  180 lines
  1. {$R-,S-,I-,D+,V-}
  2. {
  3.   ** BakLPTStandard Unit **
  4.   ** by Richard S. Sadowsky      CIS [74017,1670]
  5.   ** 8/3/88
  6.   ** version .6
  7.   ** Copyright 1988, Richard S. Sadowsky
  8.  
  9.   This unit provides standard UserErrorFunc and UserExitFunc functions to
  10.   BakLPT.  These are rough drafts at this point.
  11.  
  12. }
  13. unit BakLPTStandard;
  14.  
  15. interface
  16.  
  17. uses DOS,TPCrt,TPInt,TPTSR,TPString,BakLPT;
  18.  
  19. function QueExit : Boolean;
  20.  
  21. function QueErrFunc : Boolean;
  22.  
  23. implementation
  24.  
  25. const
  26.   Ex_X             = 17;
  27.   Er_X             = 27;
  28.   Ex_X1            = 15;
  29.   Ex_Y1            = 8;
  30.   Ex_X2            = 65;
  31.   Ex_Y2            = 16;
  32.   Er_X1            = 25;
  33.   Er_Y1            = 7;
  34.   Er_X2            = 55;
  35.   Er_Y2            = 17;
  36.   Ex_Att           = $70;
  37.   Er_Att           = $0F;
  38.   SCREENBUFSIZE    = 4000;
  39.   ERROR_STACK_SIZE = 2048;
  40.  
  41. var
  42.   Error_Handle     : Byte;
  43.   ExWPtr,
  44.   ErWPtr           : Pointer;
  45.   ErrorStack       : Array[1..ERROR_STACK_SIZE] of Byte;
  46.  
  47. procedure ExitDrawWindow(Remove : Boolean);
  48.  
  49. begin
  50.   if Remove then
  51.     RestoreWindow(Ex_X1,Ex_Y1,Ex_X2,Ex_Y2,TRUE,ExWPtr)
  52.   else begin
  53.     if SaveWindow(Ex_X1,Ex_Y1,Ex_X2,Ex_Y2,TRUE,ExWPtr) then ;
  54.     FrameWindow(Ex_X1,Ex_Y1,Ex_X2,Ex_Y2,EX_Att,Ex_Att,'');
  55.     ScrollWindowUp(Succ(Ex_X1),Succ(Ex_Y1),Pred(Ex_X2),Pred(Ex_Y2),
  56.                    Pred(Ex_Y2-Ex_Y1));
  57.   end;
  58. end;
  59.  
  60. procedure ErrorDrawWindow(Remove : Boolean);
  61.  
  62. begin
  63.   if Remove then
  64.     RestoreWindow(Er_X1,Er_Y1,Er_X2,Er_Y2,FALSE,ErWPtr)
  65.   else begin
  66.     if SaveWindow(Er_X1,Er_Y1,Er_X2,Er_Y2,FALSE,ErWPtr) then ;
  67.     FrameWindow(Er_X1,Er_Y1,Er_X2,Er_Y2,Er_Att,Er_Att,'');
  68.     ScrollWindowUp(Succ(Er_X1),Succ(Er_Y1),Pred(Er_X2),Pred(Er_Y2),
  69.                    Pred(Er_Y2-Er_Y1));
  70.   end;
  71.  
  72. end;
  73.  
  74. function WordToStr(W : Word) : String;
  75.  
  76. var
  77.   S                : String;
  78.  
  79. begin
  80.   Str(W,S);
  81.   WordToStr := S
  82. end;
  83.  
  84. function QueExit : Boolean;
  85.  
  86. var
  87.   Ch               : Char;
  88.   S                : String[80];
  89.   Y                : Byte;
  90.  
  91. begin
  92.   ExitDrawWindow(FALSE);
  93.   S := 'There are ' + WordToStr(QBI - QOutPtr) +
  94.        ' characters left in Queue Buffer.';
  95.   Y := Ex_Y1 + 2;
  96.   FastWrite(S,Y,Ex_X,TextAttr);
  97.   S := 'Halt printing and Quit (Y or N)?';
  98.   Inc(Y);
  99.   FastWrite(S,Y,Ex_X,TextAttr);
  100.   repeat
  101.     Ch := UpCase(ReadKey);
  102.   until Ch in ['Y','N'];
  103.   if Ch = 'N' then begin
  104.     Inc(Y);
  105.     FastWrite('Waiting for Queue to empty...',Y,Ex_X,TextAttr);
  106.     TICKS_TO_WAIT := 1;  { print every clock tick (this speeds up the }
  107.                          { printing considerably).  }
  108.     CHARS_PER := 160;    { stuff twice as many chars out per interval }
  109.     repeat
  110.     until (QBI - QOutPtr) = 0; { wait until queue is empty }
  111.     Inc(Y);
  112.     FastWrite('Queue emptied - Press Any Key',Y,Ex_X,TextAttr);
  113.     Ch := ReadKey;
  114.   end;
  115.   ExitDrawWindow(TRUE);
  116.   QueExit := TRUE;
  117. end;
  118.  
  119. function QueErrFunc : Boolean;
  120. { this is being called from a hardware ISR, so be gentle! }
  121.  
  122. begin
  123.   InterruptsOff;
  124.   QuePause := TRUE;
  125.   InterruptsOn;
  126.   SetPopTicker(Error_Handle,360);
  127.   QueErrFunc := FALSE;
  128. end;
  129.  
  130. {$F+}
  131. procedure ErrorHandler(Regs : Registers);
  132.  
  133. var
  134.   Y,RetByte        : Byte;
  135.   Ch               : Char;
  136.   AbortOp          : Boolean;
  137.  
  138. begin
  139.   ErrorDrawWindow(FALSE);
  140.   repeat
  141.     Y := Er_Y1 + 2;
  142.     FastWrite('Printer error '+HexW(BakError),Y,Er_X,TextAttr);
  143.     Inc(Y);
  144.     FastWrite('Prepare printer then',Y,Er_X,TextAttr);
  145.     Inc(Y);
  146.     FastWrite('Press any key to retry',Y,Er_X,TextAttr);
  147.     Inc(Y);
  148.     FastWrite('(Esc to Quit)',Y,Er_X,TextAttr);
  149.     Sound(110); Delay(800); NoSound;
  150.     Ch := ReadKey;
  151.     AbortOp := Ch = ^[;
  152.     if AbortOp then
  153.       ResetQueue(TRUE)
  154.     else
  155.       RetByte := DoInt17(PrtQue^[QOutPtr],QTextRec(Lst).LPTNo);
  156.   until AbortOp or (RetByte and $10 <> 0);
  157.   if not AbortOp then BakError := 0;
  158.   QuePause := FALSE;
  159.   ErrorDrawWindow(TRUE);
  160. end;
  161.  
  162. {$F-}
  163. begin
  164.   if BakLPTInstalled then begin
  165.     GetMem(ErWPtr,SCREENBUFSIZE);
  166.  
  167.     { set the que exit function.  this function gets called when the Lst  }
  168.     { file is closed and unprinted characters remain in the queue buffer. }
  169.     { When QueExit returns TRUE, the program may terminate. Note how      }
  170.     { QueExit waits for queue to empty before exiting if user does not    }
  171.     { wish to abort.   }
  172.     QueUserExitFunc := @QueExit;
  173.  
  174.     QueUserErrorFunc:= @QueErrFunc;
  175.     if not DefinePopProc(Error_Handle,@ErrorHandler,
  176.                          @ErrorStack[ERROR_STACK_SIZE]) then ;
  177.     PopupsOn;
  178.   end
  179. end.
  180.