Simply mouse class

[Pitto]

Here's a simply mouse class,
recognizes Left & Rigth button being pressed, held or released; double click of the left button, mouse wheel and dragging.
No external libraries, only fbgfx.

Based upon a snippet by Paul Doe (viewtopic.php?f=15&t=26673)

The class itself:

Code: Select all

'' A simple class to help us deal with the mouse
'based on a snippet by paul doe -- see topic: [url]https://www.freebasic.net/forum/viewtopic.php?f=15&t=26673[/url]
type mouse_proto
	public:
	declare function lbtn_hold() 	as boolean
	declare function lbtn_pressed() as boolean
	declare function lbtn_released() as boolean
	declare function lbtn_double_click() as boolean
      
	declare function rbtn_hold() 	as boolean
	declare function rbtn_pressed() as boolean
	declare function rbtn_released() as boolean
      
	declare function is_drag() as boolean
	declare function get_wheel() as Long
      
	declare function get_x() as Long
	declare function get_y() as Long
	declare function get_start_x() as Long
	declare function get_start_y() as Long
      
	declare sub update()
      
	declare constructor()
      
	private:
    as integer	res, x, y, clip, start_x, start_y, old_x, old_y
    as integer	wheel, old_wheel, new_wheel 
    as boolean 	new_lbtn, old_lbtn, new_rbtn, old_rbtn, _
				old_lbtn_hold, old_lbtn_pressed, old_lbtn_released
    
    as double	new_lbtn_pressed_timestamp, old_lbtn_pressed_timestamp,_
				dbl_click_grace_time
	Union
		buttons 		As Integer
        Type
            Left:1 		As Integer
            Right:1 	As Integer
            middle:1 	As Integer
        End Type
    End Union
      
end type

constructor mouse_proto()
	
	this.dbl_click_grace_time = 0.5

end constructor


sub mouse_proto.update ()
	
   this.res = GetMouse( 	this.x, this.y, _
							this.wheel, this.buttons,_
							this.clip)
	
	if this.res = 0 then

		this.old_x = this.x
		this.old_y = this.y
		
		this.old_lbtn 	= new_lbtn
		this.old_rbtn 	= new_rbtn
		this.new_lbtn 	= cbool ( this.buttons and 1 )
		this.new_rbtn 	= cbool ( this.buttons and 2 )
		this.old_wheel	= this.new_wheel
		this.new_wheel	= this.wheel
		
		if this.lbtn_pressed() then		
			this.start_x	= this.x
			this.start_y	= this.y
			this.old_lbtn_pressed_timestamp = this.new_lbtn_pressed_timestamp
			this.new_lbtn_pressed_timestamp = timer
		end if
		
	else
	
		this.x = this.old_x
		this.y = this.old_y

	end if
	
end sub


function mouse_proto.get_x() as Long
	return this.x
end function

function mouse_proto.get_y() as Long
	return this.y
end function

function mouse_proto.get_start_x() as Long
	return this.start_x
end function

function mouse_proto.get_start_y() as Long
	return this.start_y
end function

function mouse_proto.get_wheel() as Long

	if this.new_wheel = this.old_wheel then
		return 0
	elseif this.new_wheel > this.old_wheel then
		return 1
	elseif this.new_wheel < this.old_wheel then
		return -1
	end if	

end function

function mouse_proto.is_drag() as boolean

	if 	this.lbtn_hold() andAlso _
		this.start_x <> this.x andAlso _
		this.start_y <> this.y then
		
		return true
		
	else
	
		return false
	
	end if

end function

function mouse_proto.lbtn_hold() as boolean
   return ( cbool ( this.buttons and 1 ) andAlso ( this.res = 0 ))
end function

function mouse_proto.lbtn_pressed() as boolean
   return ( this.old_lbtn ) = false andAlso ( this.new_lbtn ) = true andAlso ( this.res = 0 )
end function

function mouse_proto.lbtn_released() as boolean
   return ( this.old_lbtn ) = true andAlso ( this.new_lbtn ) = false andAlso ( this.res = 0 )
end function

function mouse_proto.lbtn_double_click() as boolean
	return 	this.lbtn_pressed() = true andAlso _
			Cbool((this.new_lbtn_pressed_timestamp - _
			this.old_lbtn_pressed_timestamp) < this.dbl_click_grace_time) _
			andAlso ( this.res = 0 )
end function

function mouse_proto.rbtn_hold() as boolean
   return ( cbool ( this.buttons and 2 ) andAlso ( this.res = 0 ))
end function

function mouse_proto.rbtn_pressed() as boolean
   return ( this.old_rbtn ) = false andAlso ( this.new_rbtn ) = true andAlso ( this.res = 0 )
end function

function mouse_proto.rbtn_released() as boolean
   return ( this.old_rbtn ) = true andAlso ( this.new_rbtn ) = false andAlso ( this.res = 0 )
end function

A simply test program:

Code: Select all

#include "fbgfx.bi"

Using FB

Sub utility_consmessage (Byref e As String)
  Dim As Integer f = Freefile()
  Open cons For Output As #f
  Print #f, e
  Close #f
End Sub

#include "inc/mouse.bi"

dim mouse as mouse_proto

screenres (640, 480, 24)

SetMouse 640\2, 480\2, 0, 1


do
	if MULTIKEY (SC_Escape) then exit do

	mouse.update()
	
	if mouse.lbtn_pressed() 	then utility_consmessage 	("[X]|[ ] lbtn_pressed")
	if mouse.lbtn_released() 	then utility_consmessage 	("[*]|[ ] lbtn released")
	if mouse.lbtn_hold() 		then utility_consmessage 	("[-]|[ ] lbtn_hold")
	
	if mouse.rbtn_pressed() 	then utility_consmessage 	("[ ]|[X] rbtn_pressed")
	if mouse.rbtn_released() 	then utility_consmessage 	("[ ]|[*] released")
	if mouse.rbtn_hold() 		then utility_consmessage 	("[ ]|[-] rbtn_hold")
	
	if mouse.get_wheel() > 0	then utility_consmessage 	("[ ]^[ ] wheel " + str(mouse.get_wheel))
	if mouse.get_wheel() < 0	then utility_consmessage 	("[ ]v[ ] wheel " + str(mouse.get_wheel))
	
	if mouse.lbtn_double_click() then utility_consmessage ("{#}|[ ] ** double click **")
	
	screenlock
	cls
	
	if mouse.is_drag() then
		line (mouse.get_x(), mouse.get_y())-(mouse.get_start_x(), mouse.get_start_y()),&hFF00FF, b
		draw string (mouse.get_start_x(), mouse.get_start_y()), str (mouse.get_start_x()) + ", " + str (mouse.get_start_y())
		draw string (mouse.get_x(), mouse.get_y()), str (mouse.get_x()) + ", " + str (mouse.get_y())
		utility_consmessage ("[@]|[ ] drag")
	end if
	
	line (mouse.get_x()-5, mouse.get_y())-step(10,0)
	line (mouse.get_x(), mouse.get_y()-5)-step(0,10)
	
	screenunlock
	sleep 20,1
	
LOOP

[Tourist Trap]

Here's a simply mouse class,
recognizes Left & Rigth button being pressed, held or released; double click of the left button, mouse wheel and dragging.
No external libraries, only fbgfx.

Hi Pitto,

Nice job. Anyway I see that somehow you prevent the mouse coordinates to be recorded when outside the app.

I mean when the mouse is found to be outside the application window you will freeze the things in a way that I didn't try to track down in the code (maybe you use the clipping option , I don't know), but I can see what occuring when using DRAG is that the mouse jumps outside rather than reaching the border just before this event.

In my opinion you should not let this happen because you can never follow the mouse pointer in a smooth way. So if one is very fast the mouse will jump in the outerspace of the app before it crosses the border, which makes it feel a little iggly. I know anyway that it can be avoided. I will try to look in deep at what you do exactly later when I have time. Maybe however you can see what I mean already, and may have this fixed.

Just for the record, I see that I ran into a similar issue when I tried the same exercise a while before. I was sending the object at (-1, -1) then, which is even worst. I don't know why I didn't get it fixed at the time by the way :)

Code: Select all

'UDT designer - graphical interface
'Draggable button with drop zones 
'drop zone can be rectangle/ellipse
'landing zones can be muliple if overlaping

#include "fbgfx.bi"


#define   _DEBUG
#macro _P(id)
   ? #id, id :
#endMacro


const as double   _pi => 4*atn(1)
const as double   _2pi => 8*atn(1)

#define _MIN(a, b)   iif((a)<(b), (a), (b))
#define _MAX(a, b)   iif((a)>(b), (a), (b))

#macro _COMPLEMENTCOLOR(value, depth)
   value + iif(value<(2^(depth - 1)), +(2^(depth - 1)), -2^(depth - 1))
#endMacro

#macro _DYNARRAYINCREASE(array)
   redim preserve array(uBound(array) + 1)
