'===========================================================================
' Subject: TEXT MODE MOUSE DEMO              Date: Unknown Date (00:00)   
' Author:  Unknown Author(s)                 Code: QB, PDS                
' Keys:    TEXT,MODE,MOUSE,DEMO            Packet: MOUSE.ABC
'===========================================================================
' Text Mode Mouse Demo
' First call MUST be to initialize mouse
' Right Mouse Button to Quit Program.

DEFINT A-Z
'$INCLUDE: 'QB.BI'

DECLARE SUB SetUpGrid ()
DECLARE SUB PrintMsg (PosX%, PosY%, PrintTxt$)
DECLARE SUB Reverse ()
DECLARE SUB DspButtons (Buttons%, PX%, PY%)
DECLARE SUB Normal ()
DECLARE FUNCTION IsMono% ()
DECLARE FUNCTION Rand% (MaxValue%)
DECLARE FUNCTION GetButtonUpStatus% (Button%, MPosX%, MPosY%)
DECLARE SUB MouseHandler (ax%, bx%, cx%, dx%)
DECLARE FUNCTION GetMouseStatus% (MPosX%, MPosY%)
DECLARE SUB MouseOff ()
DECLARE SUB MouseOn ()
DECLARE FUNCTION MouseReset% ()
DECLARE FUNCTION ThereIsAMouse% ()
DECLARE SUB ClearButton (Button%)
DECLARE SUB SetMouseSoftCursor (MouseChar%, MouseFGColor%, MouseBGColor%)

COMMON SHARED /QBMouse/ True, False, OutRegs AS RegType

DIM SHARED SWidth, VideoAddr
DIM SHARED PrL, PrR, PrLr, PrM
DIM SHARED PrLM, PrMR, PrAll, PrNone
DIM SHARED ForeGround, Background, HiLight
DIM SHARED ButtonLeft, ButtonRight, ButtonMiddle

DIM SHARED MouseVisible, MHMax, MVMax
DIM SHARED MouseIntr, MHCell, MVCell

True = -1: False = 0: SWidth = 80

'Mouse 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

	IF IsMono THEN
	   ForeGround = 7: Background = 0
	ELSE
	   ForeGround = 3: Background = 0
	END IF

	SCREEN 0: CLS : SetUpGrid

	IF ThereIsAMouse THEN
	   PrintMsg 24, 1, "Mouse Installed"
	   SLEEP (1)
	   IF NOT MouseReset THEN
		  PrintMsg 24, 1, "No mouse reset"
		  END
	   ELSE
		  PrintMsg 24, 1, "Mouse reset"
	   END IF
	ELSE
	   PrintMsg 24, 1, "Sorry, there's no mouse on this system"
	   END
	END IF

	LOCATE 25, 1: Reverse: PRINT SPACE$(80);
	LOCATE 25, 1
	PRINT "(Press Left Button to change mouse,";
	PRINT "Right Button to Quit)";
	MouseOn
	ClearButton ButtonLeft

	DO WHILE Buttons <> PrR
	   Buttons = GetMouseStatus(MPosX, MPosY)
	   DspButtons Buttons, MPosX, MPosY
	   IF Buttons = PrL THEN
		  MouseCharacter = Rand(255)
		  IF IsMono THEN
			 SetMouseSoftCursor MouseCharacter, 7, 0
		  ELSE
			 FGColor = Rand(7)
			 BGColor = Rand(7)
			 SetMouseSoftCursor MouseCharacter, FGColor, BGColor
		  END IF
		  MouseOn
		  PrintMsg 2, 40, "MouseCharacter: " + STR$(MouseCharacter)
		  PrintMsg 3, 40, "MouseFGColor: " + STR$(FGColor)
		  PrintMsg 4, 40, "MouseBGColor: " + STR$(BGColor)
		  ClearButton ButtonLeft
	   END IF
	LOOP
	MouseOff
	END

SUB ClearButton (Button)
	   WHILE NOT GetButtonUpStatus(Button, 0, 0): WEND
END SUB

SUB DspButtons (Buttons, PX, PY)
	Reverse
	LOCATE 24, 42: PRINT "Buttons: ";
	SELECT CASE Buttons
	   CASE PrNone
		  PRINT "None          ";
	   CASE PrL
		  PRINT "Left          ";
	   CASE PrR
		  PRINT "Right         ";
	   CASE PrLr
		  PRINT "Left & right  ";
	   CASE PrLM
		  PRINT "Left & middle ";
	   CASE PrMR
		  PRINT "Middle & right";
	   CASE PrAll
		  PRINT "All           ";
	   CASE ELSE
		  PRINT "Unknown " + STR$(Buttons);
	END SELECT
	LOCATE 24, 66: PRINT USING "XPos=## "; PX;
	LOCATE 24, 74: PRINT USING "YPos=##"; PY;
	Normal
