#0 

26-01-2007 12:48:48

BMarleyFR
Membre
Date d'inscription: 30-11-2006
Messages: 59

Inspiré par l'exemple de Copland d'Irrlicht et d'Ode, et également définitivement rebuté par Newton, j'ai donc repris sa routine en C++ pour en faire un clone en FreeBasic. Et ca marche au poil wink



Tout d'abord les outils :
-------------------------

- Impérativement! Avoir la mise à jour 0.17 du compilateur FreeBasic dispo ici :
http://freebasic.eu/cvs/FREEBASICCVS.zip

- La dll d'Irrlicht 1.2 version GCC et DirectX dispo sur Irrlicht.fr
http://irrlichtfr.free.fr/libs/irrlicht1.2-gcc.zip


- Et pour finir, les includes d'ode 0.7 pour FreeBasic ainsi que ca librairie dispo ici :
http://freebasic.eu/libs/fbode.zip




Maintenant le code :
---------------------

Code:

'Include FreeBasic
#include "IrrlichtWrapper1.04.bi"
#include "fbode.bi"




'Parramètre de notre physique
dim shared world as dWorldID
dim shared spaces as dSpaceID
dim shared contactgroup as dJointGroupID
dim shared mass as dMass
dim shared geom as dGeomID
world = dWorldCreate()
spaces = dHashSpaceCreate (0)
contactgroup = dJointGroupCreate (0)





'Creation du Device
IrrStartEx (5,640, 480, 0, IRR_NO_SHADOWS, IRR_CAPTURE_EVENTS, 32, 0, 0, 1, 0)




'Creation de la camera
dim myCAMERA as irr_camera
myCAMERA=IrrAddCamera(30,40,-82,0,3,0)




'On met une petite lumiere pour rendre le tout plus joli
dim myLIGHT as irr_node
myLIGHT=IrrAddLight(0,500,0,255,255,255,2)



'Creation du mesh 3D de la sphere
Dim mySPHERE as irr_node
mySPHERE=IrrAddSphereSceneNode(5,32)
IrrSetNodePosition(mySPHERE,0,50,-55)
IrrSetNodeMaterialFlag(mySPHERE,IRR_EMF_LIGHTING,1)
IrrSetNodeMaterialTexture( mySPHERE, IrrGetTexture( "medias/ball.jpg" ), 0 )



'Creation d'un plan 3D physique
dCreatePlane (spaces,0,1,0,0)




'Initialisation des Body et Geom physique
Dim Body(83) as dBodyID
Dim Box(81) as dGeomID
Dim Sphere as dGeomID



'Creation du body physique de la sphere
Body(82) = dBodyCreate (world)
dMassSetSphereTotal(@mass,6, 5)
dBodySetMass(Body(82),@mass)
dBodySetPosition(Body(82),0,20,-55)



'Creation de la géométrie physique de la sphere
Sphere = dCreateSphere(spaces, 7)
dGeomSetBody(Sphere,Body(82))




'On va parramétrer la physique en même temps que la création de tout les cubes
Dim NbsCubeSceneNode as integer
Dim CubeSceneNode(81) as irr_node
dim y as single
dim x as single

    for y=0 to 40 step 5
    
        for x=-40+y to 40-y step 5
        
        
            'Creation des meshs des cubes
            CubeSceneNode(NbsCubeSceneNode) = IrrAddCubeSceneNode(5)
            IrrSetNodePosition(CubeSceneNode(NbsCubeSceneNode),x,y+2.5,0)
            IrrSetNodeMaterialFlag(CubeSceneNode(NbsCubeSceneNode),IRR_EMF_LIGHTING,1)
            IrrSetNodeMaterialTexture( CubeSceneNode(NbsCubeSceneNode), IrrGetTexture( "medias/cube.jpg" ), 0 )
          
            'Creation du Body physique des cubes
            Body(NbsCubeSceneNode) = dBodyCreate(world)
            dMassSetBoxTotal(@mass,5,5,5,5)
            dBodySetPosition(Body(NbsCubeSceneNode),x,y+2.5,0)
            dBodySetAutoDisableFlag(Body(NbsCubeSceneNode),1)
            dBodyDisable(Body(NbsCubeSceneNode))
            dBodySetAutoDisableLinearThreshold(Body(NbsCubeSceneNode),0.2)
            dBodySetAutoDisableAngularThreshold(Body(NbsCubeSceneNode),0.2)

            'Creation de la géométrie physique des cubes
            Box(NbsCubeSceneNode) = dCreateBox(spaces,5,5,5)
            dGeomSetBody(Box(NbsCubeSceneNode),Body(NbsCubeSceneNode))

            'Incrémentation de la variable NbsCubeSceneNode
            NbsCubeSceneNode+=1
          
   next
    next
    
    
    
    
    
    
