home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / GAMETP20.ZIP / MOUSE.INT < prev    next >
Encoding:
Text File  |  1992-11-05  |  5.9 KB  |  179 lines
  1. Unit Mouse;
  2.  
  3. { MOUSE version 1.0 Copyright (C) 1992 Scott D. Ramsay      }
  4. {                                  ramsays@access.digex.com }
  5.  
  6. {   MOUSE.TPU can be used freely in commerical and non-commerical    }
  7. { programs.  As long as you don't give yourself credit for writing   }
  8. { this portion of the code.  When distributing it please include all }
  9. { files and samples so others may enjoy using the code.  Thanks.     }
  10.  
  11. Interface
  12.  
  13. Uses Dos;
  14.  
  15. const
  16.    visible     : boolean = false;   { TRUE if mouse cursor is visible }
  17.    mousehere   : boolean = false;   { TRUE if the mouse drv is here }
  18.    mousewason  : boolean = false;   { TRUE is mouse was on from last MOUSEOFF call }
  19.    mouseoncall : boolean = false;   { TRUE if last call was MOUSEON, MOUSEOFF }
  20.    skl         : integer = 1;       { Scale value for X,  some mouse drivers }
  21.                                     { widths resolutions for mode 13h is     }
  22.                                     { 0..639 instead of 0..319.  Set during  }
  23.                                     { mousereset.  To use:                   }
  24.                                     { getmouse(button,x,y); x := x shr skl;  }
  25. var
  26.    m1,m2,m3,m4 : integer;           { work variables. Can use with functions }
  27.  
  28. procedure mset(var m1,m2,m3,m4:integer);
  29. function mousereset:integer;
  30. procedure mouseon;
  31. procedure mouseoff;
  32. procedure getmouse(var m2,m3,m4:integer);
  33. procedure setmouse(m3,m4:integer);
  34. procedure getmousepresses(var m2,m3,m4:integer);
  35. procedure getmousereleases(var m2,m3,m4:integer);
  36. procedure getmousemotion(var m3,m4:integer);
  37. procedure setmousecursor(m2,m3:integer; var mask);
  38. procedure setmouseratio(m3,m4:integer);
  39. procedure setmouseoff(x1,y1,x2,y2:integer);
  40. procedure cleanmouse;
  41. procedure chkmouseon;
  42. procedure setdefptr;
  43. procedure normalizemx;
  44.  
  45. { See Implementation section for description of functions }
  46.  
  47. implementation
  48.  
  49. (*************************************************************************)
  50. procedure setdefptr;
  51.  
  52.   Set mouse cursor to a small arrow pointer
  53.  
  54. (*************************************************************************)
  55. procedure mset(var m1,m2,m3,m4:integer);
  56.  
  57.   Send a mouse command to interrupt 33 hex.
  58.  
  59.   m1     maps to AX register
  60.   m2     maps to BX
  61.   m3     maps to CX
  62.   m4     maps to DX
  63.  
  64.   on return m1..m4 contains returns values of AX..DX
  65.  
  66. (*************************************************************************)
  67. procedure setmousecursor(m2,m3:integer; var mask);
  68.  
  69.   Sets the mouse cursor to new shape. Largest size is 16x16
  70.  
  71.   m2,m3      (x,y) hot spot of mouse cursor.
  72.   mask       new mouse shape.  Mask is:
  73.  
  74.              MyMouseCursor : array[0..31] of word;
  75.  
  76.              index 0..15, defines transparent mask
  77.              index 16..31, defines shape.
  78.  
  79.              Each word is a row in shape.  It bit is a pixel in
  80.              shape.
  81.  
  82.     Small_Arrow : array[0..31] of word =
  83.                   ($1fff,$0fff,$07ff,$03ff,$07ff,$03ff,$e7ff,$ffff,
  84.                    $ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,
  85.                    $0000,$4000,$6000,$7000,$6000,$1000,$0000,$0000,
  86.                    $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000);
  87.  
  88. (*************************************************************************)
  89. function mousereset:integer;
  90.  
  91.    Checks to see if the mouse/mouse driver is installed.
  92.  
  93.    returns 0 if error.
  94.  
  95.    Calls normalizemx
  96.  
  97. (*************************************************************************)
  98. procedure mouseon;
  99.  
  100.   Turns on the mouse cursor
  101.  
  102. (*************************************************************************)
  103. procedure chkmouseon;
  104.  
  105.   If mouseoff was called, and the mouse cursor was off then
  106.     this procedure turn on the mouse cursor
  107.  
  108. (*************************************************************************)
  109. procedure mouseoff;
  110.  
  111.   Turns off the mouse (hides it)
  112.  
  113. (*************************************************************************)
  114. procedure getmouse(var m2,m3,m4:integer);
  115.  
  116.   Gets the current status of the mouse.
  117.  
  118.   m2    Bit for each mouse button pressed.
  119.  
  120.            button1press := boolean(m2 and 1);
  121.            button2press := boolean(m2 and 2);
  122.            button3press := boolean(m2 and 4);
  123.  
  124. (*************************************************************************)
  125. procedure setmouse(m3,m4:integer);
  126.  
  127.   Sets the mouse position.
  128.  
  129.   m3,m4   New (x,y) coordinates.  check SKL variable if X value
  130.           needs to be scaled.  X := X shl skl;
  131.  
  132. (*************************************************************************)
  133. procedure getmousepresses(var m2,m3,m4:integer);
  134.  
  135.   m2        Button flag
  136.   m3,m4     Press area (x,y)
  137.  
  138. (*************************************************************************)
  139. procedure getmousereleases;
  140.  
  141.   m2        Button flag
  142.   m3,m4     Release area (x,y)
  143.  
  144. (*************************************************************************)
  145. procedure getmousemotion(var m3,m4:integer);
  146.  
  147.   Returns the velocity of the mouse.
  148.  
  149.   m3,m4    (dx,dy) of mouse.  Returns values of (0,0) means the mouse is not
  150.            moving.
  151.  
  152. (*************************************************************************)
  153. procedure cleanmouse;
  154.  
  155.   Waits until all mouse buttons are released
  156.  
  157. (*************************************************************************)
  158. procedure setmouseratio(m3,m4:integer);
  159.  
  160.   Sets the speed of the mouse motion.
  161.  
  162.   m3,m4     (x,y) speed.
  163.  
  164. (*************************************************************************)
  165. procedure setmouseoff(x1,y1,x2,y2:integer);
  166.  
  167.   Sets a rectangular area that if the mouse is on it will not
  168.   be displayed in that area.  To turn this rectangle area off call
  169.   MOUSERESET.
  170.  
  171. (*************************************************************************)
  172. procedure normalizemx;
  173.  
  174.   MOUSERESET calls the procedure.  Sets the value of SKL based on
  175.   the inital position of the mouse when initalized.
  176.  
  177.   see   SKL constant.
  178.  
  179.