home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TP4TSR.ZIP / TSRCLOCK.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-05-27  |  5.5 KB  |  140 lines
  1. {$M 1024,0,100}
  2. program tsrtest;     {TSR shell for Turbo Pascal 4.0 from Stephen Schneck}
  3.                      {I can be reached on Phil Grier's BBS for comments. }
  4.                      {301/498-XXXX}
  5. uses dos,crt;        {N.b. adjust compiler memory directive for changes.}
  6.  
  7.  
  8. type
  9.            byte2   = array[1..2] of byte;
  10.            byte16  = array[1..16] of byte;
  11.  
  12. const
  13.            hotkey  = 198;               {the scroll lock key when released}
  14.            vid_seg = $B000;             {monochrome ttl screen            }
  15.            vid_off = 141;               {top right screen location        }
  16.          attribute = 112;               {show clock in reverse video      }
  17. var
  18. z                  : integer;
  19. ch                 : char;
  20. scancode,x         : byte;
  21. exitvector,
  22.   new09vector,
  23.   old09vector      : pointer;
  24. regs               : registers;
  25. b                  : byte2;
  26. scr_array,
  27.   old_array        : byte16;
  28.  
  29.  
  30. {$F+}
  31. procedure my_exit;   {all-purpose exit proc modified for my kbd intercept }
  32. {$F-}                {routine -- inspired by Neil Rubenking in PC Magazine}
  33. begin
  34. setintvec($09,old09vector);  {turns off my kbd intercept routine by       }
  35.                              {reseting 09 interrupt to aim at its own code}
  36. if (exitcode <> 0) or (erroraddr <> nil) then
  37.      begin
  38.      assign(output, '');
  39.      rewrite(output);
  40.      writeln(#7);
  41.           begin
  42.           write('Critical Error #',exitcode,' at address ');
  43.           writeln(seg(erroraddr^),':',(ofs(erroraddr^)));
  44.           end;
  45.      end;
  46. exitproc := exitvector;
  47. end;
  48.  
  49. procedure convert_from_bcd;  {procedure would be smaller & speedier in asm}
  50. begin
  51. if x > 49 then begin b[1] := 53; b[2] := x - 2; end
  52.   else if x > 39 then begin b[1] := 52; b[2] := x + 8; end
  53.     else if x > 29 then begin b[1] := 51; b[2] := x + 18; end
  54.       else if x > 19 then begin b[1] := 50; b[2] := x + 28; end
  55.         else if x > 9 then begin b[1] := 49; b[2] := x + 38; end
  56.           else begin b[1] := 48; b[2] := x + 48; end;
  57. end;
  58.  
  59.  
  60. procedure newint09handler(Flags,cs,ip,ax,bx,cx,dx,si,di,ds,es,bp : word);
  61. interrupt;
  62. begin
  63.   inline($9C);                        {pushf                              }
  64.   scancode := port[$60];              {check scan code of pressed key     }
  65.   if scancode = hotkey then           {if it's our hotkey then GO!!!      }
  66.  
  67.   {████████████   Here begins what you want to run resident.   ███████████}
  68.   {████████████   You can't use Pascal code that calls DOS.    ███████████}
  69.   {My sample code is a tsr clock.  Note that I call for bios time not DOS }
  70.   {time function.  DOS time seems to be what is called in TP4's routines. }
  71.   {You can't use these because DOS normally cannot be called from tsr     }
  72.   {programs.  My computer ( Leading Edge ) gets bios time from int 1A,    }
  73.   {function 2.  I believe this is a standard for the IBM-AT and most of   }
  74.   {the XT clones.  Older IBMs and some clones may not support this.       }
  75.  
  76.   begin
  77.     for z := 1 to 16 do
  78.     old_array[z] := mem[vid_seg:vid_off + z];
  79.     regs.ah := $02;                   {set AH for bios time call (func 2) }
  80.     intr(26,regs);                    {call bios clock (int 1A)           }
  81.     x := regs.ch; convert_from_bcd;   {x has hours in bcd                 }
  82.     scr_array[1] := b[1];             {load screen array with hours       }
  83.     scr_array[3] := b[2];
  84.     scr_array[5] := 58;
  85.     x := regs.cl; convert_from_bcd;   {x has minutes in bcd               }
  86.     scr_array[7] := b[1];
  87.     scr_array[9] := b[2];
  88.     scr_array[11] := 58;
  89.     x := regs.dh; convert_from_bcd;   {x has seconds in bcd               }
  90.     scr_array[13] := b[1];
  91.     scr_array[15] := b[2];
  92.     for z := 1 to 16 do               {write screen array to screen memory}
  93.     mem[vid_seg:vid_off + z] := scr_array[z];
  94.     sound(360); delay(100); nosound;
  95.     delay(1400);                      {beep & delay to get human to notice}
  96.     for z := 1 to 16 do               {then restore screen as it was      }
  97.     mem[vid_seg:vid_off + z] := old_array[z];
  98.   end;
  99.   {████████████   Here ends what you want to run resident.     ███████████}
  100.  
  101.   {now comes hard job of switching control back to real 09 handler }
  102.   {the inline code is credited to somebody named Lane Ferris       }
  103.   inline(
  104.      $9D/                   {POPF              ;begin exit from handler    }
  105.      $A1/> old09vector+2/   {MOV AX,KBD_VEC+2  ;get seg addr of old 09     }
  106.      $8B/$1E/> old09vector/ {MOV BX,KBD_VEC    ;get off of old 09 handler  }
  107.      $87/$5E/$0E/           {XCHG BX,[BP+14]   ;restore old offset         }
  108.      $87/$46/$10/           {XCHG AX,[BP+16]   ;ditto segment -- put in ax }
  109.      $8B/$E5/               {MOV SP,BP         ;undo what TP did with INTR }
  110.      $5D/                   {POP BP            ;pop back all the registers }
  111.      $07/                   {POP ES}
  112.      $1F/                   {POP DS}
  113.      $5F/                   {POP DI}
  114.      $5E/                   {POP SI}
  115.      $5A/                   {POP DX}
  116.      $59/                   {POP CX}
  117.      $CB);                  {RETF              ;works to jmp to old 09-uses}
  118. end;
  119.  
  120. procedure tsr;
  121. begin
  122. keep(exitcode);
  123. end;
  124.  
  125. procedure start;
  126. begin
  127. getintvec($09,old09vector);           {save the machine's 09 int handler  }
  128. setintvec($09,@newint09handler);      {aim 09 int calls to our int handler}
  129. exitvector := exitproc;
  130. exitproc := @my_exit;
  131. for z := 1 to 16 do
  132. scr_array[z] := attribute;
  133. end;
  134.  
  135. begin
  136. start;
  137. writeln('                 TSR program is active -- scroll lock is hotkey.');
  138. tsr;
  139. end.
  140.