Using Distance Joints

Distance joints are used to keep the anchor points on two bodies a fixed distance apart, as if linked by an invisible rod. This example has only one distance joint, which is used to link the controller to the torso of the rag-doll marionette. Find the lines of code for the creation of the distance joint at the end of the InitializePhysics procedure. Use the mouse to change the orientation of the controller and thereby manipulate the puppet.

In order to produce this example we needed to experiment with mouse handling, which resulted in the mouse input demonstration. It was then fairly straightforward to add converted code from our online Smart Pascal demonstration.

See below the PasSFML version (with a better display of filled rectangles and circles).

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
  TQueryCallback = class(Tb2QueryCallback)
  public
    m_point: TVector2;
    m_fixture: Tb2Fixture;
    procedure Initialize(const point: TVector2); {$IFDEF INLINE_AVAIL}inline;{$ENDIF}
    function ReportFixture(fixture: Tb2Fixture): Boolean; override;
  end;

  TWorldHandler = class(Tb2ContactListener)
  private
  const
    START_X = 20;
    START_Y = 15;
    RESTITUTION = 0.3;
    FRICTION = 0.4;
    DEGTORAD = 3.142 / 180;
    FTorsoYcoords: array[0..2] of PhysicsFloat = (2.5, 4.3, 5.8);
    FLimbBodyXcoords :array[0..7] of PhysicsFloat = (-3.0, 3.0, -5.7, 5.7, -0.8, 0.8, -0.8, 0.8);
    FLimbBodyYcoords :array[0..3] of PhysicsFloat = (2.0, 2.0, 8.5, 12.0);
  var
    FWorld: Tb2World;
    FHead, FGroundBody: Tb2Body;
    FMouseJoint: Tb2MouseJoint;
    FController, FMount: Tb2Body;
    FMousePos: TVector2;
    FHingeJointDef: Tb2RevoluteJointDef;
    FHingeJoint: Tb2RevoluteJoint;
    FDistanceJointDef: Tb2DistanceJointDef;
    FDistanceJoint: Tb2DistanceJoint;
    procedure initializePhysics;
    procedure MouseDown;
    procedure MouseUp;
  end;

  TfrmMain = class(TForm)
    GLCanvas: TGLCanvas;
    imgDisplay: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure imgDisplayMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgDisplayMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgDisplayMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    private
    const
      RADTODEG = 180 / 3.142;
      FRAME_RATE = 1 / 60;
    var
      WorldHandler: TWorldHandler;
      FIsMouseDown: Boolean;
    procedure Display;
    procedure TimerProgress(const deltaTime, newTime: Double);
  end;

const
  SCALE = 10;
  FLOOR_HEIGHT = 0.5;
  RADIUS = 1.4; // head
  CONTROLLER_WIDTH = 6;
  CONTROLLER_HEIGHT = 3;

  LimbBodyHeights :array[0..3] of PhysicsFloat = (1.3, 1.2, 4.4, 4.0);
  LimbBodyWidths :array[0..3] of PhysicsFloat = (3.6, 3.4, 1.5, 1.2);
var
  frmMain: TfrmMain;
  _QueryCallback: TQueryCallback;
  TorsoBodies: array[0..2] of Tb2Body;
  LimbBodies: array[0..7] of Tb2Body;

implementation

uses
  MSTimer;

{$R *.dfm}

procedure TQueryCallback.Initialize(const point: TVector2);
begin
  m_point := point;
  m_fixture := nil;
end;

function TQueryCallback.ReportFixture(fixture: Tb2Fixture): Boolean;
begin
  if fixture.GetBody.GetType = b2_dynamicBody then
    begin
      if fixture.TestPoint(m_point) then
        begin
          m_fixture := fixture;
          // We are done, terminate the query.
          Result := False;
          Exit;
        end;
   end;
  // Continue the query.
  Result := True;
end;

procedure TWorldHandler.MouseDown;
var
  aabb: Tb2AABB;
  d: TVector2;
  body: Tb2Body;
  md: Tb2MouseJointDef;
