home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / turbopas / tpspool.arc / TPSPOOL.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-10-11  |  8.0 KB  |  249 lines
  1. {************************************************************************}
  2. {*                                                                      *}
  3. {* TPSPOOL - Print spooler                                              *}
  4. {* Version .8 8/4/88                                                    *}
  5. {* by Richard Sadowsky                                                  *}
  6. {* Released to the public domain                                        *}
  7. {************************************************************************}
  8. {* TPSPOOL size                                                         *}
  9. {* where size is the size of the spool buffer.  You may use hex numbers *}
  10. {* placing a $ in front (ex. $4000).                                    *}
  11. {*                                                                      *}
  12. {* Use Alt-Tab to toggle spooler on/off (default is off).               *}
  13. {* Turning spooler on will beep the speaker, turning it off will        *}
  14. {* dump the spool buffer.                                               *}
  15. {*                                                                      *}
  16. {************************************************************************}
  17. {$S-,I-,R-,V-}
  18. {$M 2048,0,655360} { program adjusts itself at runtime to use least }
  19.                        { possible amount of memory }
  20. program TPSpool;
  21.  
  22. {DEFINE debug}    { must define useCRT to use debug }
  23. {DEFINE useCRT}   { for debugging }
  24.  
  25. Uses DOS,
  26. { The following Units are from TurboPower's Turbo Professional 4.0 }
  27. {$IFDEF useCRT}
  28.      TPCrt,
  29. {$ENDIF}
  30.  
  31.      TPString,
  32.      TPInt,
  33.      TPTSR;
  34.  
  35. const
  36.   HotKey           = $080F;     { Alt/Tab }
  37.   WaitForDos       = TRUE;      { DOS services needed in popup }
  38.   SpoolBufSize     : Word = $FF00; { 65280 }
  39.   Int17_HANDLE     = 15;
  40.   SpoolOn          : Boolean = FALSE;
  41.   In_PopUp         : Boolean = FALSE;
  42.   ThisModule       : String[8] = 'TPSPOOL_0.8';
  43.   ProgID           =
  44.       'TPSPOOL .8 installed, press <Alt><Tab> to toggle spooler on/off';
  45.   OutFileName      : String[12] = 'SPOOL01.TMP';
  46.  
  47. type
  48.   Str20            = String[20];
  49.   SpoolBufType     = array[1..$FF00] of Byte;
  50.  
  51. var
  52.   TimerHandle      : Byte;
  53.   BetterDumpIt,SafeDumpSize,
  54.   SpoolIndex       : Word;
  55.   SpoolBuf         : ^SpoolBufType;
  56.   OutFile          : File;
  57.  
  58. function LongWMul(X,Y : Word) : LongInt;
  59. { multiplies two words and returns a longint, VERY FAST }
  60. Inline(
  61.   $5A/                   {pop    dx        ; get Y}
  62.   $58/                   {pop    ax        ; get x}
  63.   $F7/$E2);              {mul    dx        ; multiply Y*X return in DX:AX}
  64.  
  65. procedure DumpSpoolBuf;
  66. { Dump the spool buffer to disk if necessary }
  67. var
  68.   E                : Word;
  69.   Handle,Num       : Word;
  70.   FilePos          : LongInt;
  71.   P                : Pointer;
  72.  
  73. begin
  74.   InterruptsOff;
  75.   if SpoolIndex <= 1 then begin { if there's anything in the spooler }
  76.     InterruptsOn;
  77.     Exit; { nothing to dump }
  78.   end;
  79.  
  80.   Assign(OutFile,OutFileName);  { Open the spool file }
  81.   Reset(OutFile,1);
  82.   if IOresult <> 0 then
  83.     Rewrite(OutFile,1)          { not found so create it }
  84.   else
  85.     Seek(OutFile,FileSize(OutFile)); { prepare for appending }
  86.   BlockWrite(OutFile,SpoolBuf^[1],Pred(SpoolIndex),Num); { dump the buffer }
  87.   Close(OutFile);
  88.   InterruptsOff;
  89.   SpoolIndex := 1;  { reset spool index to beginning }
  90.   InterruptsOn;
  91. end;
  92.  
  93. {$F+}
  94. procedure PopUpEntry(var Regs : Registers);
  95. { User has pressed the hot key, so process it }
  96. begin
  97.   InterruptsOff;
  98.   In_PopUp := TRUE; { set semaphore for future multitasking }
  99.   InterruptsOn;
  100.   if SpoolBuf = NIL then   { if the spool buffer hasn't been allocated, }
  101.     GetMem(SpoolBuf,SpoolBufSize); { then allocate the memory on the heap }
  102.   SpoolOn := Not SpoolOn;  { toggle spooler }
  103.   if SpoolOn then begin
  104.  
  105. {$IFDEF useCRT}
  106.     { two tone beep at the user }
  107.     Sound(220);
  108.     Delay(600);
  109.     Sound(880);
  110.     Delay(300);
  111.     NoSound;
  112.  
  113. {$ELSE}
  114.  
  115.     Write(^G); { simple beep at user }
  116.  
  117. {$ENDIF}
  118.  
  119.   end
  120.   else
  121.     DumpSpoolBuf; { Spooler disabled so dump the buffer }
  122.   InterruptsOff;
  123.   In_PopUp := FALSE; { clear semaphore for future multitasking }
  124.   InterruptsOn;
  125. end;
  126. {$F-}
  127.  
  128. {$F+}
  129. procedure TimerISR(var Regs : Registers);
  130. { We have control and it's safe to call DOS, so check to see if the }
  131. { buffer needs dumping, and dump if necessary }
  132. begin
  133.   InterruptsOff;
  134.   if SpoolIndex > BetterDumpIt then begin { if the spooler needs dumping }
  135.     InterruptsOn;
  136.     DumpSpoolBuf; { dump it }
  137.   end
  138.   else
  139.     InterruptsOn;
  140. end;
  141. {$F-}
  142.  
  143. procedure Trap_Int17(BP : Word); interrupt;
  144. { If spooler is on, capture calls to ROM BIOS interrupt 17h, if the call is }
  145. { to print a character, add it to spool buffer. }
  146. var
  147.   Regs             : IntRegisters absolute BP;
  148.  
  149. begin
  150.  
  151.   if SpoolOn then begin { if spooler enabled then spool character }
  152.  
  153.     InterruptsOff;
  154.  
  155. {$IFDEF debug}
  156. { ******* Use this when debugging }
  157.     if SpoolIndex > SpoolBufSize - 1024 then begin
  158.       FastWrite(Pad(
  159.        'Crash approaching   SpoolIndex = '+Long2Str(SpoolIndex),80),25,1,$70);
  160.       if SpoolIndex >= SpoolBufSize then begin
  161.         InterruptsOn;
  162.         Exit;
  163.       end;
  164.     end;
  165.  
  166. {$ENDIF}
  167.  
  168.     SpoolBuf^[SpoolIndex] := Regs.Al; { put the character in the spool buf }
  169.     Inc(SpoolIndex);                  { increment index }
  170.  
  171.     if (SpoolIndex > BetterDumpIt) then { if buffer needs a-dumpin }
  172.       SetPopTicker(TimerHandle,36);     { try to gain access to DOS services }
  173.     Regs.Ah := $90;                     { set bits to indicate success }
  174.     InterruptsOn;
  175.  
  176.   end
  177.  
  178.   else
  179.     ChainInt(Regs,ISR_Array[Int17_HANDLE].OrigAddr); { just filter it }
  180.  
  181. end;
  182.  
  183. function InitISRs : Boolean;
  184. { Set's up ISRs and popup routines.  Also sets the buffer size. }
  185. var
  186.   Num  : Word;
  187.  
  188. begin
  189.   if ParamCount > 0 then    { if user specified a command line option }
  190.     if Str2Word(ParamStr(1),Num) then { is it a valid number? }
  191.       SpoolBufSize := Num;            { If so, set buffer size equal to it }
  192.   BetterDumpIt := SpoolBufSize Div 2; { Dump if greater than half full }
  193.  
  194.   SpoolIndex := 1; { point to first byte in spool buffer }
  195.   { now set up ISRs and popups }
  196.   InitISRs :=
  197.    { Hot key popup }
  198.    DefinePop(HotKey,@PopUpEntry,Ptr(SSeg,SPtr), WaitForDos) and
  199.  
  200.    { popup to allow buffer to be dumped }
  201.    DefinePopProc(TimerHandle,@TimerISR,Ptr(SSeg,SPtr)) and
  202.  
  203.    { Int 17h handler, traps calls to BIOS to print a character }
  204.    InitVector($17,Int17_HANDLE,@Trap_Int17)
  205. end;
  206.  
  207. var
  208.   ResidentSizeInParas : Word; { Number of paragraphs needed at runtime }
  209.   NumBytesUsed : LongInt;     { Number of bytes used at runtime }
  210.  
  211. begin { main }
  212.   if ModuleInstalled(ThisModule) then begin { already installed? }
  213.     WriteLn('TPSPOOL already installed.'); { already RAM resident }
  214.     Exit
  215.   end;
  216.   if InitISRs then begin { ISR and popups initialize OK? }
  217.     WriteLn(ProgID);     { Program ID }
  218.  
  219. {$IFDEF debug}
  220.     WriteLn('Debug On');
  221. {$ENDIF}
  222.  
  223.     WriteLn('Spool file name: ',OutFileName); { display spool file name }
  224.     { tell the user the runtime size in bytes of this program }
  225.     WriteLn('Using ',SpoolBufSize,' byte spool buffer in RAM');
  226.     { Disable TPCrt's  Ctrl Break handler }
  227.  
  228. {$IFDEF useCRT}
  229.  
  230.     SetIntVec($1B, SaveInt1B); { mandatory if CRT or TPCRT are used }
  231.  
  232. {$ENDIF}
  233.  
  234.     InstallModule(ThisModule,NIL); { Set up shop, see TProf4 manual }
  235.     PopUpsOn; { enable the popup routines }
  236.     SpoolBuf := NIL; { initialize this to NIL }
  237.     { Calculate the number of paragraphs of RAM needed at runtime }
  238.     ResidentSizeInParas :=  ParagraphsToKeep + Succ(SpoolBufSize div 16);
  239.     { User could care less about paragraphs, tell them in bytes }
  240.     NumBytesUsed := LongWMul(ResidentSizeInParas,16);
  241.     WriteLn;
  242.     WriteLn('Going resident, using ',NumBytesUsed,' bytes');
  243.     { Let's go resident now }
  244.     if not TerminateAndStayResident(ResidentSizeInParas,0) then {do nothing};
  245.   end;
  246.  
  247.   WriteLn('Unable to install TPSPOOL.'); { something went wrong!!! }
  248. end. {main}
  249.