[DBP] 3D Mouse - GameCreators Forum

Author

Message

RiiDii

19

Years of Service

User Offline

Joined: 20th Jan 2005

Location: Inatincan

Posted: 14th Jul 2009 01:55 Edited at: 14th Jul 2009 19:38

Link

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

+ Code Snippet

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!

Back to top

Profile PM Email

HowDo

21

Years of Service

User Offline

Joined: 28th Nov 2002

Location: United Kingdom

Posted: 14th Jul 2009 16:28

Link

RiiDii, that just spoiling us, nice and simple, like it

, add the ground height thingy and its all done for us.

Dark Physics makes any hot drink go cold.

Back to top

Profile PM

RiiDii

19

Years of Service

User Offline

Joined: 20th Jan 2005

Location: Inatincan

Posted: 14th Jul 2009 19:41

Link

Ok. Ground height thingy added (I think that's what you meant). I also added the ability to Y-Rotate an object that has been picked up using the left/right arrowkeys. The camera movement has been changed to WASD to accommodate the new arrowkey functionality.

Wow. This could easily become a sort of 3D environment editor.

Open MMORPG: It's your game!

Back to top

Profile PM Email

Softwizz

14

Years of Service

User Offline

Joined: 14th May 2009

Location: U.K.

Posted: 24th Jul 2009 16:42 Edited at: 24th Jul 2009 16:44

Link

that is awesome, my man, truely awesome indeed

as you say:

Quote: "Wow. This could easily become a sort of 3D environment editor."

I think I will adapt this to load a dbo level so I can place objects in it.
I will need a way of saving the co-ords of each object placed, any ideas on a way to do this?

Nothing to see here, move along please.

Back to top

Profile PM Email

RiiDii

19

Years of Service

User Offline

Joined: 20th Jan 2005

Location: Inatincan

Posted: 24th Jul 2009 20:57

Link

Thanks Softwizz.

Quote: "I will need a way of saving the co-ords of each object placed, any ideas on a way to do this?"

Basically, an array would do the trick. Then save the array.

However, I am working (from the ground up) on an Object-Oriented style library for DBPro. This will include the ability to save object placement data; more than likely the placement data will be with a parent object.

Open MMORPG: It's your game!

Back to top

Profile PM Email

Juso

21

Years of Service

User Offline

Joined: 23rd Sep 2002

Location: Finland

Posted: 28th Jul 2009 12:56

Link

'Move Camera Up 4' doesnt work in DBP 1.06x updates
but 'position camera camera position x(),camera position y()+4,camera position z()' does the very same, I think.

Back to top

Profile PM

RiiDii

19

Years of Service

User Offline

Joined: 20th Jan 2005

Location: Inatincan

Posted: 28th Jul 2009 17:29

Link

Oops. That is probably an IanM Matrix1Utils command. I use those so much, I sometimes forget which commands are native and which are from his utility.

Open MMORPG: It's your game!

Back to top

Profile PM Email

Sorry your browser is not supported!

Code Snippets / [DBP] 3D Mouse