viewtopic.php?t=31586
added:
- slight customized placement and style of boxes in a grid
- additional haptics or in other words keyboard and gamepad support very basic.
- some tricks for a dynamic mouse pointer
- very elementary animation
- rounded box, fb versions only, with many thanks to coderjeff
The code is rather fluffy and not as clear as I had
hoped for but roughly there are three parts:
core - init and subroutine box (hit detection, etc)
define - define boxes subroutine numpad, etc
main - main loop with navigation and render defined boxes
Some stats:
hitbox 32 bit color fb ~ 12MB memory / ~1% cpu usage / gpu usage ~20% - 140Mhz
hitbox 8 bit color fb ~ 13MB memory / ~0% cpu usage / gpu usage ~20% - 140Mhz
hitbox 32 bit color sdl ~ 7MB memory* / ~ up to 14% cpu usage / gpu ~10% - 140Mhz
Tested on 15-6600T / 1050ti / win7(x64)
*) initial memory usage, sdl_ttf causes a slight memory leak
tried to reduce it but still....
usage mouse movement plus wheel and right / left / middle click
keyboard arrow keys and enter
gamepad dpad for direction mouse pointer
and A button for enter
fb 8 bit color version
Code: Select all
' expanded example hitbox detection by thrive4 2022
' see https://www.freebasic.net/forum/viewtopic.php?t=31586
' navigate with mouse, keyboard or gamepad
' init screen
dim screenwidth As integer = 1280
dim screenheight As integer = 720
dim aspectratio as single = screenwidth / screenheight
dim shared foregroundcolor as integer = 15
dim shared backgroundcolor as integer = 0
' init mouse coordinates
Type mousecoord
x As integer
y As integer
End Type
' init hit box and coordinates
Type hitboxcoord
x As integer
y As integer
w As integer
h As integer
ofset as integer
label as string
misc as string
End Type
' used to set first box origin and size
Type hbinit
x As integer
y As integer
w As integer
h As integer
o as integer ' offset between boxes
v as integer
End Type
' init hit box attributes
type hitboxattributes
linecolor as integer = 15 ' line
hovercolor as integer = 8 ' hover
buttonleftcolor as integer = 2 ' left button
buttonrightcolor as integer = 4 ' right button
buttonmiddlecolor as integer = 3 ' middle button
fillcolor as integer = 7 ' fill color
textcolor as integer = 1 ' text color
linesize as integer = 0
rounded as boolean = false ' rounded box true or false
filled as boolean = false ' filled box true or false
shadow as boolean = false ' 3d effect true or false
hoverfx as string = "" ' hover
buttonleftfx as string = "" ' left button
buttonrightfx as string = "" ' right button
buttonmiddlefx as string = "" ' middle button
id as string = "" ' id name for box
end type
dim attributes as hitboxattributes
' init hit box
type hitboxtype
id(1 to 10) as hitboxcoord
end type
' match maxcols to id(1 to 10)
dim maxcols as integer = 10
dim hitbox(1 to maxcols) as hitboxtype
dim col as integer = 1
dim hitboxinit as hbinit
dim shared hboutput as string
hboutput = ""
dim shared hbid as string
hbid = ""
dim keybbuffer as string = ""
dim text as string = "T"
' init mouse feedback
dim mouse as mousecoord
Dim As Integer x, y, wheel, wheelup, buttons, buttonsup, res
mouse.x = 0
mouse.y = 0
' init gamepad
dim resgp as integer
dim swapgamepad as boolean = false
dim gpbuttons as integer
dim hatlr as single
dim hatud as single
dim chkgp as boolean = false
Const JoystickID = 0
if GetJoystick(JoystickID) then
' no gamepad reversed logic..
chkgp = false
else
chkgp = true
end if
' create curved boxes
' lifted from joytest.zip by coderjeff
' see https://www.freebasic.net/forum/viewtopic.php?p=54746&hilit=joytest#p54746
'roundbox x loc,y loc, height, width, arc size, fill color
sub roundbox _
( _
byval x as integer, _
byval y as integer, _
byval w as integer, _
byval h as integer, _
byval r as integer, _
byval c as integer _
)
circle (x + r , y + r ), r, c, , , , f
circle (x + r , y + h - r - 1), r, c, , , , f
circle (x + w - r - 1, y + r ), r, c, , , , f
circle (x + w - r - 1, y + h - r - 1), r, c, , , , f
line (x, y + r) - (x + w - 1, y + h - r), c, bf
line (x + r, y) - (x + w - r, y + h - 1), c, bf
end sub
' cheap way to alter mousepointer
sub fakepointer(p as mousecoord)
' hide hardware mouse pointer
SetMouse(p.x, p.y, 0)
Line(p.x, p.y) - step(20, 20), 15, b
'Circle (p.x, p.y), 8, 15
end sub
' draw and detect hitboxes
sub box(hitboxinit as hbinit, p as mousecoord, buttons as integer, maxcols as integer, attributes as hitboxattributes)
'dim attributes as hitboxattributes
dim hitbox(1 to maxcols) as hitboxtype
dim col as integer
dim i as integer = 1
dim tempcolor as integer
for col = 1 to maxcols
hitbox(col).id(col).x = hitboxinit.x
hitbox(col).id(col).y = hitboxinit.y
hitbox(col).id(col).w = hitboxinit.w
hitbox(col).id(col).h = hitboxinit.h
hitbox(col).id(col).ofset = hitboxinit.o
hitbox(col).id(col).label = chr$(hitboxinit.v + col)
WITH hitbox(col).id(col)
.x = .x + ((.w + .ofset) * (col - 1))
' detect mouse button within set boundry
if ((p.x >= .x) and (p.x < (.x + .w)) and (p.y >= .y) and (p.y < (.y + .h))) then
select case buttons
' left
case 1
tempcolor = attributes.buttonleftcolor
hboutput = .label
select case attributes.buttonleftfx
case "bounce"
' cheap animation bounce box
.x = .x - 5
.y = .y - 20
.w = .w + 10
.h = .h + 10
end select
' right
case 2
tempcolor = attributes.buttonrightcolor
' middle
case 4
tempcolor = attributes.buttonmiddlecolor
' hover
case else
tempcolor = attributes.hovercolor
hbid = attributes.id
hboutput = ""
select case attributes.hoverfx
case "balloon"
' cheap animation balloon box
.x = .x - 5
.y = .y - 10
.w = .w + 10
.h = .h + 10
end select
end select
' debug
print attributes.id
else
if attributes.filled then
tempcolor = attributes.fillcolor
else
tempcolor = attributes.linecolor
end if
end if
' draw boxes
if attributes.rounded then
'roundbox x loc, y loc, height, width, arc size, fill color
if attributes.filled then
roundbox .x + 4, .y + 4, .w - 8, .h - 8, 4, tempcolor
Draw String ((.x + .w * 0.5) - 3 * len(.label), .y + .h * 0.45), .label, attributes.textcolor
else
roundbox .x, .y, .w, .h, 8, tempcolor
' 3d effect
if attributes.shadow then
roundbox .x + 4, .y + 4, .w - 4, .h - 4, 4, attributes.fillcolor
else
' standard needs background color roundbox fills the button
roundbox .x + 4, .y + 4, .w - 8, .h - 8, 4, backgroundcolor
end if
Draw String ((.x + .w * 0.5) - 3 * len(.label), .y + .h * 0.45), .label, tempcolor
end if
' line size rounded not working
if attributes.linesize > 0 then
do
'Line (.x - i, .y - i) - (.x + i + .w, .y + i + .h), tempcolor, b
'roundbox 10, 10, 128, 128, 8, hitboxcolor.hbline
i += 1
loop until i > attributes.linesize
i = 1
end if
else
if attributes.filled then
Line (.x, .y) - (.x + .w, .y + .h), tempcolor, bf
Draw String ((.x + .w * 0.5) - 3 * len(.label), .y + .h * 0.45), .label, attributes.textcolor
else
' 3d effect
if attributes.shadow then
Line (.x, .y) - (.x + .w, .y + .h), tempcolor, b
Line (.x + 4, .y + 4) - (.x + .w - 4, .y + .h - 4), attributes.fillcolor, bf
else
Line (.x, .y) - (.x + .w, .y + .h), tempcolor, b
end if
Draw String ((.x + .w * 0.5) - 3 * len(.label), .y + .h * 0.45), .label, tempcolor
end if
' line size
if attributes.linesize > 0 then
do
Line (.x - i, .y - i) - (.x + i + .w, .y + i + .h), tempcolor, b
i += 1
loop until i > attributes.linesize
i = 1
end if
end if
end with
next
end sub
' define boxes
sub numpad(byref hitboxinit as hbinit, byref mouse as mousecoord, byref buttons as integer,_
byref maxcols as integer, byref attributes as hitboxattributes)
with attributes
.linecolor = 15
.hovercolor = 8
.buttonleftcolor = 2
.buttonrightcolor = 4
.buttonmiddlecolor = 3
.fillcolor = 7
.textcolor = 1
.linesize = 0
.rounded = false
.filled = false
.shadow = false
.hoverfx = ""
.buttonleftfx = ""
.buttonrightfx = ""
.buttonmiddlefx = ""
.id = "numpad"
end with
'hitboxinit = type(x coord, y coord, width, height, ofset between boxes, asc value first char)
hitboxinit = type(700, 100, 50, 50, 5, 48)
box(hitboxinit, mouse, buttons, maxcols, attributes)
hitboxinit = type(700, 160, 50, 50, 5, 51)
box(hitboxinit, mouse, buttons, maxcols, attributes)
hitboxinit = type(700, 220, 50, 50, 5, 54)
box(hitboxinit, mouse, buttons, maxcols, attributes)
hitboxinit = type(755, 280, 50, 50, 5, 47)
box(hitboxinit, mouse, buttons, 1, attributes)
end sub
sub keyboard(byref hitboxinit as hbinit, byref mouse as mousecoord, byref buttons as integer,_
byref maxcols as integer, byref attributes as hitboxattributes)
with attributes
.linecolor = 15
.hovercolor = 8
.buttonleftcolor = 2
.buttonrightcolor = 4
.buttonmiddlecolor = 3
.fillcolor = 7
.textcolor = 1
.linesize = 0
.rounded = true
.filled = false
.shadow = true
.hoverfx = ""
.buttonleftfx = ""
.buttonrightfx = ""
.buttonmiddlefx = ""
.id = "keyboard"
end with
hitboxinit = type(100, 100, 50, 50, 5, 47)
box(hitboxinit, mouse, buttons, maxcols, attributes)
hitboxinit = type(100, 160, 50, 50, 5, 64)
box(hitboxinit, mouse, buttons, maxcols, attributes)
hitboxinit = type(100, 220, 50, 50, 5, 74)
box(hitboxinit, mouse, buttons, maxcols, attributes)
hitboxinit = type(212, 280, 50, 50, 5, 84)
box(hitboxinit, mouse, buttons, 6, attributes)
hitboxinit = type(256, 340, 250, 50, 5, 47)
box(hitboxinit, mouse, buttons, 1, attributes)
end sub
sub grid(byref hitboxinit as hbinit, byref mouse as mousecoord, byref buttons as integer,_
byref maxcols as integer, byref attributes as hitboxattributes)
' not visible match colors with backgroundcolor
with attributes
.linecolor = backgroundcolor
.hovercolor = backgroundcolor
.buttonleftcolor = backgroundcolor
.buttonrightcolor = backgroundcolor
.buttonmiddlecolor = backgroundcolor
.fillcolor = backgroundcolor
.textcolor = backgroundcolor
.linesize = 0
.rounded = false
.filled = false
.shadow = false
.hoverfx = ""
.buttonleftfx = ""
.buttonrightfx = ""
.buttonmiddlefx = ""
.id = "grid"
end with
hitboxinit = type(10, 430, 450, 100, 1, 47)
box(hitboxinit, mouse, buttons, maxcols, attributes)
hitboxinit = type(10, 530, 450, 100, 1, 49)
box(hitboxinit, mouse, buttons, maxcols, attributes)
' draw bound box for invisble grid as illustration
Draw String (5, 405), "Below is a invisble box divided into four segements", 15
Line(5, 420) - (920, 640), 15, b
end sub
sub launchbar(byref hitboxinit as hbinit, byref mouse as mousecoord, byref buttons as integer,_
byref maxcols as integer, byref attributes as hitboxattributes)
with attributes
.linecolor = 15
.hovercolor = 8
.buttonleftcolor = 2
.buttonrightcolor = 4
.buttonmiddlecolor = 3
.fillcolor = 7
.textcolor = 1
.linesize = 0
.rounded = true
.filled = false
.shadow = false
.hoverfx = "balloon"
.buttonleftfx = "bounce"
.buttonrightfx = ""
.buttonmiddlefx = ""
.id = "launchbar"
end with
'hitboxinit = type(x coord, y coord, width, height, ofset between boxes, asc value first char)
hitboxinit = type(20, 660, 50, 50, 15, 48)
box(hitboxinit, mouse, buttons, maxcols, attributes)
end sub
' main
ScreenRes screenwidth, screenheight, 8
Color (foregroundcolor, backgroundcolor)
' hack needed otherwise boxes and bg and fg colors
' are not visible on startup
SetMouse(screenwidth * 0.5, screenheight * 0.5)
Do
' note check is needed otherwise calling getjoystick with no gamepad can crash application
if chkgp then
resgp = GetJoystick(JoystickID, gpbuttons,,,,,,, hatlr, hatud)
' reinit gamepad not supported
if gpbuttons = -1 then
swapgamepad = true
exit do
end if
end if
buttonsup = buttons
wheelup = wheel
res = GetMouse (x, y, wheel, buttons)
Locate 1, 1
If res <> 0 Then '' Failure
#ifdef __FB_DOS__
Print "Mouse or mouse driver not available"
#else
Print "Mouse not available or not on window"
#endif
Else
' debug
'Print Using "mouse position: ###:### buttons: "; x; y;
'If buttons And 1 Then Print "l";" hitbox output ";hboutput
'If buttons And 2 Then Print "r";" "
'If buttons And 4 Then Print "m";" "
' navigate with mouse wheel
if wheel <> wheelup then
if wheel > wheelup then
' scroll up
y = y - 10
else
' scroll down
y = y + 10
end if
else
' nop stationary
end if
' naviagte with mouse
mouse.x = x
mouse.y = y
ScreenLock()
cls
' keep navigation in lock ~ unlock otherwise there will be issues
' with the dynamic mouse pointer
if hbid = "grid" then
fakepointer(mouse)
else
SetMouse(mouse.x, mouse.y, 1)
end if
' navigate with keyboard arrow keys a bit klunky
' scancode constants need #include "fbgfx.bi" and using FB
If MultiKey(&h4B) And mouse.x > 0 Then
SetMouse mouse.x - 20, mouse.y
'print "left"
end if
If MultiKey(&h4D) And mouse.x < screenwidth Then
SetMouse mouse.x + 20, mouse.y
'print "right"
end if
If MultiKey(&h48) And mouse.y > 0 Then
SetMouse mouse.x, mouse.y - 20
'print "up"
end if
If MultiKey(&h50) And mouse.y < screenheight Then
SetMouse mouse.x, mouse.y + 20
'print "down"
end if
If MultiKey(&h1C)Then
' fake mouse button left
buttons = 1
'print "enter"
end if
' naviagte with gamepad dpad input and button A
select case hatud
' hat down
case 1
SetMouse mouse.x, mouse.y + 20
' hat up
case -1
SetMouse mouse.x, mouse.y - 20
end select
select case hatlr
' hat right
case 1
SetMouse mouse.x + 20, mouse.y
' hat left
case -1
SetMouse mouse.x - 20, mouse.y
end select
select case gpbuttons
' dinput A
case 2
buttons = 1
' xinput A
case 1
buttons = 1
end select
' draw boxes and strings
Draw String (600, 650), keybbuffer, 15
numpad(hitboxinit, mouse, buttons, 3, attributes)
keyboard(hitboxinit, mouse, buttons, 10, attributes)
grid(hitboxinit, mouse, buttons, 2, attributes)
launchbar(hitboxinit, mouse, buttons, 7, attributes)
ScreenUnlock()
' example feedback from invisible grid
if hbid = "grid" then
select case hboutput
case "0"
print "square "
case "1"
print "triangle"
case "2"
print "circle "
case "3"
print "shape "
end select
end if
' mouse button up see https://www.freebasic.net/forum/viewtopic.php?p=15237&hilit=mouse+button+up#p15237
' comment coderjeff
if ((buttons And 1) = 1) And ((buttonsup And 1) = 0) then
keybbuffer = keybbuffer + hboutput
end if
Print " "
End If
Print " "
' use sleep to keep cpu usage low
sleep(30)
Loop While Inkey <> chr$(27)
if swapgamepad then
print "gamepad swap or hot plugin not supported press key to exit..."
sleep
end if
' cleanup not sure if needed
Erase hitbox
end
Code: Select all
' expanded example hitbox detection by thrive4 2022
' see https://www.freebasic.net/forum/viewtopic.php?t=31586
' navigate with mouse, keyboard or gamepad
' init screen 32 bits
dim screenwidth As integer = 1280
dim screenheight As integer = 720
dim aspectratio as single = screenwidth / screenheight
dim shared foregroundcolor as ulong = RGB(255, 255, 255)
dim shared backgroundcolor as ulong = RGB(75, 85, 95)
' init mouse coordinates
Type mousecoord
x As integer
y As integer
End Type
' init hit box and coordinates
Type hitboxcoord
x As integer
y As integer
w As integer
h As integer
ofset as integer
label as string
misc as string
End Type
' used to set first box origin and size
Type hbinit
x As integer
y As integer
w As integer
h As integer
o as integer ' offset between boxes
v as integer
End Type
' init hit box attributes
type hitboxattributes
linecolor as ulong = rgba(255, 255, 255, 255) ' line
hovercolor as ulong = rgba(255, 255, 255, 255) ' hover
buttonleftcolor as ulong = rgba(255, 255, 255, 255) ' left button
buttonrightcolor as ulong = rgba(255, 255, 255, 255) ' right button
buttonmiddlecolor as ulong = rgba(255, 255, 255, 255) ' middle button
fillcolor as ulong = rgba(255, 255, 255, 255) ' fill color
textcolor as ulong = rgba(255, 255, 255, 255) ' text color
linesize as integer = 0
rounded as boolean = false ' rounded box true or false
filled as boolean = false ' filled box true or false
shadow as boolean = false ' 3d effect true or false
hoverfx as string = "" ' hover
buttonleftfx as string = "" ' left button
buttonrightfx as string = "" ' right button
buttonmiddlefx as string = "" ' middle button
id as string = "" ' id name for box
end type
dim attributes as hitboxattributes
' init hit box
type hitboxtype
id(1 to 10) as hitboxcoord
end type
' match maxcols to id(1 to 10)
dim maxcols as integer = 10
dim hitbox(1 to maxcols) as hitboxtype
dim col as integer = 1
dim hitboxinit as hbinit
dim shared hboutput as string
hboutput = ""
dim shared hbid as string
hbid = ""
dim keybbuffer as string = ""
dim text as string = "T"
' init mouse feedback
dim mouse as mousecoord
Dim As Integer x, y, wheel, wheelup, buttons, buttonsup, res
mouse.x = 0
mouse.y = 0
' init gamepad
dim resgp as integer
dim swapgamepad as boolean = false
dim gpbuttons as integer
dim hatlr as single
dim hatud as single
dim chkgp as boolean = false
Const JoystickID = 0
if GetJoystick(JoystickID) then
' nop no gamepad reversed logic..
chkgp = false
else
chkgp = true
end if
' create curved boxes
' lifted from joytest.zip by coderjeff
' see https://www.freebasic.net/forum/viewtopic.php?p=54746&hilit=joytest#p54746
'roundbox x loc,y loc, height, width, arc size, fill color
sub roundbox _
( _
byval x as integer, _
byval y as integer, _
byval w as integer, _
byval h as integer, _
byval r as integer, _
byval c as integer _
)
circle (x + r , y + r ), r, c, , , , f
circle (x + r , y + h - r - 1), r, c, , , , f
circle (x + w - r - 1, y + r ), r, c, , , , f
circle (x + w - r - 1, y + h - r - 1), r, c, , , , f
line (x, y + r) - (x + w - 1, y + h - r), c, bf
line (x + r, y) - (x + w - r, y + h - 1), c, bf
end sub
' cheap way to alter mousepointer
sub fakepointer(p as mousecoord)
' hide hardware mouse pointer
SetMouse(p.x, p.y, 0)
Line(p.x, p.y) - step(20, 20), rgba(255, 255, 255, 255), b
'Circle (p.x, p.y), 8, rgba(255, 255, 255, 255)
end sub
' draw and detect hitboxes
sub box(hitboxinit as hbinit, p as mousecoord, buttons as integer, maxcols as integer, attributes as hitboxattributes)
'dim attributes as hitboxattributes
dim hitbox(1 to maxcols) as hitboxtype
dim col as integer
dim i as integer = 1
dim tempcolor as integer
for col = 1 to maxcols
hitbox(col).id(col).x = hitboxinit.x
hitbox(col).id(col).y = hitboxinit.y
hitbox(col).id(col).w = hitboxinit.w
hitbox(col).id(col).h = hitboxinit.h
hitbox(col).id(col).ofset = hitboxinit.o
hitbox(col).id(col).label = chr$(hitboxinit.v + col)
WITH hitbox(col).id(col)
.x = .x + ((.w + .ofset) * (col - 1))
' detect mouse button within set boundry
if ((p.x >= .x) and (p.x < (.x + .w)) and (p.y >= .y) and (p.y < (.y + .h))) then
select case buttons
' left
case 1
tempcolor = attributes.buttonleftcolor
hboutput = .label
select case attributes.buttonleftfx
case "bounce"
' cheap animation bounce box
.x = .x - 5
.y = .y - 20
.w = .w + 10
.h = .h + 10
end select
' right
case 2
tempcolor = attributes.buttonrightcolor
' middle
case 4
tempcolor = attributes.buttonmiddlecolor
' hover
case else
tempcolor = attributes.hovercolor
hbid = attributes.id
hboutput = ""
select case attributes.hoverfx
case "balloon"
' cheap animation balloon box
.x = .x - 5
.y = .y - 10
.w = .w + 10
.h = .h + 10
end select
end select
' debug
print attributes.id
else
if attributes.filled then
tempcolor = attributes.fillcolor
else
tempcolor = attributes.linecolor
end if
end if
' draw boxes
if attributes.rounded then
'roundbox x loc, y loc, height, width, arc size, fill color
if attributes.filled then
roundbox .x + 4, .y + 4, .w - 8, .h - 8, 4, tempcolor
Draw String ((.x + .w * 0.5) - 3 * len(.label), .y + .h * 0.45), .label, attributes.textcolor
else
roundbox .x, .y, .w, .h, 8, tempcolor
' 3d effect
if attributes.shadow then
roundbox .x + 4, .y + 4, .w - 4, .h - 4, 4, attributes.fillcolor
else
' standard needs background color roundbox fills the button
roundbox .x + 4, .y + 4, .w - 8, .h - 8, 4, backgroundcolor
end if
Draw String ((.x + .w * 0.5) - 3 * len(.label), .y + .h * 0.45), .label, tempcolor
end if
' line size rounded not working
if attributes.linesize > 0 then
do
'Line (.x - i, .y - i) - (.x + i + .w, .y + i + .h), tempcolor, b
'roundbox 10, 10, 128, 128, 8, hitboxcolor.hbline
i += 1
loop until i > attributes.linesize
i = 1
end if
else
if attributes.filled then
Line (.x, .y) - (.x + .w, .y + .h), tempcolor, bf
Draw String ((.x + .w * 0.5) - 3 * len(.label), .y + .h * 0.45), .label, attributes.textcolor
else
' 3d effect
if attributes.shadow then
Line (.x, .y) - (.x + .w, .y + .h), tempcolor, b
Line (.x + 4, .y + 4) - (.x + .w - 4, .y + .h - 4), attributes.fillcolor, bf
else
Line (.x, .y) - (.x + .w, .y + .h), tempcolor, b
end if
Draw String ((.x + .w * 0.5) - 3 * len(.label), .y + .h * 0.45), .label, tempcolor
end if
' line size
if attributes.linesize > 0 then
do
Line (.x - i, .y - i) - (.x + i + .w, .y + i + .h), tempcolor, b
i += 1
loop until i > attributes.linesize
i = 1
end if
end if
end with
next
end sub
' define boxes
sub numpad(byref hitboxinit as hbinit, byref mouse as mousecoord, byref buttons as integer,_
byref maxcols as integer, byref attributes as hitboxattributes)
with attributes
.linecolor = rgba(255, 255, 255, 255)
.hovercolor = rgba(55, 55, 55, 255)
.buttonleftcolor = rgba(0, 255, 0, 255)
.buttonrightcolor = rgba(255, 0, 0, 255)
.buttonmiddlecolor = rgba(0, 0, 255, 255)
.fillcolor = rgba(155, 155, 155, 255)
.textcolor = rgba(255, 255, 255, 255)
.linesize = 0
.rounded = false ' rounded box true or false
.filled = false ' filled box true or false
.shadow = false ' 3d effect true or false
.hoverfx = ""
.buttonleftfx = ""
.buttonrightfx = ""
.buttonmiddlefx = ""
.id = "numpad"
end with
'hitboxinit = type(x coord, y coord, width, height, ofset between boxes, asc value first char)
hitboxinit = type(700, 100, 50, 50, 5, 48)
box(hitboxinit, mouse, buttons, maxcols, attributes)
hitboxinit = type(700, 160, 50, 50, 5, 51)
box(hitboxinit, mouse, buttons, maxcols, attributes)
hitboxinit = type(700, 220, 50, 50, 5, 54)
box(hitboxinit, mouse, buttons, maxcols, attributes)
hitboxinit = type(755, 280, 50, 50, 5, 47)
box(hitboxinit, mouse, buttons, 1, attributes)
end sub
sub keyboard(byref hitboxinit as hbinit, byref mouse as mousecoord, byref buttons as integer,_
byref maxcols as integer, byref attributes as hitboxattributes)
with attributes
.linecolor = rgba(255, 255, 255, 255)
.hovercolor = rgba(55, 55, 55, 255)
.buttonleftcolor = rgba(0, 255, 0, 255)
.buttonrightcolor = rgba(255, 0, 0, 255)
.buttonmiddlecolor = rgba(0, 0, 255, 255)
.fillcolor = rgba(155, 155, 155, 255)
.textcolor = rgba(255, 255, 255, 255)
.linesize = 0
.rounded = true ' rounded box true or false
.filled = false ' filled box true or false
.shadow = true ' 3d effect true or false
.hoverfx = ""
.buttonleftfx = ""
.buttonrightfx = ""
.buttonmiddlefx = ""
.id = "keyboard"
end with
hitboxinit = type(100, 100, 50, 50, 5, 47)
box(hitboxinit, mouse, buttons, maxcols, attributes)
hitboxinit = type(100, 160, 50, 50, 5, 64)
box(hitboxinit, mouse, buttons, maxcols, attributes)
hitboxinit = type(100, 220, 50, 50, 5, 74)
box(hitboxinit, mouse, buttons, maxcols, attributes)
hitboxinit = type(212, 280, 50, 50, 5, 84)
box(hitboxinit, mouse, buttons, 6, attributes)
hitboxinit = type(256, 340, 250, 50, 5, 47)
box(hitboxinit, mouse, buttons, 1, attributes)
end sub
sub grid(byref hitboxinit as hbinit, byref mouse as mousecoord, byref buttons as integer,_
byref maxcols as integer, byref attributes as hitboxattributes)
' not visible match colors with backgroundcolor
with attributes
.linecolor = backgroundcolor
.hovercolor = backgroundcolor
.buttonleftcolor = backgroundcolor
.buttonrightcolor = backgroundcolor
.buttonmiddlecolor = backgroundcolor
.fillcolor = backgroundcolor
.textcolor = backgroundcolor
.linesize = 0
.rounded = false ' rounded box true or false
.filled = false ' filled box true or false
.shadow = false ' 3d effect true or false
.hoverfx = ""
.buttonleftfx = ""
.buttonrightfx = ""
.buttonmiddlefx = ""
.id = "grid"
end with
hitboxinit = type(10, 430, 450, 100, 1, 47)
box(hitboxinit, mouse, buttons, maxcols, attributes)
hitboxinit = type(10, 530, 450, 100, 1, 49)
box(hitboxinit, mouse, buttons, maxcols, attributes)
' draw bound box for invisble grid as illustration
Draw String (5, 405), "Below is a invisble box divided into four segements", rgba(255, 255, 255, 255)
Line(5, 420) - (920, 640), rgba(255, 255, 255, 255), b
end sub
sub launchbar(byref hitboxinit as hbinit, byref mouse as mousecoord, byref buttons as integer,_
byref maxcols as integer, byref attributes as hitboxattributes)
with attributes
.linecolor = rgba(255, 255, 255, 255)
.hovercolor = rgba(55, 55, 55, 255)
.buttonleftcolor = rgba(0, 255, 0, 255)
.buttonrightcolor = rgba(255, 0, 0, 255)
.buttonmiddlecolor = rgba(0, 0, 255, 255)
.fillcolor = rgba(155, 155, 155, 255)
.textcolor = rgba(255, 255, 255, 255)
.linesize = 0
.rounded = true
.filled = false
.shadow = false
.hoverfx = "balloon"
.buttonleftfx = "bounce"
.buttonrightfx = ""
.buttonmiddlefx = ""
.id = "launchbar"
end with
'hitboxinit = type(x coord, y coord, width, height, ofset between boxes, asc value first char)
hitboxinit = type(20, 660, 50, 50, 15, 48)
box(hitboxinit, mouse, buttons, maxcols, attributes)
end sub
' main
ScreenRes screenwidth, screenheight, 32
Color (foregroundcolor, backgroundcolor)
' hack needed otherwise boxes and bg and fg colors
' are not visible on startup
SetMouse(screenwidth * 0.5, screenheight * 0.5)
Do
' note check is needed otherwise calling getjoystick with no gamepad can crash application
if chkgp then
resgp = GetJoystick(JoystickID, gpbuttons,,,,,,, hatlr, hatud)
' reinit gamepad not supported
if gpbuttons = -1 then
swapgamepad = true
exit do
end if
end if
buttonsup = buttons
wheelup = wheel
res = GetMouse (x, y, wheel, buttons)
Locate 1, 1
If res <> 0 Then '' Failure
#ifdef __FB_DOS__
Print "Mouse or mouse driver not available"
#else
Print "Mouse not available or not on window"
#endif
Else
' debug
'Print Using "mouse position: ###:### buttons: "; x; y;
'If buttons And 1 Then Print "l";" hitbox output ";hboutput
'If buttons And 2 Then Print "r";" "
'If buttons And 4 Then Print "m";" "
' navigate with mouse wheel
if wheel <> wheelup then
if wheel > wheelup then
' scroll up
y = y - 10
else
' scroll down
y = y + 10
end if
else
' nop stationary
end if
' naviagte with mouse
mouse.x = x
mouse.y = y
ScreenLock()
cls
' keep navigation in lock ~ unlock otherwise there will be issues
' with the dynamic mouse pointer
if hbid = "grid" then
fakepointer(mouse)
else
SetMouse(mouse.x, mouse.y, 1)
end if
' navigate with keyboard arrow keys a bit klunky
' scancode constants need #include "fbgfx.bi" and using FB
If MultiKey(&h4B) And mouse.x > 0 Then
SetMouse mouse.x - 20, mouse.y
'print "left"
end if
If MultiKey(&h4D) And mouse.x < screenwidth Then
SetMouse mouse.x + 20, mouse.y
'print "right"
end if
If MultiKey(&h48) And mouse.y > 0 Then
SetMouse mouse.x, mouse.y - 20
'print "up"
end if
If MultiKey(&h50) And mouse.y < screenheight Then
SetMouse mouse.x, mouse.y + 20
'print "down"
end if
If MultiKey(&h1C)Then
' fake mouse button left
buttons = 1
'print "enter"
end if
' naviagte with gamepad dpad input and button A
select case hatud
' hat down
case 1
SetMouse mouse.x, mouse.y + 20
' hat up
case -1
SetMouse mouse.x, mouse.y - 20
end select
select case hatlr
' hat right
case 1
SetMouse mouse.x + 20, mouse.y
' hat left
case -1
SetMouse mouse.x - 20, mouse.y
end select
select case gpbuttons
' dinput A
case 2
buttons = 1
' xinput A
case 1
buttons = 1
end select
' draw boxes and strings
Draw String (600, 650), keybbuffer, rgba(255, 255, 255, 255)
numpad(hitboxinit, mouse, buttons, 3, attributes)
keyboard(hitboxinit, mouse, buttons, 10, attributes)
grid(hitboxinit, mouse, buttons, 2, attributes)
launchbar(hitboxinit, mouse, buttons, 7, attributes)
ScreenUnlock()
' example feedback from invisible grid
if hbid = "grid" then
select case hboutput
case "0"
print "square "
case "1"
print "triangle"
case "2"
print "circle "
case "3"
print "shape "
end select
end if
' mouse button up see https://www.freebasic.net/forum/viewtopic.php?p=15237&hilit=mouse+button+up#p15237
' comment coderjeff
if ((buttons And 1) = 1) And ((buttonsup And 1) = 0) then
keybbuffer = keybbuffer + hboutput
end if
Print " "
End If
Print " "
' use sleep to keep cpu usage low
sleep(30)
Loop While Inkey <> chr$(27)
if swapgamepad then
print "gamepad swap or hot plugin not supported press key to exit..."
sleep
end if
' cleanup not sure if needed
Erase hitbox
end