Using Prismatic Joints

We chose an easy way to get started by saving the code of UfrmMain in the example on the preceding page then replacing it with the code of our demonstration shown below. We removed from the form all components except the TImage.

See our online Smart Pascal demonstration upon which this was based. In this version the crank and conrod appear above the piston because values on the Y axis increase up the screen.

In order to appreciate the need for the prismatic joint and to see instead a more entertaining output, comment out the line FSliderJoint := Tb2PrismaticJoint(FWorld.CreateJoint(FSliderJointDef, False));.

Pascal Code

unit UfrmMain;

interface
{$I ..\..\Physics2D\Physics2D.inc}

uses
  SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,
  UOpenGLCanvas in '..\..\OpenGL Canvas\UOpenGLCanvas.pas',
  UPhysics2D in '..\..\Physics2D\UPhysics2D.pas',
  UPhysics2DTypes in '..\..\Physics2D\UPhysics2DTypes.pas',
  UPhysics2DHelper in '..\..\Physics2D\UPhysics2DHelper.pas';

type
  TfrmMain = class(TForm)
    imgDisplay: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    private
    const
      FRAME_RATE = 1 / 60;
      SCALE = 10;
      RESTITUTION = 1;
      FRICTION = 0.3;
      WALL_WIDTH = 0.1;
      CYLINDER_LENGTH = 3.5;
      BORE = 2;
      PISTON_LENGTH = 1.5;
      ROD_WIDTH = 0.5;
      ROD_LENGTH = 3.5;
      CRANK_WIDTH = 0.5;
      CRANK_LENGTH = 1.0;
      RADTODEG = 180 / 3.142;
    var
      GLCanvas: TGLCanvas;
      FWorld: Tb2World;
      FCylinderR, FPiston, FConrod, FCrank: Tb2Body;
      FHingeJointDef: Tb2RevoluteJointDef;
      FHingeJoint, FMotorisedJoint: Tb2RevoluteJoint;
      FSliderJointDef: Tb2PrismaticJointDef;
      FSliderJoint: Tb2PrismaticJoint;
      FFrameCount: integer;

    procedure InitializePhysics;
    procedure Display;
    procedure TimerProgress(const deltaTime, newTime: Double);
  end;

var
  frmMain: TfrmMain;

implementation

uses
  MSTimer;

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  MSCadencer := TMSTimer.Create;
  MSCadencer.OnProgress := TimerProgress;
  GLCanvas := TGLCanvas.Create(imgDisplay, True, True, False, True);
  GLCanvas.DefaultFont.WinColor := clBlack;
  InitializePhysics;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  if Assigned(FWorld) then
    FWorld.Free;
  MSCadencer.Free;
  GLCanvas.Free;
end;

procedure TfrmMain.InitializePhysics;
var
  FixtureDef: Tb2FixtureDef;
  BodyDef: Tb2BodyDef;
begin
  FWorld := Tb2World.Create(MakeVector(0, -10));
  // Create fixture definition (used to describe fixture objects)
  FixtureDef := Tb2FixtureDef.Create;
  FixtureDef.Density := 1.0;
  FixtureDef.Friction := FRICTION;
  FixtureDef.Restitution := RESTITUTION;
  // Create body definition class (used to describe body objects)
  BodyDef := Tb2BodyDef.Create;
  BodyDef.BodyType := b2_StaticBody;
  // cylinder wall
  FixtureDef.Shape := Tb2PolygonShape.Create;
  Tb2PolygonShape(FixtureDef.Shape).SetAsBox(WALL_WIDTH / 2, CYLINDER_LENGTH / 2);
  BodyDef.Position := MakeVector(0.5 * imgDisplay.Width / SCALE, 0.5 * imgDisplay.Height / SCALE);
  FCylinderR := FWorld.CreateBody(BodyDef, False);
  FCylinderR.CreateFixture(FixtureDef, False, False); // cylinder right wall
  // Create piston
  BodyDef.BodyType := b2_DynamicBody;
  Tb2PolygonShape(FixtureDef.Shape).SetAsBox(BORE / 2, PISTON_LENGTH / 2);
  FPiston := FWorld.CreateBody(BodyDef, False);
  FPiston.CreateFixture(FixtureDef, False, False);
  // Create conrod and crank
  Tb2PolygonShape(FixtureDef.Shape).SetAsBox(ROD_WIDTH / 2, ROD_LENGTH / 2);
  FConrod := FWorld.CreateBody(BodyDef, False);
  FConrod.CreateFixture(FixtureDef, False, False);
  Tb2PolygonShape(FixtureDef.Shape).SetAsBox(CRANK_WIDTH / 2, CRANK_LENGTH / 2);
  FCrank := FWorld.CreateBody(BodyDef, False);
  FCrank.CreateFixture(FixtureDef, False, False);
  // Create prismatic joint for piston and cylinder wall
  FSliderJointDef := Tb2PrismaticJointDef.Create;
  FSliderJointDef.BodyA := FPiston;
  FSliderJointDef.BodyB := FCylinderR;
  FSliderJointDef.CollideConnected := False;
  FSliderJointDef.LocalAxisA := MakeVector(0, 1); // vertical
  FSliderJointDef.localAnchorA := MakeVector(1, 0);
  FSliderJointDef.localAnchorB := MakeVector(-0.05, 0);
  FSliderJoint := Tb2PrismaticJoint(FWorld.CreateJoint(FSliderJointDef, False));
  // Create revolute joint for piston and conrod
  FHingeJointDef := Tb2RevoluteJointDef.Create;
  FHingeJointDef.BodyA := FPiston;
  FHingeJointDef.BodyB := FConrod;
  FHingeJointDef.CollideConnected := False;
  FHingeJointDef.LocalAnchorA := MakeVector(0, 0);
  FHingeJointDef.LocalAnchorB := MakeVector(0, -0.45 * ROD_LENGTH );
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Create revolute joint for conrod and crank
  FHingeJointDef.BodyA := FConrod;
  FHingeJointDef.BodyB := FCrank;
  FHingeJointDef.LocalAnchorA := MakeVector(0, 0.45 * ROD_LENGTH);
  FHingeJointDef.LocalAnchorB := MakeVector(0, 0.45 * CRANK_LENGTH);
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Create revolute joint for cylinder wall and crank
  FHingeJointDef.BodyA := FCylinderR;
  FHingeJointDef.BodyB := FCrank;
  // Position the axle carefully to the left of and above the fixed cylinder wall.
  FHingeJointDef.LocalAnchorA := MakeVector(-1.05, 3.2);
  FHingeJointDef.LocalAnchorB := MakeVector(0, -0.45 * CRANK_LENGTH);
  FHingeJointDef.enableMotor := True;
  FHingeJointDef.motorSpeed := 5;
  FHingeJointDef.maxMotorTorque := 1000;
  FMotorisedJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));

  Display;
  MSCadencer.Enabled := True;
