ODE Sample #02.02

[ErosOlmi]

Same as ODE Sample #02.01 example (http://community.thinbasic.com/index.php?topic=1106.0) but one body will increase mass every 1000 loops up to 5 times its original mass.



' ODE02B - Connecting bodies with joints - more complex variant

uses "TBGL"

#include "%APP_INCLUDEPATH%/thinbasic_ode.inc"

' -- This will create window
dim hWnd as dword = tbgl_CreateWindowEx("ODE 02 - Bodies and joints - Hanged triangle", 640, 480, 32, 0)
tbgl_ShowWindow
tbgl_UseLighting 1
tbgl_UseLightsource %GL_LIGHT0, 1
' -- Yes, to create new world is that easy
dim myWorld as dWorldID = dWorldCreate

' -- Planet Earth
dWorldSetGravity(myWorld, 0, -9.81, 0)

' -- We need two bodies...
dim myBody1 as dBodyID = dBodyCreate( myWorld )
dim myBody2 as dBodyID = dBodyCreate( myWorld )
dim myBody3 as dBodyID = dBodyCreate( myWorld )
dim myBody4 as dBodyID = dBodyCreate( myWorld )
dim myBody5 as dBodyID = dBodyCreate( myWorld )

' -- Mass will be "recycled" for both of them
' -- Here we will store mass
dim myMass AS dMass
dim myMass2 AS dMass

' -- Although it might seem like something else, we give DENSITY and RADIUS
dMassSetSphere( myMass, 2500.0, 0.05 )
dMassSetSphere( myMass2, 2500.0, 0.05 )

' -- Assign mass to body
dBodySetMass( myBody1, myMass )
' -- Lets position mass at x, y, z
dBodySetPosition( myBody1, 1, 2, 0 )

' -- Assign mass to body
dBodySetMass( myBody2, myMass )
' -- Lets position mass at x, y, z
dBodySetPosition( myBody2, 1, 2, 1 )

' -- Assign mass to body
dBodySetMass( myBody3, myMass )
' -- Lets position mass at x, y, z
dBodySetPosition( myBody3, 0, 2, 1 )

' -- Assign mass to body
dBodySetMass( myBody4, myMass )
' -- Lets position mass at x, y, z
dBodySetPosition( myBody4, 1, 2, 2 )

' -- Assign mass to body
'msgbox 0, "---------------------------------------------------------------"
dBodySetMass( myBody5, myMass2 )
' -- Lets position mass at x, y, z
dBodySetPosition( myBody5, 0, 2, 2 )

dim JointPoint1 as dJointID = dJointCreateBall( myWorld, 0 )
dim JointPoint2 as dJointID = dJointCreateBall( myWorld, 0 )
dim JointPoint3 as dJointID = dJointCreateBall( myWorld, 0 )
dim JointPoint4 as dJointID = dJointCreateBall( myWorld, 0 )
dim JointPoint5 as dJointID = dJointCreateBall( myWorld, 0 )
dim JointPoint6 as dJointID = dJointCreateBall( myWorld, 0 )

dJointAttach( JointPoint1, myBody1, 0 )
dJointSetBallAnchor( JointPoint1, 0, 2, 0 )

dJointAttach( JointPoint2, myBody1, myBody2 )
dJointSetBallAnchor( JointPoint2, 1, 2, 0 )

dJointAttach( JointPoint3, myBody2, myBody3 )
dJointSetBallAnchor( JointPoint3, 1, 2, 1 )

dJointAttach( JointPoint4, myBody1, myBody3 )
dJointSetBallAnchor( JointPoint4, 1, 2, 0 )

dJointAttach( JointPoint5, myBody2, myBody4 )
dJointSetBallAnchor( JointPoint5, 1, 2, 1 )

dJointAttach( JointPoint6, myBody3, myBody5 )
dJointSetBallAnchor( JointPoint6, 0, 2, 1 )


