www.pudn.com > racecar.zip > uPhysics.pas
(*
the original converted buggy.cpp with following changes
support multiple cars
converted to xyz instead of xzy
frame rate indipendant
*)
unit uPhysics;
interface
uses ODEImport, ODEClasses, OpenGL, Windows, Classes, Keyboard;
type
TdxCar =record
Body: array[0..4] of PdxBody; //chassis and wheels
Joint: array[0..3] of TdJointID; //suspension
Box: array[0..0] of PdxGeom; //chassis
Sphere: array[0..3] of PdxGeom; //wheels
Speed: Double; //speed to get to
Steer: Double; //steering angle
v: TdReal;
MotorRunning : boolean;
end;
const
NumCars = 5; //number of cars in simulation
var
Cars: array[0..NumCars-1] of TdxCar;
cLENGTH: Single = 2.95; // chassis length
cWIDTH: Single = 1.6; // chassis width
cHEIGHT: Single = 0.4; // chassis height
cRADIUS: Single = 0.225; // wheel radius
cWWIDTH: Single = 1.0; // wheel width
cSTARTZ: Single = 1.0; // starting height of chassis
cCMASS: Single = 4.0; // chassis mass
cWMASS: Single = 0.15; // wheel mass
cWHEEL_OFFSET: Single = 0.0; // ride height
// Change these two values, and you change the entire suspension of the buggy,
// for a funny rubberband car, try cSUSPENSION_CFM=5...
// LF LR RR RF
cSUSPENSION_ERP: array[0..3] of Double = (0.5, 0.5, 0.5, 0.5);
cSUSPENSION_CFM: array[0..3] of Double = (0.8, 0.8, 0.8, 0.8);
// This sets up friction on the surfaces
cFRICTION: Double = 2.0;
// Try it, it's fun!
cWHEEL_WOBBLE: Double = 0.0;
cGRAVITY: Double = -0.96;
world : PdxWorld;
space : PdxSpace;
BodySpace : PdxSpace;
contactgroup : TdJointGroupID;
ground : PdxGeom;
procedure CreatePhysics;
procedure PhysicsDestroy;
procedure PhysicsStep;
implementation
// this is called by dSpaceCollide when two objects in space are
// potentially colliding.
procedure nearCallback (data : pointer; o1, o2 : PdxGeom); cdecl;
const
cN = 10;
var
i,n : integer;
b1, b2 : PdxBody;
c : TdJointID;
contact : array[0..cN-1] of TdContact;
begin
// exit without doing anything if the two bodies are connected by a joint
b1 := dGeomGetBody(o1);
b2 := dGeomGetBody(o2);
if (assigned(b1) and assigned(b2) and (dAreConnected (b1,b2)<>0)) then
exit;
n := dCollide (o1,o2,cN,contact[0].geom,sizeof(TdContact));
if (n > 0) then
begin
for i := 0 to n-1 do
begin
contact[i].surface.mode :=
ord(dContactSlip1) or ord(dContactSlip2) or
ord(dContactSoftERP) or ord(dContactSoftCFM);
contact[i].surface.mu := cFRICTION; //dInfinity;
contact[i].surface.slip1 := 0.1;
contact[i].surface.slip2 := 0.1;
contact[i].surface.soft_erp := 0.5;
contact[i].surface.soft_cfm := 0.3;
c := dJointCreateContact (world,contactgroup,contact[i]);
dJointAttach (c,
dGeomGetBody(contact[i].geom.g1),
dGeomGetBody(contact[i].geom.g2));
end;
end;
end;
procedure CreatePhysics;
var
i : integer;
m : TdMass;
q : TdQuaternion;
a : PdVector3;
procedure CreateBody(Index: Integer);
var
i : integer;
begin
with Cars[Index] do
Begin
// chassis body
Body[0] := dBodyCreate (World);
dBodySetPosition (Body[0], 0, cSTARTZ+cWHEEL_OFFSET, Index*4.5);
dMassSetBox (M, 1, cWIDTH, cHEIGHT, cLENGTH);
dMassAdjust (M, cCMASS);
dBodySetMass (Body[0], M);
Box[0] := dCreateBox (nil, cWIDTH, cHEIGHT, cLENGTH);
dGeomSetBody (Box[0], Body[0]);
// wheel bodies
for i := 1 to 4 do
begin
Body[i] := dBodyCreate (World);
dQFromAxisAndAngle (Q, 1, 0, 0, PI*0.5);
dBodySetQuaternion (Body[i], Q);
dMassSetSphere (M, cWWIDTH, cRADIUS);
dMassAdjust (M, cWMASS);
dBodySetMass (Body[i], M);
Sphere[i-1] := dCreateSphere (nil, cRADIUS);
dBodySetFiniteRotationMode (Body[i], 1);
dGeomSetBody (Sphere[i-1], Body[i]);
end;
dBodySetPosition (Body[1], 0.70, cSTARTZ -0.23, 1.14+(Index*4.5)); // FL
dBodySetPosition (Body[2], -0.71, cSTARTZ -0.23, 1.14+(Index*4.5)); // FR
dBodySetPosition (Body[3], 0.70, cSTARTZ -0.23, -1.81+(Index*4.5)); // RL
dBodySetPosition (Body[4], -0.72, cSTARTZ -0.23, -1.81+(Index*4.5)); // RR
// front and back wheel hinges
for i := 0 to 3 do
begin
Joint[i] := dJointCreateHinge2 (World, 0);
dJointAttach (Joint[i], Body[0], Body[i+1]);
A := dBodyGetPosition (Body[i+1]);
dJointSetHinge2Anchor (Joint[i], A[0], A[1], A[2]);
dJointSetHinge2Axis1 (Joint[i], 0, 1, 0);
dJointSetHinge2Axis2 (Joint[i], 1, 0, 0);
end;
// set joint suspension
for i := 0 to 3 do
begin
dJointSetHingeParam (Joint[i], dParamSuspensionERP, cSUSPENSION_ERP[i]);
dJointSetHingeParam (Joint[i], dParamSuspensionCFM, cSUSPENSION_CFM[i]);
end;
// lock back wheels along the steering axis
for i := 0 to 3 do
begin
// set stops to make sure wheels always stay in alignment
dJointSetHinge2Param (Joint[i], dParamLoStop, 0);//-cWHEEL_WOBBLE);
dJointSetHinge2Param (Joint[i], dParamHiStop, 0);//+cWHEEL_WOBBLE);
end;
BodySpace := dSimpleSpaceCreate(Space);
dSpaceSetCleanup(BodySpace, 0);
dSpaceAdd(BodySpace, Box[0]);
dSpaceAdd(BodySpace, Sphere[0]);
dSpaceAdd(BodySpace, Sphere[1]);
dSpaceAdd(BodySpace, Sphere[2]);
dSpaceAdd(BodySpace, Sphere[3]);
end;
end;
begin
// create world
world := dWorldCreate();
space := dHashSpaceCreate(nil);
contactgroup := dJointGroupCreate (0);
dWorldSetGravity (world,0, cGRAVITY, 0); //make gravity pull down on y
ground := dCreatePlane (space,0,1,0,0); //make a ground at y
for i:=0 to NumCars -1 do
CreateBody(i);
end;
procedure PhysicsDestroy;
var
i: Byte;
begin
dJointGroupDestroy (contactgroup);
dSpaceDestroy (space);
dWorldDestroy (world);
for i:=0 to NumCars -1 do //loop thru the cars and kill the bodies
with Cars[i] do
Begin
dGeomDestroy (box[0]);
dGeomDestroy (sphere[0]);
dGeomDestroy (sphere[1]);
dGeomDestroy (sphere[2]);
dGeomDestroy (sphere[3]);
end;
dCloseODE;
end;
procedure PhysicsStep;
const
cACCEL = 10.3;// / 5;
// cDCCEL = 0.3 / 5;
cTURN_SPEED = 0.5 / 10;
var
i: Integer;
Begin
for i:=0 to 0{NumCars -1} do //only control 1 car atm
with Cars[i] do
Begin
if IsKeyDown(VK_RIGHT) then
steer := steer + cTURN_SPEED
else
if IsKeyDown(VK_LEFT) then
steer := steer - cTURN_SPEED
else
Steer := Steer * 0.95;
MotorRunning := true;
if IsKeyDown(VK_UP) then
begin
speed := speed + cACCEL
end
else
if IsKeyDown(VK_DOWN) then
begin
speed := speed - cACCEL
end
else
begin
MotorRunning := false;
Speed := Speed * 0.008; // 1.00 - physics sleep
end;
(*
if IsKeyDown(' ') then
begin
// HANDBRAKE!
dJointSetHinge2Param (joint[1],dParamVel2,0);
dJointSetHinge2Param (joint[1],dParamFMax2,0.30);//}
dJointSetHinge2Param (joint[2],dParamVel2,0);
dJointSetHinge2Param (joint[2],dParamFMax2,0.30);//}
end else
begin
// Not handbraking
dJointSetHinge2Param (joint[1],dParamFMax2,0.0);
dJointSetHinge2Param (joint[2],dParamFMax2,0.0);//}
end; *)
if IsKeyDown('x') then
begin
dBodyAddForce(Body[2], 0, -(cGRAVITY * cCMASS) /2.5, 0);
dBodyAddForce(Body[4], 0, -(cGRAVITY * cCMASS) /2.5, 0);
//dBodyAddForce(body[4], 0, 0.255 * cCMASS, 0);
//dBodyAddForce(body[1], 0, 0.255 * cCMASS, 0);
end;
if Steer>0.75 then
Steer := 0.75;
if Steer<-0.75 then
Steer := -0.75;
if Speed>20 then
Speed := 20;
if Speed<-20 then
Speed := -20;
if MotorRunning then
begin
// motor
//dJointSetHinge2Param (joint[0],dParamVel2,-speed);
//dJointSetHinge2Param (joint[0],dParamFMax2,0.2);
//if not IsKeyDown(' ') then
Begin
// Uncomment for three wheel drive!
dJointSetHinge2Param (joint[2],dParamVel2,-speed);
dJointSetHinge2Param (joint[2],dParamFMax2,0.4);
dJointSetHinge2Param (joint[3],dParamVel2,-speed);
dJointSetHinge2Param (joint[3],dParamFMax2,0.4);
end;
//dJointSetHinge2Param (joint[1],dParamVel2,-speed);
//dJointSetHinge2Param (joint[1],dParamFMax2,0.2);
end else
begin
// the clutch is in! (not accel or breaking)
dJointSetHinge2Param (joint[0],dParamVel2,-speed);
dJointSetHinge2Param (joint[0],dParamFMax2,0.02);
//if not IsKeyDown(' ') then
Begin
// Uncomment for three wheel drive!
dJointSetHinge2Param (joint[1],dParamVel2,-speed);
dJointSetHinge2Param (joint[1],dParamFMax2,0.02);
dJointSetHinge2Param (joint[2],dParamVel2,-speed);
dJointSetHinge2Param (joint[2],dParamFMax2,0.02);
end;
dJointSetHinge2Param (joint[3],dParamVel2,-speed);
dJointSetHinge2Param (joint[3],dParamFMax2,0.02);
end;
// optional wind
//dBodyAddForce(body[1], TrackBar1.Position /100, TrackBar2.Position /100, 0);
// steering
v := steer - dJointGetHinge2Angle1 (joint[0]);
if (v > 0.1) then
v := 0.1;
if (v < -0.1) then
v := -0.1;
v := v * 10.0;
dJointSetHinge2Param (joint[0],dParamVel,v);
dJointSetHinge2Param (joint[0],dParamFMax,0.2);
dJointSetHinge2Param (joint[0],dParamLoStop,-0.75);
dJointSetHinge2Param (joint[0],dParamHiStop,0.75);
dJointSetHinge2Param (joint[0],dParamFudgeFactor,0.1);
// steering
v := steer - dJointGetHinge2Angle1 (joint[1]);
if (v > 0.1) then
v := 0.1;
if (v < -0.1) then
v := -0.1;
v := v * 10.0;
dJointSetHinge2Param (joint[1],dParamVel,v);
dJointSetHinge2Param (joint[1],dParamFMax,0.2);
dJointSetHinge2Param (joint[1],dParamLoStop,-0.75);
dJointSetHinge2Param (joint[1],dParamHiStop,0.75);
dJointSetHinge2Param (joint[1],dParamFudgeFactor,0.1);
end;
//we must check for collisions before steping the physics world
dSpaceCollide (space, nil, nearCallback);
dWorldStep (world, 0.05);
// remove all contact joints
dJointGroupEmpty (contactgroup);
end;
end.