#endMacro
#macro _DYNARRAYDECREASE(array)
   if uBound(array)>0 then
      redim preserve array(uBound(array) - 1)
   else
      erase array
   end if
#endMacro
#macro _DYNARRAYINCREASEBYRANGE(array, range)
   redim preserve array(uBound(array) + range)
#endMacro
#macro _ARRAYLASTITEM(array)
   array(uBound(array))
#endMacro
#macro _ARRAYRANGE(array)
   (uBound(array) - lBound(array) + 1)
#endMacro


#macro _IMGCREATE(imgvariablename, imgW, imgH, bckgColor, imgColorDepth)
   imgvariablename = imageCreate(imgW, imgH, bckgColor, imgColorDepth)
#endMacro
#macro _IMGRESET(imgvariablename, bckgColor, imgColorDepth)
   scope
      dim as integer   imgW, imgH
         imageInfo   imgvariablename, imgW, imgH
      imageDestroy(imgvariablename)
      imgvariablename = imageCreate(imgW, imgH, bckgColor, imgColorDepth)
   end scope
#endMacro
#macro _IMGDESTROY(imgvariablename)
   imageDestroy(imgvariablename)
   imgvariablename   = 0
#endMacro


type BIINTVALUE
      as integer   _bivi
      as integer   _bivj
end type


type POSITIONXY
      as integer   _x
      as integer   _y
end type
declare operator -(byval as POSITIONXY, byval as POSITIONXY) as POSITIONXY
declare operator <>(byval as POSITIONXY, byval as POSITIONXY) as boolean
operator -(byval LeftOperand as POSITIONXY, byval RightOperand as POSITIONXY) as POSITIONXY
   dim as POSITIONXY   operationResult
   operationResult._x = LeftOperand._x - RightOperand._x
   operationResult._y = LeftOperand._y - RightOperand._y
   '---->
   return operationResult
end operator
operator <>(byval LeftOperand as POSITIONXY, byval RightOperand as POSITIONXY) as boolean
   if LeftOperand._x<>RightOperand._x   orElse _
      LeftOperand._y<>RightOperand._y   then
      '---->
      return TRUE
   else
      '---->
      return FALSE
   end if
end operator


type WIDHEI
   #define _refreshErrorType   typeOf(Err())
   declare operator Cast() as integer
   declare property Wid() as integer
   declare property Wid(byval as integer)
   declare property Hei() as integer
   declare property Hei(byval as integer)
   declare property Max() as integer
   declare property RatioForEllipse() as single
   declare function Xf(byval as integer) as integer
   declare function Yf(byval as integer) as integer
   declare function Refresh(byval as integer=-1, _
                      byval as integer=-1) _
                      as _refreshErrorType
      as integer   _wid
      as integer   _hei
      as integer   _maxOfWH
      as single   _ratioForEllipse
   #undef _refreshErrorType
end type
operator WIDHEI.Cast() as integer
   '---->
   return THIS._wid
end operator
property WIDHEI.Wid() as integer
   '---->
   return THIS._wid
end property
property WIDHEI.Wid(byval SetValue as integer)
   THIS.Refresh(SetValue)
end property
property WIDHEI.Hei() as integer
   '---->
   return THIS._hei
end property
property WIDHEI.Hei(byval SetValue as integer)
   THIS.Refresh( , SetValue)
end property
property WIDHEI.Max() as integer
   '---->
   return THIS._maxOfWH
end property
property WIDHEI.RatioForEllipse() as single
   '---->
   return THIS._ratioForEllipse
end property
function WIDHEI.Xf(byval Xi as integer) as integer
   '---->
   return Xi + THIS._wid - 1
end function
function WIDHEI.Yf(byval Yi as integer) as integer
   '---->
   return Yi + THIS._hei - 1
end function
#define _refreshErrorType   typeOf(Err())
function WIDHEI.Refresh(byval W as integer=-1, _
                  byval H as integer=-1) _
                  as _refreshErrorType
   dim as _refreshErrorType   returnValue
   '
   if W<1 then
      returnValue += 1
   else
      THIS._wid = W
   end if
   if H<1 then
      returnValue += 1
   else
      THIS._hei = H
   end if
   '
   THIS._maxOfWH         = _MAX(THIS._wid, THIS._hei)
   THIS._ratioForEllipse   = THIS._hei/THIS._wid
   '
   '---->
   return returnValue
end function
#undef _refreshErrorType


type DROPZONE
    enum _DROPZONESHAPE
        _fullRectangle
        _maximumEllipse
    end enum
    declare constructor()
    declare property Xi() as integer
    declare property Yi() as integer
    declare property Xf() as integer
    declare property Yf() as integer
    declare function IsInDropzoneShape overload(byval as integer, _
                                     byval as integer) _
                                     as boolean
    declare function IsInDropzoneShape(byval as POSITIONXY) as boolean
    declare sub DrawDropZone(byval as integer=-1)
       as _DROPZONESHAPE   _dzShape
        as POSITIONXY      _topLeftCorner
        as WIDHEI         _widHei
        as string         _keyId
end type
type DZ   as DROPZONE
constructor DROPZONE()
   dim as integer   scrW, scrH
      screenInfo   scrW, scrH
   '
   with THIS
      ._dzShape         => DZ._DROPZONESHAPE._fullRectangle
      ._topLeftCorner._x   => scrW\4
      ._topLeftCorner._y   => scrH\3
      ._widHei.Wid      => scrW\2
      ._widHei.Hei      => scrH\2
      ._keyId            => "ID"& str(int(rnd*9e+12))
   end with
end constructor
property DZ.Xi() as integer
   '---->
   return THIS._topLeftCorner._x
end property
property DZ.Yi() as integer
   '---->
   return THIS._topLeftCorner._y
end property
property DZ.Xf() as integer
   '---->
   return THIS._widHei.Xf(THIS._topLeftCorner._x)
end property
property DZ.Yf() as integer
   '---->
   return THIS._widHei.Yf(THIS._topLeftCorner._y)
end property
function DZ.IsInDropzoneShape(byval PosX as integer, _
                        byval PosY as integer) _
                        as boolean
    select case THIS._dzShape
       case DZ._DROPZONESHAPE._fullRectangle
          if PosX>=THIS.Xi   andAlso _
             PosX<=THIS.Xf   andAlso _
             PosY>=THIS.Yi   andAlso _
             PosY<=THIS.Yf   then
             '---->
             return TRUE
          else
             '---->
             return FALSE
          end if
       case else
          'DZ._DROPZONESHAPE._maximumEllipse
          if PosX>=THIS.Xi   andAlso _
             PosX<=THIS.Xf   andAlso _
             PosY>=THIS.Yi   andAlso _
             PosY<=THIS.Yf   then
             dim as single   xCenter => (THIS.Xi + THIS.Xf)\2
             dim as single   yCenter => (THIS.Yi + THIS.Yf)\2
             dim as single   rX => THIS._widhei._wid\2
             dim as single   rY => THIS._widhei._hei\2
            if (((PosX - xCenter)/rX)^2 + ((PosY - yCenter)/rY)^2)<1 then
               '---->
               return TRUE
            else
               '---->
               return FALSE
            end if
          else
             '---->
             return FALSE
          end if
    end select
end function
function DZ.IsInDropzoneShape(byval PosXY as POSITIONXY) as boolean
    select case THIS._dzShape
       case DZ._DROPZONESHAPE._fullRectangle
          if PosXY._x>=THIS.Xi   andAlso _
             PosXY._x<=THIS.Xf   andAlso _
             PosXY._y>=THIS.Yi   andAlso _
             PosXY._y<=THIS.Yf   then
             '---->
             return TRUE
          else
             '---->
             return FALSE
          end if
       case else
          'DZ._DROPZONESHAPE._maximumEllipse
          if PosXY._x>=THIS.Xi   andAlso _
             PosXY._x<=THIS.Xf   andAlso _
             PosXY._y>=THIS.Yi   andAlso _
             PosXY._y<=THIS.Yf   then
             dim as single   xCenter => (THIS.Xi + THIS.Xf)\2
             dim as single   yCenter => (THIS.Yi + THIS.Yf)\2
             dim as single   rX => THIS._widhei._wid\2
             dim as single   rY => THIS._widhei._hei\2
            if (((PosXY._x - xCenter)/rX)^2 + ((PosXY._y - yCenter)/rY)^2)<1 then
               '---->
               return TRUE
            else
               '---->
               return FALSE
            end if
         else
             '---->
             return FALSE
          end if
    end select
