
{---------------------------------------------------------------}
{                                                               }
{       Pascal Mouse                                            }
{       Mouse Interface for Turbo/Borland Pascal 6.0/7.0        }
{       Version 1.5                                             }
{       June 17 1997                                            }
{                                                               }
{       Copyright (c) 1996-1997 Horatiu A. Tanescu              }
{                                                               }
{---------------------------------------------------------------}
{       Source code                                             }
{---------------------------------------------------------------}

{$G+} (* enable 80286 code generation *)

unit Mouse;


interface


{ Graphic cursor shape record used by SetGraphicCursor }

type
  TGraphicCursor = record
    HotSpotX, HotSpotY : Integer;
    Masks : array [0..1, 0..15] of Word;
  end;

{ Mouse installed flag }

const
  MouseInstalled : Boolean = False;

{ Number of buttons on the mouse }

var
  ButtonCount : Integer;

{ Mouse buttons state variables }

var
  RightButtonPressed  : Boolean;
  LeftButtonPressed   : Boolean;
  CenterButtonPressed : Boolean;

{ Current position of the mouse }

var
  MouseX : Integer;
  MouseY : Integer;

function  InitMouse : Boolean;
procedure ShowMouse;
procedure HideMouse;
procedure ReadMouse;
procedure MouseTo(X, Y : Integer);
function  GetMouseDown(Button : Integer; var LastX, LastY : Integer) : Integer;
function  GetMouseUp(Button : Integer; var LastX, LastY : Integer) : Integer;
procedure SetMouseXRange(MinX, MaxX : Integer);
procedure SetMouseYRange(MinY, MaxY : Integer);
procedure SetMouseRange(MinX, MinY, MaxX, MaxY : Integer);
procedure SetGraphicCursor(NewShape : TGraphicCursor);
procedure SetTextCursor(ScreenMask, CursorMask : Word);
procedure SetHardwareCursor(FirstLn, LastLn : Word);
procedure GetMouseMove(var X, Y : Integer);
procedure SetMouseHandler(Mask : Integer; Handler : Pointer);
procedure SetLightPenEmulation(LightPen : Boolean);
procedure SetMickeyRatio(X, Y : Integer);
procedure HideMouseIn(X1, Y1, X2, Y2 : Integer);
function  DefineGraphicCursor(Width, Height, HotSpotX, HotSpotY : Byte; Masks : Pointer) : Integer;
procedure SetMouseThreshold(Threshold : Integer);
function  ExchangeMouseHandler(Mask : Integer; Handler : Pointer; var OldMask : Integer) : Pointer;
function  DriverStateSize : Integer;
procedure SaveDriverState(Size : Integer; var Buf);
procedure RestoreDriverState(Size : Integer; Buf : Pointer);
function  SetAlternateMouseHandler(Mask : Integer; Handler : Pointer) : Boolean;
function  GetAlternateMouseHandler(Mask : Integer) : Pointer;
procedure SetMouseSensitivity(Horiz, Vert, Threshold : Integer);
procedure GetMouseSensitivity(var Horiz, Vert, Threshold : Integer);
procedure SetMouseInterruptRate(Rate : Integer);
procedure SetMousePage(Page : Integer);
function  GetMousePage : Integer;
function  DisableMouse : Pointer;
function  EnableMouse : Boolean;
function  SoftwareReset : Boolean;
procedure SetMouseLanguage(Language : Integer);
function  GetMouseLanguage : Integer;
function  MouseVersion : Integer;
function  MouseIRQ : Byte;
function  MouseType : Byte;
function  MouseCursor : Byte;
procedure GetMouseMaxRange(var MaxX, MaxY : Integer);
procedure GetTextCursor(var ScreenMask, CursorMask : Word);
procedure GetHardwareCursor(var FirstLn, LastLn : Word);
function  GetMouseState : ShortInt;
function  GetMouseHotSpotX : Integer;
function  GetMouseHotSpotY : Integer;
function  GetMouseMinX : Integer;
function  GetMouseMinY : Integer;
function  GetMouseMaxX : Integer;
function  GetMouseMaxY : Integer;
procedure GetMouseRange(var MinX, MinY, MaxX, MaxY : Integer);
function  TextX(X : Integer) : Integer;
function  TextY(Y : Integer) : Integer;
function  VirtualX(X : Integer) : Integer;
function  VirtualY(Y : Integer) : Integer;


implementation


uses Dos;