end;

procedure TfrmMain.Display;
var
  Pos: TVector2;
  Theta: PhysicsFloat;

  procedure DrawRod(Body: Tb2Body; Width, Length: PhysicsFloat);
  begin
    Pos := Body.GetPosition;
    Theta := Body.GetAngle;
    GLCanvas.SetTranslateX(GLCanvas.TranslateX + Pos.x * SCALE);
    GLCanvas.SetTranslateY(GLCanvas.TranslateY + Pos.y * SCALE);
    GLCanvas.SetRotation(GLCanvas.Rotation + Theta * RADTODEG);
    GLCanvas.FillRect((-0.5 * Width) * SCALE, - (0.5 * Length) * SCALE,
                      (0.5 * Width) * SCALE, (0.5 * Length) * SCALE);
    GLCanvas.SetRotation(GLCanvas.Rotation - Theta * RADTODEG);
    GLCanvas.SetTranslateY(GLCanvas.TranslateY - Pos.y * SCALE);
    GLCanvas.SetTranslateX(GLCanvas.TranslateX - Pos.x * SCALE);
  end;

begin
  inc(FFrameCount);
  GLCanvas.RenderingBegin(clGreen);
  // Draw right cylinder wall
  GLCanvas.SetBrushColorWin(clBlack, 255, False);
  Pos := FCylinderR.GetPosition;
  GLCanvas.FillRect((Pos.X  - 0.5 * WALL_WIDTH) * SCALE, (Pos.Y - 0.5 * CYLINDER_LENGTH) * SCALE,
                    (Pos.X  + 0.5 * WALL_WIDTH) * SCALE, (Pos.Y + 0.5 * CYLINDER_LENGTH) * SCALE);
  // Draw piston
  GLCanvas.SetBrushColorWin(clSilver, 255, False);
  Pos := FPiston.GetPosition;
  GLCanvas.FillRect((Pos.X  - 0.5 * BORE) * SCALE, (Pos.Y - 0.5 * PISTON_LENGTH) * SCALE,
                    (Pos.X  + 0.5 * BORE) * SCALE, (Pos.Y + 0.5 * PISTON_LENGTH) * SCALE);
  // Draw conrod and crank
  GLCanvas.SetBrushColorWin(clBlack, 255, False);
  DrawRod(FConrod, ROD_WIDTH, ROD_LENGTH);
  DrawRod(FCrank, CRANK_WIDTH, CRANK_LENGTH);

  if FFrameCount = 4000 then
    FMotorisedJoint.SetMotorSpeed(0);
  GLCanvas.RenderingEnd;
end;

procedure TfrmMain.TimerProgress(const deltaTime, newTime: Double);
const
  FixedStep = FRAME_RATE;
var
  dt: Double;
begin
  if deltaTime < 1.2 * FixedStep then
    FWorld.Step(deltaTime, 6, 2)
  else
    begin
      dt := deltaTime;
      while dt > 0 do
        begin
          FWorld.Step(FixedStep, 6, 2);
          dt := dt - FixedStep;
        end;
      end;
  Display;
  Application.ProcessMessages;
end;

end.    

Code of Form

object frmMain: TfrmMain
  Left = 430
  Height = 117
  Top = 77
  Width = 120
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsSingle
  Caption = 'Piston'
  ClientHeight = 117
  ClientWidth = 120
  Color = clBtnFace
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  KeyPreview = True
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  Position = poDesktopCenter
  LCLVersion = '1.4.4.0'
  object imgDisplay: TImage
    Left = 8
    Height = 100
    Top = 8
    Width = 100
  end
end    

Programming - a skill for life!

How to use the Box2D physics engine in Lazarus