end function
sub DZ.DrawDropZone(byval DrawingFlag as integer=-1)
   static as integer   counter
   static as boolean   isFlipped
   '
   'get background color
   dim as integer   bkgColor
      screenControl fb.GET_COLOR, , bkgColor
   'get screen color depth
   dim as integer   scrDepth
      screenInfo   , , scrDepth
   '
   line (THIS.Xi, THIS.Yi)-(THIS.Xf, THIS.Yf), _
       _COMPLEMENTCOLOR(bkgColor, scrDepth), _
       b, _
       iif(isFlipped, &b1111000011111111, &b0000111111110000)
   select case THIS._dzShape
       case DZ._DROPZONESHAPE._fullRectangle
         line (THIS.Xi + 1, THIS.Yi + 1)-(THIS.Xf - 1, THIS.Yf - 1), _
             _COMPLEMENTCOLOR(bkgColor, scrDepth), _
             b, _
             iif(isFlipped, &b1111000011111111, &b0000111111110000)
          if DrawingFlag<>-1 then
            line (THIS.Xi + 4, THIS.Yi + 4)-(THIS.Xf - 4, THIS.Yf - 4), _
                _COMPLEMENTCOLOR(bkgColor, scrDepth), _
                bf, _
                iif(isFlipped, &b1111000011111111, &b0000111111110000)
          end if
      case else
          'DZ._DROPZONESHAPE._maximumEllipse
          circle ((THIS.Xi + THIS.Xf)\2, (THIS.Yi + THIS.Yf)\2), _
                THIS._widhei.Max\2, _
                5 , _
                (_pi/180)*(counter + 10), _
                (_pi/180)*(counter + 20), _
                THIS._widhei.RatioForEllipse
          circle ((THIS.Xi + THIS.Xf)\2, (THIS.Yi + THIS.Yf)\2), _
                THIS._widhei.Max\2, _
                13 , _
                (_pi/180)*(counter + 30), _
                (_pi/180)*(counter + 40), _
                THIS._widhei.RatioForEllipse
          if DrawingFlag<>-1 then
             circle ((THIS.Xi + THIS.Xf)\2, (THIS.Yi + THIS.Yf)\2), _
                   THIS._widhei.Max\2 - 4, _
                   5 , _
                   , _
                   , _
                   THIS._widhei.RatioForEllipse, _
                   f
          end if
    end select
   '
   counter += 1
   if counter>310 then counter = 0
   if (counter mod 12)=0 then isFlipped = not isFlipped
end sub


type DRAGDROPBUTTON
    enum _DGDPBTNSHAPE
        _naked
        _squared
        _rounded
    end enum
    declare constructor()
    declare property FontWidth() as integer
    declare property FontHeight() as integer
    declare property Xi() as integer
    declare property Yi() as integer
    declare property Xf() as integer
    declare property Yf() as integer
    declare property RoundedShapeRadius() as BIINTVALUE
    declare property DropZoneCount() as integer
    declare sub AddDropZoneToArrayOfPtr(byval as DROPZONE ptr)
    declare sub AddDropZoneArrayOfPtrToArrayOfPtr(() as DROPZONE ptr)
             declare sub RemoveAllDropZoneFromArrayOfPtr()                        ''todo
             declare sub RemoveDropZoneFromArrayOfPtrAtIndexAtIndex(byval as integer)   ''todo
             declare sub RemoveDropZoneFromArrayOfPtrAtIndexByKeyId(byval as string)      ''todo
    declare sub TestScreen()
    declare sub ResetLandableZone()
    declare sub AddDropZoneAsLandableZoneAtIndex(byval as integer)
    declare function IsInButtonShape(byval as integer, _
                             byval as integer) _
                             as boolean
    declare sub TestMouse()
    declare sub ShowAllDropZone()
    declare sub ShowAllLandableZone()
             declare sub ShowDropZoneAtIndex(byval as integer)                     ''todo
             declare sub ShowDropZoneAtKeyId(byval as string)                     ''todo
    declare sub DrawDgdpbtn()
       as _DGDPBTNSHAPE   _btnShape
       as integer         _roundedShapeRadius
        as string         _btnTxt
        as POSITIONXY      _topLeftCorner
        as WIDHEI         _widHei
       '
       as integer         _dpZoneCount
       as DROPZONE ptr      _dpZoneArrayPtr(any)
       as DROPZONE ptr      _landableDropZone(any)
       as fb.IMAGE ptr      _dgdpbtnImage
       as ulong         _idleColour
       as ulong         _mouseOverColour
       as ulong         _mouseClickColour
       as ulong         _mouseDragColour
       as ulong         _mouseDroppableColour
       as ulong         _mouseDroppedColour
       as boolean         _hasMouseOver
       as boolean         _hasMouseClick
       as POSITIONXY      _offsetAtClick
       as boolean         _hasDragStarted
       as boolean         _isMouseOverDropZone
       as boolean         _isMouseDropped
       '
       as integer         _scrW
       as integer         _scrH
       as integer         _scrDepth
          as integer         _colWidth
       as integer         _rowWidth
    static as integer               constructionCount
    static as integer               arrayOfDragDropButtonPtrCount
    static as DRAGDROPBUTTON ptr    arrayOfDragDropButtonPtr(any)
end type
type DGDPBTN as DRAGDROPBUTTON
dim as integer         DGDPBTN.constructionCount
dim as integer         DGDPBTN.arrayOfDragDropButtonPtrCount
dim as DGDPBTN ptr      DGDPBTN.arrayOfDragDropButtonPtr(any)
constructor DRAGDROPBUTTON()
   DGDPBTN.constructionCount += 1
   _DYNARRAYINCREASE(DGDPBTN.arrayOfDragDropButtonPtr)
   _ARRAYLASTITEM(DGDPBTN.arrayOfDragDropButtonPtr) => @THIS
   '
   THIS.TestScreen()
   '
   with THIS
       ._btnShape            => DGDPBTN._DGDPBTNSHAPE._naked
        ._btnTxt            => "OK"
        ._topLeftCorner         => type<POSITIONXY>(THIS._scrW/2, THIS._scrH/2)
        ._widHei.Wid         => _MAX(18, .FontWidth*len(._btnTxt))
        ._widHei.Hei         => .FontHeight + 4
       '
       .AddDropZoneToArrayOfPtr(0)
       _IMGCREATE(._dgdpbtnImage, ._widHei._wid, ._widHei._hei, 13, 8)
       '
       ._idleColour         => &h007
       ._mouseOverColour      => &h00F
       ._mouseClickColour      => &h00A
       ._mouseDragColour      => &h00B
       ._mouseDroppableColour   => &h00E
       ._mouseDroppedColour   => &h000
       ._hasMouseOver         => FALSE   
       ._hasMouseClick         => FALSE
       ._offsetAtClick         => type<POSITIONXY>(-1, -1)
       ._hasDragStarted      => FALSE
       ._isMouseOverDropZone   => FALSE
       ._isMouseDropped      => FALSE
   end with
end constructor
property DGDPBTN.FontWidth() as integer
   '---->
   return 8
end property
property DGDPBTN.FontHeight() as integer
   '---->
   return 8
end property
property DGDPBTN.Xi() as integer
   '---->
   return THIS._topLeftCorner._x
end property
property DGDPBTN.Yi() as integer
   '---->
   return THIS._topLeftCorner._y
end property
property DGDPBTN.Xf() as integer
   '---->
   return THIS._widHei.Xf(THIS._topLeftCorner._x)
end property
property DGDPBTN.Yf() as integer
   '---->
   return THIS._widHei.Yf(THIS._topLeftCorner._y)
end property
property DGDPBTN.RoundedShapeRadius() as BIINTVALUE
   dim as BIINTVALUE   returnValue
   returnValue._bivi = THIS._widHei._wid\6
   returnValue._bivj = THIS._widHei._hei\2
   '---->
   return returnValue
end property
property DGDPBTN.DropZoneCount() as integer
   '---->
   return THIS._dpZoneCount
end property
sub DGDPBTN.AddDropZoneToArrayOfPtr(byval DZitem as DROPZONE ptr)
   if DZitem=0 then exit sub
   '
   #define _ALIAS   THIS._dpZoneArrayPtr
   '
   _DYNARRAYINCREASE(_ALIAS)
   _ARRAYLASTITEM(_ALIAS) => DZitem
   '
   #ifdef _ALIAS
      #undef _ALIAS
   #endif
end sub
sub DGDPBTN.AddDropZoneArrayOfPtrToArrayOfPtr(DZArrayOfPtr() as DROPZONE ptr)
   if uBound(DZArrayOfPtr)<0 then exit sub
   '
   #define _ALIAS   THIS._dpZoneArrayPtr
   '
   dim as integer   initialLastIndex = uBound(_ALIAS)
   for index as integer = 0 to uBound(DZArrayOfPtr)
      if DZArrayOfPtr(index)<>0 then
         _DYNARRAYINCREASE(_ALIAS)
         _ARRAYLASTITEM(_ALIAS) => DZArrayOfPtr(index)
      end if
   next index
   '
   #ifdef _ALIAS
      #undef _ALIAS
   #endif
end sub
sub DGDPBTN.TestScreen()
   screenInfo   THIS._scrW, _
            THIS._scrH, _
            THIS._scrDepth
   dim as ulong scrWidth   => width()
   THIS._colWidth         => loWord(scrWidth)
   THIS._rowWidth         => hiWord(scrWidth)
end sub
sub DGDPBTN.ResetLandableZone()
   erase(THIS._landableDropZone)
