home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / KMOUSE10.ZIP / KMOUSE.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-04  |  11KB  |  283 lines
  1. {                                 KMouse.Pas                                 }
  2. {                    Copyright 1989 by Kenneth A. Hill, P.E.                 }
  3. {                                                                            }
  4. {                                                                            }
  5. { KeyMouse implements a mouse handler that is transparent to the application }
  6. { Once initialized the mouse handler stuffs the selected keystrokes into     }
  7. { the keyboard buffer where the application reads them.                      }
  8.  
  9. Unit KMouse;
  10.  
  11. InterFace
  12.  
  13. Const
  14.   HasMouse : Boolean = False;
  15.   { Set to True if mouse found during initialization }
  16.   MouseVerified : Boolean = False;
  17.   { Set to True if the mouse reset function finds the mouse }
  18.   GoodMouse : Boolean = False;
  19.   { Set to True if Mouse driver is Ver. 6 or higher }
  20.  
  21.   {Mouse Motion Masks}
  22.   MoveRight = $01;
  23.   MoveLeft  = $02;
  24.   MoveDown  = $04;
  25.   MoveUp    = $08;
  26.   MoveAll   = $0F;
  27.   { The default is MoveAll }
  28.  
  29.   {Mouse Report masks}
  30.   MouseMoved      = $01;
  31.   MouseLBPressed  = $02;
  32.   MouseLBReleased = $04;
  33.   MouseRBPressed  = $08;
  34.   MouseRBReleased = $10;
  35.   MouseMBPressed  = $20;
  36.   MouseMBReleased = $40;
  37.   { The default is MouseMoved }
  38.  
  39.  
  40. Procedure ResetMouse;
  41. {Performs hardware reset on the mouse, sets Mouse verified}
  42.  
  43. Procedure InitMouse(Mask:Word);
  44.  
  45. { InitMouse installs the mouse handler to the mouse.  It must be called  }
  46. {  during program initialization, although additional calls are harmless }
  47. {  and may be used to change the interrupt mask.                         }
  48. {   Mask is the mask passed to the mouse driver to define the Mouse      }
  49. {  actions to report on.  This Word is bit encoded as follows:           }
  50. {                                                                        }
  51. {      15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00                   }
  52. {       0  0  0  0  0  0  0  0  0  x  x  x  x  x  x  x                   }
  53. {       -------------------------  ^  ^  ^  ^  ^  ^  ^                   }
  54. {                   ^              |  |  |  |  |  |  Mouse motion        }
  55. {                   |              |  |  |  |  |  Left button pressed    }
  56. {                   |              |  |  |  |  Left button released      }
  57. {                   |              |  |  |  Right button pressed         }
  58. {                   |              |  |  Right button released           }
  59. {                   |              |  Mid Button pressed                 }
  60. {                   |              Mid button released                   }
  61. {                   Reserved, must be 0                                  }
  62. { If the bit is set (ie, 1) the mouse calls the user installed handler   }
  63. { when the event occurs.                                                 }
  64. {  Utilizing the constants above for the Mask, the call                  }
  65. {     InitMouse(MouseMoved+MouseLBReleased+MouseRBReleased);             }
  66. {  installs the handler and sets the mouse for motion, and L & R button  }
  67. {  releases.                                                             }
  68.  
  69.  
  70. Procedure SetMouseMotion(Direction : Byte);
  71. { Sets the movement directions the mouse will report on.                 }
  72. { Using the the definitions of the constants above, following the call   }
  73. {  SetMouseMotion(MoveUp+MoveDown), the mouse will report vertical motion}
  74. { Correspondingly, SetMouseMotion(MoveAll); establishes vertical and     }
  75. { horizontal mouse motion. The default is MoveAll.  Use this procedure   }
  76. { to toggle mouse response from a vertical to a horizonal menu or a      }
  77. { full screen application.                                               }
  78.  
  79. Procedure SetMouseButtons( LB,RB,MB : Word );
  80. { Causes the mouse buttons to return the specified scancodes.            }
  81. {  Should be called before first initialization, may be called anytime   }
  82. {  after to change the buttons returned scancodes.  Each button enabled  }
  83. {  by the call mask must be > 0                                          }
  84.  
  85. Procedure SetMouseDelay( VDelay, HDelay : Word);
  86. { Sets the delay count for vertical and horizontal mouse movements.  The }
  87. {  delay is read and decremented by the mouse driver and only actuated   }
  88. {  when the delay counter reaches 0.  Use this Procedure to change the   }
  89. {  mouse sensitivity for menus, etc. The default is VDelay = 3, HDelay =1}
  90.  
  91. Procedure SaveMouse;
  92. { Saves the mouse state if the mouse driver is ver. 6.0 or higher.       }
  93.  
  94. Procedure RestoreMouse;
  95. { Restores a previously saved mouse state if the mouse driver is Ver. 6.0 }
  96. {  or higher.                                                             }
  97.  
  98. { The initialization code saves the current mouse in a separate buffer and }
  99. {  restores it during the exit process.                                    }
  100. { The save/restore mouse procs may be used by a TP application before and }
  101. {  after spawning a child process, eg. in a menuing program.              }
  102. { These procedures require that GoodMouse be true, ie. the mouse driver   }
  103. {   must be ver 6.0 or higher.                                            }
  104.  
  105. (*****************************************************************************)
  106.  
  107. Implementation
  108. Uses Dos;            {For system calls}
  109.  
  110. Const
  111.   MouseInt = $33;
  112.   {  Key and control definition defaults }
  113.   RKey  : Word = $4D00; { Right Cursor Key Scancode }
  114.   LKey  : Word = $4B00; { Left Cursor Key Scancode  }
  115.   DKey  : Word = $5000; { Down Cursor Key Scancode  }
  116.   UKey  : Word = $4800; { Up Cursor Key Scancode    }
  117.   LBKey : Word = $0000; { Left Button Key Scancode  }
  118.   RBKey : Word = $0000; { Right Button Key Scancode }
  119.   MBKey : Word = $0000; { Middle Button Key Scancode}
  120.   VDly  : Word = $0003; { Vertical Delay            }
  121.   HDly  : Word = $0001; { Horizontal Delay          }
  122.   Msk   : Word = MouseMoved; {Set Motion only       }
  123.   VCount : Word = $0003; { Current Vertical delay count }
  124.   HCount : Word = $0001; { Current Horizontal delay count }
  125.   MouseMotion : Byte = MoveAll; { Set motion to report UDRL }
  126.  
  127. Type
  128.   VecPtr = ^Byte;
  129.  
  130. Var
  131.   Regs : Registers;  { Pseudo registers for mouse calls }
  132.  
  133.   MouseSize : Word;  { Size required by mouse buffer }
  134.  
  135.   OldMouseState,
  136.   OurMouseState : Array [0..511] of Byte;  { Storage buffers for mouse states}
  137.  
  138.   NextExit  : Pointer; { Exit pointer }
  139.   MouseVec  : Pointer;  {Mouse Interrupt Vector}
  140.   MousePtr  : VecPtr ABSOLUTE $0000:$00CC; {mouse vector address}
  141. {$F+}
  142. {$L KeyMous}
  143. Procedure MousKey; External;
  144. { The mouse event processor }
  145.  
  146. Procedure ResetMouse;
  147.   Begin
  148.       Regs.AX := 0; {Function 0 Reset the mouse}
  149.       Intr(MouseInt,Regs);
  150.       MouseVerified := Regs.AX <> 0;
  151.       {If Regs.AX <> 0 Then MouseVerified := True else MouseVerified := false;}
  152.   End;
  153.  
  154. Procedure SetMouseMotion(Direction : Byte);
  155. Begin
  156.   MouseMotion := Direction;
  157. End;
  158.  
  159. Procedure SetMouseButtons( LB,RB,MB : Word );
  160.   Begin
  161.     LBKey := LB;
  162.     RBKey := RB;
  163.     MBKey := MB;
  164.   End;
  165.  
  166. Procedure SetMouseDelay( VDelay, HDelay : Word);
  167.   Begin
  168.     If VDelay > 0 Then
  169.       Begin
  170.         VDly := VDelay;
  171.         VCount := VDelay;
  172.       End;
  173.     If HDelay > 0 Then
  174.       Begin
  175.         HDly := HDelay;
  176.         HCount := HDelay;
  177.       End;
  178.   End;
  179.  
  180. Procedure InitMouse(Mask:Word);
  181. Begin
  182.   Msk := Mask;
  183.   If MouseVerified {HasMouse} Then             { Install Driver }
  184.     Begin
  185.       Regs.AX := 12;
  186.       Regs.CX := Msk;
  187.       Regs.DX := Ofs(MousKey);
  188.       Regs.ES := Seg(MousKey);
  189.       Intr(MouseInt,Regs);
  190.     End;
  191. End; {InitMouse}
  192.  
  193. Procedure SaveMouse;
  194. { Saves the mouse state }
  195. Begin
  196.   If MouseVerified {HasMouse} Then
  197.     If GoodMouse Then
  198.     If MouseSize < SizeOf(OurMouseState) Then
  199.     Begin
  200.       Regs.AX := $16;
  201.       Regs.DX := Ofs(OurMouseState);
  202.       Regs.ES := Seg(OurMouseState);
  203.       Intr(MouseInt,Regs);
  204.     End
  205.     Else WriteLn('Insufficient Buffer size to save mouse.');
  206. End;
  207.  
  208. Procedure RestoreMouse;
  209. { Restores a previously saved mouse state }
  210. Begin
  211.   If MouseVerified {HasMouse} Then
  212.     If GoodMouse Then
  213.       If MouseSize < SizeOf(OurMouseState) Then
  214.         Begin
  215.           Regs.AX := $17;
  216.           Regs.DX := Ofs(OurMouseState);
  217.           Regs.ES := Seg(OurMouseState);
  218.           Intr(MouseInt,Regs);
  219.         End
  220.         Else WriteLn('Cannot restore Mouse. Insufficient buffer');
  221. End;
  222.  
  223. Procedure MouseExit;
  224. { This is the program exit Processor }
  225. Begin
  226.   If MouseVerified {HasMouse} Then
  227.     Begin
  228.     ResetMouse;                 {Clear the current mouse}
  229.     If GoodMouse and (MouseSize < SizeOf(OldMouseState)) Then
  230.       Begin
  231.         Regs.AX := $17;   {Restore driver state}
  232.         Regs.DX := Ofs(OldMouseState);
  233.         Regs.ES := Seg(OldMouseState);
  234.         Intr(MouseInt,Regs);
  235.       End;
  236.     End;
  237.   ExitProc := NextExit;
  238. End;
  239.  
  240. Procedure SaveOldMouse;
  241. { Saves the mouse state during program initialization }
  242.  
  243. Begin
  244.   If MouseVerified {HasMouse} Then
  245.     If GoodMouse Then
  246.       If MouseSize < SizeOf(OldMouseState) Then
  247.         Begin
  248.           Regs.AX := $16;
  249.           Regs.DX := Ofs(OldMouseState);
  250.           Regs.ES := Seg(OldMouseState);
  251.           Intr(MouseInt,Regs);
  252.         End;
  253. End;
  254.  
  255.  
  256. Begin           { Mouse initialization }
  257. { First check to see if the mouse interrupt vector points to an IRET }
  258. { or is NIL                                                          }
  259.   GetIntVec(MouseInt,MouseVec);
  260.   If (MouseVec = Nil) or (MousePtr^ = $CF) { $CF is an IRET}
  261.     Then
  262.       HasMouse := False
  263.     Else
  264.       Begin
  265.         HasMouse := True;              { lets us know we have a mouse }
  266.         Regs.AX := $24;                { Check mouse Version }
  267.         Regs.BX := $FFFF;              { Set BX to a known state }
  268.         Intr(MouseInt,Regs);           { Call mouse }
  269.         If (Regs.BX <> $FFFF) and (Regs.BH >= 6) Then
  270.           Begin
  271.             GoodMouse := True;      { Ver 6 Driver allows saving mouse state}
  272.             Regs.AX := $15;             { get its size }
  273.             Intr(MouseInt,Regs);
  274.             MouseSize := Regs.BX;
  275.             SaveOldMouse;                  { save its state }
  276.           End
  277.         Else GoodMouse := False;
  278.         ResetMouse;                    { Clear the old mouse }
  279.         NextExit := ExitProc;          { Save old Exit Proc  }
  280.         ExitProc := @MouseExit;        { Establish our exit link }
  281.       End;
  282. End.  {KMouse.Pas}
  283.