NEW MOUSE UNIT - Programmers Heaven

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories

NEW MOUSE UNIT

Phat NatPhat Nat Posts: 757Member
This unit (TP7) is NOT meant for animated backgrounds. It works well with stationary backgrounds in any VESA mode pretty much (640x400x8-bit &up)
Feel free to modify however you want. One point, it will throw off your clock, although Win XP & maybe others will keep the correct clock in windows.

Have Fun,
Phat Nat

PS - The next message contains a demo of how to use it. It assumes that you have the GRAPHICS unit I posted up here.

[code]
{$F+,S-,W-}
UNIT Mouse;
INTERFACE
USES Dos;

PROCEDURE ShowMouse;
PROCEDURE HideMouse;
PROCEDURE GetMouse(VAR MouseX, MouseY : Word; VAR MouseB : Byte);
PROCEDURE SetMouseCursor(X,Y : Word; Data : Pointer);
PROCEDURE SetDefaultMouseCursor;
PROCEDURE SetMouseScreen(MinX,MinY,MaxX,MaxY : Word);
FUNCTION GetPixel(X,Y : LongInt; Where : Word) : Byte;
PROCEDURE PutPixel(X,Y : LongInt;Color : Byte; Where : Word);
PROCEDURE SetColor(Color, R, G, B : Byte);

VAR
MouseButtons : Byte;
MouseX, MouseY : Word;

CONST
ScrWidth : Word = 320;
ScrHeight : Word = 200;
BPP : Byte = 8;

IMPLEMENTATION

TYPE
ModeInfoBlock = record
{ mandatory information }
ModeAttributes : Integer; { ; mode attributes }
WinAAttributes : Byte; { ; window A attributes }
WinBAttributes : Byte; { ; window B attributes }
WinGranularity : Integer; { ; window granularity }
WinSize : Integer; { ; window size }
WinASegment : Integer; { ; window A start segment }
WinBSegment : Integer; { ; window B start segment }
WinFuncPtr : LongInt; { ; pointer to windor function }
BytesPerScanLine : Integer; { ; bytes per scan line }
{ formerly optional information (now mandatory) }
XResolution : Integer; { ; horizontal resolution }
YResolution : Integer; { ; vertical resolution }
XCharSize : Byte; { ; character cell width }
YCharSize : Byte; { ; character cell height }
NumberOfPlanes : Byte; { ; number of memory planes }
BitsPerPixel : Byte; { ; bits per pixel }
NumberOfBanks : Byte; { ; number of banks }
MemoryModel : Byte; { ; memory model type }
BankSize : Byte; { ; bank size in kb }
NumberOfImagePages : Byte; { ; number of images }
Reserved : Byte; { 1 ; reserved for page function }
{ new Direct Color fields }
RedMaskSize : Byte; { ; size of direct color red mask in bits }
RedFieldPosition : Byte; { ; bit position of LSB of red mask }
GreenMaskSize : Byte; { ; size of direct color green mask in bits }
GreenFieldPosition : Byte; { ; bit position of LSB of green mask }
BlueMaskSize : Byte; { ; size of direct color blue mask in bits }
BlueFieldPosition : Byte; { ; bit position of LSB of blue mask }
RsvdMaskSize : Byte; { ; size of direct color reserved mask in bits }
DirectColorModeInfo : Byte; { ; Direct Color mode attributes }
BlockReserved : Array[0..215] Of Byte; { ; remainder of ModeInfoBlock }
End;
{ Max Cursor Size = 64x64, Max 4 Bytes/Pixel (32-bit) }
CursorSpace = Array[0..63*4,0..63*4] Of Byte;
CursorSpacePtr = ^CursorSpace;

VAR
Int1CSave : Pointer;
OldExit : Pointer;
ModeInfo : ModeInfoBlock;