end sub
sub DGDPBTN.AddDropZoneAsLandableZoneAtIndex(byval Index as integer)
   _DYNARRAYINCREASE(THIS._landableDropZone)
   _ARRAYLASTITEM(THIS._landableDropZone) = THIS._dpZoneArrayPtr(index)
end sub
function DGDPBTN.IsInButtonShape(byval GmX as integer, _
                          byval GmY as integer) _
                          as boolean
   select case THIS._btnShape
      case DGDPBTN._DGDPBTNSHAPE._naked
         if GmX>=THIS.Xi   andAlso _
            GmX<=THIS.Xf   andAlso _
            GmY>=THIS.Yi   andAlso _
            GmY<=THIS.Yf then
            '---->
            return TRUE
         else
            '---->
            return FALSE
         end if
      case DGDPBTN._DGDPBTNSHAPE._squared
         if GmX>=THIS.Xi - 8   andAlso _
            GmX<=THIS.Xf + 8   andAlso _
            GmY>=THIS.Yi   - 8 andAlso _
            GmY<=THIS.Yf + 8   then
            '---->
            return TRUE
         else
            '---->
            return FALSE
         end if
      case else
      'DGDPBTN._DGDPBTNSHAPE._rounded
         if GmX>=THIS.Xi - THIS._widHei._wid/2      andAlso _
            GmX<=THIS.Xf + THIS._widHei._wid/2      andAlso _
            GmY>=THIS.Yi - THIS._widHei._hei/2      andAlso _
            GmY<=THIS.Yf + THIS._widHei._hei/2      then
            if ( GmX>=THIS.Xi                     andAlso   _
                 GmX<=THIS.Xf                     andAlso   _
                 GmY>=THIS.Yi - THIS._widHei._hei/2      andAlso   _
                 GmY<=THIS.Yf + THIS._widHei._wid/2 )   then
                  '---->
                  return TRUE
            else
               dim as integer   rx   => THIS.RoundedShapeRadius._bivi
               dim as integer   ry   => THIS.RoundedShapeRadius._bivj
               dim as single   yrMinLeft   => THIS.Yi - sqr(rx^2 - ( GmX - THIS.Xi)^2)*ry/rx
               dim as single   yrMaxLeft   => THIS.Yf + sqr(rx^2 - ( GmX - THIS.Xi)^2)*ry/rx
               dim as single   yrMinRight   => THIS.Yi - sqr(rx^2 - ( GmX - THIS.Xf)^2)*ry/rx
               dim as single   yrMaxRight   => THIS.Yf + sqr(rx^2 - ( GmX - THIS.Xf)^2)*ry/rx
               if ( GmX>=THIS.Xi - THIS._widHei._wid/2      andAlso _
                    GmX<=THIS.Xi                     andAlso _
                    GmY>=yrMinLeft                     andAlso _
                    GmY<=yrMaxLeft   )                  orElse   _
                  ( GmX>=THIS.Xf                     andAlso _
                    GmX<=THIS.Xf + THIS._widHei._wid/2      andAlso _
                    GmY>=yrMinRight                  andAlso _
                    GmY<=yrMaxRight )                  then
                     '---->
                     return TRUE
               else
                     '---->
                     return FALSE
               end if
            end if
         else
            '---->
            return FALSE
         end if
   end select
end function
sub DGDPBTN.TestMouse()
   static as boolean   hasMovedAtLeastOnce
   dim as integer   gmX, gmY, gmWheel, gmBtn
      getMouse   gmX, gmY, gmWheel, gmBtn
   '
   #ifdef _DEBUG
      _P(hasMovedAtLeastOnce)
      _P(THIS._hasMouseClick)
      _P(THIS._hasDragStarted)
      _P(THIS._hasMouseOver)
      _P(THIS._isMouseOverDropZone)
      _P(THIS._isMouseDropped)
   #endif
   select case THIS._hasMouseClick
      case TRUE
         if THIS._isMouseDropped then THIS._isMouseDropped = FALSE
         THIS._hasDragStarted = TRUE
         '
         if not _
            ( gmX=(THIS._topLeftCorner._x + THIS._offsetAtClick._x)   andAlso _
              gmY=(THIS._topLeftCorner._y + THIS._offsetAtClick._y) )   then
             'moving -> update position
                if not hasMovedAtLeastOnce then hasMovedAtLeastOnce = TRUE
               THIS._topLeftCorner._x   = gmX - THIS._offsetAtClick._x
               THIS._topLeftCorner._y   = gmY - THIS._offsetAtClick._y
         else
            'not moving
            if not hasMovedAtLeastOnce then
               THIS._hasDragStarted = FALSE
            else
               THIS._hasDragStarted = TRUE
            end if
            '
            if THIS.IsInButtonShape(gmX, gmY) then
               if not gmBtn>0 then
                  'reset mouseClick state
                  if hasMovedAtLeastOnce then hasMovedAtLeastOnce = FALSE
                  THIS._hasMouseClick = FALSE
                  THIS._offsetAtClick._x   = -1
                  THIS._offsetAtClick._y   = -1
               end if
            else
               'reset mouseOver state
               THIS._hasMouseOver = FALSE
            end if
         end if
      case else
         'THIS._hasMouseClick==FALSE
         if THIS._hasDragStarted then
            THIS._hasDragStarted = FALSE
         end if
         '
         if THIS.IsInButtonShape(gmX, gmY) then
            if not THIS._hasMouseOver then THIS._hasMouseOver = TRUE
            '
            if gmBtn>0 then
               THIS._hasMouseClick = TRUE
               THIS._offsetAtClick._x   = gmX - THIS._topLeftCorner._x
               THIS._offsetAtClick._y   = gmY - THIS._topLeftCorner._y
            end if
         else
            if THIS._hasMouseOver then THIS._hasMouseOver = FALSE
         end if
   end select
   '
   if THIS._hasDragStarted then
      'test if dropped if dropability previously granted
      select case THIS._isMouseOverDropZone
         case TRUE
            'is dropable
            if THIS.IsInButtonShape(gmX, gmY) then
               if not gmBtn>0 then
                  'is dropped
                  if not THIS._isMouseDropped then THIS._isMouseDropped = TRUE
                  'reset mouseClick state
                  THIS._hasMouseClick = FALSE
                  THIS._offsetAtClick._x   = -1
                  THIS._offsetAtClick._y   = -1                  
               end if
            else
               'reset mouseOver state
               THIS._hasMouseOver = FALSE
            end if
         case else
            'is not dropable
            if THIS.IsInButtonShape(gmX, gmY) then
               if not gmBtn>0 then
                  'is not dropped
                  if THIS._isMouseDropped then THIS._isMouseDropped = FALSE
                  'reset mouseClick state
                  THIS._hasMouseClick = FALSE
                  THIS._offsetAtClick._x   = -1
                  THIS._offsetAtClick._y   = -1                  
               end if
            else
               'reset mouseOver state
               THIS._hasMouseOver = FALSE
            end if
      end select
      'test for dropability if not dropped already
      if not THIS._isMouseDropped   then
         ResetLandableZone()
         for index as integer = 0 to uBound(THIS._dpZoneArrayPtr)
            '
            _P(index)
            _P(THIS._dpZoneArrayPtr(index)->IsInDropzoneShape(gmX, gmY))
            '
            if THIS._dpZoneArrayPtr(index)->IsInDropzoneShape(gmX, gmY)   then
               if not THIS._isMouseOverDropZone then THIS._isMouseOverDropZone = TRUE
               THIS.AddDropZoneAsLandableZoneAtIndex(index)
            else
               if THIS._isMouseOverDropZone then THIS._isMouseOverDropZone = FALSE
            end if
         next index
         if _ARRAYRANGE(THIS._landableDropZone)>0 then
            if not THIS._isMouseOverDropZone then THIS._isMouseOverDropZone = TRUE
         end if
      end if
      '
   end if
end sub
sub DGDPBTN.ShowAllDropZone()
   #define _ALIAS   THIS._dpZoneArrayPtr
   '
   'get background color
   dim as integer   bkgColor
      screenControl fb.GET_COLOR, , bkgColor
   'get screen color depth
   dim as integer   scrDepth
      screenInfo   , , scrDepth
   '
   for index as integer = 0 to uBound(THIS._dpZoneArrayPtr)
      line (_ALIAS(index)->Xi + 2, _ALIAS(index)->Yi + 2)- _
          (_ALIAS(index)->Xf - 2, _ALIAS(index)->Yf - 2), _
          _COMPLEMENTCOLOR(bkgColor, scrDepth\2), _
          b
   next index
   '
   #ifdef _ALIAS
      #undef _ALIAS
   #endif
end sub
sub DGDPBTN.ShowAllLandableZone()
   for index as integer = 0 to uBound(THIS._landableDropZone)
      THIS._landableDropZone(index)->DrawDropZone(0)
   next index