begin
  if Assigned(FmouseJoint) then
    Exit;
  // Make a small box.
  {$IFDEF OP_OVERLOAD}
  d.SetValue(0.001, 0.001);
  aabb.lowerBound := FMousePos - d;
  aabb.upperBound := FMousePos + d;
  {$ELSE}
  SetValue(d, 0.001, 0.001);
  aabb.lowerBound := Subtract(FMousePos, d);
  aabb.upperBound := Add(FMousePos, d);
  {$ENDIF}

  // Query the world for overlapping shapes.
  _QueryCallback.Initialize(FMousePos);
  Fworld.QueryAABB(_QueryCallback, aabb);
  if Assigned(_QueryCallback.m_fixture) then
    begin
      body := _QueryCallback.m_fixture.GetBody;
      md := Tb2MouseJointDef.Create;
      md.bodyA := FGroundBody;
      md.bodyB := body;
      md.target := FMousePos;
      md.maxForce := 1000.0 * body.GetMass;
      FmouseJoint := Tb2MouseJoint(Fworld.CreateJoint(md));
      body.SetAwake(True);
    end;
end;

procedure TWorldHandler.MouseUp;
begin
  if Assigned(FmouseJoint) then
    begin
      Fworld.DestroyJoint(FmouseJoint);
      FmouseJoint := nil;
    end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  _QueryCallback := TQueryCallback.Create;
  WorldHandler := TWorldHandler.Create;
  MSCadencer := TMSTimer.Create;
  MSCadencer.OnProgress := TimerProgress;
  GLCanvas := TGLCanvas.Create(imgDisplay, True, True, False, True);
  WorldHandler.InitializePhysics;
  Display;
  MSCadencer.Enabled := True;
end;

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

procedure TfrmMain.imgDisplayMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ActiveControl := nil;
  WorldHandler.FMousePos.x := X / SCALE;
  WorldHandler.FMousePos.y := (imgDisplay.Height - Y) / SCALE;
  WorldHandler.MouseDown;
  FIsMouseDown := True;
end;

procedure TfrmMain.imgDisplayMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  WorldHandler.FMousePos.x := X / SCALE;
  WorldHandler.FMousePos.y := (imgDisplay.Height - Y) / SCALE;
  WorldHandler.MouseDown;
end;

procedure TfrmMain.imgDisplayMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  WorldHandler.MouseUp;
  FIsMouseDown := False;
end;