var
  ScreenWidth  : Word absolute $0040:$004A;


procedure ButtonsState; assembler;
asm
        MOV     LeftButtonPressed, AL
        MOV     RightButtonPressed, AL
        MOV     CenterButtonPressed, AL
        AND     LeftButtonPressed, 0001H
        AND     RightButtonPressed, 0002H
        AND     CenterButtonPressed, 0004H
end;

function InitMouse : Boolean; assembler;
asm
        XOR     AX, AX
        INT     33H
        MOV     ButtonCount, BX
        MOV     MouseInstalled, AL
end;

procedure ShowMouse; assembler;
asm
        MOV     AX, 0001H
        INT     33H
end;

procedure HideMouse; assembler;
asm
        MOV     AX, 0002H
        INT     33H
end;

procedure ReadMouse; assembler;
asm
        MOV     AX, 0003H
        INT     33H
        MOV     MouseX, CX
        MOV     MouseY, DX
        MOV     AX, BX
        CALL    ButtonsState
end;

procedure MouseTo(X, Y : Integer); assembler;
asm
        MOV     AX, 0004H
        MOV     CX, X
        MOV     DX, Y
        INT     33H
        CALL    ReadMouse
end;

function GetMouseDown(Button : Integer; var LastX, LastY : Integer) : Integer; assembler;
asm
        MOV     AX, 0005H
        MOV     BX, Button
        INT     33H
        CALL    ButtonsState
        LES     DI, LastX
        MOV     AX, CX
        STOSW
        LES     DI, LastY
        MOV     AX, DX
        STOSW
        MOV     AX, BX
end;

function GetMouseUp(Button : Integer; var LastX, LastY : Integer) : Integer; assembler;
asm
        MOV     AX, 0006H
        MOV     BX, Button
        INT     33H
        CALL    ButtonsState
        LES     DI, LastX
        MOV     AX, CX
        STOSW
        LES     DI, LastY
        MOV     AX, DX
        STOSW
        MOV     AX, BX
end;

procedure SetMouseXRange(MinX, MaxX : Integer); assembler;
asm
        MOV     AX, 0007H
        MOV     CX, MinX
        MOV     DX, MaxX
        INT     33H
        CALL    ReadMouse
end;

procedure SetMouseYRange(MinY, MaxY : Integer); assembler;
asm
        MOV     AX, 0008H
        MOV     CX, MinY
        MOV     DX, MaxY
        INT     33H
        CALL    ReadMouse
end;

procedure SetMouseRange(MinX, MinY, MaxX, MaxY : Integer); assembler;
asm
        MOV     AX, 0007H
        MOV     CX, MinX
        MOV     DX, MaxX
        INT     33H
        MOV     AX, 0008H
        MOV     CX, MinY
        MOV     DX, MaxY
        INT     33H
        CALL    ReadMouse
end;

procedure SetGraphicCursor(NewShape : TGraphicCursor); assembler;
asm
        PUSH    DS
        LDS     SI, NewShape
        LODSW
        MOV     BX, AX
        LODSW
        MOV     CX, AX
        POP     DS
        LES     DX, NewShape
        ADD     DX, OFFSET TGraphicCursor.Masks
        MOV     AX, 0009H
        INT     33H
end;

procedure SetTextCursor(ScreenMask, CursorMask : Word); assembler;
asm
        MOV     AX, 000AH
        XOR     BX, BX
        MOV     CX, ScreenMask
        MOV     DX, CursorMask
        INT     33H
end;

procedure SetHardwareCursor(FirstLn, LastLn : Word); assembler;
asm
        MOV     AX, 000AH
        MOV     BX, 0001h
        MOV     CX, FirstLn
        MOV     DX, LastLn
        INT     33H
end;

procedure GetMouseMove(var X, Y : Integer); assembler;
asm
        MOV     AX, 000BH
        INT     33H
        MOV     AX, CX
        LES     DI, X
        STOSW
        MOV     AX, DX
        LES     DI, Y
        STOSW
end;

procedure SetMouseHandler(Mask : Integer; Handler : Pointer); assembler;
asm
        LES     DX, Handler
        MOV     CX, Mask
        MOV     AX, 000CH
        INT     33H
end;

procedure SetLightPenEmulation(LightPen : Boolean); assembler;
asm
        CMP     LightPen, False
        JE      @@1
        MOV     AX, 000DH
        JMP     @@2
@@1:    MOV     AX, 000EH
@@2:    INT     33H
end;