dim FPS, dt as double
dim m as single
dim LoopFlag as BYTE = %TRUE
dim Clk as long = gettickcount

tbgl_BackColor 255, 255, 255

type t_xyz
x as dReal
y as dReal
z as dReal
end type

dim xyz0 as t_xyz
xyz0.x = 0.0
xyz0.y = 2.0
xyz0.z = 0.0

dim xyz1 as t_xyz at dBodyGetPosition ( myBody1 )
dim xyz2 as t_xyz at dBodyGetPosition ( myBody2 )
dim xyz3 as t_xyz at dBodyGetPosition ( myBody3 )
dim xyz4 as t_xyz at dBodyGetPosition ( myBody4 )
dim xyz5 as t_xyz at dBodyGetPosition ( myBody5 )

dim Body5Diam as single

tbgl_GetAsyncKeyState(-1)

doevents on
dim i as long

While LoopFlag

FPS = tbgl_getFrameRate

if tbgl_GetWindowKeyState( hWnd, %VK_ESCAPE ) then loopFlag = %FALSE

tbgl_ClearFrame

tbgl_Camera 0, 0, 5, 0, 0, 0
Render_Scene

tbgl_translate 0, -1, 0
tbgl_scale 1, 0, 1
Render_Scene

tbgl_DrawFrame

dt = 1/FPS
if FPS < 25 then dt = 0.04
incr i
if i > 1000 then
i = 0

if m < 5 then
incr m
dMassSetSphere( myMass2, 2500 * m, 0.05 * m)
Body5Diam = 0.05 * m
dBodySetMass( myBody5, myMass2 )
end if

tbgl_SetWindowTitle( hWnd, FPS & " - " & time$ & " - " & m)

end if

dWorldStep( myWorld, dt )


wend

tbgl_DestroyWindow

sub Render_Scene()
DrawSphere( xyz1 )

DrawLine2( xyz0, xyz1 )

DrawLine2( xyz1, xyz2 )

DrawSphere( xyz2 )

DrawLine2( xyz2, xyz3 )

DrawSphere( xyz3 )

DrawLine2( xyz1, xyz3 )

DrawSphere( xyz4 )

DrawLine2( xyz2, xyz4 )

DrawSphere( xyz5 , Body5Diam)
DrawLine2( xyz3, xyz5 )

end sub

sub DrawSphere( xyz as t_xyz , optional Diam as single)
tbgl_PushMatrix
tbgl_Translate xyz.x, xyz.y, xyz.z

tbgl_color 255, 0, 0
if Diam = 0 then Diam = 0.05
tbgl_Sphere diam

tbgl_PopMatrix
end sub

sub DrawLine2( P1 as t_xyz, P2 as t_xyz)
tbgl_color 0, 255, 0
tbgl_BeginPoly %GL_LINES
tbgl_Vertex P1.x, P1.y, P1.z
tbgl_Vertex P2.x, P2.y, P2.z
tbgl_EndPoly
end sub

[Petr Schreiber]

Perfect sample Eros,

here is derived version with some automatic spheres and joints render + black shadow :)


' ODE02.02B - Connecting bodies with joints - more complex variant with some wrappers
' With black shadows

uses "TBGL"

#include "%APP_INCLUDEPATH%/thinbasic_ode.inc"

' -- This will create window
dim hWnd as dword = tbgl_CreateWindowEx("ODE 02 - Bodies and joints - Hanged triangle", 640, 480, 32, 0)
tbgl_ShowWindow

' -- Yes, to create new world is that easy
dim myWorld as dWorldID = dWorldCreate

' -- Planet Earth
dWorldSetGravity(myWorld, 0, -9.81, 0)

' -- We need some bodies...
Init_SphereBodies()

