I might continue the example further into a full design if there is ample interest.
Features:
How to click and move your character
Pressing SHIFT displays items on the ground
Moving cursor over displayed item name will change its display colors
set display mode 1024,768,32
autocam off
sync on
sync rate 60
REM VARIABLES
screenwidth# = screen width()
screenheight# = screen height()
screenwidth2# = screenwidth#/2.0
screenheight2# = screenheight#/2.0
scalefactor# = screenheight#/1.2
rem camera height movement speed
cyspd# as float = 4.0
rem starting camera height position
cy# as float = 350.0
Global targetX# as float
Global targetY# as float
Global targetZ# as float
Global player as integer
player = 1
move_character = 0
rem player move speed
spd# = 3.0
px# = 100
py# = 40
pz# = 50
box_color as dword
text_color as dword
box_color = rgb(128,128,128)
text_color = rgb(200,0,0)
box_color_h as dword
text_color_h as dword
box_color_h = rgb(100,100,100)
text_color_h = rgb(220,220,0)
make matrix 1, 2000,2000,50,50
make object sphere player, 100
scale object player, 30,100,30
items = 10
for t = 1 to items
make object cube t+1, rnd(10)+5
position object t+1, rnd(1000),0,rnd(1000)
next t
DO
_M_C = mouseclick()
_SHIFT = shiftkey()
if _SHIFT = 1
object_found = 0
for t = 1 to items
if object in screen(t+1)
tx$ = "Object "+str$(t+1)
cx = object screen x(t+1)
cy = object screen y(t+1)
cx2 = cx + text width(tx$)
cy2 = cy + text height(" ")
if mouseWithin(cx,cy,cx2,cy2) = 1 and object_found = 0
object_found = t+1
bc = box_color_h
tc = text_color_h
else
bc = box_color
tc = text_color
endif
rem draw box
ink bc, 0
box cx, cy, cx2, cy2
ink tc, 0
text cx,cy,tx$
endif
next t
endif
if _M_C > 0
clickMatrix(screenwidth2#, screenheight2#, scalefactor#, offsetx#, offsety#, offsetz#)
move_character = 1
a# = atanfull(targetX#-px#, targetZ#-pz#)
endif
if move_character = 1
px# = newxvalue(px#, a#, spd#)
pz# = newzvalue(pz#, a#, spd#)
position object player, px#, py#, pz#
if distance#(px#,pz#,targetX#,targetZ#) < spd#^2 then move_character = 0
endif
gosub _Control_Camera
text 1, 1, "FPS: "+str$(screen fps())
sync
LOOP
_Control_Camera:
if scancode()=30 then inc cy#,cyspd#
if scancode()=44 then dec cy#,cyspd#
if cy#>400 then cy#=400
if cy#<200 then cy#=200
cx# = object position x(player)
cz# = object position z(player)
position camera cx#,cy#,cz#-300
offsetx# = cx#
offsety# = 0
offsetz# = cz#
point camera offsetx#,offsety#,offsetz#
RETURN
function clickMatrix(screenwidth2# as float, screenheight2# as float, scalefactor# as float, offsetx# as float, offsety# as float, offsetz# as float)
mouseposx#=mousex()-screenwidth2#
mouseposy#=screenheight2#-mousey()
dist#=sqrt((camera position x()-offsetx#)^2+(camera position y()-offsety#)^2+(camera position z()-offsetz#)^2)
if mouseposy#<>0
vectorang#=atanfull(scalefactor#,mouseposy#)
else
vectorang#=90.0
endif
if vectorang#+camera angle x()>90.965
ratio#=mouseposy#/(sin((vectorang#+camera angle x() )-90.0))
cursorposy#=ratio#*sin(180.0-vectorang#)
else
cursorposy#=1000000.0
endif
hyplength#=scalefactor#/sin(vectorang#)
cursorposx#=(((ratio#*sin(90.0-camera angle x() ))/hyplength#)+1.0)*mouseposx#
if mouseposx#<>0
angtotal#=wrapvalue(camera angle y()-atanfull(mouseposy#,mouseposx#))
else
if mouseposy#<0
angtotal#=wrapvalue(camera angle y()+90.0)
else
angtotal#=wrapvalue(camera angle y()-90.0)
endif
endif
cameraang#=wrapvalue(360.0-camera angle y() )
cosang#=cos(cameraang#)
sinang#=sin(cameraang#)
movex#=(dist#/scalefactor#)*((cosang#*cursorposx#)+((-1*sinang#)*cursorposy#))
movez#=(dist#/scalefactor#)*((sinang#*cursorposx#)+(cosang#*cursorposy#))
`\\\ 3D translated coords from 2D mouse coords \\\
targetX#=movex#+offsetx#
targetZ#=movez#+offsetz#
targetY#=0
endfunction
REM returns the squared distance between to 2D points
function distance#(x1 as float, y1 as float, x2 as float, y2 as float)
d# = (x1-x2)*(x1-x2) + (y1-y2)*(y1-y2)
endfunction d#
REM returns 1 if mouse cursor is within the defined box
function mouseWithin(x1,y1,x2,y2)
ok = 0
x = mousex()
y = mousey()
if x>x1 and x<x2 and y>y1 and y<y2 then ok = 1
endfunction ok
"eureka" - Archimedes
