hgephysics.pas

此為國外大名鼎鼎的2D遊戲引擎HGE的Delphi版本 原官方是C++的,現在完全改為Delphi可使用,另外再增加許多單元與功能 新增的單元有HGEImages,HGECanvas,HGEDef

unit HGEPhysics;
(*
** Haaf's Game Engine 1.7
** Copyright (C) 2003-2007, Relish Games
** hge.relishgames.com
**
** Extension to the HGE engine to support box based physics.
** This extension is based on Box2D (http://www.gphysics.com).
** Extension added by Erik van Bilsen
**
** This extension is NOT part of the original HGE engine.
*)

interface

uses
  Math, HGE, HGEVector, HGEMatrix;

type
  IHGEBody = interface
  ['{99739E99-4DD1-4913-A59E-A3A85E4F4420}']
    { Property access methods }
    function GetPosition: THGEVector;
    function GetPPosition: PHGEVector;
    procedure SetPosition(const Value: THGEVector);
    function GetRotation: Single;
    procedure SetRotation(const Value: Single);
    function GetVelocity: THGEVector;
    function GetPVelocity: PHGEVector;
    procedure SetVelocity(const Value: THGEVector);
    function GetAngularVelocity: Single;
    procedure SetAngularVelocity(const Value: Single);
    function GetBiasedVelocity: THGEVector;
    function GetPBiasedVelocity: PHGEVector;
    procedure SetBiasedVelocity(const Value: THGEVector);
    function GetBiasedAngularVelocity: Single;
    procedure SetBiasedAngularVelocity(const Value: Single);
    function GetForce: THGEVector;
    function GetPForce: PHGEVector;
    procedure SetForce(const Value: THGEVector);
    function GetTorque: Single;
    procedure SetTorque(const Value: Single);
    function GetSize: THGEVector;
    function GetPSize: PHGEVector;
    function GetFriction: Single;
    procedure SetFriction(const Value: Single);
    function GetMass: Single;
    function GetInvMass: Single;
    function GetI: Single;
    function GetInvI: Single;
    function GetIsStationary: Boolean;

    { Methods }
    procedure AddForce(const Force: THGEVector);

    { Properties }
    property Position: THGEVector read GetPosition write SetPosition;
    property PPosition: PHGEVector read GetPPosition;
    property Rotation: Single read GetRotation write SetRotation;
    property Velocity: THGEVector read GetVelocity write SetVelocity;
    property PVelocity: PHGEVector read GetPVelocity;
    property AngularVelocity: Single read GetAngularVelocity write SetAngularVelocity;
    property BiasedVelocity: THGEVector read GetBiasedVelocity write SetBiasedVelocity;
    property PBiasedVelocity: PHGEVector read GetPBiasedVelocity;
    property BiasedAngularVelocity: Single read GetBiasedAngularVelocity write SetBiasedAngularVelocity;
    property Force: THGEVector read GetForce write SetForce;
    property PForce: PHGEVector read GetPForce;
    property Torque: Single read GetTorque write SetTorque;
    property Size: THGEVector read GetSize;
    property PSize: PHGEVector read GetPSize;
    property Friction: Single read GetFriction write SetFriction;
    property Mass: Single read GetMass;
    property InvMass: Single read GetInvMass;
    property I: Single read GetI;
    property InvI: Single read GetInvI;
    property IsStationary: Boolean read GetIsStationary;
  end;

type
  IHGEBodyList = interface
  ['{6C94306E-015D-477A-B6A5-BC9F98BD6533}']
    { Property access methods }
    function GetCount: Integer;
    function GetBody(const Index: Integer): IHGEBody;

    { Methods }
    procedure Add(const Body: IHGEBody);
    procedure Clear;

    { Properties }
    property Count: Integer read GetCount;
    property Bodies[const Index: Integer]: IHGEBody read GetBody; default;
  end;

type
  IHGEJoint = interface
  ['{EAA8B96D-0F27-4E01-867F-B266ACBAF258}']
    { Property access methods }
    function GetBiasFactor: Single;
    procedure SetBiasFactor(const Value: Single);
    function GetSoftness: Single;
    procedure SetSoftness(const Value: Single);
    function GetBody1: IHGEBody;
    function GetBody2: IHGEBody;
    function GetLocalAnchor1: THGEVector;
    function GetLocalAnchor2: THGEVector;

    { Methods }
    procedure PreStep(const InvDt: Single);
    procedure ApplyImpulse;

    { Properties }
    property BiasFactor: Single read GetBiasFactor write SetBiasFactor;
    property Softness: Single read GetSoftness write SetSoftness;
    property Body1: IHGEBody read GetBody1;
    property Body2: IHGEBody read GetBody2;
    property LocalAnchor1: THGEVector read GetLocalAnchor1;
    property LocalAnchor2: THGEVector read GetLocalAnchor2;
  end;

type
  IHGEJointList = interface
  ['{A7D7F96D-7D57-4EB6-B821-1BED1DB30197}']
    { Property access methods }
    function GetCount: Integer;
    function GetJoint(const Index: Integer): IHGEJoint;

    { Methods }
    procedure Add(const Joint: IHGEJoint);
    procedure Clear;

    { Properties }
    property Count: Integer read GetCount;
    property Joints[const Index: Integer]: IHGEJoint read GetJoint; default;
  end;

type
  IHGEArbiter = interface
  ['{838417B1-94EB-4C3A-9A34-4FC4F8530E1F}']
    { Property access methods }
    function GetBody1: IHGEBody;
    function GetBody2: IHGEBody;
    function GetNext: IHGEArbiter;
    procedure SetNext(const Value: IHGEArbiter);

    { Methods }
    procedure PreStep(const InvDT: Single);
    procedure ApplyImpulse;

    { Properties }
    property Body1: IHGEBody read GetBody1;
    property Body2: IHGEBody read GetBody2;

    { Internal }
    function Implementor: TObject;
    property Next: IHGEArbiter read GetNext write SetNext;
  end;

type
  IHGEArbiterList = interface
  ['{14DB415C-F609-4517-B6B5-742B7068E70A}']
    { Property access methods }
    function GetCount: Integer;

    { Methods }
    procedure Add(const Arbiter: IHGEArbiter);
    procedure Clear;
    procedure Erase(const Body1, Body2: IHGEBody);
    function First: IHGEArbiter;
    function Next: IHGEArbiter;
    function Find(const Body1, Body2: IHGEBody): IHGEArbiter;

    { Properties }
    property Count: Integer read GetCount;
  end;

type
  IHGEWorld = interface
  ['{5E229E68-FB26-4E10-A915-AFC87A44AEB3}']
    { Property access methods }
    function GetBodies: IHGEBodyList;
    function GetJoints: IHGEJointList;
    function GetArbiters: IHGEArbiterList;
    function GetGravity: THGEVector;
    function GetIterations: Integer;

    { Methods }
    procedure Add(const Body: IHGEBody); overload;
    procedure Add(const Joint: IHGEJoint); overload;
    procedure Clear;
    procedure Step(const DT: Single);

    { Properties }
    property Bodies: IHGEBodyList read GetBodies;
    property Joints: IHGEJointList read GetJoints;
    property Arbiters: IHGEArbiterList read GetArbiters;
    property Gravity: THGEVector read GetGravity;
    property Iterations: Integer read GetIterations;
  end;

type
  THGEBody = class(TInterfacedObject,IHGEBody)
  protected
    { IHGEBody }
    function GetPosition: THGEVector;
    function GetPPosition: PHGEVector;
    procedure SetPosition(const Value: THGEVector);
    function GetRotation: Single;
    procedure SetRotation(const Value: Single);
    function GetVelocity: THGEVector;
    function GetPVelocity: PHGEVector;
    procedure SetVelocity(const Value: THGEVector);
    function GetAngularVelocity: Single;
    procedure SetAngularVelocity(const Value: Single);
    function GetBiasedVelocity: THGEVector;
    function GetPBiasedVelocity: PHGEVector;
    procedure SetBiasedVelocity(const Value: THGEVector);
    function GetBiasedAngularVelocity: Single;
    procedure SetBiasedAngularVelocity(const Value: Single);
    function GetForce: THGEVector;
    function GetPForce: PHGEVector;
    procedure SetForce(const Value: THGEVector);
    function GetTorque: Single;
    procedure SetTorque(const Value: Single);
    function GetSize: THGEVector;
    function GetPSize: PHGEVector;
    function GetFriction: Single;
    procedure SetFriction(const Value: Single);
    function GetMass: Single;
    function GetInvMass: Single;
    function GetI: Single;
    function GetInvI: Single;
    function GetIsStationary: Boolean;

    procedure AddForce(const Force: THGEVector);
  private
    FPosition: THGEVector;
    FRotation: Single;
    FVelocity: THGEVector;
    FAngularVelocity: SIngle;
    FBiasedVelocity: THGEVector;
    FBiasedAngularVelocity: Single;
    FForce: THGEVector;
    FTorque: Single;
    FSize: THGEVector;
    FFriction: SIngle;
    FMass: Single;
    FInvMass: Single;
    FI: Single;
    FInvI: Single;
  public
    constructor Create; overload;
    constructor Create(const ASize: THGEVector); overload;
    constructor Create(const ASize: THGEVector; const AMass: Single); overload;
    destructor Destroy; override;
  end;

type
  THGEJoint = class(TInterfacedObject,IHGEJoint)
  protected
    { IHGEJoint }
    function GetBiasFactor: Single;
    procedure SetBiasFactor(const Value: Single);
    function GetSoftness: Single;
    procedure SetSoftness(const Value: Single);
    function GetBody1: IHGEBody;
    function GetBody2: IHGEBody;
    function GetLocalAnchor1: THGEVector;
    function GetLocalAnchor2: THGEVector;

    procedure PreStep(const InvDt: Single);
    procedure ApplyImpulse;
  private
    FBody1: IHGEBody;
    FBody2: IHGEBody;
    FLocalAnchor1: THGEVector;
    FLocalAnchor2: THGEVector;
    FBiasFactor: Single;
    FSoftness: Single;
    FM: THGEMatrix;
    FR1: THGEVector;
    FR2: THGEVector;
    FBias: THGEVector;
    FP: THGEVector;
  public
    constructor Create; overload;
    constructor Create(const ABody1, ABody2: IHGEBody;
      const AAnchor: THGEVector); overload;
    destructor Destroy; override;
  end;

type
  THGEWorld = class(TInterfacedObject,IHGEWorld)
  protected
    { IHGEWorld }
    function GetBodies: IHGEBodyList;
    function GetJoints: IHGEJointList;
    function GetArbiters: IHGEArbiterList;
    function GetGravity: THGEVector;
    function GetIterations: Integer;

    procedure Add(const Body: IHGEBody); overload;
    procedure Add(const Joint: IHGEJoint); overload;
    procedure Clear;
    procedure Step(const DT: Single);
  private
    FBodies: IHGEBodyList;
    FJoints: IHGEJointList;
    FArbiters: IHGEArbiterList;
    FGravity: THGEVector;
    FIterations: Integer;
    procedure BroadPhase;
  public
    class var AccumulateImpulses: Boolean;
    class var SplitImpules: Boolean;
    class var WarmStarting: Boolean;
    class var PositionCorrection: Boolean;
  public
    constructor Create(const AGravity: THGEVector; const AIterations: Integer);
    destructor Destroy; override;
  end;

var // Debug
  HGEBodyCount: Integer = 0;
  HGEJointCount: Integer = 0;
  HGEArbiterCount: Integer = 0;

implementation

uses
  Classes;

type
  THGEBodyList = class(TInterfacedObject,IHGEBodyList)
  protected
    { IHGEBodyList }
    function GetCount: Integer;
    function GetBody(const Index: Integer): IHGEBody;

    procedure Add(const Body: IHGEBody);
    procedure Clear;
  private
    FBodies: IInterfaceList;
  public
    constructor Create;
  end;

type
  THGEJointList = class(TInterfacedObject,IHGEJointList)
  protected
    { IHGEJointList }
    function GetCount: Integer;
    function GetJoint(const Index: Integer): IHGEJoint;

    procedure Add(const Joint: IHGEJoint);
    procedure Clear;
  private
    FJoints: IInterfaceList;
  public
    constructor Create;
  end;

type
  TEdges = packed record
    InEdge1: Byte;
    OutEdge1: Byte;
    InEdge2: Byte;
    OutEdge2: Byte;
  end;

type
  TFeaturePair = record
    case Integer of
      0: (E: TEdges);
      1: (Value: Integer);
  end;

type
  TContact = record
  public
    Position: THGEVector;
    Normal: THGEVector;
    R1: THGEVector;
    R2: THGEVector;
    Separation: Single;
    Pn: Single;  // accumulated normal impulse
    Pt: Single;  // accumulated tangent impulse
    Pnb: Single; // accumulated normal impulse for position bias
    MassNormal: Single;
    MassTangent: Single;
    Bias: Single;
    Feature: TFeaturePair;
  end;
  PContact = ^TContact;

type
  TContacts = array [0..1] of TContact;

type
  THGEArbiter = class(TInterfacedObject,IHGEArbiter)
  protected
    { IHGEArbiter }
    function GetBody1: IHGEBody;
    function GetBody2: IHGEBody;
    function GetNext: IHGEArbiter;
    procedure SetNext(const Value: IHGEArbiter);
    function Implementor: TObject;

    procedure PreStep(const InvDT: Single);
    procedure ApplyImpulse;
  private
    FBody1: IHGEBody;
    FBody2: IHGEBody;
    FNext: IHGEArbiter;
    FFriction: Single;
    FNumContacts: Integer;
    FContacts: TContacts;
  public
    constructor Create(const ABody1, ABody2: IHGEBody;
      const AContacts: TContacts; const ANumContacts: Integer);
    destructor Destroy; override;
    procedure Update(const NewContacts: TContacts; const NewNumContacts: Integer);
  end;

const
  ArbiterHashSize = 1 shl 14;
  ArbiterHashMask = ArbiterHashSize - 1;

type
  TArbiterBuckets = array [0..ArbiterHashSize - 1] of IHGEArbiter;

type
  THGEArbiterList = class(TInterfacedObject,IHGEArbiterList)
  protected
    { IHGEArbiterList }
    function GetCount: Integer;

    procedure Add(const Arbiter: IHGEArbiter);
    procedure Clear;
    procedure Erase(const Body1, Body2: IHGEBody);
    function First: IHGEArbiter;
    function Next: IHGEArbiter;
    function Find(const Body1, Body2: IHGEBody): IHGEArbiter;
  private
    FBuckets: TArbiterBuckets;
    FCount: Integer;
    FCurrentIndex: Integer;
    FCurrentEntry: IHGEArbiter;
    function Hash(const Body1, Body2: IHGEBody): Cardinal;
  public
    destructor Destroy; override;
  end;

// Box vertex and edge numbering:
//
//        ^ y
//        |
//        e1
//   v2 ------ v1
//    |        |
// e2 |        | e4  --> x
//    |        |
//   v3 ------ v4
//        e3

type
  TAxis = (FaceAX,FaceAY,FaceBX,FaceBY);

const
  NoEdge = 0;
  Edge1  = 1;
  Edge2  = 2;
  Edge3  = 3;
  Edge4  = 4;

type
  TClipVertex = record
  public
    V: THGEVector;
    FP: TFeaturePair;
  end;

type
  TClipVertices = array [0..1] of TClipVertex;

procedure Swap(var A, B: Byte); inline;
var
  T: Byte;
begin
  T := A;
  A := B;
  B := T;
end;

function Clamp(const A, Low, High: Single): Single; inline;
begin
  Result := Max(Low,Min(A,High));
end;

procedure ComputeIncidentEdge(var C: TClipVertices; const H, Pos: THGEVector;
  const Rot: THGEMatrix; const Normal: THGEVector);
var
  RotT: THGEMatrix;
  N, NAbs: THGEVector;
begin
	// The normal is from the reference box. Convert it
	// to the incident boxe's frame and flip sign.
  RotT := Rot.Transpose;
  N := -(RotT * Normal);
  NAbs := N.Abs;

  if (NAbs.X > NAbs.Y) then begin
    if (Sign(N.X) > 0) then begin
      C[0].V := THGEVector.Create(H.X,-H.Y);
      C[0].FP.E.InEdge2 := Edge3;
      C[0].FP.E.OutEdge2 := Edge4;

      C[1].V := THGEVector.Create(H.X,H.Y);
      C[1].FP.E.InEdge2 := Edge4;
      C[1].FP.E.OutEdge2 := Edge1;
    end else begin
      C[0].V := THGEVector.Create(-H.X,H.Y);
      C[0].FP.E.InEdge2 := Edge1;
      C[0].FP.E.OutEdge2 := Edge2;

      C[1].V := THGEVector.Create(-H.X,-H.Y);
      C[1].FP.E.InEdge2 := Edge2;
      C[1].FP.E.OutEdge2 := Edge3;
    end;
  end else begin
    if (Sign(N.Y) > 0) then begin
      C[0].V := THGEVector.Create(H.X,H.Y);
      C[0].FP.E.InEdge2 := Edge4;
      C[0].FP.E.OutEdge2 := Edge1;

      C[1].V := THGEVector.Create(-H.X,H.Y);
      C[1].FP.E.InEdge2 := Edge1;
      C[1].FP.E.OutEdge2 := Edge2;
    end else begin
      C[0].V := THGEVector.Create(-H.X,-H.Y);
      C[0].FP.E.InEdge2 := Edge2;
      C[0].FP.E.OutEdge2 := Edge3;

      C[1].V := THGEVector.Create(H.X,-H.Y);
      C[1].FP.E.InEdge2 := Edge3;
      C[1].FP.E.OutEdge2 := Edge4;
    end;
  end;
  C[0].V := Pos + Rot * C[0].V;
  C[1].V := Pos + Rot * C[1].V;
end;

function ClipSegmentToLine(var VOut: TClipVertices; const VIn: TClipVertices;
  const Normal: THGEVector; const Offset: Single; const ClipEdge: Byte): Integer;
var
  Distance0, Distance1, Interp: Single;
begin
	// Start with no output points
  Result := 0;

	// Calculate the distance of end points to the line
  Distance0 := Normal.Dot(VIn[0].V) - Offset;
  Distance1 := Normal.Dot(VIn[1].V) - Offset;

	// If the points are behind the plane
  if (Distance0 <= 0) then begin