Joints and Body Collisions

For the past few days I've been working on writing and testing an object oriented encapsulation of the open source Chipmunk2D physics library. This compliments my existing SDL and NanoVG bindings for Free Pascal. Below is a short video clip of my program to test precise detection of body collision points as well as the use of spring joints

Video

The program below tests the precise detection of collision points against a class of physics bodies. Receding pink circles are drawn at points where the bodies collide. Dynamic bodies (those that are not anchored) can be moved with the mouse and a green arrow indicates the force being applied to the body being grabbed. All the graphics are drawn in real time using OpenGLESv2 with the extremely fast NanoVG vector graphics library.
Video: Collision Test


Source Code

The following is a listing of the Pascal unit responsible for the test program above. The SDL, NanoVG, and Chipmunk2D code were built by me as static libraries and link inside of programs like this test. I have written well formatted Pascal units handling both the C interface to these projects. Additionally, I am in the process of writing quite sensible object orient encapsulations of each of these units, making it easier to discover and use these libraries in Pascal.
If you are interested in helping me write or test the Pascal encapsulations, message me and we can use Discord to share ideas.
unit JointScene;

{$i options.inc}

interface

uses
  NanoVG, Chipmunk2D, ChipmunkObjs, PhysicsTools;

{ TJointScene }

type
  TJointScene = class(TPhysicsScene)
  private
    FHits: array[0..50] of TVect;
    FHitTimes: array[0..50] of Double;
    FHitIndex: Integer;
    procedure HandleHits(arb: cpArbiter);
  protected
    procedure Load; override;
    procedure Render(Width, Height: Integer; const Time: Double); override;
  end;

implementation

const
  ballType = TCollisionType(1);
  weightType = TCollisionType(2);
  boxType = TCollisionType(3);

procedure TJointScene.HandleHits(arb: cpArbiter);
var
  Points: cpContactPointSetStruct;
begin
  Points := cpArbiterGetContactPointSet(arb);
  FHits[FHitIndex] := Points.points[0].pointA;
  FHitTimes[FHitIndex] := Time;
  FHitIndex := (FHitIndex + 1) mod (High(FHits) + 1);
end;

procedure WeightsCollide(arb: cpArbiter; space: cpSpace; userData: cpDataPointer); cdecl;
var
  Scene: TJointScene absolute userData;
begin
  if cpArbiterIsFirstContact(arb) <> cpFalse then
    Scene.HandleHits(arb);
end;

procedure TJointScene.Load;
var
  Handler: TCollisionHandler;
  B, C, K: TBody;
  J: TJoint;
  M: TFloat;
  I: Integer;
begin
  inherited Load;
  Space.Gravity := Vect(0, 1000);
  Space.SleepTimeThreshold := 0.25;
  Space.IdleSpeedThreshold := 8;
  Space.Damping := 0.8;

  Handler := Space.AddCollisionHandler(weightType, weightType);
  Handler.postSolveFunc := WeightsCollide;
  Handler.userData := Self;

  Handler := Space.AddCollisionHandler(weightType, ballType);
  Handler.postSolveFunc := WeightsCollide;
  Handler.userData := Self;

  for I := 0 to 20 do
  begin
    C := Space.NewBody;
    with C.NewCircle(30) do
    begin
      Friction := 0.7;
      Elasticity := 0.75;
      Density := 2;
      CollisionType := ballType;
    end;
    C.Position := Vect(Random * 1800 + 100, Random * -500 - 200);
  end;

  for I := 1 to 7 do
  begin
    B := Space.NewBody;
    with B.NewBox(80, I * 25) do
    begin
      Friction := 0.7;
      Elasticity := 1;
      Density := 5;
      CollisionType := weightType;
    end;
    B.Position := Vect(I * 200 + 150, 600);
    K := Space.NewKinematicBody;
    with K.NewBox(40, 40) do
    begin
      Friction := 0;
      Elasticity := 0;
      CollisionType := boxType;
    end;
    K.Position := Vect(I * 200 + 150, 400);
    M := cpBodyGetMass(B) / 100000;
    J := Space.NewDampedSpring(K, B,  Vect(0, 0), Vect(0, -I * 25 / 2), 100, 1000000 * M, 0.1);
    J.CollideBodies := True;
  end;

  GenerateStudioWalls;
  AllowGrab := True;
end;

procedure TJointScene.Render(Width, Height: Integer; const Time: Double);
const
  Title = 'Joint & Collision Test'#10 +
    'This program tests spring joints and precise collision detection of contact points';
  RingTime = 3;
var
  Fade: Double;
  I, J: Integer;
begin
  inherited Render(Width, Height, Time);
  DrawPhysics;
  nvgStrokeWidth(Ctx, 3);
  for I := Low(FHits) to High(FHits) do
    if Time - FHitTimes[I] < RingTime then
    begin
      Fade := 1 - (Time - FHitTimes[I]) / RingTime;
      Fade := Fade * Fade * Fade * Fade * Fade;
      for J := 0 to 2 do
      begin
        nvgStrokeColor(Ctx, nvgRGBAf(1, 0.5, 1, Fade));
        nvgBeginPath(Ctx);
        nvgCircle(Ctx, FHits[I].x, FHits[I].y, 50 * Fade);
        nvgStroke(Ctx);
        Fade := Fade * Fade;
      end;
    end;
  nvgResetTransform(Ctx);
  DrawSceneInfo(Title);
end;

end.