end sub
sub DGDPBTN.DrawDgdpbtn()
   THIS.TestMouse()
   '
   dim as ulong   btnColour
   if THIS._isMouseOverDropZone      then
      btnColour = THIS._mouseDroppableColour
   elseIf THIS._hasDragStarted         then
      btnColour = THIS._mouseDragColour
   elseIf THIS._hasMouseClick         then
      btnColour = THIS._mouseClickColour
   elseIf THIS._hasMouseOver         then
      btnColour = THIS._mouseOverColour
   else
      btnColour = THIS._idleColour
   end if
   '
   if THIS._isMouseOverDropZone then THIS.ShowAllLandableZone()
   '
   select case THIS._btnShape
      case DGDPBTN._DGDPBTNSHAPE._naked
         line (THIS.Xi, THIS.Yi)-(THIS.Xf, THIS.Yf), _COMPLEMENTCOLOR(btnColour, 4), bf
      case DGDPBTN._DGDPBTNSHAPE._squared
         line (THIS.Xi - 8, THIS.Yi - 8)- _
             (THIS.Xf + 8, THIS.Yf + 8), _
             _COMPLEMENTCOLOR(btnColour, 4), _
             bf
      case else
         dim as integer rx   => THIS.RoundedShapeRadius._bivi
         dim as integer ry   => THIS.RoundedShapeRadius._bivj
         dim as integer rr   => _MAX(THIS.RoundedShapeRadius._bivi, THIS.RoundedShapeRadius._bivj)
         line (THIS.Xi - 1, THIS.Yi - 1)-(THIS.Xf + 1, THIS.Yf + 1), btnColour, bf
         '
         line (THIS.Xi - rx, THIS.Yi)-(THIS.Xi, THIS.Yf), btnColour, bf
         line (THIS.Xi, THIS.Yf + ry)-(THIS.Xf, THIS.Yf), btnColour, bf
         line (THIS.Xf + rx, THIS.Yf)-(THIS.Xf, THIS.Yi), btnColour, bf
         line (THIS.Xf, THIS.Yi - ry)-(THIS.Xi, THIS.Yi), btnColour, bf
         '
         dim as integer   inc => rr
         while inc>=0
            inc -= 1
         circle (THIS.Xi, THIS.Yi), _
               inc, _
               btnColour, _
               _pi/2, _
               _pi, _
               THIS.RoundedShapeRadius._bivj/THIS.RoundedShapeRadius._bivi
         circle (THIS.Xi, THIS.Yf), _
               inc, _
               btnColour, _
               _pi, _
               3*_pi/2, _
               THIS.RoundedShapeRadius._bivj/THIS.RoundedShapeRadius._bivi
         circle (THIS.Xf, THIS.Yf), _
               inc, _
               btnColour, _
               3*_pi/2, _
               _2pi, _
               THIS.RoundedShapeRadius._bivj/THIS.RoundedShapeRadius._bivi
         circle (THIS.Xf, THIS.Yi), _
               inc, _
               btnColour, _
               0, _
               _pi/2, _
               THIS.RoundedShapeRadius._bivj/THIS.RoundedShapeRadius._bivi
         wend
   end select
   '
   draw string (THIS.Xi, THIS.Yi), _
             THIS._btnTxt, _
             _COMPLEMENTCOLOR(btnColour, 4)
end sub



'````````````````````````````````````````````````````````````````
'````````````````````````````````````````````````````````````````
screen 18, 8
color 0, 8


dim as DRAGDROPBUTTON   ddb1
ddb1._btnShape = DGDPBTN._DGDPBTNSHAPE._naked

dim as DRAGDROPBUTTON   ddb2
ddb2._topLeftCorner._y = 300
ddb2._btnShape = DGDPBTN._DGDPBTNSHAPE._squared

dim as DRAGDROPBUTTON   ddb3
ddb3._topLeftCorner._y = 400
ddb3._btnShape = DGDPBTN._DGDPBTNSHAPE._rounded

dim as DROPZONE   dz1
/'
dz1._topLeftCorner._x = 10
dz1._topLeftCorner._y = 200
dz1._widHei.Wid   = 80
dz1._widHei.Hei   = 50
'/

dim as DROPZONE   dz2
dz2._dzShape = DZ._DROPZONESHAPE._maximumEllipse
/'
dz2._topLeftCorner._x = 320
dz2._topLeftCorner._y = 200
dz2._widHei.Wid   = 80
dz2._widHei.Hei   = 150
'/

scope
   redim as DZ ptr   arrayOfDZptr(1)
   arrayOfDZptr(0) = @dz1
   arrayOfDZptr(1) = @dz2
   ddb1.AddDropZoneArrayOfPtrToArrayOfPtr(arrayOfDZptr())
end scope


do
   screenLock
      cls
      dz1.DrawDropZone()
      dz2.DrawDropZone()
      ddb1.DrawDgdpbtn()
      'ddb2.DrawDgdpbtn()
      'ddb3.DrawDgdpbtn()
   screenUnlock
   '
   sleep 25
loop until inkey()=chr(27)


'````````````````````````````````````````````````````````````````
'````````````````````````````````````````````````````````````````

getKey()
'(eof)

[Pitto]

Hi Tourist Trap,

thanks for the review, I appreciate it.