procedure TWorldHandler.InitializePhysics;
var
  FixtureDef: Tb2FixtureDef;
  BodyDef: Tb2BodyDef;
  i: integer;
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;
  FixtureDef.Shape := Tb2PolygonShape.Create;
  // Create body definition class (used to describe body objects)
  BodyDef := Tb2BodyDef.Create;
  FGroundBody := FWorld.CreateBody(BodyDef, False);
    // Create bottom bar.
  FixtureDef.Shape := Tb2PolygonShape.Create;
  Tb2PolygonShape(FixtureDef.Shape).SetAsBox(0.5 * 400 / SCALE, FLOOR_HEIGHT / 2);
  BodyDef.Position := MakeVector(0.5 * 400 / SCALE, FLOOR_HEIGHT / 2);
  FWorld.CreateBody(BodyDef, False).CreateFixture(FixtureDef, False, False);
  // Create head
  BodyDef.BodyType := b2_DynamicBody;
  FixtureDef.shape := Tb2CircleShape.Create;
  FixtureDef.shape.m_radius := RADIUS;
  BodyDef.Position := MakeVector(START_X, START_Y);
  FHead := FWorld.CreateBody(BodyDef, False);
  FHead.CreateFixture(FixtureDef, False, False);
  // Create torso
  FixtureDef.Shape := Tb2PolygonShape.Create;
  Tb2PolygonShape(FixtureDef.Shape).SetAsBox(1.5, 1.0);
  FixtureDef.restitution := 0.1;
  for i := 0 to 2 do
    begin
      BodyDef.Position := MakeVector(START_X, START_Y - FTorsoYcoords[i]);
      TorsoBodies[i] := FWorld.CreateBody(BodyDef, False);
      TorsoBodies[i].CreateFixture(FixtureDef, False, False);
    end;
  // Create limbs
  for i := 0 to 7 do
    begin
      Tb2PolygonShape(FixtureDef.Shape).SetAsBox(LimbBodyWidths[i div 2] / 2, LimbBodyHeights[i div 2] / 2);
      BodyDef.Position := MakeVector(START_X + FLimbBodyXcoords[i], START_Y - FLimbBodyYcoords[i div 2]);
      LimbBodies[i] := FWorld.CreateBody(BodyDef, False);
      LimbBodies[i].CreateFixture(FixtureDef, False, False);
    end;
  // Create controller
  BodyDef.BodyType := b2_DynamicBody;
  BodyDef.Position := MakeVector(0.5 * 400 / SCALE, 300 / SCALE - 5);
  Tb2PolygonShape(FixtureDef.Shape).SetAsBox(0.5 * CONTROLLER_WIDTH, 0.5 * CONTROLLER_HEIGHT);
  FController := FWorld.CreateBody(BodyDef, False);
  FController.CreateFixture(FixtureDef,False, False);
  // Create mount for controller
  BodyDef.BodyType := b2_StaticBody;
  FMount := FWorld.CreateBody(BodyDef, False);
  FMount.CreateFixture(FixtureDef, False, False);
  // Create revolute joints
  FHingeJointDef := Tb2RevoluteJointDef.Create;
  FHingeJointDef.EnableLimit := True;
  // Head to shoulders
  FHingeJointDef.LowerAngle := -10.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 10.0 * DEGTORAD;
  FHingeJointDef.Initialize(TorsoBodies[0], FHead, MakeVector(START_X, (START_Y - 1.5)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Upper arm to shoulders
  // L
  FHingeJointDef.LowerAngle := -85.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 130.0 * DEGTORAD;
  FHingeJointDef.Initialize(TorsoBodies[0], LimbBodies[0], MakeVector(START_X - 1.8, (START_Y - 2.0)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // R
  FHingeJointDef.LowerAngle := -130.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 85.0 * DEGTORAD;
  FHingeJointDef.Initialize(TorsoBodies[0], LimbBodies[1], MakeVector(START_X + 1.8, (START_Y - 2.0)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Lower arm to upper arm
  // L
  FHingeJointDef.LowerAngle := -130.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 10.0 * DEGTORAD;
  FHingeJointDef.Initialize(LimbBodies[0], LimbBodies[2], MakeVector(START_X - 4.5, (START_Y - 2.0)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // R
  FHingeJointDef.LowerAngle := -10.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 130.0 * DEGTORAD;
  FHingeJointDef.Initialize(LimbBodies[1], LimbBodies[3], MakeVector(START_X + 4.5, (START_Y - 2.0)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Shoulders to stomach
  FHingeJointDef.LowerAngle := -15.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 15.0 * DEGTORAD;
  FHingeJointDef.Initialize(TorsoBodies[0], TorsoBodies[1], MakeVector(START_X, (START_Y - 3.5)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Stomach to hips
  FHingeJointDef.Initialize(TorsoBodies[1], TorsoBodies[2], MakeVector(START_X, (START_Y - 5.0)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Torso to upper leg
  // L
  FHingeJointDef.LowerAngle := -25.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 45.0 * DEGTORAD;
  FHingeJointDef.Initialize(TorsoBodies[2], LimbBodies[4], MakeVector(START_X - 0.8, (START_Y - 7.2)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // R
  FHingeJointDef.LowerAngle := -45.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 25.0 * DEGTORAD;
  FHingeJointDef.Initialize(TorsoBodies[2], LimbBodies[5], MakeVector(START_X + 0.8, (START_Y - 7.2)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Upper leg to lower leg
  // L
  FHingeJointDef.LowerAngle := -25.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 115.0 * DEGTORAD;
  FHingeJointDef.Initialize(LimbBodies[4], LimbBodies[6], MakeVector(START_X - 0.8, (START_Y - 10.5)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // R
  FHingeJointDef.LowerAngle := -115.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 25.0 * DEGTORAD;
  FHingeJointDef.Initialize(LimbBodies[5], LimbBodies[7], MakeVector(START_X + 0.8, (START_Y - 10.5)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Mount to controller
  FHingeJointDef.LowerAngle := -20 * DEGTORAD;
  FHingeJointDef.UpperAngle := 20 * DEGTORAD;
  FHingeJointDef.Initialize(FMount, FController, MakeVector(0.5 * 400 / SCALE, 300 / SCALE - 5));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Distance joint from controller to torso
  FDistanceJointDef := Tb2DistanceJointDef.Create;
  FDistanceJointDef.Initialize(FController, TorsoBodies[1],
                               MakeVector(0.5 * 400 / SCALE - 2, 300 / SCALE - 5),
                               MakeVector(START_X, START_Y));
  FDistanceJoint := Tb2DistanceJoint(FWorld.CreateJoint(FDistanceJointDef, False));
end;

procedure TfrmMain.Display;

var
  Pos: TVector2;
  Theta: PhysicsFloat;
  i: integer;

  procedure DrawBody(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
  GLCanvas.RenderingBegin(clGreen);
  GLCanvas.SetBrushColorWin(clDkGray, 255, False);
  GLCanvas.FillRect(0, 0, imgDisplay.Width, FLOOR_HEIGHT * SCALE); // the ground
  Pos := WorldHandler.FHead.GetPosition;
  // Draw head
  GLCanvas.SetBrushColorWin(RGBToColor(224, 150, 122), 255, False);
  GLCanvas.FillEllipseRect((Pos.X - RADIUS) * SCALE, (Pos.Y - RADIUS) * SCALE,
                           (Pos.X + RADIUS) * SCALE, (Pos.Y + RADIUS) * SCALE);
  // Draw torso
  GLCanvas.SetBrushColorWin(clBlue, 255, False);
  DrawBody(TorsoBodies[0], 3, 2);
  DrawBody(TorsoBodies[1], 3, 2);
  GLCanvas.SetBrushColorWin(clBlack, 255, False);
  DrawBody(TorsoBodies[2], 3, 2);
  // Draw limbs
  GLCanvas.SetBrushColorWin(clBlue, 255, False);
  for i := 0 to 7 do
    begin
      if i >= 4 then
         GLCanvas.SetBrushColorWin(clBlack, 255, False);
      DrawBody(LimbBodies[i], LimbBodyWidths[i div 2],
               LimbBodyHeights[i div 2]);
    end;
  // Draw controller
  GLCanvas.SetBrushColorWin(clRed, 255, False);
  DrawBody(WorldHandler.FController, CONTROLLER_WIDTH, CONTROLLER_HEIGHT);
  GLCanvas.RenderingEnd;
  if Assigned(WorldHandler.FMouseJoint) then
    if FIsMouseDown then
      WorldHandler.FMouseJoint.SetTarget(WorldHandler.FMousePos)
    else
      begin
        WorldHandler.FWorld.DestroyJoint(WorldHandler.FMouseJoint);
        WorldHandler.FMouseJoint := nil;
      end;
end;

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

end.    

Code of Form

object frmMain: TfrmMain
  Left = 511
  Height = 317
  Top = 90
  Width = 418
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsSingle
  Caption = 'Marionette'
  ClientHeight = 317
  ClientWidth = 418
  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 = 300
    Top = 8
    Width = 400
    OnMouseDown = imgDisplayMouseDown
    OnMouseMove = imgDisplayMouseMove
    OnMouseUp = imgDisplayMouseUp
  end
end    

PasSFML Version

See our page entitled Downloading PasSFML and Learning from Examples for the files that you will need in the folder of this console program.

program Marionette;
{$Mode Delphi}
{$Apptype GUI}
{$I ..\..\Physics2D\Physics2D.inc}

uses
  SysUtils, SfmlGraphics, SfmlSystem, SfmlWindow,
  UPhysics2D in '..\..\Physics2D\UPhysics2D.pas',
  UPhysics2DTypes in '..\..\Physics2D\UPhysics2DTypes.pas',
  UPhysics2DHelper in '..\..\Physics2D\UPhysics2DHelper.pas';

type
  TQueryCallback = class(Tb2QueryCallback)
  public
    m_point: TVector2;
    m_fixture: Tb2Fixture;
    procedure Initialize(const point: TVector2); {$IFDEF INLINE_AVAIL}inline;{$ENDIF}
    function ReportFixture(fixture: Tb2Fixture): Boolean; override;
  end;

  TWorldHandler = class(Tb2ContactListener)
  private
  const
    START_X = 20;
    START_Y = 15;
    RESTITUTION = 0.3;
    FRICTION = 0.4;
    DEGTORAD = 3.142 / 180;
    FTorsoYcoords: array[0..2] of PhysicsFloat = (2.5, 4.3, 5.8);
    FLimbBodyXcoords :array[0..7] of PhysicsFloat = (-3.0, 3.0, -5.7, 5.7, -0.8, 0.8, -0.8, 0.8);
    FLimbBodyYcoords :array[0..3] of PhysicsFloat = (2.0, 2.0, 8.5, 12.0);
  var
    FWorld: Tb2World;
    FGroundBody, FMount: Tb2Body;
    FMouseJoint: Tb2MouseJoint;
    FMousePos: TVector2;
    FHingeJointDef: Tb2RevoluteJointDef;
    FHingeJoint: Tb2RevoluteJoint;
    FDistanceJointDef: Tb2DistanceJointDef;
    FDistanceJoint: Tb2DistanceJoint;
    procedure initializePhysics;
    procedure MouseDown;
    procedure MouseUp;
  end;

const
  FRAME_RATE = 1 / 60;
  WINDOW_WIDTH = 400;
  WINDOW_HEIGHT = 300;
  SCALE = 10;
  FLOOR_HEIGHT = 0.5;
  RADIUS = 1.4; // head
  TORSO_BODY_WIDTH = 3;
  TORSO_BODY_HEIGHT = 2;
  CONTROLLER_WIDTH = 6;
  CONTROLLER_HEIGHT = 3;
  RADTODEG = 180 / 3.142;
  LimbBodyHeights: array[0..3] of PhysicsFloat = (1.3, 1.2, 4.4, 4.0);
  LimbBodyWidths: array[0..3] of PhysicsFloat = (3.6, 3.4, 1.5, 1.2);
var
  Window: TSfmlRenderWindow;
  Event: TsfmlEvent;
  MouseDown: Boolean = False;
  _QueryCallback: TQueryCallback;
  Head, Controller: Tb2Body;
  TorsoBodies: array[0..2] of Tb2Body;
  LimbBodies: array[0..7] of Tb2Body;
  WorldHandler: TWorldHandler;
  GroundRect, ControllerRect, TorsoRect, LimbRect: TSfmlRectangleShape;
  Circle: TSfmlCircleShape;
  Settings: TsfmlContextSettings;

procedure TQueryCallback.Initialize(const point: TVector2);
begin
  m_point := point;
  m_fixture := nil;
end;

function TQueryCallback.ReportFixture(fixture: Tb2Fixture): Boolean;
begin
  if fixture.GetBody.GetType = b2_dynamicBody then
    begin
      if fixture.TestPoint(m_point) then
        begin
          m_fixture := fixture;
          // We are done, terminate the query.
          Result := False;
          Exit;
        end;
   end;
  // Continue the query.
  Result := True;
end;

procedure TWorldHandler.MouseDown;
var
  aabb: Tb2AABB;
  d: TVector2;
  body: Tb2Body;
  md: Tb2MouseJointDef;
begin
  if Assigned(FmouseJoint) then
    Exit;
  // Make a small box.
  {$IFDEF OP_OVERLOAD}
  d.SetValue(0.001, 0.001);
  aabb.lowerBound := FMousePos - d;
  aabb.upperBound := FMousePos + d;
  {$ELSE}
  SetValue(d, 0.001, 0.001);
  aabb.lowerBound := Subtract(FMousePos, d);
  aabb.upperBound := Add(FMousePos, d);
  {$ENDIF}

  // Query the world for overlapping shapes.
  _QueryCallback.Initialize(FMousePos);
  Fworld.QueryAABB(_QueryCallback, aabb);
  if Assigned(_QueryCallback.m_fixture) and (_QueryCallback.m_fixture.GetBody = Controller) then
    begin
      body := Controller;
      md := Tb2MouseJointDef.Create;
      md.bodyA := FGroundBody;
      md.bodyB := body;
      md.target := FMousePos;
      md.maxForce := 1000.0 * body.GetMass;
      FmouseJoint := Tb2MouseJoint(Fworld.CreateJoint(md));
      body.SetAwake(True);
    end;
end;

procedure TWorldHandler.MouseUp;
begin
  if Assigned(FmouseJoint) then
    begin
      Fworld.DestroyJoint(FmouseJoint);
      FmouseJoint := nil;
    end;
end;

procedure TWorldHandler.InitializePhysics;
var
  FixtureDef: Tb2FixtureDef;
  BodyDef: Tb2BodyDef;
  i: integer;
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;
  FixtureDef.Shape := Tb2PolygonShape.Create;
  // Create body definition class (used to describe body objects)
  BodyDef := Tb2BodyDef.Create;
  FGroundBody := FWorld.CreateBody(BodyDef, False);
    // Create bottom bar.
  FixtureDef.Shape := Tb2PolygonShape.Create;
  Tb2PolygonShape(FixtureDef.Shape).SetAsBox(0.5 * 400 / SCALE, FLOOR_HEIGHT / 2);
  BodyDef.Position := MakeVector(0.5 * 400 / SCALE, FLOOR_HEIGHT / 2);
  FWorld.CreateBody(BodyDef, False).CreateFixture(FixtureDef, False, False);
  // Create head
  BodyDef.BodyType := b2_DynamicBody;
  FixtureDef.shape := Tb2CircleShape.Create;
  FixtureDef.shape.m_radius := RADIUS;
  BodyDef.Position := MakeVector(START_X, START_Y);
  Head := FWorld.CreateBody(BodyDef, False);
  Head.CreateFixture(FixtureDef, False, False);
  // Create torso
  FixtureDef.Shape := Tb2PolygonShape.Create;
  Tb2PolygonShape(FixtureDef.Shape).SetAsBox(TORSO_BODY_WIDTH / 2, TORSO_BODY_HEIGHT / 2);
  FixtureDef.restitution := 0.1;
  for i := 0 to 2 do
    begin
      BodyDef.Position := MakeVector(START_X, START_Y - FTorsoYcoords[i]);
      TorsoBodies[i] := FWorld.CreateBody(BodyDef, False);
      TorsoBodies[i].CreateFixture(FixtureDef, False, False);
    end;
  // Create limbs
  for i := 0 to 7 do
    begin
      Tb2PolygonShape(FixtureDef.Shape).SetAsBox(LimbBodyWidths[i div 2] / 2, LimbBodyHeights[i div 2] / 2);
      BodyDef.Position := MakeVector(START_X + FLimbBodyXcoords[i], START_Y - FLimbBodyYcoords[i div 2]);
      LimbBodies[i] := FWorld.CreateBody(BodyDef, False);
      LimbBodies[i].CreateFixture(FixtureDef, False, False);
    end;
  // Create controller
  BodyDef.BodyType := b2_DynamicBody;
  BodyDef.Position := MakeVector(0.5 * 400 / SCALE, 300 / SCALE - 5);
  Tb2PolygonShape(FixtureDef.Shape).SetAsBox(0.5 * CONTROLLER_WIDTH, 0.5 * CONTROLLER_HEIGHT);
  Controller := FWorld.CreateBody(BodyDef, False);
  Controller.CreateFixture(FixtureDef,False, False);
  // Create mount for controller
  BodyDef.BodyType := b2_StaticBody;
  FMount := FWorld.CreateBody(BodyDef, False);
  FMount.CreateFixture(FixtureDef, False, False);
  // Create revolute joints
  FHingeJointDef := Tb2RevoluteJointDef.Create;
  FHingeJointDef.EnableLimit := True;
  // Head to shoulders
  FHingeJointDef.LowerAngle := -10.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 10.0 * DEGTORAD;
  FHingeJointDef.Initialize(TorsoBodies[0], Head, MakeVector(START_X, (START_Y - 1.5)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Upper arm to shoulders
  // L
  FHingeJointDef.LowerAngle := -85.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 130.0 * DEGTORAD;
  FHingeJointDef.Initialize(TorsoBodies[0], LimbBodies[0], MakeVector(START_X - 1.8, (START_Y - 2.0)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // R
  FHingeJointDef.LowerAngle := -130.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 85.0 * DEGTORAD;
  FHingeJointDef.Initialize(TorsoBodies[0], LimbBodies[1], MakeVector(START_X + 1.8, (START_Y - 2.0)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Lower arm to upper arm
  // L
  FHingeJointDef.LowerAngle := -130.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 10.0 * DEGTORAD;
  FHingeJointDef.Initialize(LimbBodies[0], LimbBodies[2], MakeVector(START_X - 4.5, (START_Y - 2.0)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // R
  FHingeJointDef.LowerAngle := -10.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 130.0 * DEGTORAD;
  FHingeJointDef.Initialize(LimbBodies[1], LimbBodies[3], MakeVector(START_X + 4.5, (START_Y - 2.0)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Shoulders to stomach
  FHingeJointDef.LowerAngle := -15.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 15.0 * DEGTORAD;
  FHingeJointDef.Initialize(TorsoBodies[0], TorsoBodies[1], MakeVector(START_X, (START_Y - 3.5)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Stomach to hips
  FHingeJointDef.Initialize(TorsoBodies[1], TorsoBodies[2], MakeVector(START_X, (START_Y - 5.0)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Torso to upper leg
  // L
  FHingeJointDef.LowerAngle := -25.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 45.0 * DEGTORAD;
  FHingeJointDef.Initialize(TorsoBodies[2], LimbBodies[4], MakeVector(START_X - 0.8, (START_Y - 7.2)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // R
  FHingeJointDef.LowerAngle := -45.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 25.0 * DEGTORAD;
  FHingeJointDef.Initialize(TorsoBodies[2], LimbBodies[5], MakeVector(START_X + 0.8, (START_Y - 7.2)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Upper leg to lower leg
  // L
  FHingeJointDef.LowerAngle := -25.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 115.0 * DEGTORAD;
  FHingeJointDef.Initialize(LimbBodies[4], LimbBodies[6], MakeVector(START_X - 0.8, (START_Y - 10.5)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // R
  FHingeJointDef.LowerAngle := -115.0 * DEGTORAD;
  FHingeJointDef.UpperAngle := 25.0 * DEGTORAD;
  FHingeJointDef.Initialize(LimbBodies[5], LimbBodies[7], MakeVector(START_X + 0.8, (START_Y - 10.5)));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Mount to controller
  FHingeJointDef.LowerAngle := -20 * DEGTORAD;
  FHingeJointDef.UpperAngle := 20 * DEGTORAD;
  FHingeJointDef.Initialize(FMount, Controller, MakeVector(0.5 * 400 / SCALE, 300 / SCALE - 5));
  FHingeJoint := Tb2RevoluteJoint(FWorld.CreateJoint(FHingeJointDef, False));
  // Distance joint from controller to torso
  FDistanceJointDef := Tb2DistanceJointDef.Create;
  FDistanceJointDef.Initialize(Controller, TorsoBodies[1],
                               MakeVector(0.5 * 400 / SCALE - 2, 300 / SCALE - 5),
                               MakeVector(START_X, START_Y));
  FDistanceJoint := Tb2DistanceJoint(FWorld.CreateJoint(FDistanceJointDef, False));
end;

procedure InitializeDisplay;
begin
  Settings.antialiasingLevel := 8;
  Window := TSfmlRenderWindow.Create(SfmlVideoMode(WINDOW_WIDTH, WINDOW_HEIGHT, 32),
                                     AnsiString('Marionette'), [sfTitleBar, sfClose], @Settings);
  Window.SetVerticalSyncEnabled(True);
  GroundRect := TSfmlRectangleShape.Create;
  GroundRect.FillColor := SfmlBlack;
  GroundRect.Size := SfmlVector2f(WINDOW_WIDTH, FLOOR_HEIGHT * SCALE);
  GroundRect.Origin := SfmlVector2f(0, 0);
  GroundRect.Position := SfmlVector2f(0, WINDOW_HEIGHT - FLOOR_HEIGHT * SCALE );
  // Controller rectangle
  ControllerRect := TSfmlRectangleShape.Create;
  ControllerRect.FillColor := SfmlRed;
  ControllerRect.Size := SfmlVector2f(CONTROLLER_WIDTH * SCALE, CONTROLLER_HEIGHT * SCALE);
  ControllerRect.Origin := SfmlVector2f(CONTROLLER_WIDTH * SCALE / 2, CONTROLLER_HEIGHT * SCALE / 2);
  ControllerRect.Position := SfmlVector2f(0.5 * 400, 5 * SCALE);
  // Circle (head)
  Circle := TSfmlCircleShape.Create;
  Circle.FillColor := SfmlColorFromRGB(224, 150, 122);
  Circle.Radius := RADIUS * SCALE;
  // Torso rectangle (always same size)
  TorsoRect := TSfmlRectangleShape.Create;
  TorsoRect.Size := SfmlVector2f(TORSO_BODY_WIDTH * SCALE, TORSO_BODY_HEIGHT * SCALE);
  TorsoRect.Origin := SfmlVector2f(TORSO_BODY_WIDTH * SCALE / 2,  TORSO_BODY_HEIGHT * SCALE / 2);
  // Limb rectangle (variable size)
  LimbRect := TSfmlRectangleShape.Create;
end;

procedure Display;
var
  Pos: TVector2;
  Theta, LimbWidth, LimbHeight: PhysicsFloat;
  i: integer;
begin
  Window.Clear(SfmlGreen);
  Window.Draw(GroundRect);
  Pos := Head.GetPosition;
  Circle.Position := SfmlVector2f(Pos.X  * SCALE - Circle.Radius,
                                  300 - Pos.Y * SCALE - Circle.Radius);
  Window.Draw(Circle);

  TorsoRect.FillColor := SfmlBlue;
  for i := 0 to 2 do
    begin
      Pos := TorsoBodies[i].GetPosition;
      Theta := TorsoBodies[i].GetAngle;
      TorsoRect.Position := SfmlVector2f(Pos.X * SCALE, 300 - Pos.Y * SCALE);
      TorsoRect.Rotate(-Theta * RADTODEG);
      if i = 2 then
         TorsoRect.FillColor := SfmlBlack;
      Window.Draw(TorsoRect);
      TorsoRect.Rotate(Theta * RADTODEG);
    end;

  LimbRect.FillColor := SfmlBlue;
  for i := 0 to 7 do
    begin
      Pos := LimbBodies[i].GetPosition;
      Theta := LimbBodies[i].GetAngle;
      LimbRect.Position := SfmlVector2f(Pos.X * SCALE, 300 - Pos.Y * SCALE);
      LimbWidth := LimbBodyWidths[i div 2] * SCALE;
      LimbHeight := LimbBodyHeights[i div 2] * SCALE;
      LimbRect.Size := SfmlVector2f(LimbWidth, LimbHeight);
      LimbRect.Origin := SfmlVector2f(LimbWidth / 2, LimbHeight / 2);
      LimbRect.Rotate(-Theta * RADTODEG);
      if i = 4 then
        LimbRect.FillColor := SfmlBlack;
      Window.Draw(LimbRect);
      LimbRect.Rotate(Theta * RADTODEG);
    end;

  Theta := Controller.GetAngle;
  ControllerRect.Rotate(-Theta * RADTODEG);
  Window.Draw(ControllerRect);
  ControllerRect.Rotate(Theta * RADTODEG);
  Window.Display;
  if Assigned(WorldHandler.FMouseJoint) then
    if MouseDown then
      WorldHandler.FMouseJoint.SetTarget(WorldHandler.FMousePos)
    else
      begin
        WorldHandler.FWorld.DestroyJoint(WorldHandler.FMouseJoint);
        WorldHandler.FMouseJoint := nil;
      end;
end;

begin
  _QueryCallback := TQueryCallback.Create;
  WorldHandler := TWorldHandler.Create;
  WorldHandler.InitializePhysics;
  InitializeDisplay;

  while Window.isOpen do
    begin
      while SfmlRenderWindowPollEvent(Window.Handle, Event) do
        begin
          case Event.EventType of
            sfEvtClosed: SfmlRenderWindowClose(Window.Handle);
            sfEvtKeyPressed: if Event.Key.Code = sfKeyEscape then   // Escape key pressed
                               SfmlRenderWindowClose(Window.Handle);
            sfEvtMouseButtonPressed: begin
                                       WorldHandler.FMousePos.x := Window.MousePosition.X / SCALE;
                                       WorldHandler.FMousePos.y := (300 - Window.MousePosition.Y) / SCALE;
                                       WorldHandler.MouseDown;
                                       MouseDown := True;
                                     end;
            sfEvtMouseButtonReleased: begin
                                        MouseDown := False;
                                        WorldHandler.MouseUp;
                                      end;
            sfEvtMouseMoved: begin
                               WorldHandler.FMousePos.x := Window.MousePosition.X / SCALE;
                               WorldHandler.FMousePos.y := (300 - Window.MousePosition.Y) / SCALE;
                               WorldHandler.MouseDown;
                               MouseDown := True;
                             end;
          end;
        end;
      WorldHandler.FWorld.Step(FRAME_RATE, 6, 2);
      Display;
    end;
end.
    
Programming - a skill for life!

How to use the Box2D physics engine in Lazarus