unit mouse;

interface

type
    Str6 = string[6];

procedure reset_mouse(var mouse_OK: Boolean; var button: Byte);
procedure show_cursor;
procedure hide_cursor;
procedure get_mouse_status(var button: Byte; var x, y: Word);
procedure mouse_gotoXY(x, y: Word);
procedure get_mouse_button_press(var button: Byte; var count, x, y: Word);
function double_click(timeout: Word): boolean;
procedure Get_mouse_button_release(var button: Byte; var count, x, y: Word);
procedure set_cursor_x_lim(min_x, max_x: Word);
procedure set_cursor_y_lim(min_y, max_y: Word);
procedure set_graph_cursor_shape(hot_x, hot_y: Integer; address: Pointer);
procedure set_text_cursor_shape(screen_mask, cursor_mask: Word);
procedure get_relative_move(var x, y: integer);
procedure set_hide_cursor_window(x0, y0, x1, y1: Word);
procedure get_mouse_state_size(var size: Word);
procedure save_mouse_driver_state(address: Pointer);
procedure restore_mouse_driver_state(address: Pointer);
procedure get_mouse_page(var page: Word);
procedure set_mouse_page(page: Word);
procedure reset_mouse_software(var installed: Boolean; var no_buttons: Word);
procedure get_mouse_info(var ver: Str6; var port, IRQ: Byte);

implementation

uses DOS, CRT;

var
   regs: Registers;

procedure reset_mouse(var mouse_OK: Boolean; var button: Byte);
begin
     regs.AX := $00;
     Intr($33, regs);
     mouse_OK := Odd(regs.AX);
     button := regs.BX;
end;

procedure show_cursor;
begin
     regs.AX := $01;
     intr($33, regs);
end;

procedure hide_cursor;
begin
     regs.AX := $02;
     intr($33, regs);
end;

procedure get_mouse_status(var button: Byte; var x, y: Word);
begin
     regs.AX := $03;
     intr($33, regs);
     with regs do
     begin
          button := BL;
          x := CX;
          y := DX;
     end;
end;

procedure mouse_gotoXY(x, y: Word);
begin
     with regs do
     begin
          AX := $04;
          CX := x;
          DX := y;
     end;
     intr($33, regs);
end;

procedure get_mouse_button_press(var button: Byte; var count, x, y: Word);
begin
     regs.AX := $05;
     regs.BL := button;
     intr($33, regs);
     with regs do
     begin
          button := AL;
          count := BX;
          x := CX;
          y := DX;
     end;
end;

function double_click(timeout: Word): Boolean;
var
   k, x, y: Word;
   button: Byte;
begin
     double_click := False;
     repeat
           get_mouse_status(button, x, y);
     until button = 0;
     repeat
           get_mouse_status(button, x, y);
     until button = 1;
     repeat
           get_mouse_status(button, x, y);
     until button = 0;
     k := 0;
     repeat
           Delay(1);
           Inc(k);
           get_mouse_status(button, x, y);
     until (button = 1) or (k = timeout);
     if k = timeout then Exit;
     repeat
           Delay(1);
           Inc(k);
           get_mouse_status(button, x, y);
     until (button = 0) or (k = timeout);
     double_click := (k < timeout);
end;

procedure get_mouse_button_release(var button: Byte; var count, x, y: Word);
begin
     regs.AX := $06;
     regs.BL := button;
     intr($33, regs);
     with regs do
     begin
          button := AL;
          Count := BX;
          x := CX;
          y := DX;
     end;
end;

procedure set_cursor_x_lim(Min_x, Max_x: Word);
begin
     with regs do
     begin
          AX := $07;
          CX := Min_x;
          DX := Max_x;
     end;
     intr($33, regs);
end;

procedure set_cursor_y_lim(min_y, max_y: Word);
begin
     with regs do
     begin
          AX := $08;
          CX := min_y;
          DX := max_y;
     end;
     intr($33, regs);
end;

procedure set_graph_cursor_shape(hot_x, hot_y: Integer; address: Pointer);
begin
     with regs do
     begin
          AX :=$09;
          BX := Word(hot_x);
          CX := Word(hot_y);
          ES := Seg(address^);
          DX := Ofs(address^);
     end;
     intr($33, regs);
end;

procedure set_text_cursor_shape(screen_mask, cursor_mask: Word);
begin
     with regs do
     begin
          AX := $0A;
          BX := $00;
          CX := screen_mask;
          DX := cursor_mask;
     end;
     intr($33, regs);
end;

procedure get_relative_move(var x, y: Integer);
begin
     regs.AX := $0B;
     intr($33, regs);
     x := Integer(regs.CX);
     y := Integer(regs.DX);
end;

procedure set_hide_cursor_window(x0, y0, x1, y1: Word);
begin
     with regs do
     begin
          AX := $10;
          CX := x0;
          DX := y0;
          SI := x1;
          DI := y1;
     end;
     intr($33, regs);
end;

procedure get_mouse_state_size(var size: Word);
begin
     regs.AX := $15;
     intr($33, regs);
     size := regs.BX;
end;
procedure save_mouse_driver_state(address: Pointer);
begin
     with regs do
     begin
          AX := $16;
          ES := Seg(address^);
          DX := Ofs(address^);
     end;
     intr($33, regs);
end;

procedure restore_mouse_driver_state(address: Pointer);
begin
     with regs do
     begin
     AX := $17;
     ES := Seg(address^);
     DX := Ofs(address^);
     end;
     intr($33, regs);
end;

procedure set_mouse_page(page: Word);
begin
     regs.AX := $1D;
     regs.BX := page;
     intr($33, regs);
end;

procedure get_mouse_page(var page: Word);
begin
     regs.AX := $1E;
     intr($33, regs);
     page := regs.BX;
end;

procedure reset_mouse_software(var installed: Boolean; var no_buttons: Word);
begin
     regs.AX := $21;
     intr($33, regs);
     installed := regs.AX = $FFFF;
     no_buttons := regs.BX;
end;

procedure get_mouse_info(var ver: Str6; var port, IRQ: Byte);
var
   ss: Str6;
begin
     regs.AX := $24;
     intr($33, regs);
     with regs do
     begin
          Str(BH, ver); Str(BL, ss);
          ver := ver + '.'+ ss;
          port := CH; IRQ := CL;
     end;
end;

end.