The code works by translating the mouse's screen position to a virtual screen in 3d space. It uses the vector between the mouse's 3d location and the camera to determine the distance of each bounding sphere centre to the vector. The spheres which have a radius less than their distance to the vector are in the line of selection, the sphere that is closest to the camera is the current object.
I figured this could be used with any 3d game (or app) where entities need to be selected with the mouse.
Code: Select all
;cheating a bit with this structure - I use it for both 3D points and vectors
Structure vector
x.d
y.d
z.d
EndStructure
Structure mouse
x.l
y.l
v.vector
button.l
over.l
EndStructure
Structure bounded
object.l
centre.vector
radius.d
distance.d
EndStructure
Global height.l, width.l, mousedepth.d, camera.vector, lookat.vector, origin.vector
Global NewList spheres.bounded()
width = 1024
height = 768
mousedepth = -665
;width = 800 ;These numbers seem to work for a
;height = 600 ;800 by 600 screen but the graphic
;mousedepth = -519 ;detail is better at 1024x768
Procedure copy(*a.vector,*b.vector)
*a\x = *b\x
*a\y = *b\y
*a\z = *b\z
EndProcedure
Procedure new(*v.vector,x.d,y.d,z.d)
*v\x = x
*v\y = y
*v\z = z
EndProcedure
Procedure vectorise(*v.vector,*from.vector,*toPoint.vector)
new(*v, *toPoint\x - *from\x,*toPoint\y - *from\y,*toPoint\z - *from\z)
EndProcedure
Procedure equal(*a.vector,*b.vector)
If *a\x <> *b\x:ProcedureReturn 0:EndIf
If *a\y <> *b\y:ProcedureReturn 0:EndIf
If *a\z <> *b\z:ProcedureReturn 0:EndIf
ProcedureReturn 1
EndProcedure
Procedure translate(*v.vector, *t.vector)
*v\x+*t\x
*v\y+*t\y
*v\z+*t\z
EndProcedure
Procedure rotate(*v.vector, *r.vector)
copy(temp.vector,*v) ;rotate x axis
*v\y = temp\y*Cos(-*r\x)-temp\z*Sin(-*r\x)
*v\z = temp\y*Sin(-*r\x)+temp\z*Cos(-*r\x)
copy(temp.vector,*v) ;rotate y axis
*v\z = temp\z*Cos(-*r\y)-temp\x*Sin(-*r\y)
*v\x = temp\z*Sin(-*r\y)+temp\x*Cos(-*r\y)
copy(temp.vector,*v) ;rotate z axis
*v\x = temp\x*Cos(-*r\z)-temp\y*Sin(-*r\z)
*v\y = temp\x*Sin(-*r\z)+temp\y*Cos(-*r\z)
EndProcedure
Procedure.d dot(*a.vector,*b.vector)
ProcedureReturn (*a\x * *b\x)+(*a\y * *b\y)+(*a\z * *b\z)
EndProcedure
Procedure.d angle(*a.vector, *b.vector)
ProcedureReturn ACos(dot(*a,*b)/(Pow(dot(*a,*a),0.5)*Pow(dot(*b,*b),0.5)))
EndProcedure
Procedure map(*v.vector)
a.d:b.d:c.d
vectorise(LA.vector,camera,lookat)
new(screen.vector,0,0,mousedepth)
new(Lxy.vector,LA\x,LA\y,0)
new(Lyz.vector,0,LA\y,LA\z)
new(Lxz.vector,LA\x,0,LA\z)
new(Sxy.vector,screen\x,screen\y,0)
new(Syz.vector,0,screen\y,screen\z)
new(Sxz.vector,screen\x,0,screen\z)
a = angle(Sxy,Lxy)
b = angle(Syz,Lyz)
c = angle(Sxz,Lxz)
If equal(Lxy,origin)+equal(Sxy,origin):a=0:EndIf
If equal(Lyz,origin)+equal(Syz,origin):b=0:EndIf
If equal(Lxz,origin)+equal(Sxz,origin):c=0:EndIf
new(angles.vector,b,c,a)
rotate(*v,angles)
translate(*v,camera)
EndProcedure
Procedure.d distance(*a.vector,*b.vector,*c.vector)
;distance between line AB and point C
new(AB.vector,*b\x-*a\x,*b\y-*a\y,*b\z-*a\z)
new(AC.vector,*c\x-*a\x,*c\y-*a\y,*c\z-*a\z)
angle.d = angle(AB,AC)
ProcedureReturn Pow(dot(AC,AC),0.5)*Sin(angle)
EndProcedure
Procedure over(*v.vector)
ForEach spheres()
Delay(0)
copy(centre.vector,spheres()\centre)
spheres()\distance=Pow(Pow(camera\x-centre\x,2)+Pow(camera\y-centre\y,2)+Pow(camera\z-centre\z,2),0.5)
basicangle.l = (180*angle(lookat,centre)/#PI)
If basicangle>90:spheres()\distance = -spheres()\distance:EndIf
Next
SortStructuredList(spheres(),0,OffsetOf(bounded\distance),#PB_Sort_Double)
ForEach spheres()
Delay(0)
If (spheres()\distance>=0) And (distance(camera,*v,spheres()\centre)<= spheres()\radius): ProcedureReturn spheres()\object:EndIf
Next
ProcedureReturn -1
EndProcedure
Procedure getMouse(*m.mouse)
ExamineMouse()
If MouseButton(#PB_MouseButton_Left)
*m\button=1
ElseIf MouseButton(#PB_MouseButton_Right)
*m\button=2
ElseIf MouseButton(#PB_MouseButton_Middle)
*m\button=3
Else
*m\button=0
EndIf
x = MouseX()-width/2
y = (height/2-MouseY())
z = mousedepth
new(v.vector,x,y,z)
map(v)
*m\x = MouseX()
*m\y = MouseY()
copy(*m\v,v)
*m\over = over(v)
EndProcedure
Procedure.s displayMouse(*m.mouse)
ProcedureReturn "("+Str(*m\x)+","+Str(*m\y)+") - ["+StrD(*m\v\x,2)+","+StrD(*m\v\y,2)+","+StrD(*m\v\z,2)+"] - distance "+StrD(Pow(Pow(*m\v\x - camera\x,2)+Pow(*m\v\y - camera\y,2)+Pow(*m\v\z - camera\z,2),0.5),2)
EndProcedure
Procedure setcamera(cameraID.l,*v.vector)
If *v <> #Null:copy(camera,*v):EndIf
CameraLocate(cameraID,*v\x,*v\y,*v\z)
If lookat <> #Null:new(lookat,0,0,-1000):EndIf
CameraLookAt(cameraID,lookat\x,lookat\y,lookat\z)
EndProcedure
Procedure setlookat(cameraID.l,*v.vector)
If *v <> #Null:copy(lookat,*v):EndIf
CameraLookAt(cameraID,lookat\x,lookat\y,lookat\z)
EndProcedure
Procedure addSphere(object.l,*centre.vector,radius.d)
AddElement(spheres())
spheres()\object = object
spheres()\centre\x = *centre\x
spheres()\centre\y = *centre\y
spheres()\centre\z = *centre\z
spheres()\radius = radius
EndProcedure
Procedure moveObject(object.l,*v.vector)
MoveEntity(object,*v\x,*v\y,*v\z)
SortStructuredList(spheres(),0,OffsetOf(bounded\object),#PB_Sort_Long)
ForEach spheres()
If spheres()\object = object:translate(spheres()\centre,*v):EndIf
If spheres()\object > object:ProcedureReturn:EndIf
Next
EndProcedure
;-Initialise
ExamineDesktops()
InitEngine3D()
InitSprite()
InitKeyboard()
InitMouse()
OpenScreen(width,height,32,"")
UseJPEGImageDecoder()
UsePNGImageDecoder()
Add3DArchive("Data\", #PB_3DArchive_FileSystem)
Parse3DScripts()
LoadSprite(0,"Data\mouse.PNG")
;-Setup Movement Vectors
new(up.vector,0,0,-1):map(up)
new(down.vector,0,0,1):map(down)
new(left.vector,-1,0,0):map(left)
new(right.vector,1,0,0):map(right)
;-Set named Vectors
new(origin,0,0,0)
new(camera,0,0,0)
new(lookat,0,0,mousedepth)
;-Setup Camera
CreateCamera(0, 0, 0, 100, 100)
setcamera(0,camera)
setlookat(0,lookat)
CameraFOV(0, #PI / 3)
;-Setup Cubes
LoadMesh (1, "cube.mesh")
LoadTexture(1, "stone.jpg")
CreateMaterial(1,TextureID(1))
For i=1 To 1000
new(r.vector,2*Random(width)-width,2*Random(height)-height,-Random(-mousedepth))
CreateEntity(i,MeshID(1),MaterialID(1),r\x,r\y,r\z)
ScaleEntity(i,0.1,0.1,0.1)
addSphere(i,r,6.5)
Next i
;-Main loop
Repeat
ClearScreen(0)
RenderWorld()
getmouse(mouse.mouse)
StartDrawing(ScreenOutput())
DrawText(0,0, "Mouse location: "+displayMouse(mouse),$FFFF,0)
ovr = over(mouse\v)
If ovr<0
DrawText(0,16, "Mouse is over: nothing ",$FF,0)
Else
DrawText(0,16, "Mouse is over: object "+Str(ovr),$FF00,0)
If ExamineKeyboard()
If KeyboardPushed(#PB_Key_Up)
moveObject(ovr,up)
ElseIf KeyboardPushed(#PB_Key_Down)
moveObject(ovr,down)
ElseIf KeyboardPushed(#PB_Key_Left)
moveObject(ovr,left)
ElseIf KeyboardPushed(#PB_Key_Right)
moveObject(ovr,right)
EndIf
EndIf
EndIf
StopDrawing()
DisplayTransparentSprite(0,MouseX(),MouseY())
FlipBuffers()
ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)
Cheers,
Matt
PS the code needs three files in the Data\ directory
- mouse.png
wall.jpg
cube.mesh