CONST
{ countdown = 1193180/1200; { 1200 = 60Hz * 20 }
StandardCountdown = $0000; { 65536, 18.2/sec }
{ VideoCountdown = 994; { 994, 1200.38/sec }
{ VideoCountdown = 852; { 852, 1400.45/sec }
VideoCountdown = 8522; { 2*70Hz }
CX : Byte = 0;
CY : Byte = 0;
DefaultMouseX = 12;
DefaultMouseY = 18;
DefaultCursor : Array[0..DefaultMouseY-1,0..DefaultMouseX-1] Of Byte =
((000,255,255,255,255,255,255,255,255,255,255,255),
(000,000,255,255,255,255,255,255,255,255,255,255),
(000,001,000,255,255,255,255,255,255,255,255,255),
(000,001,001,000,255,255,255,255,255,255,255,255),
(000,001,002,001,000,255,255,255,255,255,255,255),
(000,001,002,002,001,000,255,255,255,255,255,255),
(000,001,002,003,002,001,000,255,255,255,255,255),
(000,001,002,003,003,002,001,000,255,255,255,255),
(000,001,002,003,003,003,000,001,000,255,255,255),
(000,001,002,003,003,000,255,255,255,255,255,255),
(000,001,000,000,003,000,255,255,255,255,255,255),
(000,000,255,255,000,003,000,255,255,255,255,255),
(000,255,255,255,000,003,000,255,255,255,255,255),
(255,255,255,255,255,000,003,000,255,255,255,255),
(255,255,255,255,255,000,003,000,255,255,255,255),
(255,255,255,255,255,255,000,003,000,255,255,255),
(255,255,255,255,255,255,000,003,000,255,255,255),
(255,255,255,255,255,255,255,000,255,255,255,255));

VAR
Saved : CursorSpacePtr;
SaveMX,
SaveMY : Word;
MouseOn : Boolean;
OldBank : Word;
Cursor : CursorSpacePtr;

PROCEDURE GetMouse(VAR MouseX, MouseY : Word; VAR MouseB : Byte); Assembler;
ASM
Mov Ax, $0003
Int $33
Les Di, MouseX { ES:DI = @MouseX }
Mov Es:[Di], Cx
Les Di, MouseY { ES:DI = @MouseY }
Mov Es:[Di], Dx
Les Di, MouseB { ES:DI = @MouseY }
Mov Es:[Di], Bl
End;

FUNCTION GetPixel(X,Y : LongInt; Where : Word) : Byte;
VAR Bank : Word;
Begin
Bank := (Y*ScrWidth+X) Shr 16;
If OldBank <> Bank Then
Begin
ASM
Mov Ax, $4f05
Xor Bh, Bh
Mov Dx, Bank
Int $10
END;
OldBank := Bank;
End;
GetPixel := Mem[Where:X+Y*ScrWidth-(Bank Shl 16)];
End;

PROCEDURE PutPixel(X,Y : LongInt;Color : Byte; Where : Word);
VAR Bank : Word;
Begin
Bank := (Y*ScrWidth+X) Shr 16;
If OldBank <> Bank Then
Begin
ASM
Mov Ax, $4f05
Xor Bh, Bh
Mov Dx, Bank
Int $10
END;
OldBank := Bank;
End;
Mem[Where:X+Y*ScrWidth-(Bank Shl 16)] := Color
End;

PROCEDURE DrawCursor;
VAR
X, Y : Byte;
Begin
If Not(MouseOn) Then Exit;
For Y := 0 to CY Do
For X := 0 to CX*(BPP SHR 3) Do
PutPixel(SaveMX+X,SaveMY+Y,Saved^[Y,X],$A000);
SaveMX := MouseX;
SaveMY := MouseY;
For Y := 0 to CY Do
Begin
For X := 0 to CX*(BPP SHR 3) Do
Begin
Saved^[Y,X] := GetPixel(SaveMX+X,SaveMY+Y,$A000);
If SaveMX+X < ScrWidth Then
If Cursor^[Y,X DIV (BPP SHR 3)] <> $FF Then
PutPixel(SaveMX+X,SaveMY+Y,Cursor^[Y,X DIV (BPP SHR 3)]+230,$A000);
End;
End;
End;

PROCEDURE CheckRefresh; Interrupt; Assembler;
ASM
Mov dx,3DAh
In al,dx
And al,08h
@l1:
In al,dx
And al,08h
Jnz @l1
@l2:
In al,dx
And al,08h
Jz @l2 { Wait for Vertical Retrace }
CALL DrawCursor
End;

PROCEDURE SetTimer(countdown : Word); Assembler;
ASM
cli
mov al,00110110b { bit 7,6 = (00) timer counter 0 }
{ bit 5,4 = (11) write LSB then MSB }
{ bit 3-1 = (011) generate square wave }
{ bit 0 = (0) binary counter }
out 43h,al { prep PIT, counter 0, square wave&init count }
jmp @Delay1 { JMP $+2 }
@Delay1:
mov cx,countdown { default is 0x0000 (65536) (18.2 per sec) }
{ interrupts when counter decrements to 0 }
mov al,cl { send LSB of timer count }
out 40h,al
jmp @Delay2 { JMP $+2 }
@Delay2:
mov al,ch { send MSB of timer count }
out 40h,al
jmp @Delay3 { JMP $+2 }
@Delay3:
sti
END;

PROCEDURE GetVideoInfo;
Begin
ASM
Mov Ax, $4F03
Int $10
Cmp Al, $4F
Jnz @Error
Cmp Ah, $00
Jnz @Error
Mov Ax, $4F01
Mov Cx, Bx
Mov DI, SEG ModeInfo
Mov ES, DI
Mov DI, OFFSET ModeInfo
Int $10
Jmp @End
@Error:
@End:
END;
ScrWidth := ModeInfo.XResolution;
ScrHeight := ModeInfo.YResolution;
BPP := ModeInfo.BitsPerPixel;
End;

PROCEDURE SetMouseScreen(MinX,MinY,MaxX,MaxY : Word); Assembler;
ASM
Mov Ax, $0007
Mov Cx, MinX
Mov Dx, MaxX
Mov ScrWidth, Dx
Int $33
Mov Ax, $0008
Mov Cx, MinY
Mov Dx, MaxY
Int $33
End;

PROCEDURE ShowMouse;
VAR
X, Y : Word;
Begin
If MouseOn Then Exit;
GetVideoInfo;
If CX = 0 Then SetDefaultMouseCursor;
SetMouseScreen(0,0,ScrWidth*BPP SHR 3,ScrHeight);
GetIntVec($1C,Int1CSave);
SetIntVec($1C,Addr(CheckRefresh));
GetMouse(MouseX,MouseY,MouseButtons);
For Y := 0 to CY Do
For X := 0 to CX*(BPP SHR 3) Do
Saved^[Y,X] := GetPixel(SaveMX+X,SaveMY+Y,$A000);
MouseOn := True;
End;

PROCEDURE HideMouse;
VAR
X, Y : Word;
Begin
If Not(MouseOn) Then Exit;
SetIntVec($01C,Int1CSave);
For Y := 0 to CY Do
For X := 0 to CX*(BPP SHR 3) Do
PutPixel(SaveMX+X,SaveMY+Y,Saved^[Y,X],$A000);
MouseOn := False;
End;

PROCEDURE SetMouseCursor(X,Y : Word; Data : Pointer);
VAR
MouseVisible : Boolean;
Begin
MouseVisible := MouseOn;
If MouseVisible Then HideMouse;
Cx := X-1; Cy := Y-1;
For Y := 0 to CY Do
For X := 0 to CX Do
Cursor^[Y,X] := Mem[Seg(Data^):Ofs(Data^)+Y*(CX+1)+X];
If MouseVisible Then ShowMouse;
End;

PROCEDURE SetDefaultMouseCursor;
Begin
SetMouseCursor(DefaultMouseX,DefaultMouseY,@DefaultCursor);
SetColor(230,0,0,0);
SetColor(231,43,43,43);
SetColor(232,53,53,53);
SetColor(233,63,63,63);
End;

PROCEDURE SetColor(Color, R, G, B : Byte); Assembler;
ASM
Mov Dx, 3c8h
Mov Al, Color
Out Dx, Al
Inc Dx
Mov Al, R
Out Dx, Al
Mov Al, G
Out Dx, Al
Mov Al, B
Out Dx, Al
END;

PROCEDURE MyExitProc;
Begin
ExitProc := OldExit;
HideMouse;
SetTimer(StandardCountdown);
Dispose(Cursor); Dispose(Saved);
End;

Begin
OldBank := 255;
ExitProc := @MyExitProc;
SetTimer(VideoCountdown);
New(Cursor); New(Saved);
End.
[/code]

Comments

  • Phat NatPhat Nat Posts: 757Member
    Here is a demo on how to use the MOUSE.TPU. It is assumed that you also have the GRAPHICS.TPU for it to work (for the SVGA modes, etc).

    *NOTE* You can load Pointers up to 64x64 in size, 16 colors. Colors are taken from the Palette starting at entry 230, and the following 16 colors up to 246.

    [code]
    USES Crt, Mouse, Graphics;
    CONST
    MyMouseX = 7;
    MyMouseY = 7;
    MyMouse : Array[0..MyMouseY-1,0..MyMouseX-1] Of Byte =
    (($FF,$FF,$FF,$00,$FF,$FF,$FF),
    ($FF,$FF,$FF,$00,$FF,$FF,$FF),
    ($FF,$FF,$00,$01,$00,$FF,$FF),
    ($00,$00,$01,$02,$01,$00,$00),
    ($FF,$FF,$00,$01,$00,$FF,$FF),
    ($FF,$FF,$FF,$00,$FF,$FF,$FF),
    ($FF,$FF,$FF,$00,$FF,$FF,$FF));
    VAR
    X,Y : Word;
    OldButton : Byte;
    Begin
    InitSVGA($101);
    { For X := 0 to 15 Do
    SetColor(230+X,(X*30) MOD 63,(X*40) MOD 63,(X*50) MOD 63);}
    For Y := 0 to ScrHeight-1 Do
    For X := 0 to ScrWidth-1 do
    PutPixel(X,Y,((X DIV (5-(BPP SHR 3)))*(Y DIV 5)) MOD(16)+15+(BPP SHR 3)*70,0,VGA);
    ShowMouse;
    repeat
    GetMouse(MouseX,MouseY,MouseButtons);
    X := Random(Mouse.ScrWidth);
    Y := Random(Mouse.ScrHeight);
    Case MouseButtons Of
    0 : If OldButton <> 0 Then Begin
    SetDefaultMouseCursor;
    OldButton := MouseButtons;
    End;
    1 : If OldButton <> 1 Then Begin
    SetMouseCursor(MyMouseX,MyMouseY,@MyMouse);
    OldButton := MouseButtons;
    End;
    End;
    Delay(10);
    until Keypressed;
    HideMouse;
    CloseGraphics;
    WriteLn(Mouse.ScrWidth);
    WriteLn(Mouse.ScrHeight);
    WriteLn(Mouse.BPP);
    End.
    [/code]
Sign In or Register to comment.