swag/mouse/0021.pas at master · dominicusin/swag

This repository was archived by the owner on Oct 11, 2022. It is now read-only.
296 lines (265 loc) · 5.68 KB
Unit Mouse;
{ Copyright (c) 1991, Crazy Systems Software, Inc. }
 *************************************************
 *       Mouse in Text Mode Interface Unit       *
 *            for Borland Pascal 7.0             *
 *      Completely written by  Andrew Eigus      *
 *************************************************
  TMouseWinRect = record
    X1, Y1, X2, Y2 : word
  TMouseParamTable = record
    BaudRate,  { Baud rate / 100 }
    Emulation,
    ReportRate, { Report rate }
    FirmRev,
    ZeroWord,  { Should be zero }
    Port,  { Com Port used }
    PhysButtons, { Physical buttons }
    LogButtons : word { Logical buttons }
  TMouseRec = record
    Hzints,
    XCoord,
    YCoord,
    HSpeed,
    VSpeed,
    DSpeed : word;
    Column,
    Row : byte;
    W : TMouseWinRect;
    ButtonClicked : byte;
    ParamTable : TMouseParamTable
  LeftButton  = 1;
  MidButton   = 4;
  RightButton = 2;
  mNoInts    = 0;
  m30HzInts  = 1;
  m50HzInts  = 2;
  m100HzInts = 3;
  m200HzInts = 4;
  M : TMouseRec;
  MouseInstalled : boolean;
function InstallMouse : boolean;
function GetMouseInfo(var M : TMouseRec) : byte;
function ButtonReleased : boolean;
procedure SetMouseCursor(CursorOn : boolean);
procedure SetMouseCursorType(HotSpotX, HotSpotY : word; var CursorImage);
procedure MoveMouseTo(XCoord, YCoord : integer);
procedure SetMouseWindow(X1, Y1, X2, Y2 : word);
procedure GetMouseSpeed;
procedure SetMouseSpeed(HorSpeed, VrtSpeed, DblSpeed : integer);
procedure SetMouseInts(Hz : word);
function GetMousePage : word;
procedure SetMousePage(Page : word);
procedure UninstallMouse;
implementation
Function InstallMouse; assembler;
  XOR AX,AX  { zero function }
  MOV MouseInstalled,True
  MOV [ES:DI](TMouseRec).Keys,0
  MOV [ES:DI](TMouseRec).Keys,BX
  CALL GetMouseInfo
  CALL GetMousePage
  CALL GetMouseSpeed
  MOV [ES:DI](TMouseRec).W.X1,1
  MOV [ES:DI](TMouseRec).W.Y1,1
  MOV [ES:DI](TMouseRec).W.X2,639
  MOV [ES:DI](TMouseRec).W.Y2,199
  MOV AX,246Ch
  LEA DX,M.ParamTable
  MOV AL,True
End; { InstallMouse }
Function GetMouseInfo; assembler;
  CMP MouseInstalled,True
  MOV AX,0003h
  MOV [ES:DI](TMouseRec).XCoord,CX
  MOV [ES:DI](TMouseRec).Column,CL
  MOV [ES:DI](TMouseRec).YCoord,DX
  MOV [ES:DI](TMouseRec).Row,DL
  MOV [ES:DI](TMouseRec).ButtonClicked,BL
  MOV AL,BL   { LeftButton, MidButton or RightButton }
End; { GetMouseInfo }
Function ButtonReleased; assembler;
  CALL GetMouseInfo
  MOV AL,True
  MOV AL,False
End; { ButtonReleased }
Procedure SetMouseCursor; assembler;
  CMP MouseInstalled,True
  MOV AX,0001h
  CMP CursorOn,True
  MOV AX,0002h
End; { SetMouseCursor }
Procedure SetMouseCursorType; assembler;
  CMP MouseInstalled,True
  MOV AX,000Ah
  MOV BX,HotSpotX
  MOV CX,HotSpotY
  LES DX,CursorImage
End; { SetMouseCursorType }
Procedure MoveMouseTo; assembler;
  CMP MouseInstalled,True
  MOV AX,0004h
  MOV CX,XCoord
  MOV DX,YCoord
End; { MoveMouseTo }
Procedure SetMouseWindow; assembler;
  CMP MouseInstalled,True
  MOV AX,0007h
  MOV CX,X1
  MOV [ES:DI](TMouseRec).W.X1,CX
  MOV DX,X2
  MOV [ES:DI](TMouseRec).W.X2,DX
  MOV AX,0008h
  MOV CX,Y1
  MOV [ES:DI](TMouseRec).W.Y1,CX
  MOV DX,Y2
  MOV [ES:DI](TMouseRec).W.Y2,DX
End; { SetMouseWindow }
Procedure GetMouseSpeed; assembler;
  CMP MouseInstalled,True
  MOV AX,001Bh
  MOV [ES:DI](TMouseRec).HSpeed,BX
  MOV [ES:DI](TMouseRec).VSpeed,CX
  MOV [ES:DI](TMouseRec).DSpeed,DX
End; { GetMouseSpeed }
Procedure SetMouseSpeed; assembler;
  CMP MouseInstalled,True
  MOV AX,001Ah
  MOV BX,HorSpeed
  MOV CX,VrtSpeed
  MOV DX,DblSpeed
  CALL GetMouseSpeed
End; { SetMouseSpeed }
Procedure SetMouseInts; assembler;
  CMP MouseInstalled,True
  MOV AX,001Ch
  MOV BX,Hz
End; { SetMouseInts }
Function GetMousePage; assembler;
  CMP MouseInstalled,True
  MOV AX,001Eh
  MOV [ES:DI](TMouseRec).Page,BX
  MOV AX,BX
End; { GetMousePage }
Procedure SetMousePage; assembler;
  CMP MouseInstalled,True
  MOV AX,001D
  MOV BX,Page
  CALL GetMousePage
End; { SetMousePage }
Procedure UninstallMouse; assembler;
  CMP MouseInstalled,True
  MOV AX,0020h
End; { UninstallMouse }
  MouseInstalled := False;
  FillChar(M, SizeOf(TMouseRec), 0)
End. { Mouse }
{---now the demo program---}
Program MouDemo;
uses Crt, Mouse;
  if InstallMouse then
    ClrScr;
    SetMouseCursor(True);
    WriteLn('Mouse is installed.');
    WriteLn('Click left mouse button in the upper left corner of your ' +
      'screen to quit.');
      GetMouseInfo(M);
    until (M.ButtonClicked = LeftButton) and (M.Column = 1) and (M.Row = 1);
    Write('Waiting to release left button...');
    repeat until ButtonReleased;
    Write(#13);
    ClrEol;
    SetMouseCursor(False);
    UninstallMouse
  end else WriteLn('Mouse is NOT installed.')
FilesExpand file tree

0021.pas

Latest commit

History

0021.pas

File metadata and controls