' -- Procedure returns unique ID
%SPH_UPPER = SphereBody_Create( 2500, 0.05, 0, 0, 0 )
%SPH_LOWERLEFT = SphereBody_Create( 2500, 0.05, 1, -1, 0 )
%SPH_LOWERRIGHT = SphereBody_Create( 2500, 0.05,-1, -1, 0 )
%SPH_LOWESTLEFT = SphereBody_Create( 2500, 0.05, 1, -1, 1 )
%SPH_LOWESTRIGHT = SphereBody_Create( 2500, 0.05,-1, -1, 1 )

' -- First parameter is presumed joint point
SphereBody_JointBall_With( %SPH_UPPER , 0 )
SphereBody_JointBall_With( %SPH_UPPER , %SPH_LOWERLEFT )
SphereBody_JointBall_With( %SPH_LOWERLEFT , %SPH_LOWERRIGHT )
SphereBody_JointBall_With( %SPH_LOWERRIGHT , %SPH_UPPER )
SphereBody_JointBall_With( %SPH_LOWESTLEFT , %SPH_LOWERLEFT )
SphereBody_JointBall_With( %SPH_LOWESTRIGHT, %SPH_LOWERRIGHT )

dim FPS, dt as double
dim m as single = 0.1

dim Body5Diam as single

doevents on

dim i as long

dim WantColors as byte
dim WantSimulate as byte = 1

' -- Some GL setup
tbgl_BackColor 255, 255, 255
tbgl_LineWidth 3
tbgl_UseLighting 1
tbgl_UseLightsource %GL_LIGHT0, 1

tbgl_GetAsyncKeyState(-1)

While tbgl_IsWindow(hWnd)

FPS = tbgl_getFrameRate

if tbgl_GetWindowKeyState( hWnd, %VK_ESCAPE ) then Exit while

' -- Pause simulation
if tbgl_GetWindowKeyonce( hWnd, %VK_SPACE ) then WantSimulate = WantSimulate xor 1

tbgl_ClearFrame

tbgl_Camera 5, 5, 5, 0, 0, 0
Render_Scene( -4 )


tbgl_DrawFrame

incr i
if i > 1000 then
i = 0
tbgl_SetWindowTitle( hWnd, "Frames per second:" & FPS & " - " & time$ & " - Mass of bigger leg: " & m)
end if

if WantSimulate then
dt = 1/FPS
if FPS < 25 then dt = 0.04

if m < 5 then
m += 0.2/FPS
Body5Diam = 0.05 * m
SphereBody_SetDensityAndRadius( %SPH_LOWESTRIGHT, 2500 * m, Body5Diam )

end if

dWorldStep( myWorld, dt )
end if

wend

tbgl_DestroyWindow

' --------------------------------------------
' -- Auxiliary procedures, end of main code --
' --------------------------------------------

sub Render_Scene( YOfPlaneOfShadows as single )
WantColors = 255
SphereBody_RenderAll
SphereBody_RenderConnectionAll

tbgl_translate 0, YOfPlaneOfShadows, 0
tbgl_scale 1, 0, 1
WantColors = 0
SphereBody_RenderAll
SphereBody_RenderConnectionAll

end sub

sub Init_SphereBodies()
type t_xyz
x as dReal
y as dReal
z as dReal
end type

type t_joins
id1 as long
id2 as long
end type

type tSphereProps
radius as single
density as single
end type

global mySphereBody(8) as dBodyID
global mySphereBodyProperties(8) as tSphereProps
global JointPointBall(8) as dJointID
global JointPointBallConnections(8) as t_joins
global mySphereBodyNum as long
global mySphereBodyPropsNum as long
global JointPointBallNum as long
end sub

function SphereBody_Create( density as single, radius as single, posX as single, posY as single, posZ as single ) as long

local mass as dMass

incr mySphereBodyNum
if mySphereBodyNum > ubound(mySphereBody) then redim preserve mySphereBody(mySphereBodyNum+7)
if mySphereBodyPropsNum > ubound(mySphereBodyProperties) then redim preserve mySphereBodyProperties(mySphereBodyPropsNum+7)
mySphereBody(mySphereBodyNum) = dBodyCreate( myWorld )