procedure SetMickeyRatio(X, Y : Integer); assembler;
asm
        MOV     AX, 000FH
        MOV     CX, X
        MOV     DX, Y
        INT     33H
end;

procedure HideMouseIn(X1, Y1, X2, Y2 : Integer); assembler;
asm
        MOV     AX, 0010H
        MOV     CX, X1
        MOV     DX, Y1
        MOV     SI, X2
        MOV     DI, Y2
        INT     33H
end;

function DefineGraphicCursor(Width, Height, HotSpotX, HotSpotY : Byte;
                             Masks : Pointer) : Integer; assembler;
asm
        MOV     AX, 0012H
        MOV     BH, Width
        MOV     CH, Height
        MOV     BL, HotSpotX
        MOV     CL, HotSpoty
        LES     DX, Masks
        INT     33H
end;

procedure SetMouseThreshold(Threshold : Integer); assembler;
asm
        MOV     AX, 0013H
        MOV     DX, Threshold
        INT     33H
end;

function ExchangeMouseHandler(Mask : Integer; Handler : Pointer;
                              var OldMask : Integer) : Pointer; assembler;
asm
        LES     DX, Handler
        MOV     CX, Mask
        MOV     AX, 0014H
        INT     33H
        PUSH    ES
        PUSH    DX
        MOV     AX, CX
        LES     DI, OldMask
        STOSW
        POP     AX
        POP     DX
end;

function DriverStateSize : Integer; assembler;
asm
        MOV     AX, 0015H
        INT     33H
        MOV     AX, BX
end;

procedure SaveDriverState(Size : Integer; var Buf); assembler;
asm
        MOV     AX, 0016H
        MOV     BX, Size
        LES     DX, Buf
        INT     33H
end;

procedure RestoreDriverState(Size : Integer; Buf : Pointer); assembler;
asm
        MOV     AX, 0017H
        MOV     BX, Size
        LES     DX, Buf
        INT     33H
end;

function SetAlternateMouseHandler(Mask : Integer; Handler : Pointer) : Boolean; assembler;
asm
        LES     DX, Handler
        MOV     CX, Mask
        MOV     AX, 0018H
        INT     33H
        CMP     AX, 0018H
        JNE     @@1
        MOV     AL, True
        RET
@@1:
        MOV     AL, False
end;

function GetAlternateMouseHandler(Mask : Integer) : Pointer; assembler;
asm
        MOV     CX, Mask
        MOV     AX, 0019H
        INT     33H
        OR      CX, CX
        JE      @@1
        MOV     AX, DX
        MOV     DX, BX
        RET
@@1:
        XOR     DX, DX
        XOR     AX, AX
end;

procedure SetMouseSensitivity(Horiz, Vert, Threshold : Integer); assembler;
asm
        MOV     AX, 001AH
        MOV     BX, Horiz
        MOV     CX, Vert
        MOV     DX, Threshold
        INT     33H
end;

procedure GetMouseSensitivity(var Horiz, Vert, Threshold : Integer); assembler;
asm
        MOV     AX, 001BH
        INT     33H
        MOV     AX, BX
        LES     DI, Horiz
        STOSW
        MOV     AX, CX
        LES     DI, Vert
        STOSW
        MOV     AX, DX
        LES     DI, Threshold
        STOSW
end;

procedure SetMouseInterruptRate(Rate : Integer); assembler;
asm
        MOV     BX, Rate
        MOV     AX, 001CH
        INT     33H
end;

procedure SetMousePage(Page : Integer); assembler;
asm
        MOV     AX, 001DH
        MOV     BX, Page
        INT     33H
end;

function GetMousePage : Integer; assembler;
asm
        MOV     AX, 001EH
        INT     33H
        MOV     AX, BX
end;

function DisableMouse : Pointer; assembler;
asm
        MOV     AX, 001FH
        INT     33H
        CMP     AX, 001FH
        JE      @@1
        MOV     DX, ES
        MOV     AX, BX
        RET
@@1:
        XOR     DX, DX
        XOR     AX, AX
end;

function EnableMouse : Boolean; assembler;
asm
        MOV     AX, 0020H
        INT     33H
        CMP     AX, 0020H
        JE      @@1
        MOV     AL, True
        RET
@@1:
        MOV     AL, False
end;

function SoftwareReset : Boolean; assembler;
asm
        MOV     AX, 0021H
        INT     33H
        CMP     AX, 0021H
        JE      @@1
        MOV     ButtonCount, BX
        MOV     MouseInstalled, AL
        RET
