Delphi/CppBuilder

开发平台：
Delphi

UMain.pas：源码内容
							unit UMain;
interface
{$I ....SourcePhysics2D.inc}
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CheckLst, ExtCtrls, UOpenGLCanvas, MSTimer, UPhysics2D,
  UPhysics2DTypes, Math, OpenGL;
const
   k_maxContactPoints = 2048;
type
  TDrawPanel = class(TWinControl)
  published
     property OnResize;
     property OnMouseDown;
     property OnMouseMove;
     property OnMouseUp;
  end;
  TfrmMain = class(TForm)
    Panel1: TPanel;
    cboTests: TComboBox;
    Label1: TLabel;
    chkPositionCorrection: TCheckBox;
    chkWarmStarting: TCheckBox;
    chkTimeOfImpact: TCheckBox;
    Label2: TLabel;
    chklstVisibility: TCheckListBox;
    btnPause: TButton;
    btnSingleStep: TButton;
    GroupBox1: TGroupBox;
    editGravityX: TEdit;
    editGravityY: TEdit;
    btnConfirmGravity: TButton;
    Label3: TLabel;
    Label4: TLabel;
    btnReset: TButton;
    GroupBox2: TGroupBox;
    rdoRealTime: TRadioButton;
    rdoFixedStep: TRadioButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure chklstVisibilityClickCheck(Sender: TObject);
    procedure SimulationOptionsChanged(Sender: TObject);
    procedure btnSingleStepClick(Sender: TObject);
    procedure btnPauseClick(Sender: TObject);
    procedure cboTestsChange(Sender: TObject);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure btnConfirmGravityClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure btnResetClick(Sender: TObject);
    procedure cboTestsCloseUp(Sender: TObject);
    procedure rdoRealTimeClick(Sender: TObject);
    procedure rdoFixedStepClick(Sender: TObject);
  private
    { Private declarations }
	   lastp: TGLPointF;
     DrawPanel: TDrawPanel;
     procedure DrawPanelResize(Sender: TObject);
     procedure DrawPanelMouseDown(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
     procedure DrawPanelMouseUp(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
     procedure DrawPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
       Y: Integer);
  public
    { Public declarations }
     procedure TimerProgress(const deltaTime, newTime: Double);
     procedure ResetView;
  end;
  TTester = class;
  TDrawer = class(Tb2DebugDraw)
  public
      Canvas: TGLCanvas;
      procedure DrawPolygon(const vertices: Tb2PolyVertices; vertexCount: Int32; const color: RGBA); override;
      procedure DrawPolygon4(const vertices: TVectorArray4; vertexCount: Int32; const color: RGBA); override;
      procedure DrawSolidPolygon(const vertices: Tb2PolyVertices; vertexCount: Int32; const color: RGBA); override;
      procedure DrawCircle(const center: TVector2; radius: Float; const color: RGBA); override;
      procedure DrawSolidCircle(const center, axis: TVector2; radius: Float; const color: RGBA); override;
      procedure DrawSegment(const p1, p2: TVector2; const color: RGBA); override;
      procedure DrawXForm(const xf: Tb2XForm); override;
      procedure DrawPoint(const p: TVector2; size: Float; const color: RGBA);
  end;
  TDestructionListener = class(Tb2DestructionListener)
  public
     test: TTester;
     procedure SayGoodbye(shape:Tb2Shape); overload; override;
     procedure SayGoodbye(joint: Tb2Joint); overload; override;
  end;
  TBoundaryListener = class(Tb2BoundaryListener)
  public
     test: TTester;
     procedure Violation(body: Tb2Body); override;
  end;
  TContactListener = class(Tb2ContactListener)
  public
     test: TTester;
   	 procedure Add(var point: Tb2ContactPoint); override;
     procedure Persist(var point: Tb2ContactPoint); override;
	   procedure Remove(var point: Tb2ContactPoint); override;
  end;
  TContactState = (e_contactAdded, e_contactPersisted, e_contactRemoved);
  TContactPoint = record
     shape1, shape2: Tb2Shape;
     normal, position, velocity: TVector2;
     id: Tb2ContactID;
     state: TContactState;
  end;
  TSettings = record
     drawShapes, drawJoints, drawCoreShapes, drawAABBs,
     drawOBBs, drawPairs, drawContactPoints, drawContactNormals,
     drawContactForces, drawFrictionForces, drawCOMs, drawStats, drawKeyInfo,
     enableWarmStarting, enablePositionCorrection, enableTOI,
     pause, singleStep, realTime, customedStep: Boolean;
  end;
  TTestClass = class of TTester;
  TTester = class
  protected
     m_RemainTime: Float;
  public
     m_frameCount: Integer;
     m_worldAABB: Tb2AABB;
     m_points: array[0..k_maxContactPoints - 1] of TContactPoint;
     m_pointCount: Int32;
     m_destructionListener: TDestructionListener;
     m_boundaryListener: TBoundaryListener;
     m_contactListener: TContactListener;
     m_world: Tb2World;
     m_bomb: Tb2Body;
     m_mouseJoint: Tb2MouseJoint;
     m_debugDrawer: TDrawer;
     m_textLine: Int32;
     constructor Create; virtual;
     destructor Destroy; override;
     procedure NextLine;
     procedure Step(var settings: TSettings; timeStep: Float); virtual;
     procedure Keyboard(key: Byte); virtual;
     procedure MouseDown(const p: TVector2);
     procedure MouseUp;
     procedure MouseMove(const p: TVector2);
     procedure LaunchBomb(velocity_factor: Float = 1.0); virtual;
     procedure DrawText(const text: string);
     // Let derived tests know that a joint was destroyed.
     procedure JointDestroyed(joint: Tb2Joint); virtual;
     procedure BoundaryViolated(body: Tb2Body); virtual;
  end;
const
   DefaultStep = 1 / 60;
var
  frmMain: TfrmMain;
procedure RegisterTestEntry(name: ShortString; ClassType: TTestClass);
implementation
{$R *.dfm}
type
   PTestEntry = ^TTestEntry;
   TTestEntry = record
      Name: ShortString;
      ClassType: TTestClass;
   end;
var
   Settings: TSettings;
   Drawer: TDrawer;
   GLCanvas: TGLCanvas;
   Test: TTester;
   TestEntries: array of TTestEntry;
   TestCount: Integer;
   ActiveEntry: PTestEntry;
procedure RegisterTestEntry(name: ShortString; ClassType: TTestClass);
begin
   SetLength(TestEntries, TestCount + 1);
   TestEntries[TestCount].Name := name;
   TestEntries[TestCount].ClassType := ClassType;
   Inc(TestCount);
end;   
procedure TfrmMain.btnConfirmGravityClick(Sender: TObject);
var
   v: TVector2;
begin
   if Assigned(Test) then
   begin
      v.x := StrToFloatDef(editGravityX.Text, 0.0);
      v.y := StrToFloatDef(editGravityY.Text, -10.0);
      editGravityX.Text := FloatToStr(v.x);
      editGravityY.Text := FloatToStr(v.y);
      Test.m_world.SetGravity(v);
      Test.m_world.WakeAllSleepingBodies;
   end;
end;
procedure TfrmMain.btnPauseClick(Sender: TObject);
begin
   Settings.pause := not Settings.pause;
end;
procedure TfrmMain.btnResetClick(Sender: TObject);
begin
   if Assigned(Test) then
   begin
      FreeAndNil(Test);
      if Assigned(ActiveEntry) then
      begin
         Test := ActiveEntry^.ClassType.Create;
         MSCadencer.Reset;
      end;
   end;
end;
procedure TfrmMain.btnSingleStepClick(Sender: TObject);
begin
	 Settings.pause := True;
	 Settings.singleStep := True;
end;
procedure TfrmMain.cboTestsChange(Sender: TObject);
begin
   if cboTests.ItemIndex = -1 then
      ActiveEntry := nil
   else
      ActiveEntry := @TestEntries[cboTests.ItemIndex];   
   if Assigned(ActiveEntry) then
   begin
      if Assigned(Test) then
         Test.Free;
      Test := ActiveEntry^.ClassType.Create;
      MSCadencer.Reset;
      MSCadencer.Enabled := True;
   end;
end;
procedure TfrmMain.cboTestsCloseUp(Sender: TObject);
begin
   if frmMain.ActiveControl = cboTests then
      frmMain.ActiveControl := nil;
end;
procedure TfrmMain.chklstVisibilityClickCheck(Sender: TObject);
type
   TSettingArray = array[0..SizeOf(TSettings) div SizeOf(Boolean) - 1] of Boolean;
var
   flag: Tb2DebugDrawBitsSet;
   i: Integer;
   SettingArray: TSettingArray;
begin
   for i := 0 to High(SettingArray) - 7 do
      TSettingArray(Settings)[i] := chklstVisibility.Checked[i];
   flag := [];
   with Settings do
   begin
      if drawShapes then
         Include(flag, e_shapeBit);
      if drawJoints then
         Include(flag, e_jointBit);
      if drawCoreShapes then
         Include(flag, e_coreShapeBit);
      if drawAABBs then
         Include(flag, e_aabbBit);
      if drawOBBs then
         Include(flag, e_obbBit);
      if drawPairs then
         Include(flag, e_pairBit);
      if drawCOMs then
         Include(flag, e_centerOfMassBit);
   end;
   Drawer.m_drawFlags := flag;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
var
   i: Integer;
begin
   DrawPanel := TDrawPanel.Create(Self);
   DrawPanel.Parent := Self;
   DrawPanel.Align := alClient;
   DrawPanel.OnMouseDown := DrawPanelMouseDown;
   DrawPanel.OnMouseMove := DrawPanelMouseMove;
   DrawPanel.OnMouseUp := DrawPanelMouseUp;
   DrawPanel.OnResize := DrawPanelResize;
   // Add test entries
   for i := 0 to TestCount - 1 do
      cboTests.Items.Add(TestEntries[i].Name);
   FillChar(Settings, SizeOf(Settings), 0);
   with Settings do
   begin
	    drawShapes := True;
	 	  drawJoints := True;
      drawStats := True;
      drawKeyInfo := True;
		  enableWarmStarting := True;
		  enablePositionCorrection := True;
		  enableTOI := True;
      realTime := True;
   end;
   chklstVisibility.Checked[0] := True;
   chklstVisibility.Checked[1] := True;
   chklstVisibility.Checked[11] := True;
   chklstVisibility.Checked[12] := True;
   chkPositionCorrection.Checked := True;
   chkWarmStarting.Checked := True;
   chkTimeOfImpact.Checked := True;
   rdoRealTime.Checked := True;
   MSCadencer := TMSTimer.Create;
   MSCadencer.OnProgress := TimerProgress;
   GLCanvas := TGLCanvas.Create(DrawPanel, False, True, False, True);
   GLCanvas.DefaultFont.WinColor := clWhite;
   Drawer := TDrawer.Create;
   Drawer.Canvas := GLCanvas;
   ResetView;
   chklstVisibilityClickCheck(nil);
   cboTests.ItemIndex := 0;
   cboTestsChange(nil);
   SimulationOptionsChanged(nil);
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
   MSCadencer.Enabled := False;
   if Assigned(Test) then
      Test.Free;
   MSCadencer.Free;
   GLCanvas.Free;
   Drawer.Free;
end;
procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   case Key of
      VK_ESCAPE: Close;
      90{'Z'}: GLCanvas.SetEqualScale(b2Min(GLCanvas.ScaleX * 1.1, 60.0));
      88{'X'}: GLCanvas.SetEqualScale(b2Min(GLCanvas.ScaleX * 0.9, 0.5));
      VK_SPACE:
         if Assigned(Test) then
            Test.LaunchBomb;
      VK_LEFT: GLCanvas.SetTranslateX(GLCanvas.TranslateX - 1.0);
      VK_RIGHT: GLCanvas.SetTranslateX(GLCanvas.TranslateX + 1.0);
      VK_UP: GLCanvas.SetTranslateY(GLCanvas.TranslateY + 1.0);
      VK_DOWN: GLCanvas.SetTranslateY(GLCanvas.TranslateY - 1.0);
      VK_HOME: ResetView;
   else
      if Assigned(Test) then
         Test.Keyboard(Key);
   end;
end;
procedure TfrmMain.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
   GLCanvas.SetEqualScale(b2Max(GLCanvas.ScaleX * 0.9, 0.5));
end;
procedure TfrmMain.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
   GLCanvas.SetEqualScale(b2Min(GLCanvas.ScaleX * 1.1, 60.0));
end;
procedure TfrmMain.rdoFixedStepClick(Sender: TObject);
begin
   Settings.realTime := False;
end;
procedure TfrmMain.rdoRealTimeClick(Sender: TObject);
begin
   Settings.realTime := True;
end;
procedure TfrmMain.DrawPanelResize(Sender: TObject);
begin
   if Assigned(GLCanvas) then
      ResetView;
end;
procedure TfrmMain.DrawPanelMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
   p: TGLPointF;
   pv: TVector2;
begin
   ActiveControl := nil;
   if Button = mbLeft then
   begin            
      if Assigned(Test) then
      begin
         p := GLCanvas.ConvertScreenToWorld(X, Y);
         pv.x := p.X;
         pv.y := p.Y;
         Test.MouseDown(pv);
      end;
   end
   else if Button = mbRight then
   begin
      lastp.X := X;
      lastp.Y := Y;
   end;
end;
procedure TfrmMain.DrawPanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
   p: TGLPointF;
   pv, diff: TVector2;
begin
   p := GLCanvas.ConvertScreenToWorld(X, Y);
   pv.x := p.X;
   pv.y := p.Y;
   if Assigned(Test) then
      Test.MouseMove(pv);
   if ssRight in Shift then
   begin
      diff.x := lastp.X - X;
      diff.y := lastp.Y - Y;
      GLCanvas.BeginUpdateTransformation;
      GLCanvas.TranslateX := GLCanvas.TranslateX - diff.x;
      GLCanvas.TranslateY := GLCanvas.TranslateY + diff.y;
      GLCanvas.EndUpdateTransformation;
      lastp.X := X;
      lastp.Y := Y;
   end;
end;
procedure TfrmMain.DrawPanelMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if Button = mbLeft then
      test.MouseUp;
end;
procedure TfrmMain.ResetView;
begin
   GLCanvas.BeginUpdateTransformation.ResetTransformation.
      SetTranslateX(DrawPanel.Width div 2).SetTranslateY(DrawPanel.Height div 2 - 20).SetEqualScale(10).
   EndUpdateTransformation;
end;
procedure TfrmMain.SimulationOptionsChanged(Sender: TObject);
begin
   with Settings do
   begin
      enableWarmStarting := chkWarmStarting.Checked;
      enablePositionCorrection := chkPositionCorrection.Checked;
      enableTOI := chkTimeOfImpact.Checked;
      if Assigned(Test) then
      begin
         Test.m_world.m_warmStarting := enableWarmStarting;
         Test.m_world.m_positionCorrection := enablePositionCorrection;
         Test.m_world.m_continuousPhysics := enableTOI;
      end;
   end;
end;
procedure TfrmMain.TimerProgress(const deltaTime, newTime: Double);
begin
   if Assigned(Test) then
   begin
      GLCanvas.RenderingBegin(clBlack);
      Test.m_textLine := DrawPanel.ClientHeight - 15;
      Test.DrawText(ActiveEntry^.Name);
      Test.NextLine;
      Test.DrawText(Format('Delta Time: %.3fs', [deltaTime]));
      Test.Step(settings, deltaTime);
      GLCanvas.RenderingEnd;
   end
   else
      MSCadencer.Enabled := False;
end;
{ TDrawer }
procedure TDrawer.DrawPolygon(const vertices: Tb2PolyVertices;
  vertexCount: Int32; const color: RGBA);
{$IFNDEF SINGLE_PRECISION}
var
   i: Integer;
{$ENDIF}
begin
   {$IFDEF SINGLE_PRECISION}
   Canvas.SetPenColor(TColorVector(color)).Polygon(TGLPointsF(@vertices[0]), vertexCount);
   {$ELSE}
   Canvas.SetPenColor(TColorVector(color));
   glBegin(GL_LINE_LOOP);
   for i := 0 to vertexCount - 1 do
      glVertex2d(vertices[i].X, vertices[i].Y);
   glEnd;
   {$ENDIF}
end;
procedure TDrawer.DrawPolygon4(const vertices: TVectorArray4;
   vertexCount: Int32; const color: RGBA);
{$IFNDEF SINGLE_PRECISION}
var
   i: Integer;
{$ENDIF}
begin
   {$IFDEF SINGLE_PRECISION}
   Canvas.SetPenColor(TColorVector(color)).Polygon(TGLPointsF(@vertices[0]), 4);
   {$ELSE}
   Canvas.SetPenColor(TColorVector(color));
   glBegin(GL_LINE_LOOP);
   for i := 0 to 3 do
      glVertex2d(vertices[i].X, vertices[i].Y);
   glEnd;
   {$ENDIF}
end;
procedure TDrawer.DrawSolidPolygon(const vertices: Tb2PolyVertices;
   vertexCount: Int32; const color: RGBA);
var
   tmp: TColorVector;
{$IFNDEF SINGLE_PRECISION}
   i: Integer;
{$ENDIF}
begin
   with TRGBA(color) do
   begin
      tmp[0] := red / 2;
      tmp[1] := green / 2;
      tmp[2] := blue / 2;
      tmp[3] := 0.5;
   end;
   {$IFDEF SINGLE_PRECISION}
   Canvas.SetPenColor(TColorVector(color)).SetBrushColor(tmp).
      FillPolygon(TGLPointsF(@vertices[0]), vertexCount, True);
   {$ELSE}
   Canvas.SetPenColor(tmp);
   glBegin(GL_POLYGON);
   for i := 0 to vertexCount - 1 do
      glVertex2d(vertices[i].X, vertices[i].Y);
   glEnd;
   Canvas.SetPenColor(TColorVector(color));
   glBegin(GL_LINE_LOOP);
   for i := 0 to vertexCount - 1 do
      glVertex2d(vertices[i].X, vertices[i].Y);
   glEnd;
   {$ENDIF}
end;
procedure TDrawer.DrawCircle(const center: TVector2; radius: Float; const color: RGBA);
begin
   Canvas.SetPenColor(TColorVector(color)).Ellipse(center.x, center.y, radius, radius);
end;
procedure TDrawer.DrawSolidCircle(const center, axis: TVector2; radius: Float; const color: RGBA);
var
   tmp: TColorVector;
   p: TVector2;
begin
   Canvas.SetPenColor(TColorVector(color));
   with TRGBA(color) do
   begin
      tmp[0] := red / 2;
      tmp[1] := green / 2;
      tmp[2] := blue / 2;
      tmp[3] := 0.5;
   end;
   Canvas.SetBrushColor(tmp).FillEllipse(center.x, center.y, radius, radius, True);
  {$IFDEF OP_OVERLOAD}
	p := center + radius * axis;
  {$ELSE}
  p := Add(center, Multiply(axis, radius));
  {$ENDIF}
  Canvas.Line(center.x, center.y, p.x, p.y);
end;
procedure TDrawer.DrawSegment(const p1, p2: TVector2; const color: RGBA);
begin
   Canvas.SetPenColor(TColorVector(color)).Line(p1.x, p1.y, p2.x, p2.y);
end;
procedure TDrawer.DrawXForm(const xf: Tb2XForm);
const
   k_axisScale = 0.4;
   clRed: TColorVector = (1.0, 0.0, 0.0, 1.0);
   clGreen: TColorVector = (0.0, 1.0, 0.0, 1.0);
var
   p2: TVector2;
begin
   with xf do
   begin
      p2.x := position.x + k_axisScale * R.col1.x;
      p2.y := position.y + k_axisScale * R.col1.y;
      Canvas.SetPenColor(clRed).Line(position.x, position.y, p2.x, p2.y);
      p2.x := position.x + k_axisScale * R.col2.x;
      p2.y := position.y + k_axisScale * R.col2.y;
      Canvas.SetPenColor(clGreen).Line(position.x, position.y, p2.x, p2.y);
   end;
end;
procedure TDrawer.DrawPoint(const p: TVector2; size: Float; const color: RGBA);
begin
   glPointSize(size);
   glColor3f(color[0], color[1], color[2]);
   glBegin(GL_POINTS);
   glVertex2f(p.x, p.y);
   glEnd;
   glPointSize(1.0);
end;
{ TDestructionListener }
procedure TDestructionListener.SayGoodbye(shape: Tb2Shape);
begin
end;
procedure TDestructionListener.SayGoodbye(joint: Tb2Joint);
begin
   if test.m_mouseJoint = joint then
      test.m_mouseJoint := nil
   else
      test.JointDestroyed(joint);
end;
{ TBoundaryListener }
procedure TBoundaryListener.Violation(body: Tb2Body);
begin
	if test.m_bomb <> body then
	   test.BoundaryViolated(body);
end;
{ TContactListener }
procedure TContactListener.Add(var point: Tb2ContactPoint);
begin
   if test.m_pointCount = k_maxContactPoints then
      Exit;
   with test.m_points[test.m_pointCount] do
   begin
      shape1 := point.shape1;
      shape2 := point.shape2;
      position := point.position;
      normal := point.normal;
      id := point.id;
      state := e_contactAdded;
   end;
   Inc(test.m_pointCount);
end;
procedure TContactListener.Persist(var point: Tb2ContactPoint);
begin
   if test.m_pointCount = k_maxContactPoints then
      Exit;
   with test.m_points[test.m_pointCount] do
   begin
      shape1 := point.shape1;
      shape2 := point.shape2;
      position := point.position;
      normal := point.normal;
      id := point.id;
      state := e_contactPersisted;
   end;
   Inc(test.m_pointCount);
end;
procedure TContactListener.Remove(var point: Tb2ContactPoint);
begin
   if test.m_pointCount = k_maxContactPoints then
      Exit;
   with test.m_points[test.m_pointCount] do
   begin
      shape1 := point.shape1;
      shape2 := point.shape2;
      position := point.position;
      normal := point.normal;
      id := point.id;
      state := e_contactRemoved;
   end;
   Inc(test.m_pointCount);
end;
{ TTester }
constructor TTester.Create;
const
   WorldLowerBound: TVector2 = (x: -200.0; y: -100.0);
   WorldUpperBound: TVector2 = (x: 200.0; y: 200.0);
var
   gravity: TVector2;
begin
   m_RemainTime := 0.0;
   m_frameCount := 0;
   m_destructionListener := TDestructionListener.Create;
   m_boundaryListener := TBoundaryListener.Create;
   m_contactListener := TContactListener.Create;
   m_worldAABB.lowerBound := WorldLowerBound;
   m_worldAABB.upperBound := WorldUpperBound;
   gravity.x := 0.0;
   gravity.y := -10.0;
   m_world := Tb2World.Create(m_worldAABB, gravity, True);
   frmMain.editGravityX.Text := FloatToStr(gravity.x);
   frmMain.editGravityY.Text := FloatToStr(gravity.y);
   m_bomb := nil;
   m_textLine := 30;
   m_mouseJoint := nil;
   m_pointCount := 0;
   m_destructionListener.test := Self;
   m_boundaryListener.test := Self;
   m_contactListener.test := Self;
   m_world.m_destructionListener := m_destructionListener;
   m_world.m_boundaryListener := m_boundaryListener;
   m_world.m_contactListener := m_contactListener;
   m_world.m_debugDraw := Drawer;
   m_debugDrawer := Drawer;
   m_world.m_warmStarting := Settings.enableWarmStarting;
   m_world.m_positionCorrection := Settings.enablePositionCorrection;
   m_world.m_continuousPhysics := Settings.enableTOI;
end;
destructor TTester.Destroy;
begin
   m_world.Free;
   m_destructionListener.Free;
   m_boundaryListener.Free;
   m_contactListener.Free;   
   inherited;
end;
procedure TTester.NextLine;
begin
   m_textLine := m_textLine - 15;
end;
procedure TTester.Step(var settings: TSettings; timeStep: Float);
const
   k_axisScale = 0.4;
   clAdd: RGBA = (0.3, 0.95, 0.3, 1.0);
   clPersist: RGBA = (0.3, 0.3, 0.95, 1.0);
   clRemove: RGBA = (0.95, 0.3, 0.3, 1.0);
   clContactNormal: RGBA = (0.4, 0.9, 0.4, 1.0);
var
   i: Integer;
   p1, p2: TVector2;
begin
   if not Settings.customedStep then
   begin
      m_pointCount := 0;
      if not settings.realTime then
         timeStep := DefaultStep;
      if settings.pause then
      begin
         m_RemainTime := 0.0;
         if settings.singleStep then
         begin
            settings.singleStep := False;
            Inc(m_frameCount);
         end
         else
            timeStep := 0.0;
         DrawText('****PAUSED****');
      end
      else
         Inc(m_frameCount);
      if settings.realTime then // Make sure that every frame is processed using a time step pf 1/60s.
      begin
         timeStep := timeStep + m_RemainTime;
         while timeStep > DefaultStep do
         begin
            m_world.Step(DefaultStep, 10, False);
            timeStep := timeStep - DefaultStep;
         end;
         m_RemainTime := timeStep;
         m_world.DrawDebugData;
      end
      else
         m_world.Step(timeStep, 10, True);
      m_world.Validate;
      if Assigned(m_bomb) and m_bomb.IsFrozen then
      begin
         m_world.DestroyBody(m_bomb);
         m_bomb := nil;
      end;
   end;
   if settings.drawKeyInfo then
      DrawText('Z:Zoom in   X:Zoom out   Space:Launch bomb   Arrows:Move view   Home:Reset view');
   if settings.drawStats then
   begin
      DrawText(Format('proxies(max) = %d(%d), pairs(max) = %d(%d)',
        [m_world.GetProxyCount, b2_maxProxies, m_world.GetPairCount, b2_maxPairs]));
      DrawText(Format('bodies/contacts/joints = %d/%d/%d',
         [m_world.GetBodyCount, m_world.GetContactCount, m_world.GetJointCount]));
      NextLine;
   end;
   if Assigned(m_mouseJoint) then
   begin
      p1 := m_mouseJoint.GetBody2.GetWorldPoint(m_mouseJoint.m_localAnchor);
      p2 := m_mouseJoint.m_target;
      glPointSize(4.0);
      glColor3f(0.0, 1.0, 0.0);
      glBegin(GL_POINTS);
      glVertex2f(p1.x, p1.y);
      glVertex2f(p2.x, p2.y);
      glEnd;
      glPointSize(1.0);
      glColor3f(0.8, 0.8, 0.8);
      glBegin(GL_LINES);
      glVertex2f(p1.x, p1.y);
      glVertex2f(p2.x, p2.y);
      glEnd;
   end;
   if settings.drawContactPoints then
   begin
      for i := 0 to m_pointCount - 1 do
         with m_points[i] do
         begin
            if state = e_contactAdded then // Add
               Drawer.DrawPoint(position, 10.0, clAdd)
            else if state = e_contactPersisted then // Persist
               Drawer.DrawPoint(position, 5.0, clPersist)
            else // Remove
               Drawer.DrawPoint(position, 10.0, clRemove);
            if settings.drawContactNormals then
               {$IFDEF OP_OVERLOAD}
               Drawer.DrawSegment(position, position + k_axisScale * normal, clContactNormal);
               {$ELSE}               
               Drawer.DrawSegment(position, Add(position, Multiply(normal, k_axisScale)), clContactNormal);
               {$ENDIF}
         end;
   end;
end;
procedure TTester.Keyboard(key: Byte);
begin
end;
procedure TTester.MouseDown(const p: TVector2);
const k_maxCount = 10;
var
   i: Integer;
   aabb: Tb2AABB;
   d: TVector2;
   count: Int32;
   body, shapeBody: Tb2Body;
   shapes: TList;
   md: Tb2MouseJointDef;
begin
   if Assigned(m_mouseJoint) then
      Exit;
   // Make a small box.
   {$IFDEF OP_OVERLOAD}   
   d.SetValue(0.001, 0.001);
   aabb.lowerBound := p - d;
   aabb.upperBound := p + d;
   {$ELSE}   
   SetValue(d, 0.001, 0.001);
   aabb.lowerBound := Subtract(p, d);
   aabb.upperBound := Add(p, d);
   {$ENDIF}      
   // Query the world for overlapping shapes.
   shapes := TList.Create;
   count := m_world.Query(aabb, shapes, k_maxCount);
   body := nil;
   for i := 0 to count - 1 do
   begin
      shapeBody := Tb2Shape(shapes[i]).GetBody;
      if (not shapeBody.IsStatic) and (shapeBody.GetMass > 0.0) then
         if Tb2Shape(shapes[i]).TestPoint(shapeBody.m_xf, p) then
         begin
            body := Tb2Shape(shapes[i]).GetBody;
            Break;
         end;
   end;
   if Assigned(body) then
   begin
      md := Tb2MouseJointDef.Create;
      md.body1 := m_world.GetGroundBody;
      md.body2 := body;
      md.target := p;
      md.maxForce := 1000.0 * body.GetMass;
      m_mouseJoint := Tb2MouseJoint(m_world.CreateJoint(md));
      body.WakeUp;
   end;
end;
procedure TTester.MouseUp;
begin
   if Assigned(m_mouseJoint) then
   begin
      m_world.DestroyJoint(m_mouseJoint);
      m_mouseJoint := nil;
   end;
end;
procedure TTester.MouseMove(const p: TVector2);
begin
	 if Assigned(m_mouseJoint) then
      m_mouseJoint.SetTarget(p);
end;
procedure TTester.LaunchBomb(velocity_factor: Float = 1.0);
var
   bd: Tb2BodyDef;
   sd: Tb2CircleDef;
begin
   if Assigned(m_bomb) then
   begin
     m_world.DestroyBody(m_bomb);
     m_bomb := nil;
   end;
   bd := Tb2BodyDef.Create;
   bd.allowSleep := True;
   {$IFDEF OP_OVERLOAD}   
   bd.position.SetValue(RandomRange(-15, 15), RandomRange(10, 30));
   {$ELSE}
   SetValue(bd.position, RandomRange(-15, 15), RandomRange(10, 30));
   {$ENDIF}      
   bd.isBullet := True;
   m_bomb := m_world.CreateBody(bd);
   {$IFDEF OP_OVERLOAD}   
   m_bomb.SetLinearVelocity(-5.0 * bd.position * velocity_factor);
   {$ELSE}   
   m_bomb.SetLinearVelocity(Multiply(bd.position, -5.0 * velocity_factor));
   {$ENDIF}      
   sd := Tb2CircleDef.Create;
   sd.radius := 0.3;
   sd.density := 20.0;
   sd.restitution := 0.1;
   m_bomb.CreateShape(sd);
   m_bomb.SetMassFromShapes;
end;
procedure TTester.DrawText(const text: string);
begin
   m_debugDrawer.Canvas.TextOutASCII(text, 5, m_textLine);
   NextLine;
end;
procedure TTester.JointDestroyed(joint: Tb2Joint);
begin
end;
procedure TTester.BoundaryViolated(body: Tb2Body);
begin
end;
initialization
   RegisterClass(TDrawPanel);
   TestCount := 0;
   ActiveEntry := nil;
end.

						