I think that the problem may be fixed in this way: clipping the mouse to the to the foreground window (https://www.freebasic.net/wiki/KeyPgSetmouse).

Code: Select all

SetMouse 640\2, 480\2, 0, 1

I've updated the first post.

[paul doe]

Hi, Pitto.

Nice! I have since then updated that tiny class (and also the one you used in 'Impossible Victhorse' for the keyboard), with more useful features. I can post them here if you're interested...

[Pitto]

Hi paul doe,
thank you.
Feel free to post it here.
Best regards

[paul doe]

...
Feel free to post it here.
...

Very well:

fbg-keyboard.bi

Code: Select all

#ifndef __FBGAME_KEYBOARD__
#define __FBGAME_KEYBOARD__

#include once "fbgfx.bi"

namespace FbGame
  type KeyboardInput
    public:
      declare constructor()
      declare constructor( as integer )
      declare destructor()
      
      declare sub onEvent( as any ptr )
        
      declare function pressed( as long ) as boolean
      declare function released(as long ) as boolean
      declare function held( as long, as double = 0.0 ) as boolean
      declare function repeated( as long, as double = 0.0 ) as boolean
    
    private:
      enum KeyState
        None
        Pressed             = ( 1 shl 0 )
        AlreadyPressed      = ( 1 shl 1 )
        Released            = ( 1 shl 2 )
        AlreadyReleased     = ( 1 shl 3 )
        Held                = ( 1 shl 4 )
        HeldInitialized     = ( 1 shl 5 )
        Repeated            = ( 1 shl 6 )
        RepeatedInitialized = ( 1 shl 7 )
      end enum
      
      '' These will store the bitflags for the key states
      as ubyte _state( any )
      
      /'
        Caches when a key started being held/repeated
      '/
      as double _
        _heldStartTime( any ), _
        _repeatedStartTime( any )
      
      /'
        The mutex for this instance
      '/
      as any ptr _mutex
  end type
  
  constructor KeyboardInput()
    this.constructor( 128 )
  end constructor
  
  constructor KeyboardInput( aNumberOfKeys as integer )
    dim as integer keys = iif( aNumberOfKeys < 128, _
        128, aNumberOfKeys )
    
    redim _
      _state( 0 to keys - 1 ), _
      _heldStartTime( 0 to keys - 1 ), _
      _repeatedStartTime( 0 to keys - 1 )
    
    _mutex = mutexCreate()
  end constructor
  
  destructor KeyboardInput()
    mutexDestroy( _mutex )
  end destructor
  
  sub KeyboardInput.onEvent( e as any ptr )
    mutexLock( _mutex )
      var ev = cptr( Fb.Event ptr, e )
      
      select case as const( ev->type )
        case Fb.EVENT_KEY_PRESS
          _state( ev->scanCode ) or= _
            ( KeyState.Pressed or KeyState.Held or KeyState.Repeated )
          _state( ev->scanCode ) = _
            _state( ev->scanCode ) and not KeyState.AlreadyPressed
          
        case Fb.EVENT_KEY_RELEASE
          _state( ev->scanCode ) or= KeyState.Released
          _state( ev->scanCode ) = _
            _state( ev->scanCode ) and not KeyState.AlreadyReleased
          _state( ev->scanCode ) = _state( ev->scanCode ) and not _
            ( KeyState.Held or KeyState.HeldInitialized or _
              KeyState.Repeated or KeyState.RepeatedInitialized )
      end select
    mutexUnlock( _mutex )
  end sub
  
  /'
    Returns whether or not a key was pressed.
    
    'Pressed' in this context means that the method will return 'true'
    *once* upon a key press. If you press and hold the key, it will
    not report 'true' until you release the key and press it again.
  '/
  function KeyboardInput.pressed( scanCode as long ) as boolean
    mutexLock( _mutex )
      dim as boolean isPressed
      
      if( _
        cbool( _state( scanCode ) and KeyState.Pressed ) andAlso _
        not cbool( _state( scanCode ) and KeyState.AlreadyPressed ) ) then
        
        isPressed = true
        
        _state( scanCode ) or= KeyState.AlreadyPressed
      end if
    mutexUnlock( _mutex )
    
    return( isPressed )
  end function
  
  /'
    Returns whether or not a key was released.
    
    'Released' means that a key has to be pressed and then released for
    this method to return 'true' once, just like the 'pressed()' method
    above.
  '/
  function KeyboardInput.released( scanCode as long ) as boolean
    mutexLock( _mutex )
      dim as boolean isReleased
      
      if( _
        cbool( _state( scanCode ) and KeyState.Released ) andAlso _
        not cbool( _state( scanCode ) and KeyState.AlreadyReleased ) ) then
        
        isReleased = true
        
        _state( scanCode ) or= KeyState.AlreadyReleased
      end if
    mutexUnlock( _mutex )
    
    return( isReleased )
  end function
  
  /'
    Returns whether or not a key is being held.
    
    'Held' means that the key was pressed and is being held pressed, so the
    method behaves pretty much like a call to 'multiKey()', if the 'interval'
    parameter is unspecified.
    
    If an interval is indeed specified, then the method will report the 'held'
    status up to the specified interval, then it will stop reporting 'true'
    until the key is released and held again.
    
    Both this and the 'released()' method expect their intervals to be expressed
    in milliseconds.
  '/
  function KeyboardInput.held( scanCode as long, interval as double = 0.0 ) as boolean
    mutexLock( _mutex )
      dim as boolean isHeld
      
      if( cbool( _state( scanCode ) and KeyState.Held ) ) then
        isHeld = true
        
        if( cbool( interval > 0.0 ) ) then
          if( not cbool( _state( scanCode ) and KeyState.HeldInitialized ) ) then
            _state( scanCode ) or= KeyState.HeldInitialized
            _heldStartTime( scanCode ) = timer()
          else
            dim as double _
              elapsed = ( timer() - _heldStartTime( scanCode ) ) * 1000.0d
            
            if( elapsed >= interval ) then
              isHeld = false
              
              _state( scanCode ) = _state( scanCode ) and not KeyState.Held
            end if
          end if
        end if
      end if
    mutexUnlock( _mutex )
    
    return( isHeld )
  end function
  
  /'
    Returns whether or not a key is being repeated.
    
    'Repeated' means that the method will intermittently report the 'true'
    status once 'interval' milliseconds have passed. It can be understood
    as the autofire functionality of some game controllers: you specify the
    speed of the repetition using the 'interval' parameter.
    
    Bear in mind, however, that the *first* repetition will be reported
    AFTER one interval has elapsed. In other words, the reported pattern is 
    [pause] [repeat] [pause] instead of [repeat] [pause] [repeat].
    
    If no interval is specified, the method behaves like a call to
    'held()'.
  '/
  function KeyboardInput.repeated( scanCode as long, interval as double = 0.0 ) as boolean
    mutexLock( _mutex )
      dim as boolean isRepeated
      
      if( cbool( _state( scanCode ) and KeyState.Repeated ) ) then
        if( cbool( interval > 0.0 ) ) then
          if( not cbool( _state( scanCode ) and KeyState.RepeatedInitialized ) ) then
            _repeatedStartTime( scanCode ) = timer()
            _state( scanCode ) or= KeyState.RepeatedInitialized
          else
            dim as double _
              elapsed = ( timer() - _repeatedStartTime( scanCode ) ) * 1000.0d
            
            if( elapsed >= interval ) then
              isRepeated = true
              
              _state( scanCode ) = _
                _state( scanCode ) and not KeyState.RepeatedInitialized
            end if
          end if
        else
          isRepeated = true
        end if
      end if
    mutexUnlock( _mutex )
    
    return( isRepeated )
  end function
end namespace

#endif

fbg-mouse.bi

Code: Select all

#ifndef __FBGAME_MOUSE__
#define __FBGAME_MOUSE__

#include once "fbgfx.bi"

namespace FbGame
  type MouseInput
    public:
      declare constructor()
      declare constructor( as integer )
      declare destructor()
      
      declare property X() as integer
      declare property Y() as integer
      declare property deltaX() as integer
      declare property deltaY() as integer
      declare property startX() as integer
      declare property startY() as integer
      declare property horizontalWheel() as integer
      declare property verticalWheel() as integer
      
      declare sub onEvent( as any ptr )
      
      declare function pressed( as integer ) as boolean
      declare function released( as integer ) as boolean
      declare function held( as integer, as double = 0.0 ) as boolean
      declare function repeated( as integer, as double = 0.0 ) as boolean
      declare function drag( byval as integer ) as boolean
      declare function drop( byval as integer ) as boolean
      
    private:
      enum ButtonState
        None
        Pressed             = ( 1 shl 0 )
        AlreadyPressed      = ( 1 shl 1 )
        Released            = ( 1 shl 2 )
        AlreadyReleased     = ( 1 shl 3 )
        Held                = ( 1 shl 4 )
        HeldInitialized     = ( 1 shl 5 )
        Repeated            = ( 1 shl 6 )
        RepeatedInitialized = ( 1 shl 7 )
      end enum
      
      '' The bitflags for the button states
      as ubyte _state( any )
      
      as integer _
        _x, _y, _
        _sx, _sy, _
        _dx, _dy, _
        _hWheel, _
        _vWheel
      
      '' Caches when a button started being held/repeated
      as double _
        _heldStartTime( any ), _
        _repeatedStartTime( any )
      
      '' The mutex for this instance
      as any ptr _mutex
      
      '' Current state
      as boolean _
        _pressed, _
        _dragging, _
        _dropped
  end type
  
  constructor MouseInput()
    constructor( 3 )
  end constructor
  
  constructor MouseInput( buttons as integer )
    _mutex = mutexCreate()
    
    redim _state( 0 to buttons - 1 )
    redim _heldStartTime( 0 to buttons - 1 )
    redim _repeatedStartTime( 0 to buttons - 1 )
  end constructor
  
  destructor MouseInput()
    mutexDestroy( _mutex )
  end destructor
  
  property MouseInput.X() as integer
    return( _x )
  end property
  
  property MouseInput.Y() as integer
    return( _y )
  end property
  
  property MouseInput.deltaX() as integer
    return( _dx )
  end property
  
  property MouseInput.deltaY() as integer
    return( _dy )
  end property
  
  property MouseInput.startX() as integer
    return( _sx )
  end property
  
  property MouseInput.startY() as integer
    return( _sy )
  end property
  
  property MouseInput.horizontalWheel() as integer
    return( _hWheel )
  end property
  
  property MouseInput.verticalWheel() as integer
    return( _vWheel )
  end property
  
  /'
    Handles the events and sets internal state appropriately so we can
    query the other methods individually. This method must be called
    before any other method/property (usually done from the main thread).
  '/
  sub MouseInput.onEvent( e as any ptr )
    mutexLock( _mutex )
      var ev = cptr( Fb.Event ptr, e )
      
      select case as const( ev->type )
        case Fb.EVENT_MOUSE_MOVE
          /'
            This cast is necessary to correctly compute coordinates when dragging
            outside the window. Even though FreeBasic defines the mouse coordinates
            as long in the Fb.Event struct, when you're dragging they get reported
            as a ushort (0..65535).
          '/
          _x = *cast( short ptr, @ev->x )
          _y = *cast( short ptr, @ev->y )
          
          if( _pressed ) then
            _dx = _x - _sx
            _dy = _y - _sy
            
            _dragging = true
            _dropped = false
          end if
          
        case Fb.EVENT_MOUSE_BUTTON_PRESS
          _state( ev->button ) or= _
            ( ButtonState.Pressed or ButtonState.Held or ButtonState.Repeated )
          _state( ev->button ) = _
            _state( ev->button ) and not ButtonState.AlreadyPressed
          
          _dx = 0
          _dy = 0
          _sx = _x
          _sy = _y
          _pressed = true
          _dragging = false
          
        case Fb.EVENT_MOUSE_BUTTON_RELEASE
          _state( ev->button ) or= ButtonState.Released
          _state( ev->button ) = _
            _state( ev->button ) and not ButtonState.AlreadyReleased
          _state( ev->button ) = _state( ev->button ) and not _
            ( ButtonState.Held or ButtonState.HeldInitialized or _
              ButtonState.Repeated or ButtonState.RepeatedInitialized )
          
          _pressed = false
          
          if( _dx <> 0 andAlso _dy <> 0 ) then
            _dropped = true
          else
            _dropped = false
          end if
          
        case _
          Fb.EVENT_MOUSE_WHEEL, _
          Fb.EVENT_MOUSE_HWHEEL
          
          _hWheel = ev->w
          _vWheel = ev->z
      end select
    mutexUnlock( _mutex )
  end sub
  
  /'
    Returns whether or not a button was pressed.
    
    'Pressed' in this context means that the method will return 'true'
    *once* upon a button press. If you press and hold the button, it will
    not report 'true' until you release the button and press it again.
  '/
  function MouseInput.pressed( aButton as integer ) as boolean
    mutexLock( _mutex )
      dim as boolean isPressed
      
      if( _
        cbool( _state( aButton ) and ButtonState.Pressed ) andAlso _
        not cbool( _state( aButton ) and ButtonState.AlreadyPressed ) ) then
        
        isPressed = true
        
        _state( aButton ) or= ButtonState.AlreadyPressed
      end if
    mutexUnlock( _mutex )
    
    return( isPressed )
  end function
  
  /'
    Returns whether or not a mouse button was released.
    
    'Released' means that a button has to be pressed and then released for
    this method to return 'true' once, just like the 'pressed()' method
    above.
  '/
  function MouseInput.released( aButton as integer ) as boolean
    mutexLock( _mutex )
      dim as boolean isReleased
      
      if( _
        cbool( _state( aButton ) and ButtonState.Released ) andAlso _
        not cbool( _state( aButton ) and ButtonState.AlreadyReleased ) ) then
        
        isReleased = true
        
        _state( aButton ) or= ButtonState.AlreadyReleased
      end if
    mutexUnlock( _mutex )
    
    return( isReleased )
  end function
  
  /'
    Returns whether or not a mouse button is being held.
    
    'Held' means that the button was pressed and is being held pressed, so the
    method behaves pretty much like a call to 'multiKey()', if the 'interval'
    parameter is unspecified.
    
    If an interval is indeed specified, then the method will report the 'held'
    status up to the specified interval, then it will stop reporting 'true'
    until the button is released and held again.
    
    Both this and the 'released()' method expect their intervals to be expressed
    in milliseconds.
  '/
  function MouseInput.held( aButton as integer, interval as double = 0.0 ) as boolean
    mutexLock( _mutex )
      dim as boolean isHeld
      
      if( cbool( _state( aButton ) and ButtonState.Held ) ) then
        isHeld = true
        
        if( cbool( interval > 0.0 ) ) then
          if( not cbool( _state( aButton ) and ButtonState.HeldInitialized ) ) then
            _state( aButton ) or= ButtonState.HeldInitialized
            _heldStartTime( aButton ) = timer()
          else
            dim as double _
              elapsed = ( timer() - _heldStartTime( aButton ) ) * 1000.0d
            
            if( elapsed >= interval ) then
              isHeld = false
              
              _state( aButton ) = _
                _state( aButton ) and not ButtonState.Held
            end if
          end if
        end if
      end if
    mutexUnlock( _mutex )
    
    return( isHeld )
  end function
  
  /'
    Returns whether or not a mouse button is being repeated.
    
    'Repeated' means that the method will intermittently report the 'true'
    status once 'interval' milliseconds have passed. It can be understood
    as the autofire functionality of some game controllers: you specify the
    speed of the repetition using the 'interval' parameter.
    
    Bear in mind, however, that the *first* repetition will be reported
    AFTER one interval has elapsed. In other words, the reported pattern is 
    [pause] [repeat] [pause] instead of [repeat] [pause] [repeat].
    
    If no interval is specified, the method behaves like a call to
    'held()'.
  '/
  function MouseInput.repeated( aButton as integer, interval as double = 0.0 ) as boolean
    mutexLock( _mutex )
      dim as boolean isRepeated
      
      if( cbool( _state( aButton ) and ButtonState.Repeated ) ) then
        if( cbool( interval > 0.0 ) ) then
          if( not cbool( _state( aButton ) and ButtonState.RepeatedInitialized ) ) then
            _repeatedStartTime( aButton ) = timer()
            _state( aButton ) or= ButtonState.RepeatedInitialized
          else
            dim as double _
              elapsed = ( timer() - _repeatedStartTime( aButton ) ) * 1000.0d
            
            if( elapsed >= interval ) then
              isRepeated = true
              
              _state( aButton ) = _
                _state( aButton ) and not ButtonState.RepeatedInitialized
            end if
          end if
        else
          isRepeated = true
        end if
      end if
    mutexUnlock( _mutex )
    
    return( isRepeated )
  end function
  
  function MouseInput.drag( aButton as integer ) as boolean
    return( held( aButton ) andAlso _dragging )
  end function
  
  function MouseInput.drop( aButton as integer ) as boolean
    return( released( aButton ) andAlso _dropped )
  end function
end namespace

#endif

The keyboard functions like the old version, it just uses events instead of multiKey(), and allows you to specify intervals in milliseconds for held() and repeated(). The mouse works similarly.

Some test code for the mouse (I can add some for the keyboard if requested, but it follows the exact same pattern):

Code: Select all

#include once "inc/fbg-mouse.bi"

type as ulong color_t

#define _R_( _c_ ) ( culng( _c_ ) shr 16 and 255 )
#define _G_( _c_ ) ( culng( _c_ ) shr  8 and 255 )
#define _B_( _c_ ) ( culng( _c_ ) and 255 )
#define _A_( _c_ ) ( culng( _c_ ) shr 24 )

#define mix( _c1_, _c2_, _x_ ) ( ( _c2_ - _c1_ ) * _x_ + _c1_ )
#define clerp( _c1_, _c2_, _x_ ) ( rgba( _
  mix( _R_( _c1_ ), _R_( _c2_ ), _x_ ), _
  mix( _G_( _c1_ ), _G_( _c2_ ), _x_ ), _
  mix( _B_( _c1_ ), _B_( _c2_ ), _x_ ), _
  mix( _A_( _c1_ ), _A_( _c2_ ), _x_ ) ) )