'On creer un mesh cubique qu'on applatira par le scale pour le sol
Dim SolSceneNode as irr_node
SolSceneNode = IrrAddCubeSceneNode(10000)
IrrSetNodeMaterialFlag(SolSceneNode,IRR_EMF_LIGHTING,1)
IrrSetNodeMaterialTexture( SolSceneNode, IrrGetTexture( "medias/sol.jpg" ), 0 )
IrrSetNodeScale(SolSceneNode,1,0.000001,1)




'On ajoute un boutton pour expulser notre boule
Dim Boutton_Fire as irr_gui
Boutton_Fire=IrrGuiAddButton("Fire!",10,10,120,35,0,-1)

'Puis un boutton pour quitter
Dim Boutton_Exit as irr_gui
Boutton_Exit=IrrGuiAddButton("Exit",10,40,120,65,0,-1)




'On parramètre la gravité de la physique et le nombre de 
'frame qu'elle va saute pour les calculs
dWorldSetGravity (world,0,-7,0)







'Le fameux callBack de calcul pour la physique (merci Copland :-P )
'*******************************************************************************
sub nearCallback cdecl (datas as any ptr, o1 as dGeomID, o2 as dGeomID)
                             

  assert(o1)
  assert(o2)
  
const Nn = 32
  dim  contact(Nn) as dContact
  dim  n as integer
dim  c as dJointID


 if dGeomIsSpace(o1) or dGeomIsSpace(o2) then

    'Y'a-t-il une collision dans l'espace
    dSpaceCollide2(o1,o2,datas,@nearCallback)
    return

endif

  

  n = dCollide (o1,o2,Nn,@(contact(0).geom),sizeof(dContact))


  if (n > 0) then
    dim yy as integer
   for yy=0 to n-1
    
     contact(yy).surface.slip1 = 0.7
     contact(yy).surface.slip2 = 0.7
     contact(yy).surface.mode = dContactSoftERP or dContactSoftCFM or dContactApprox1 or dContactSlip1 or dContactSlip2
     contact(yy).surface.mu = dInfinity
     contact(yy).surface.soft_erp = 0.97
     contact(yy).surface.soft_cfm = 0.2
     
     c = dJointCreateContact (world,contactgroup,@contact(yy))
   dJointAttach (c,dGeomGetBody(contact(yy).geom.g1),dGeomGetBody(contact(yy).geom.g2))
   next
  endif
end sub
'*******************************************************************************





'La mise à jour de la physique se fait aussi par la mise à jour des objets
'*******************************************************************************
Sub updateEntitiesAfterPhysics(node as irr_node, geom as dGeomID)

'Ici on met à jour la position
dim Vect3Dpos as IRR_VECTOR
Vect3Dpos.X=dGeomGetPosition(geom)[0]
Vect3Dpos.Y=dGeomGetPosition(geom)[1]
Vect3Dpos.Z=dGeomGetPosition(geom)[2]
IrrSetNodePosition(node,Vect3Dpos.X,Vect3Dpos.Y,Vect3Dpos.Z)



'On recupere les Quaternions D'Ode
dim QuatW as single
dim QuatX as single
dim QuatY as single
dim QuatZ as single
QuatW=dGeomGetRotation(geom)[0]
QuatX=dGeomGetRotation(geom)[1]
QuatY=dGeomGetRotation(geom)[2]
QuatZ=dGeomGetRotation(geom)[3]

