[Back to MOUSE SWAG index]  [Back to Main SWAG index]  [Original]

UNIT Mouse;

{Program:   Master Mouse Routine Library}

INTERFACE

USES DOS;

CONST

  {Button press definitions}

   PrL = 1;
   PrR = 2;
   PrLr = 3;
   PrM = 4;
   PrLM = 5;
   PrMR = 6;
   PrAll = 7;
   PrNone = 0;

  {Button definitions}

   ButtonLeft = 0;
   ButtonRight = 1;
   ButtonMiddle = 2;


FUNCTION ThereIsAMouse: Boolean;
FUNCTION MouseReset: Boolean;
FUNCTION GetMouseStatus
         (VAR MPosX, MPosY: Byte): Byte;

PROCEDURE ClearButton (Button: Byte);
PROCEDURE MouseOn;
PROCEDURE MouseOff;
PROCEDURE SetMouseSoftCursor
   (MouseChar, MouseFGColor, MouseBGColor: Byte);

IMPLEMENTATION

CONST
   MouseIntr = $33;

VAR
   MouseVisible                         : Boolean;
   MHMax, MVMax, MHCell, MVCell         : Word;
   Regs : Registers;

PROCEDURE MouseHandler (A, B, C, D: Byte);
   BEGIN
      WITH Regs DO
                        BEGIN
                                ax := A;
                                bx := B;
                                cx := C;
                                dx := D;
                                Intr(MouseIntr, Regs)
                        END
   END;

FUNCTION GetButtonUpStatus
  (Button: Byte;VAR MPosX, MPosY: Word): Boolean;

   BEGIN
      WITH Regs DO
                        BEGIN
                                ax := 6;
                                bx := Button;
                                MouseHandler(ax, bx, 0, 0);
                                MPosX := cx DIV MHCell + 1;
                                MPosY := dx DIV MVCell + 1;
                                IF ax = 0 THEN
                                        GetButtonUpStatus := TRUE
                                ELSE
                                        GetButtonUpStatus := FALSE
                        END
   END;

PROCEDURE ClearButton (Button: Byte);
VAR
   MPosX,MPosY: Word;

   BEGIN
      REPEAT UNTIL
          GetButtonUpStatus(Button, MPosX,MPosY)
   END;

FUNCTION GetMouseStatus
         (VAR MPosX, MPosY: Byte): Byte;
   BEGIN
      WITH Regs DO
                        BEGIN
                                ax := 3;
                                MouseHandler(ax, 0, 0, 0);
                                GetMouseStatus := bx;
                                MPosX := cx DIV MHCell + 1;
                                MPosY := dx DIV MVCell + 1
                        END
   END;

PROCEDURE MouseOff;
   BEGIN
      IF MouseVisible THEN
                        BEGIN
                                MouseHandler(2, 0, 0, 0);
                                MouseVisible := FALSE
                        END
   END;

PROCEDURE MouseOn;
   BEGIN
      IF NOT MouseVisible THEN
                        BEGIN
                                MouseHandler(1, 0, 0, 0);
                                MouseVisible := TRUE
                        END
   END;

FUNCTION MouseReset: Boolean;
   BEGIN
      MHMax := 639; {Max virtual horizontal pos}
      MVMax := 199; {Max virtual vertical pos}
      MHCell := 8;  {Mouse horizontal cell width}
      MVCell := 8;  {Mouse vertical cell height}
      MouseHandler(0, 0, 0, 0);
      IF Regs.ax = 0 THEN
         MouseReset := FALSE
      ELSE
         MouseReset := TRUE;
                        MouseVisible := FALSE
   END;

PROCEDURE SetMouseSoftCursor
   (MouseChar, MouseFGColor, MouseBGColor: Byte);
   BEGIN
      MouseOn;
      Regs.ax := 10;
      Regs.bx := 0; {Select software cursor}
   {Screen Mask Value (don't change character)}
      Regs.cx := $8800;
      Regs.dx := $8800 + MouseBGColor * 4096 +
                  MouseFGColor * 256 + MouseChar;
      Intr($33,Regs);
      MouseOff
   END;

FUNCTION ThereIsAMouse: Boolean;
CONST
   IRET = 207;
VAR
   MouseSegment : Word ABSOLUTE $0000:$00CE;
   MouseOffset : Word ABSOLUTE $0000:$00CC;
   MouseInstruction: Byte;
   BEGIN
      IF (MouseSegment = 0) AND
           (MouseOffset = 0) THEN
         ThereIsAMouse := FALSE
      ELSE
                        BEGIN
                                MouseInstruction :=
                   MEM[MouseSegment:MouseOffset];
                                IF MouseInstruction = IRET THEN
                                        ThereIsAMouse := FALSE
                                ELSE
                                        ThereIsAMouse := TRUE
                        END
   END;

{No initialization section}

END.

[Back to MOUSE SWAG index]  [Back to Main SWAG index]  [Original]