@@1:
        XOR     AL, AL
        MOV     MouseInstalled, AL
end;

procedure SetMouseLanguage(Language : Integer); assembler;
asm
        MOV     AX, 0022H
        MOV     BX, Language
        INT     33H
end;

function GetMouseLanguage : Integer; assembler;
asm
        MOV     AX, 0023H
        INT     33H
        MOV     AX, BX
end;

function MouseVersion : Integer; assembler;
asm
        MOV     AX, 0024H
        INT     33H
        CMP     AX, 0FFFFH
        JE      @@1
        MOV     AX, BX
@@1:
end;

function MouseIRQ : Byte; assembler;
asm
        MOV     AX, 0024H
        INT     33H
        CMP     AX, 0FFFFH
        JE      @@1
        MOV     AL, CL
@@1:
end;

function MouseType : Byte; assembler;
asm
        MOV     AX, 0024H
        INT     33H
        CMP     AX, 0FFFFH
        JE      @@1
        MOV     AL, CH
@@1:
end;

function MouseCursor : Byte; assembler;
asm
        MOV     AX, 0025H
        INT     33H
        SHL     AH, 2
        SHR     AH, 6
        MOV     AL, AH
end;

procedure GetMouseMaxRange(var MaxX, MaxY : Integer); assembler;
asm
        MOV     AX, 0026H
        INT     33H
        MOV     AX, CX
        LES     DI, MaxX
        STOSW
        MOV     AX, DX
        LES     DI, MaxY
        STOSW
end;

procedure GetTextCursor(var ScreenMask, CursorMask : Word); assembler;
asm
        MOV     AX, 0027H
        INT     33H
        LES     DI, ScreenMask
        STOSW
        MOV     AX, BX
        LES     DI, CursorMask
        STOSW
end;

procedure GetHardwareCursor(var FirstLn, LastLn : Word); assembler;
asm
        MOV     AX, 0027H
        INT     33H
        LES     DI, FirstLn
        STOSW
        MOV     AX, BX
        LES     DI, LastLn
        STOSW
end;

function GetMouseState : ShortInt; assembler;
asm
        MOV     AX, 002AH
        INT     33H
end;

function GetMouseHotSpotX : Integer; assembler;
asm
        MOV     AX, 002AH
        INT     33H
        MOV     AX, BX
end;

function GetMouseHotSpotY : Integer; assembler;
asm
        MOV     AX, 002AH
        INT     33H
        MOV     AX, CX
end;

function GetMouseMinX : Integer; assembler;
asm
        MOV     AX, 0031H
        INT     33H
end;

function GetMouseMinY : Integer; assembler;
asm
        MOV     AX, 0031H
        INT     33H
        MOV     AX, BX
end;

function GetMouseMaxX : Integer; assembler;
asm
        MOV     AX, 0031H
        INT     33H
        MOV     AX, CX
end;

function GetMouseMaxY : Integer; assembler;
asm
        MOV     AX, 0031H
        INT     33H
        MOV     AX, DX
end;

procedure GetMouseRange(var MinX, MinY, MaxX, MaxY : Integer); assembler;
asm
        MOV     AX, 0031H
        INT     33H
        LES     DI, MinX
        STOSW
        MOV     AX, BX
        LES     DI, MinY
        STOSW
        MOV     AX, CX
        LES     DI, MaxX
        STOSW
        MOV     AX, DX
        LES     DI, MaxY
        STOSW
end;

function TextX(X : Integer) : Integer;
begin
  TextX := X div (640 div ScreenWidth) + 1
end;

function TextY(Y : Integer) : Integer;
begin
  TextY := Y div 8 + 1
end;

function VirtualX(X : Integer) : Integer;
begin
  VirtualX := X * (640 div ScreenWidth) + 1
end;

function VirtualY(Y : Integer) : Integer;
begin
  VirtualY := Y * 8 + 1
end;

var
  Int33 : Pointer;

begin

  { Before using INT 33H, the mouse software interrupt, we must verify  }
  { that the INT 33H vector is non-zero. If the vector is zero it is    }
  { dangerous to call any mouse routine through INT 33H. PASCAL MOUSE   }
  { will simply halt your program in this case (but you can easily      }
  { modify this behaviour).                                             }
  GetIntVec($33, Int33); if Int33 = nil then Halt;

  MouseInstalled := InitMouse
end.