'On bascule notre quaternion en vecteur d'angle euler
dim RotX as single
dim RotY as single
dim RotZ as single
RotX = atan2((2*(QuatY*QuatW))-(2*(QuatX*QuatZ)) , 1 - ((2*(QuatY*QuatY)) - (2*(QuatZ*QuatZ))))
RotY = asin((2*(QuatX*QuatY)) + (2*(QuatZ*QuatW))) 
RotZ = atan2((2*(QuatX*QuatW))-(2*(QuatY*QuatZ)) , 1 - ((2*(QuatX*QuatX)) - (2*(QuatZ*QuatZ))))

'On passe les radians en degres
RotX = (RotX / (4 * ATN ( 1 ))) * 180
RotY = (RotY / (4 * ATN ( 1 ))) * 180
RotZ = (RotZ / (4 * ATN ( 1 ))) * 180

'Et on met à jour la rotation
IrrSetNodeRotation(node,RotX,RotY,RotZ)



end sub
'*******************************************************************************















'Boucle principale
'*******************************************************************************
WHILE IrrRunning






    
  
    
    
'On récupère le FPS dans la variable fps
dim fps as integer
fps = IrrGetFPS
if fps=0 Then 
IrrSetWindowCaption("FPS Initialisation - Wait please...")
else
IrrSetWindowCaption("Irrlicht Engine with ODE [" & fps & " FPS] - FreeBasic translation by BMarley(MICRO-Break)")
endif
    
    
'Calcul de notre physique
dSpaceCollide (spaces, 0, @nearCallback)
if fps=0 then dWorldStepFast1(world,1/5000000,1) Else dWorldStepFast1(world,1/fps*2,1)
dJointGroupEmpty(contactgroup)


'On met à jour la boule en position + rotation grace à notre physique
updateEntitiesAfterPhysics(mySPHERE,Sphere)


'On met à jour les cubes en position + rotation grace à notre physique
Dim increm_cubeA as integer
for increm_cubeA=0 to 80
updateEntitiesAfterPhysics(CubeSceneNode(increm_cubeA),Box(increm_cubeA))
next






'début des calculs d'irrlicht
IrrBeginScene( 158, 204, 226)


'On test si les bouttons de la gui sont appuyé
If IrrGuiButtonIsPressed(Boutton_Fire)=1 then
dBodyAddForce(Body(82),0,600,2000)
ElseIf IrrGuiButtonIsPressed(Boutton_Exit)=1 then
end
endif






'On dessine tout
IrrDrawScene

'On dessine le gui
IrrDrawGUI


'Fin des calculs d'irrlicht
IrrEndscene
     
     




WEND 
'*******************************************************************************








'On supprime le device d'irrlicht
IrrStop


'On supprime les groupes de joints de Ode
dJointGroupEmpty (contactgroup)
dJointGroupDestroy (contactgroup)


'On supprime la géométrie de la sphère
dGeomDestroy (Sphere)


'On supprime les géométries des cubes
dim increm_cubeB as integer
For increm_cubeB=0 to 80
dGeomDestroy(Box(increm_cubeB))
Next


'On détruit l'espace d'ode
dSpaceDestroy (spaces)


'On détruit le monde d'ode
dWorldDestroy (world)

end

Voila!


L'ensemble complet à cette adresse (EDIT : lien mis à jour) :
http://microbreak.servehttp.com/DEMO_ODE.rar

Dernière modification par BMarleyFR (05-12-2007 23:29:22)


Amstrad CPC6128 - RAM 128Ko - Lecteur disquettes double faces - Moniteur 256 couleurs ...  :-P

Hors ligne


#1 

21-10-2007 11:22:58

Copland
Modérateur
Lieu: ZarbiLand
Date d'inscription: 22-09-2006
Messages: 657
Site web

1 an plus tard je me réveille.... J'avais pas vu se code, merci beaucoup de partager pour les freebasiciens wink.


Config : I5 2400, ATI HD6870 1Go DDR5, 4Go DDR3.
Single Boot : Windows Seven.

Hors ligne


Options Liens officiels Caractéristiques Statistiques Communauté
Corrections
irrlicht
irrklang
irredit
irrxml
xhtml 1.0
css 2.1
Propulsé par FluxBB
Traduit par FluxBB.fr
883 membres
1429 sujets
11121 messages
Dernier membre inscrit: Saidov17
84 invités en ligne
Aucun membre connecté
RSS Feed