END SUB

FUNCTION GetButtonUpStatus (Button, MPosX, MPosY)
	   ax = 6
	   bx = Button
	   OutRegs.ax = 0
	   OutRegs.bx = 0
	   OutRegs.cx = 0
	   OutRegs.dx = 0

	   MouseHandler ax, bx, 0, 0

	   MPosX = OutRegs.cx \ MHCell + 1
	   MPosY = OutRegs.dx \ MVCell + 1
	   IF OutRegs.ax = 0 THEN
			 GetButtonUpStatus = True
	   ELSE
			 GetButtonUpStatus = False
	   END IF
END FUNCTION

FUNCTION GetMouseStatus (MPosX, MPosY)
	   ax = 3
	   OutRegs.bx = 0: OutRegs.cx = 0: OutRegs.dx = 0
	   MouseHandler ax, 0, 0, 0
	   GetMouseStatus = OutRegs.bx
	   MPosX = OutRegs.cx \ MHCell + 1
	   MPosY = OutRegs.dx \ MVCell + 1
END FUNCTION

FUNCTION IsMono
	DIM InRegs AS RegType
	InRegs.ax = &HF00
	INTERRUPT &H10, InRegs, OutRegs
	IsMono = (OutRegs.ax MOD 256 = 7)
END FUNCTION

SUB MouseHandler (ax, bx, cx, dx)

DIM InRegs AS RegType
	   InRegs.ax = ax
	   InRegs.bx = bx
	   InRegs.cx = cx
	   InRegs.dx = dx
	   INTERRUPT MouseIntr, InRegs, OutRegs
END SUB

SUB MouseOff
	   IF MouseVisible THEN
			 MouseHandler 2, 0, 0, 0
			 MouseVisible = False
	   END IF
END SUB

SUB MouseOn
	   IF NOT MouseVisible THEN
			 MouseHandler 1, 0, 0, 0
			 MouseVisible = True
	   END IF
END SUB

FUNCTION MouseReset
	   MHMax = 639    'Max virtual horizontal mouse position
	   MVMax = 199    'Max virtual vertical mouse position
	   MHCell = 8     'Mouse horizontal cell width
	   MVCell = 8     'Mouse vertical cell height
	   MouseIntr = &H33
	   MouseHandler 0, 0, 0, 0
	   MouseReset = OutRegs.ax
	   MouseVisible = False
END FUNCTION

SUB Normal
	COLOR ForeGround, Background
END SUB

SUB PrintMsg (PosX, PosY, PrintTxt$)
	LOCATE PosX, PosY: Reverse
	PRINT LEFT$(PrintTxt$ + STRING$(40, " "), 40);
	Normal
END SUB

FUNCTION Rand (MaxValue)
	Rand = INT((MaxValue + 1) * RND)
END FUNCTION

SUB Reverse
	COLOR Background, ForeGround
END SUB

SUB SetMouseSoftCursor (MouseChar, MouseFGColor, MouseBGColor)
	   MouseOn
	   ax = 10
	   bx = 0         'Select software cursor
	   cx = &H8800    'Screen mask value
	   dx = &H8800 + MouseBGColor * 4096 + MouseFGColor * 256 + MouseChar
	   MouseHandler ax, bx, cx, dx
	   MouseOff
END SUB

SUB SetUpGrid
	LOCATE 1, 1
	FOR I = 1 TO 80
	   PRINT RIGHT$(STR$(I), 1);
	NEXT
	LOCATE 2, 1
	FOR I = 2 TO 25
	   LOCATE I, 1
	   PRINT USING "##"; I;
	NEXT
	Reverse
	LOCATE 24, 1: PRINT SPACE$(80);
	Normal
END SUB

FUNCTION ThereIsAMouse
	   IRET = 207
	   DEF SEG = 0    'Set to base system address
	   MouseSegment = PEEK(207) * 256 + PEEK(206)
	   MouseOffset = PEEK(205) * 256 + PEEK(204)
	   IF MouseSegment = 0 AND MouseOffset = 0 THEN
			 ThereIsAMouse = False
	   ELSE
			 DEF SEG = MouseSegment
			 MouseInstruction = PEEK(MouseOffset)
			 IF MouseInstruction = IRET THEN
					ThereIsAMouse = False
			 ELSE
					ThereIsAMouse = True
			 END IF
	   END IF
	   DEF SEG
END FUNCTION