Perfect sample Eros,
here is derived version with some automatic spheres and joints render + black shadow
[code=thinbasic]
' 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( as dBodyID
global mySphereBodyProperties( as tSphereProps
global JointPointBall( as dJointID
global JointPointBallConnections( 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
[/code]
Bye,
Petr
Bookmarks