dMassSetSphere( mass, density, radius )
dBodySetMass( mySphereBody(mySphereBodyNum), mass )
dBodySetPosition( mySphereBody(mySphereBodyNum), posX, posY, posZ )

mySphereBodyProperties(mySphereBodyNum).radius = radius
mySphereBodyProperties(mySphereBodyNum).density = density
function = mySphereBodyNum

end function

sub SphereBody_SetDensityAndRadius( sphereBodyID as dword, density as single, radius as single )

local mass as dMass
dMassSetSphere( mass, density, radius )
dBodySetMass( mySphereBody(sphereBodyID), mass )

mySphereBodyProperties(mySphereBodyNum).radius = radius
mySphereBodyProperties(mySphereBodyNum).density = density


end sub

sub SphereBody_JointBall_With( sphereBodyID1 as dword, sphereBodyID2 as dword )


swap sphereBodyID1, sphereBodyID2
if sphereBodyID1 = 0 then
dim xyz as t_xyz

else
dim xyz as t_xyz at dBodyGetPosition ( mySphereBody(sphereBodyID1) )
end if

incr JointPointBallNum
if JointPointBallNum > ubound(JointPointBall) then
redim preserve JointPointBall(JointPointBallNum+7)
redim preserve JointPointBallConnections(JointPointBallNum+7)
end if

JointPointBall(JointPointBallNum) = dJointCreateBall( myWorld, 0 )

dJointAttach( JointPointBall(JointPointBallNum), iif(sphereBodyID1 <> 0, mySphereBody(sphereBodyID1), 0), iif(sphereBodyID2 <> 0, mySphereBody(sphereBodyID2), 0) )
dJointSetBallAnchor( JointPointBall(JointPointBallNum), xyz.x, xyz.y, xyz.z )

JointPointBallConnections(JointPointBallNum).id1 = sphereBodyID1
JointPointBallConnections(JointPointBallNum).id2 = sphereBodyID2

end sub

sub SphereBody_RenderAll()
local i as long

for i = 1 to mySphereBodyNum
SphereBody_Render(i)
next

end sub

sub SphereBody_Render( sphereBodyID as dword )

dim xyz as t_xyz at dBodyGetPosition ( mySphereBody(sphereBodyID) )

tbgl_PushMatrix
tbgl_Translate xyz.x, xyz.y, xyz.z

tbgl_color WantColors, 0, 0
tbgl_Sphere mySphereBodyProperties(sphereBodyID).radius

tbgl_PopMatrix

end sub

sub SphereBody_RenderConnectionAll()
local i as long

for i = 1 to JointPointBallNum
SphereBody_RenderConnection(i)
next

end sub

sub SphereBody_RenderConnection( nConnection as long )

if JointPointBallConnections(nConnection).id1 = 0 then
dim p1 as t_xyz
else
dim p1 as t_xyz at dBodyGetPosition ( mySphereBody(JointPointBallConnections(nConnection).id1) )
end if

if JointPointBallConnections(nConnection).id2 = 0 then
dim p2 as t_xyz
else
dim p2 as t_xyz at dBodyGetPosition ( mySphereBody(JointPointBallConnections(nConnection).id2) )
end if

tbgl_UseLighting 0
tbgl_color 0, WantColors/2, 0
tbgl_BeginPoly %GL_LINES
tbgl_Vertex P1.x, P1.y, P1.z
tbgl_Vertex P2.x, P2.y, P2.z
tbgl_EndPoly
tbgl_UseLighting 1

end sub


Bye,
Petr

[ErosOlmi]

Wow, Petr, it is very easy to play with objects now.
A big fun looking at forces and masses interactions :D

Maybe this can be the basis for specific SDK or module. A more advanced set of high level functionalities to be used, for example, at school and in some class experiments. This open really a new set of possibilities.

Friction is missing but for this I need to develop more complex UDT handling :-[ Guilty is still my side in this case!!

Thanks a lot
Eros