Probably been done a million times, but here is my version anyway.
Mouse arcs around camera instead of using linear movement.
Increase/Decrease range using mouse wheel.
Supports full camera movement/rotation (single camera only).
Self-contained code = ready to plug into any project (just call
_Update_3DMouse() in main loop + no initialization needed).
Left-click interface for 3D objects: Pick up and move 3D objects with the 3D mouse.
Height bar indicator (each bar is 1 DBP unit).
Provide MouseGroundHeight value to adjust height-bar for variable terrain heights.
Left/Right arrowkeys rotate a picked up object.
REM Project: 3DMouse
REM Created: 7/13/2009 2:44:00 PM
REM
REM ***** Main Source File *****
REM
`========================================================================
`=3D MOUSE DEMO==========================================================
`========================================================================
Sync On:Sync Rate 0:Autocam Off
Hide Mouse
Move Camera Up 4
For i =1 to 50
Make Object Cube i,Rnd(2)+1
Position Object i,Rnd(200)-100,2.0-(.5*(4-Object Size Y(i))),Rnd(200)
Set Object Collision To Boxes i
Next i
TurnRate#=2.0
MoveRate#=.5
Do
`Basic WASD Controls
Turn Camera Right (KeyState(32)-KeyState(30))*TurnRate#*TimeFactor(60)
Move Camera (KeyState(17)-KeyState(31))*MoveRate#*TimeFactor(60)
_Update_3DMouse(0)
Set Cursor 0,0
Print "Use WASD keys to move around."
Print "Use mouse wheel to move mouse further/closer to the camera."
Print "Left-click & hold an object to pick it up."
Print "Use Left/Right Arrowkeys to rotate a held object."
Print
Print "Framerate:";Screen FPS()
TimeFactor_Sync()
Loop
End
`========================================================================
`=3D MOUSE===============================================================
`========================================================================
`_Update_3DMouse(): Use this function to create and use a 3D mouse.
`GroundHeight: Used to create a relative height-line from terrain. Use 0 (or default ground height) if no terrain.
`Hiding the default mouse pointer (Hide Mouse) is recommended when using the 3D mouse.
Function _Update_3DMouse(GroundHeight as Float)
_Initialize_3DMouse()
CamX#=Camera Position X()
CamY#=Camera Position Y()
CamZ#=Camera Position Z()
Position Object MouseObjects(1),CamX#,CamY#,CamZ#
Set Object To Camera Orientation MouseObjects(1)
Show Object MouseObjects(1)
NoValue=Pick Object(MouseX(),MouseY(),MouseObjects(1),MouseObjects(1))
NewX#=CamX#+Get Pick Vector X()
NewY#=CamY#+Get Pick Vector Y()
NewZ#=CamZ#+Get Pick Vector Z()
Position Object MouseObjects(0),NewX#,NewY#,NewZ#
Point Object MouseObjects(0),CamX#,CamY#,CamZ#
Turn Object Right MouseObjects(0),180
OffGround#=NewY#-GroundHeight
stp=((NewY#>GroundHeight)*2)-1
Lock Pixels
For i#=GroundHeight to NewY# Step stp
Position Object MouseObjects(3),NewX#,i#,NewZ#
x=Object Screen X(MouseObjects(3))
y=Object Screen Y(MouseObjects(3))
Paste Sprite MouseObjects(3),x-3,y-2
Next i
Unlock Pixels
Hide Object MouseObjects(1)
mmz#=MouseMoveZ()
if mmz#
MouseObjectRange(0)=MouseObjectRange(0)+(mmz#*.005)
If MouseObjectRange(0)<2 Then MouseObjectRange(0)=2
_Size_Object(MouseObjects(1),MouseObjectRange(0)*4.0,MouseObjectRange(0)*4.0,MouseObjectRange(0)*2.0)
EndIf
_Mouse_Click()
EndFunction
`========================================================================
`=3D MOUSE INTITIALIZATION===============================================
`========================================================================
`These functions are not intended for external use.
Type MouseLockType
ObjID as DWord
OffX as Float
OffY as Float
OffZ as Float
EndType
Function _Initialize_3DMouse()
Dim MouseObjects(3)
If MouseObjects(0)>0 Then ExitFunction
Dim MouseObjectRange(0) as Float
MouseObjectRange(0)=5.0
Dim MouseLock(0) as MouseLockType
`Make background object
MouseObjects(1)=_Free_Object()
Make Object Sphere MouseObjects(1),10,20,20
Set Object Cull MouseObjects(1),0
Set Object Collision Off MouseObjects(1)
Hide Object MouseObjects(1)
Scale Limb MouseObjects(1),0,200,200,100,1
`Make (or load) mouse object
MouseObjects(0)=_Free_Object()
Make Object Cone MouseObjects(0),.5
TempObj=_Free_Object()
Make Object Cylinder TempObj,.2
Make Mesh From Object 1,TempObj
Delete Object TempObj
Add Limb MouseObjects(0),1,1
Offset Limb MouseObjects(0),1,0,-.3,0
Scale Limb MouseObjects(0),1,100,200,100
Set Object Cull MouseObjects(0),0
Set Object Collision Off MouseObjects(0)
Turn Object Right MouseObjects(0),120
Pitch Object Up MouseObjects(0),45
Fix Object Pivot MouseObjects(0)
Set Object Normals MouseObjects(0)
MouseObjects(2)=_Free_Object()
Make Object Sphere MouseObjects(2),2
Hide Object MouseObjects(2)
Ink RGB(255,255,0),0
For i = 1 to 128 step 4
Line 1,i,128,i
Line i,1,i,128
Next i
Get Image MouseObjects(2),1,1,128,128,1
Texture Object MouseObjects(2),MouseObjects(2)
Ink RGB(255,255,255),0
Set Alpha Mapping On MouseObjects(2),50
Set Object Light MouseObjects(2),0
Set Object Collision Off MouseObjects(2)
Cls
MouseObjects(3)=_Free_Object()
Make Object Triangle MouseObjects(3), 0,0,0, 0,.01,0, 0,0,0
Set Object Collision Off MouseObjects(3)
Hide Object MouseObjects(3)
Cls
Ink RGB(255,0,0),0
Line 1,1,6,1
Get Image MouseObjects(3),1,1,6,2
Sprite MouseObjects(3),-100,0,MouseObjects(3)
Set Sprite MouseObjects(3),0,1
Ink RGB(255,255,255),0
EndFunction
Function _Mouse_Click()
_Initialize_3DMouse()
ObjX#=Object Position X(MouseObjects(0))
ObjY#=Object Position Y(MouseObjects(0))
ObjZ#=Object Position Z(MouseObjects(0))
Position Object MouseObjects(2),ObjX#,ObjY#,ObjZ#
If MouseLock(0).ObjID>0
If MouseClick()=0
MouseLock(0).ObjID=0
Else
x#=MouseLock(0).OffX+ObjX#
y#=MouseLock(0).OffY+ObjY#
z#=MouseLock(0).OffZ+ObjZ#
Position Object MouseLock(0).ObjID,x#,y#,z#
YRotate Object MouseLock(0).ObjID,Object Angle Y(MouseLock(0).ObjID)+((RightKey()-LeftKey())*TimeFactor(60))
ExitFunction
EndIf
EndIf
Set Object Collision On MouseObjects(2)
obj=Object Collision(MouseObjects(2),0)
Set Object Collision Off MouseObjects(2)
If obj = 0
Hide Object MouseObjects(2)
ExitFunction
EndIf
If Object Exist(obj)=0
Hide Object MouseObjects(2)
ExitFunction
EndIf
Show Object MouseObjects(2)
Set Alpha Mapping On MouseObjects(2),40
Turn Object Right MouseObjects(2),1.0*TimeFactor(60)
If MouseClick()=1
MouseLock(0).ObjID=obj
MouseLock(0).OffX=Object Position X(obj)-ObjX#
MouseLock(0).OffY=Object Position Y(obj)-ObjY#
MouseLock(0).OffZ=Object Position Z(obj)-ObjZ#
EndIf
EndFunction
Function _Size_Object(ObjectID as DWord, SizeX as Float, SizeY as Float, SizeZ as Float)
sx#=Object Size X(ObjectID)
sy#=Object Size Y(ObjectID)
sz#=Object Size Z(ObjectID)
scaleX#=(SizeX/sx#)*100.0
scaleY#=(SizeY/sy#)*100.0
scaleZ#=(SizeZ/sz#)*100.0
Scale Object ObjectID,scaleX#,scaleY#,scaleZ#
EndFunction
`========================================================================
`=TimeFactor()===========================================================
`========================================================================
`TimeFactor() functions are used for timer-based movement.
`========================================================================
`
`When calling the TimeFactor() function, pass the target virtual frame rate (FrameRate)
`to achieve (i.e. 60 for 60 FPS, or 30 for 30 FPS). A value of 0 defaults to 60 FPS
`since previous projects use the array variable TimeFactor(0).
`Think of the return value as a percentage; multiply movement, turning, or other timer-based
`factor by the TimeFactor() return value.
Function TimeFactor(FrameRate as Integer)
Dim TimeStamp(0) as Integer
Dim TimeDiff(0) as Double Float
If FrameRate=0 Then FrameRate=60
MS#=1000.0/FrameRate
TF#=TimeDiff(0)/MS#
`If the frame rate is far too slow to support the virtual Frame Rate, the return value needs to be capped.
`Using value of 2.0 maximizes the return value at 200%, or 1/2 target frame rate. For example, if trying to achieve
`a virtual frame rate of 60, but the actual frame rate is less than 30, then this value will cap out at 200%
If TF#>2 then TF#=2
EndFunction TF#
`Call the Update_TimeFactor() once each frame, ideally after the Sync command.
`Do not use this function if using the TimeFactor_Sync() function (in the same loop)
Function Update_TimeFactor()
Dim TimeStamp(0) as Integer
Dim TimeDiff(0) as Double Float
If TimeStamp(0)=0 Then TimeStamp(0)=Timer()-16
TimeDiff(0)=Timer()-TimeStamp(0)
Timestamp(0)=Timer()
Endfunction
`Use this function to include a sync command while updating the TimeFactor values.
`Do not use this function if using the Update_TimeFactor() function (in the same loop)
Function TimeFactor_Sync()
Dim TimeStamp(0) as Integer
Dim TimeDiff(0) as Double Float
Sync
If TimeStamp(0)=0 Then TimeStamp(0)=Timer()-16
TimeDiff(0)=Timer()-TimeStamp(0)
Timestamp(0)=Timer()
Endfunction
`========================================================================
`=FREE OBJECT============================================================
`========================================================================
Function _Free_Object()
i=1000
Repeat
Inc i
Until Object Exist(i)=0
EndFunction i
Open MMORPG: It's your game!