home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / mouse.swg / 0013_Rodent Control.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-26  |  16.3 KB  |  413 lines
  1. UNIT Mouse;
  2. {*****************************************************************************}
  3.                                INTERFACE
  4. {*****************************************************************************}
  5. USES DOS;
  6.  
  7. TYPE mouse_cursor_mask = RECORD
  8.                          screen_mask : ARRAY[0..7] OF BYTE;
  9.                          cursor_mask : ARRAY[8..15] OF BYTE;
  10.                          END;
  11.  
  12. CONST on = TRUE;
  13. CONST off = FALSE;
  14. CONST left = $00;
  15. CONST right = $01;
  16.  
  17. CONST change_in_cursor_position = $0001;         {call masks for user defined}
  18. CONST left_button_pressed = $0002;               {input mask and swap vectors}
  19. CONST left_button_released = $0004;
  20. CONST right_button_pressed = $0008;
  21. CONST right_button_released = $0010;
  22.  
  23. CONST alternate_key_pressed = $0001;   {call masks for alternate user handlers}
  24. CONST control_key_pressed = $0002;
  25. CONST shift_button_pressed = $0004;
  26. CONST right_button_up = $0008;
  27. CONST right_button_down = $0010;
  28. CONST left_button_up = $0020;
  29. CONST left_button_down = $0040;
  30. CONST cursor_moved = $0080;
  31.  
  32. VAR mouse_driver_disabled : BOOLEAN;
  33. VAR number_of_presses, number_of_releases : INTEGER;
  34. VAR number_buttons, x, y : INTEGER;
  35. VAR button_status, horizontal_counts, vertical_counts : INTEGER;
  36. VAR left_mouse_button_pressed, right_mouse_button_pressed,
  37.     left_mouse_button_released, right_mouse_button_released : BOOLEAN;
  38. VAR register : REGISTERS;
  39.  
  40. PROCEDURE check_button_status;
  41. PROCEDURE disable_mouse_driver (VAR int33h_vector_address : POINTER);
  42. PROCEDURE enable_mouse_driver; INLINE($B8/$20/$00/$CD/$33);
  43. FUNCTION  get_alternate_user_interrupt_vector (call_mask : WORD) : POINTER;
  44. PROCEDURE get_left_button_press_information;
  45. PROCEDURE get_left_button_release_information;
  46. PROCEDURE get_mouse_position;
  47. PROCEDURE get_mouse_sensitivity (VAR horizontal_coordinates_per_pixel,
  48.                                      vertical_coordinates_per_pixel,
  49.                                      double_speed_threshold : WORD);
  50. PROCEDURE get_right_button_press_information;
  51. PROCEDURE get_right_button_release_information;
  52. PROCEDURE light_pen_emulation; INLINE($B8/$0D/$00/$CD/$33);
  53. FUNCTION  mouse_button_pressed : BOOLEAN;
  54. PROCEDURE mouse_cursor_off; INLINE($B8/$02/$00/$CD/$33);
  55. PROCEDURE mouse_cursor_off_area (x1,y1,x2,y2 : INTEGER);
  56. PROCEDURE mouse_cursor_on; INLINE($B8/$01/$00/$CD/$33);
  57. FUNCTION  mouse_exists : BOOLEAN;
  58. FUNCTION  mouse_state_buffer_size : INTEGER;
  59. FUNCTION  mouse_video_page : WORD;
  60. FUNCTION  number_of_buttons : INTEGER;
  61. PROCEDURE relative_number_of_screen_positions_moved (VAR x, y : INTEGER);
  62.           {reported in units of 0.02 inches - approximately 0.5 millimeters}
  63. PROCEDURE reset_mouse_software; INLINE($B8/$21/$00/$CD/$33);
  64. PROCEDURE restore_mouse_driver_state (mouse_state_buffer_segment,
  65.                                       mouse_state_buffer_offset : WORD);
  66.           {use when returning from another program to your program}
  67. PROCEDURE save_mouse_driver_state (mouse_state_buffer_segment,
  68.                                    mouse_state_buffer_offset : WORD);
  69.           {use mouse_state_buffer_size to set up buffer first;
  70.            use when EXEC another program from your program}
  71. PROCEDURE set_alternate_mouse_user_handler (call_mask,
  72.                                             function_offset : INTEGER);
  73. PROCEDURE set_double_speed_threshold (threshold_speed : INTEGER);
  74. PROCEDURE set_graphics_mouse_cursor (hot_spot_x, hot_spot_y : INTEGER;
  75.                                    screen_and_cursor_mask : mouse_cursor_mask);
  76. PROCEDURE set_mouse_physical_movement_ratio (x8_positions_to_move,
  77.                                              y8_positions_to_move : INTEGER);
  78.           {each position corresponds to 1/200th of an inch}
  79. PROCEDURE set_mouse_position (x,y : INTEGER);
  80. PROCEDURE set_mouse_sensitivity (horizontal_coordinates_per_pixel,
  81.                                  vertical_coordinates_per_pixel,
  82.                                  double_speed_threshold : WORD);
  83. PROCEDURE set_mouse_video_page (page_number : WORD);
  84. PROCEDURE set_mouse_x_bounds (minimum_x, maximum_x : WORD);
  85. PROCEDURE set_mouse_y_bounds (minimum_y, maximum_y : WORD);
  86. PROCEDURE set_text_mouse_attribute_cursor (screen_cursor_mask_offset : WORD);
  87. PROCEDURE set_text_mouse_hardware_cursor (top_scan_line,
  88.                                           bottom_scan_line : INTEGER);
  89. PROCEDURE stop_light_pen_emulation; INLINE($B8/$0E/$00/$CD/$33);
  90. PROCEDURE swap_mouse_interrupt_vector (VAR call_mask, mouse_vector_segment,
  91.                                            mouse_vector_offset : WORD);
  92. {*****************************************************************************}
  93.                              IMPLEMENTATION
  94. {*****************************************************************************}
  95. PROCEDURE check_button_status;
  96.    VAR check_left, check_right : WORD;
  97.    BEGIN
  98.       IF button_status AND $0001 = $0001 THEN
  99.          left_mouse_button_pressed := TRUE ELSE
  100.          left_mouse_button_pressed := FALSE;
  101.  
  102.       IF button_status AND $0002 = $0002 THEN
  103.          right_mouse_button_pressed := TRUE ELSE
  104.          right_mouse_button_pressed := FALSE;
  105.    END;
  106. {*****************************************************************************}
  107. PROCEDURE disable_mouse_driver (VAR int33h_vector_address : POINTER);
  108.    BEGIN
  109.       register.AX := $001F;
  110.       INTR($33,register);
  111.       IF register.AX = $001F THEN
  112.          BEGIN
  113.             mouse_driver_disabled := TRUE;
  114.             int33h_vector_address := PTR(register.ES,register.BX);
  115.          END ELSE mouse_driver_disabled := FALSE;
  116.    END;
  117. {*****************************************************************************}
  118. FUNCTION  get_alternate_user_interrupt_vector (call_mask : WORD) : POINTER;
  119.    BEGIN
  120.       register.AX := $0019;
  121.       register.CX := call_mask;
  122.       INTR($33,register);
  123.       get_alternate_user_interrupt_vector := PTR(register.BX,register.DX);
  124.    END;
  125. {*****************************************************************************}
  126. PROCEDURE get_left_button_press_information;
  127.    BEGIN
  128.       register.BX := $0000;
  129.       register.AX := $0005;
  130.       INTR($33,register);
  131.       number_of_presses := register.BX;
  132.       x := register.CX;
  133.       y := register.DX;
  134.       button_status := register.AX;
  135.       check_button_status;
  136.    END;
  137. {*****************************************************************************}
  138. PROCEDURE get_left_button_release_information;
  139.    BEGIN
  140.       register.BX := $0000;
  141.       register.AX := $0006;
  142.       INTR($33,register);
  143.       number_of_releases := register.BX;
  144.       x := register.CX;
  145.       y := register.DX;
  146.       button_status := register.AX;
  147.       check_button_status;
  148.    END;
  149. {*****************************************************************************}
  150. PROCEDURE get_mouse_position;
  151.    BEGIN
  152.       register.AX := $0003;
  153.       INTR($33,register);
  154.       x := register.CX;
  155.       y := register.DX;
  156.       button_status := register.BX;
  157.       check_button_status;
  158.    END;
  159. {*****************************************************************************}
  160. PROCEDURE get_mouse_sensitivity (VAR horizontal_coordinates_per_pixel,
  161.                                      vertical_coordinates_per_pixel,
  162.                                      double_speed_threshold : WORD);
  163.    BEGIN
  164.       register.AX := $001B;
  165.       register.BX := horizontal_coordinates_per_pixel;
  166.       register.CX := vertical_coordinates_per_pixel;
  167.       register.DX := double_speed_threshold;
  168.       INTR($33,register);
  169.    END;
  170. {*****************************************************************************}
  171. PROCEDURE get_right_button_press_information;
  172.    BEGIN
  173.       register.BX := $0001;
  174.       register.AX := $0005;
  175.       INTR($33,register);
  176.       number_of_presses := register.BX;
  177.       x := register.CX;
  178.       y := register.DX;
  179.       button_status := register.AX;
  180.       check_button_status;
  181.    END;
  182. {*****************************************************************************}
  183. PROCEDURE get_right_button_release_information;
  184.    BEGIN
  185.       register.BX := $0001;
  186.       register.AX := $0006;
  187.       INTR($33,register);
  188.       number_of_releases := register.BX;
  189.       x := register.CX;
  190.       y := register.DX;
  191.       button_status := register.AX;
  192.       check_button_status;
  193.    END;
  194. {*****************************************************************************}
  195. FUNCTION mouse_button_pressed : BOOLEAN;
  196.    BEGIN
  197.       register.AX := $0003;
  198.       INTR($33,register);
  199.       button_status := register.BX;
  200.       check_button_status;
  201.    END;
  202. {*****************************************************************************}
  203. PROCEDURE mouse_cursor_off_area (x1,y1,x2,y2 : INTEGER);
  204.    BEGIN
  205.       register.AX := $0010;
  206.       register.CX := x1;
  207.       register.DX := y1;
  208.       register.SI := x2;
  209.       register.DI := y2;
  210.       INTR($33,register);
  211.       mouse_cursor_on;   {may need to remove this statement}
  212.    END;
  213. {*****************************************************************************}
  214. FUNCTION  mouse_exists : BOOLEAN;
  215.    BEGIN
  216.       register.AX := $0021;
  217.       INTR($33,register);
  218.       IF (register.AX = $FFFF) AND (register.BX = $02) THEN
  219.          mouse_exists := TRUE ELSE
  220.          mouse_exists := FALSE;
  221.    END;
  222. {*****************************************************************************}
  223. FUNCTION  mouse_state_buffer_size : INTEGER;
  224.    BEGIN
  225.       register.AX := $15;
  226.       INTR($33,register);
  227.       mouse_state_buffer_size := register.BX;
  228.    END;
  229. {*****************************************************************************}
  230. FUNCTION mouse_video_page : WORD;
  231.    BEGIN
  232.       INLINE($B8/$1E/$00/$CD/$33);
  233.       mouse_video_page := register.BX;
  234.    END;
  235. {*****************************************************************************}
  236. FUNCTION number_of_buttons : INTEGER;
  237.    BEGIN
  238.       register.AX := $0000;
  239.       INTR($33,register);
  240.       number_of_buttons := register.BX;
  241.    END;
  242. {*****************************************************************************}
  243. PROCEDURE relative_number_of_screen_positions_moved (VAR x, y : INTEGER);
  244.    BEGIN
  245.       register.AX := $000B;
  246.       INTR($33,register);
  247.       register.CX := x;
  248.       register.DX := y;
  249.    END;
  250. {*****************************************************************************}
  251. PROCEDURE restore_mouse_driver_state (mouse_state_buffer_segment,
  252.                                       mouse_state_buffer_offset : WORD);
  253.    BEGIN
  254.       register.AX := $17;
  255.       register.ES := mouse_state_buffer_segment;
  256.       register.DX := mouse_state_buffer_offset;
  257.       INTR($33,register);
  258.    END;
  259. {*****************************************************************************}
  260. PROCEDURE save_mouse_driver_state (mouse_state_buffer_segment,
  261.                                    mouse_state_buffer_offset : WORD);
  262.    BEGIN
  263.       register.AX := $16;
  264.       register.ES := mouse_state_buffer_segment;
  265.       register.DX := mouse_state_buffer_offset;
  266.       INTR($33,register);
  267.    END;
  268. {*****************************************************************************}
  269. PROCEDURE set_alternate_mouse_user_handler (call_mask,
  270.                                             function_offset : INTEGER);
  271.    BEGIN
  272.       register.AX := $0018;
  273.       register.CX := call_mask;
  274.       register.DX := function_offset;
  275.       INTR($33,register);
  276.       x := register.CX;
  277.       y := register.DX;
  278.       horizontal_counts := register.DI;
  279.       vertical_counts := register.SI;
  280.       button_status := register.BX;
  281.       check_button_status;
  282.    END;
  283. {*****************************************************************************}
  284. PROCEDURE set_mouse_video_page (page_number : WORD);
  285.    BEGIN
  286.       register.AX := $001D;
  287.       register.BX := page_number;
  288.       INTR($33,register);
  289.    END;
  290. {*****************************************************************************}
  291. PROCEDURE set_double_speed_threshold (threshold_speed : INTEGER);
  292.    BEGIN
  293.       register.AX := $0013;
  294.       register.DX := threshold_speed;
  295.       INTR($33,register);
  296.    END;
  297. {*****************************************************************************}
  298. PROCEDURE set_graphics_mouse_cursor (hot_spot_x, hot_spot_y : INTEGER;
  299.                                    screen_and_cursor_mask : mouse_cursor_mask);
  300.    BEGIN
  301.       register.AX := $0009;
  302.       register.BX := hot_spot_x;
  303.       register.CX := hot_spot_y;
  304.       register.ES := SEG(screen_and_cursor_mask);
  305.       register.DX := OFS(screen_and_cursor_mask);
  306.       INTR($33,register);
  307.    END;
  308. {*****************************************************************************}
  309. PROCEDURE set_mouse_physical_movement_ratio (x8_positions_to_move,
  310.                                              y8_positions_to_move : INTEGER);
  311.    BEGIN
  312.       register.AX := $000F;
  313.       register.CX := x8_positions_to_move;
  314.       register.DX := y8_positions_to_move;
  315.       INTR($33,register);
  316.    END;
  317. {*****************************************************************************}
  318. PROCEDURE set_mouse_position (x,y : INTEGER);
  319.    BEGIN
  320.       register.AX := $0004;
  321.       register.CX := x;
  322.       register.DX := y;
  323.       INTR($33,register);
  324.    END;
  325. {*****************************************************************************}
  326. PROCEDURE set_mouse_sensitivity (horizontal_coordinates_per_pixel,
  327.                                  vertical_coordinates_per_pixel,
  328.                                  double_speed_threshold : WORD);
  329.    BEGIN
  330.       register.AX := $001A;
  331.       register.BX := horizontal_coordinates_per_pixel;
  332.       register.CX := vertical_coordinates_per_pixel;
  333.       register.DX := double_speed_threshold;
  334.       INTR($33,register);
  335.    END;
  336. {*****************************************************************************}
  337. PROCEDURE set_mouse_x_bounds (minimum_x, maximum_x : WORD);
  338.    BEGIN
  339.       register.AX := $0008;
  340.       register.CX := minimum_x;
  341.       register.DX := maximum_x;
  342.       INTR($33,register);
  343.    END;
  344. {*****************************************************************************}
  345. PROCEDURE set_mouse_y_bounds (minimum_y, maximum_y : WORD);
  346.    BEGIN
  347.       register.AX := $0007;
  348.       register.CX := minimum_y;
  349.       register.DX := maximum_y;
  350.       INTR($33,register);
  351.    END;
  352. {*****************************************************************************}
  353. PROCEDURE set_text_mouse_attribute_cursor (screen_cursor_mask_offset : WORD);
  354.    BEGIN
  355.       register.AX := $000A;
  356.       register.BX := $0000;
  357.       register.CX := screen_cursor_mask_offset;
  358.       register.DX := screen_cursor_mask_offset + 8;
  359.       INTR($33,register);
  360.    END;
  361. {*****************************************************************************}
  362. PROCEDURE set_text_mouse_hardware_cursor (top_scan_line,
  363.                                           bottom_scan_line : INTEGER);
  364.    BEGIN
  365.       register.AX := $000A;
  366.       register.BX := $0001;
  367.       register.CX := top_scan_line;
  368.       register.DX := bottom_scan_line;
  369.       INTR($33,register);
  370.    END;
  371. {*****************************************************************************}
  372. PROCEDURE set_user_defined_input_mask (call_mask, function_offset : INTEGER);
  373.    BEGIN
  374.       register.AX := $000C;
  375.       register.CX := call_mask;
  376.       register.DX := function_offset;
  377.       INTR($33,register);
  378.    END;
  379. {*****************************************************************************}
  380. PROCEDURE swap_mouse_interrupt_vector (VAR call_mask, mouse_vector_segment,
  381.                                            mouse_vector_offset : WORD);
  382.    VAR register_DS : INTEGER;
  383.    BEGIN
  384.       register_DS := register.DS;  {save the data segment}
  385.       register.AX := $0014;
  386.       register.CX := call_mask;
  387.       register.ES := mouse_vector_offset;
  388.       register.DX := mouse_vector_offset;
  389.       INTR($33,register);
  390.       call_mask := register.CX;
  391.       mouse_vector_segment := register.ES;
  392.       mouse_vector_offset := register.DX;
  393.       register.DS := register_DS;   {resets the data segment}
  394.       button_status := register.BX;
  395.       check_button_status;
  396.       horizontal_counts := register.DI;
  397.       vertical_counts := register.SI;
  398.       x := register.CX;
  399.       y := register.DX;
  400.    END;
  401. {*****************************************************************************}
  402. BEGIN
  403.    x := 0;
  404.    y := 0;
  405.    number_buttons := number_of_buttons;
  406.    number_of_presses := 0;
  407.    number_of_releases := 0;
  408.    left_mouse_button_released := FALSE;
  409.    right_mouse_button_released := FALSE;
  410.    left_mouse_button_released := FALSE;
  411.    right_mouse_button_released := FALSE;
  412. END.
  413.