#define clamp( v, x, y ) ( iif( v < x, x, iif( v > y, y, v ) ) )

function createBackground( _
    c1 as color_t, c2 as color_t, w as integer, h as integer ) as Fb.Image ptr
  
  dim as single _
    centerX = w / 2, _
    centerY = h / 2, _
    maxValue = sqr( centerX ^ 2 + centerY ^ 2 )
  
  var s = imageCreate( w, h )
  
  for y as integer = 0 to h - 1
    for x as integer = 0 to w - 1
      dim as single _
        v = sqr( ( centerX - x ) ^ 2 + ( centerY - y ) ^ 2 ) / ( maxValue + 1 )
      
      pset s, ( x, y ), clerp( c1, c2, v )
    next
  next
  
  return( s )
end function

/'
  Test code
'/
using FbGame

dim as integer w = 800, h = 600

screenRes( w, h, 32 )

var back = createBackground( _
  rgba( 252, 252, 252, 255 ), _
  rgba( 191, 191, 191, 255 ), _
  800, 600 )

var mouse = MouseInput()

dim as boolean toggle = false

dim as Fb.Event e

do
  '' Poll events
  do while( screenEvent( @e ) )
    mouse.onEvent( @e )
  loop
  
  dim as color_t _
    ballColor = rgba( 255, 0, 0, 255 ), _
    squareColor = iif( toggle, _
      rgba( 255, 255, 0, 255 ), _
      rgba( 0, 255, 0, 255 ) )
  
  if( mouse.held( Fb.BUTTON_LEFT ) ) then
    ballColor = rgba( 0, 0, 255, 255 )
  end if
  
  if( mouse.repeated( Fb.BUTTON_LEFT, 200.0d ) ) then
    toggle xor= true
  end if
  
  '' Render frame
  screenLock()
    put( 0, 0 ), back, pset
    
    dim as integer _
      mx = clamp( mouse.X, 0, w - 1 ), _
      my = clamp( mouse.Y, 0, h - 1 )
    
    circle( mx, my ), 25, ballColor, , , , f
    line( mx - 200 - 25, my - 25 ) - _
      ( mx - 200 + 25, my + 25 ), squareColor, bf
  screenUnlock()
  
  sleep( 1, 1 )
loop until( e.type = Fb.EVENT_WINDOW_CLOSE )

imageDestroy( back )

Code: Select all

#include once "inc/fbg-mouse.bi"

'' A set of simple macros to do color blending
type as ulong color_t

#define _R_( _c_ ) ( culng( _c_ ) shr 16 and 255 )
#define _G_( _c_ ) ( culng( _c_ ) shr  8 and 255 )
#define _B_( _c_ ) ( culng( _c_ ) and 255 )
#define _A_( _c_ ) ( culng( _c_ ) shr 24 )

#define mix( _c1_, _c2_, _x_ ) ( ( _c2_ - _c1_ ) * _x_ + _c1_ )
#define clerp( _c1_, _c2_, _x_ ) ( rgba( _
  mix( _R_( _c1_ ), _R_( _c2_ ), _x_ ), _
  mix( _G_( _c1_ ), _G_( _c2_ ), _x_ ), _
  mix( _B_( _c1_ ), _B_( _c2_ ), _x_ ), _
  mix( _A_( _c1_ ), _A_( _c2_ ), _x_ ) ) )

#define clamp( v, x, y ) ( iif( v < x, x, iif( v > y, y, v ) ) )

'' Just creates a nice background
function createBackground( _
    c1 as color_t, c2 as color_t, w as integer, h as integer ) as Fb.Image ptr
  
  dim as single _
    centerX = w / 2, _
    centerY = h / 2, _
    maxValue = sqr( centerX ^ 2 + centerY ^ 2 )
  
  var s = imageCreate( w, h )
  
  for y as integer = 0 to h - 1
    for x as integer = 0 to w - 1
      dim as single _
        v = sqr( ( centerX - x ) ^ 2 + ( centerY - y ) ^ 2 ) / ( maxValue + 1 )
      
      pset s, ( x, y ), clerp( c1, c2, v )
    next
  next
  
  return( s )
end function

function rndColor() as color_t
  return( rnd() * &hffffff )
end function

type Rectangle
  as long x1, y1, x2, y2
  as color_t c
end type

sub drawRect( byref r as Rectangle )
  line( r.x1, r.y1 ) - ( r.x2, r.y2 ), r.c, bf
end sub

sub add( rects() as Rectangle, r as Rectangle, byref count as integer )
  redim preserve rects( lbound( rects ) to ubound( rects ) + 1 )
  rects( ubound( rects ) ) = r
  count += 1
end sub

/'
  Test code
'/ 
using FbGame

dim as integer _
  w = 800, h = 600

screenRes( w, h, 32 )

var back = createBackground( _
  rgba( 252, 252, 252, 255 ), _
  rgba( 191, 191, 191, 255 ), _
  800, 600 )

var mouse = MouseInput()

dim as boolean drawing = false

dim as Fb.Event e

dim as integer rectCount = 0
dim as Rectangle rectangles( any )

do
  '' Poll events
  do while( screenEvent( @e ) )
    mouse.onEvent( @e )
  loop
  
  with mouse
    if( .drag( Fb.BUTTON_LEFT ) ) then
      drawing = true
    end if
    
    if( .drop( Fb.BUTTON_LEFT ) ) then
      add( rectangles(), type <Rectangle>( _
        .startX, .startY, clamp( .X, 0, w - 1 ), clamp( .Y, 0, h - 1 ), rndColor() ), rectCount )
      
      drawing = false
    end if
  end with
  
  '' Render frame
  screenLock()
    cls()
    put( 0, 0 ), back, pset
    
    for i as integer = 0 to rectCount - 1
      drawRect( rectangles( i ) )
    next
    
    if( drawing ) then
      line( mouse.startX, mouse.startY ) - _
        ( clamp( mouse.X, 0, w - 1 ), clamp( mouse.Y, 0, h - 1 ) ), rgb( 0, 0, 0 ), b
    end if
  screenUnlock()
  
  sleep( 1, 1 )
loop until( e.type = Fb.EVENT_WINDOW_CLOSE )

imageDestroy( back )

I hope you might find it useful, and use it for a sequel of 'Impossible Victhorse' ;)

[Pitto]

Hi paul doe,

well done, it's much more powerful than mine version. I see that it recognizes also a button release outside the window. I will study it. Thanks.

I go a little off topic: I was working on this mouse class because I wish to rewrite from scratch FB Low Poly Editor (https://github.com/Pitto/Fb_Low_Poly_Editor), making it more object oriented.

I've seen your implementation of Delaunay triangulation, and I think it should work also with points extracted from a bezier path. In this case the user, instead of draw the polygons one by one, may draw wireframe bezier lines of the image, and then automate the process of generating polygons (I saw that UEZ did a similar thing).

I hope you might find it useful, and use it for a sequel of 'Impossible Victhorse' ;)

Last but not least: even if I've added some new features, Impossible Victhorse's sequel is stopped at the moment … I wish he could launch his floppies soon through a new adventure.

[paul doe]

...
well done, it's much more powerful than mine version. I see that it recognizes also a button release outside the window. I will study it. Thanks.
...

No prob. The only real limitation is that it stops updating the mouse coordinates when it goes outside the window (this is due to how FBGFX works; with other libraries you can 'capture' mouse and keyboard events as long as the window has focus).

I changed to using events to be able to use this with other gfx libraries also (I tested it with raylib, SDL2 and SFML so far), so these are kind of 'nerfed' versions of the real things. If you study it, you'll see that the only place where library specific coding happens is in the onEvent() method. Thus, that is the only thing you need to reimplement when using other libs. The rest stays the same (and is in fact implemented in a base class).

...
I've seen your implementation of Delaunay triangulation, and I think it should work also with points extracted from a bezier path. In this case the user, instead of draw the polygons one by one, may draw wireframe bezier lines of the image, and then automate the process of generating polygons (I saw that UEZ did a similar thing).
...

Sure, why not?. All the function cares for is receiving an array of points (they don't need to be in any particular order). The only gotcha is that the array needs to be dynamic due to the algorithm it uses (it needs to resize the array internally). Also, it is not constrained, which means that it'll need a little more work if you want, say, polygons with holes. It's just a very simple implementation meant as a stepping stone.

This is one of the things that I've coded way back at the time of Lachie's compo. If you remember, my entry was going to be a pinball, and this was developed along with a SVG renderer (you can see some screenshots of the WIP in that thread). I was working on the assets (it was fully vectorial and used OpenGL, hence the triangulation routine) when I ran out of time. Oh well. Unfortunately, all that work (and much more) was lost a while back due to a HDD crash.

...
Last but not least: even if I've added some new features, Impossible Victhorse's sequel is stopped at the moment … I wish he could launch his floppies soon through a new adventure.

Oh so you did make a sequel? Nice! Looking forward to it =D

[paul doe]

@Pitto: I've uploaded a simple 'game' that uses the keyboard class shown here. You can see it here.

By the way: the keyboard class you used in Impossible Victhorse had a bug, which I discovered after you won the competition, so you were lucky it didn't manifested there XD

Might as well update it, just in case.

[Pitto]

Hi Paul Doe,

funny game and useful framework to improve my poor math.

Just for the sake of learning & debug: this is the old keyboard class I've used in the compo https://github.com/Pitto/Impossible_Vic ... eyboard.bi:

Code: Select all

'' A simple class to help us deal with the keyboard
' by paul doe -- see topic: https://www.freebasic.net/forum/viewtopic.php?f=15&t=26673
type keyboard_proto
   public:
      declare function hold( byval as long ) as boolean
      declare function pressed( byval as long ) as boolean
      declare function released( byval as long ) as boolean
      
      declare constructor()
      
   private:
      '' These will store the states of the keys
      m_oldKey( 0 to 255 )   as boolean
      m_newKey( 0 to 255 )   as boolean
      
end type

constructor keyboard_proto()

end constructor

function keyboard_proto.hold( byval index as long ) as boolean
   '' Returns whether a key is being held
   return( cbool( multiKey( index ) ) )
end function

function keyboard_proto.pressed( byval index as long ) as boolean
   '' Returns whether a key was pressed
   m_oldKey( index ) = m_newKey( index )
   m_newKey( index ) = cbool( multiKey( index ) )
   
   return( m_oldKey( index ) = false andAlso m_newKey( index ) = true )
end function

function keyboard_proto.released( byval index as long ) as boolean
   '' Returns whether a key was released
   m_oldKey( index ) = m_newKey( index )
   m_newKey( index ) = cbool( multiKey( index ) )
   
   return( m_oldKey( index ) = true andAlso m_newKey( index ) = false )
end function

Correct me if I'm wrong: a problem may occour in this old class if the function pressed() or released() where called sequentially, because in them the state became recorded each time, overwriting values.

Indeed in the mouse routine I did a modify: the sub update () stores these values once.

However, if Victor will a day launch again floppies, it will happen with an improved class

[paul doe]

...
Correct me if I'm wrong: a problem may occour in this old class if the function pressed() or released() where called sequentially, because in them the state became recorded each time, overwriting values.

Indeed in the mouse routine I did a modify: the sub update () stores these values once.
...

Exactly. And the same thing happened with other combinations too (which, fortunately, you didn't used in your game). More than a straight 'bug', I'd say it was a (gross) oversight on my part, so your fix is spot-on.

The overall idea is/was to be able to query input state independently of each other (an idea that a similar class by relsoft gave me), not to have them altered depending on the order on which you call them, which is annoying and defeats the entire purpose of having the class in the first place, bar pure convenience. You can, however, make the queries in a specific order if your code requires it, just not because the class forces you to do so. This way, you can simplify a lot of your input logic, as you might have seen in the Asteroids snippet: I implemented rate of fire for the ship simply by passing an argument to repeated().

It was nice to see it being given some good shakin'. You might try to update your game with the new version, to help me stress test it a little. The more the merrier =D

Btw, I also had an illegal amount of fun with your other game (JASC Soccer), especially since sometimes the players 'bug out', giving rise to lots of hilarious situations that frequently made me lol.

In my opinion, you should create a thread for Impossible Victhorse in the 'Projects' section, as it is well done, really fun and a good showcase of what you can do with FreeBasic given the time and dedication. A nice project to have and study.