Monday, September 19, 2011

New code formatter

 I know I'm a bit lazy when we talk about polishing my blog entries, I will try to improve the quality of the HTML visualization of the code submitted, as an example I'm posting the full 2d collision unit, which BTW let's you test the collision of two bitmaps taking into account zoom and angle.

unit BB.Screen.Collisions;

interface

uses
  Windows, Classes,
  BB.Screen.Surfaces, BB.Screen.Interfaces, BB.E3D.Interfaces, BB.Types, BB.Screen.Types, BB.E3D.Polygons;

type
  TBoundingBox = (bbFull, bbManual, bbAuto);

  TCollision = class
  private
    FCollisionShape: TCollisionShape;
    FCollider: ICollider;
    FBB,
    FSiluoette,
    FShape,
    FCurrentShape: IShape;
    FAccuracy: TCollisionAccuracy;
    FBoundingBox: TBoundingBox;

    function GetEdges: IShape;
    procedure CheckCollider;
    function GetAccuracy(aTotal: integer): integer;
    function GetRect(aShape: IShape): TRect;
    function GetShape(aShape: TCollisionShape): IShape;
    function GetBB: IShape;
    procedure SetCollisionShape(const aValue: TCollisionShape);
    function TestBB(aCollision: TCollision; out aRectA, aRectB, aOverlap: TRect): boolean;
    function TestColorKey(const aRectA, aRectB, aOverlap: TRect; aCollision: TCollision; out aX, aY: integer): boolean;
    procedure SetCurrentShapeAsBB;
    procedure SetCurrentShapeAsCustom;
  public
    constructor Create(aCollider: ICollider);
    destructor Destroy; override;
    function Test(aCollision: TCollision; out aX, aY: integer): boolean;
    procedure Reset;
    function GetCurrentShape: IShape;

    property Collider: ICollider read FCollider;
    property CollisionShape: TCollisionShape read FCollisionShape write SetCollisionShape;
    property Accuracy: TCollisionAccuracy read FAccuracy write FAccuracy;
    property BoundingBox: TBoundingBox read FBoundingBox write FBoundingBox;
  end;

implementation

uses
  SysUtils, {Types, }Generics.Collections,
  BB.Math.Matrix, BB.Math.Vector, BB.E3D.Vertex, BB.Math, BB.Interfaces, BB.Screen, BB.Colors, BB.Utils;

{ TCollision }

constructor TCollision.Create(aCollider: ICollider);
begin
  FCurrentShape := nil;
  FShape := nil;
  FBB := nil;
  FSiluoette := nil;
  FCollider := aCollider;
  FAccuracy := caLow;
  FBoundingBox := bbFull;

  CollisionShape := csRectangle;
end;

destructor TCollision.Destroy;
begin
  FSiluoette := nil;
  FBB := nil;
  FShape := nil;

  inherited;
end;

function TCollision.GetEdges: IShape;
begin
  Exit(IShape(FCollider.GetSurface.GetShape));
end;

function TCollision.GetShape(aShape: TCollisionShape): IShape;
var
  nx, ny, ScaledWidth, ScaledHeight, cx, cy,
  angle, x, y, z, zoom: TFloat;
  matrix: TMatrix;
  vertex, vector: TVector;
  accuracy, i, width, height: integer;
  surface: ISurface;
  //bb: TRect;

begin
  FCollider.GetInfo(x, y, z, zoom, angle);
  surface := FCollider.GetSurface;

  //width := (bb.Right - bb.Left);
  //height := (bb.Bottom - bb.Top);
  width := surface.GetWidth;
  height := surface.GetHeight;
  nx := zoom / 100;
  ny := zoom / 100;

  case FBoundingBox  of
    bbFull:
    begin
      ScaledWidth := width * nx / 2;
      ScaledHeight := height * ny / 2;
    end;

    bbManual, bbAuto:
    begin
      ScaledWidth := 0;
      ScaledHeight := 0;
      { TODO : bbAuto 0,0,31,31 }
    end;
  end;

  //cx := bb.Left + ScaledWidth;
  //cy := bb.Top + ScaledHeight;
  cx := x + ScaledWidth;
  cy := y + ScaledHeight;
  matrix := TMatrix.Create(0, 0, -angle);

  case aShape of
    csPrecise:
    begin
      if FSiluoette = nil then
      begin
        FSiluoette := GetEdges;
        if FSiluoette = nil then
          Exit(GetShape(csRectangle));
        FShape := TPolygon.Create(FSiluoette.GetSides);
      end;

      for i := 0 to FSiluoette.GetSides - 1 do
      begin
        vector := FSiluoette.GetVertex(i).ClippedVertex;
        vector.X := vector.X - (Width / 2);//ScaledWidth;
        vector.Y := vector.Y - (Height / 2);//ScaledHeight;
        vertex.Rotate(vector, matrix);

        FShape.GetVertex(i).ClippedVertex := TVector.Create(cx + (vertex.X * nx), cy + (vertex.Y * ny), z);
      end;
    end;

    csRhombus:
    begin
      //  1
      //4   2
      //  3

      //1
      vertex.Rotate(TVector.Create(0, -ScaledHeight, 0), matrix);
      FShape.GetVertex(0).ClippedVertex := TVector.Create(cx + vertex.X, cy + vertex.Y, z);

      //2
      vertex.Rotate(TVector.Create(ScaledWidth, 0, 0), matrix);
      FShape.GetVertex(1).ClippedVertex := TVector.Create(cx + vertex.X, cy + vertex.Y, z);

      //3
      vertex.Rotate(TVector.Create(0, ScaledHeight, 0), matrix);
      FShape.GetVertex(2).ClippedVertex := TVector.Create(cx + vertex.X, cy + vertex.Y, z);

      //4
      vertex.Rotate(TVector.Create(-ScaledWidth, 0, 0), matrix);
      FShape.GetVertex(3).ClippedVertex := TVector.Create(cx + vertex.X, cy + vertex.Y, z);
    end;

    csRectangle:
    begin
      FShape := FBB;
    end;

    csCircle:
    begin
      accuracy := 360 div GetAccuracy(360);
      for i := 0 to FShape.GetSides - 1 do
      begin
        vertex.Rotate(TVector.Create(ScaledWidth * Cos(i * accuracy * RAD), ScaledHeight * Sin(i * accuracy * RAD), 0), matrix);
        FShape.GetVertex(i).ClippedVertex := TVector.Create(cx + vertex.X, cy + vertex.Y, z);
      end;
    end;

    csTriangle:
    begin
      //  1
      //
      //3   2

      //1
      vertex.Rotate(TVector.Create(0, -ScaledHeight, 0), matrix);
      FShape.GetVertex(0).ClippedVertex := TVector.Create(cx + vertex.X, cy + vertex.Y, z);

      //2
      vertex.Rotate(TVector.Create(ScaledWidth, ScaledHeight, 0), matrix);
      FShape.GetVertex(1).ClippedVertex := TVector.Create(cx + vertex.X, cy + vertex.Y, z);

      //3
      vertex.Rotate(TVector.Create(-ScaledWidth, ScaledHeight, 0), matrix);
      FShape.GetVertex(2).ClippedVertex := TVector.Create(cx + vertex.X, cy + vertex.Y, z);
    end;

    csColorKey:
    begin
    end;
  end;

  result := FShape;
end;

procedure TCollision.SetCollisionShape(const aValue: TCollisionShape);
begin
  FCollisionShape := aValue;
  if FShape <> nil then
  begin
    FBB := nil;
    FShape := nil;

    Reset;
  end;

  //Always use Bounding Boxes
  FBB := TPolygon.Create(4);
  FCurrentShape := FBB;

  case FCollisionShape of
    csRectangle:
    begin
      FShape := FBB;
    end;

    csRhombus:
    begin
      FShape := TPolygon.Create(4);
    end;

    csCircle:
    begin
      FShape := TPolygon.Create(GetAccuracy(360));
    end;

    csTriangle:
    begin
      FShape := TPolygon.Create(3);
    end;
  end;
end;

function TCollision.Test(aCollision: TCollision; out aX, aY: integer): boolean;
var
  sa, sb: IShape;
  RectA, RectB, overlap: TRect;

begin
  CheckCollider;
  aCollision.CheckCollider;

  aX := -1;
  aY := -1;

  if (CollisionShape = csNone) or (aCollision.CollisionShape = csNone) or (aCollision = self) then
    Exit(False);

  //Fast bounding boxes
  SetCurrentShapeAsBB;
  aCollision.SetCurrentShapeAsBB;
  if not TestBB(aCollision, RectA, RectB, overlap) then
    Exit(False);

  if (CollisionShape = csColorKey) and (aCollision.CollisionShape = csColorKey) then
    Exit(TestColorKey(RectA, RectB, overlap, aCollision, aX, aY));

  //Custom collision test
  SetCurrentShapeAsCustom;
  aCollision.SetCurrentShapeAsCustom;
  sa := GetShape(FCollisionShape);
  sb := aCollision.GetShape(aCollision.FCollisionShape);
  if (sa = nil) or (sb = nil) then
    Exit(False);
  result := sa.Collision(sb, aX, aY) > -1;
end;

function TCollision.TestBB(aCollision: TCollision; out aRectA, aRectB, aOverlap: TRect): boolean;
begin
  aRectA := GetRect(GetBB);
  aRectB := GetRect(aCollision.GetBB);
  result := IntersectRect(aOverlap, aRectA, aRectB);
end;

function TCollision.TestColorKey(const aRectA, aRectB, aOverlap: TRect; aCollision: TCollision; out aX, aY: integer): boolean;
{ TODO :
-bpp
-optimize
}
var
  xb, yb, xa, ya,
  i, j, width, height: integer;
  BufferB, BufferA: pointer;
  ColorKeyB, ColorKeyA: cardinal;
  SurfaceB, SurfaceA: ISurface;

begin
  result := False;
  width := aOverlap.Right - aOverlap.Left - 1;
  height := aOverlap.Bottom - aOverlap.Top - 1;

  //Self
  if aRectA.Left < aOverlap.Left  then
    xa := aOverlap.Left - aRectA.Left
  else
    xa := 0;

  if aRectA.Top < aOverlap.Top  then
    ya := aOverlap.Top - aRectA.Top
  else
    ya := 0;

  //Other
  if aRectB.Left < aOverlap.Left  then
    xb := aOverlap.Left - aRectB.Left
  else
    xb := 0;

  if aRectB.Top < aOverlap.Top  then
    yb := aOverlap.Top - aRectB.Top
  else
    yb := 0;

  SurfaceB := aCollision.FCollider.GetSurface;
  SurfaceA := FCollider.GetSurface;

  SurfaceA.Lock([lfRead], nil);
  SurfaceB.Lock([lfRead], nil);
  try
    ColorKeyA := SurfaceA.GetColorKey;
    ColorKeyB := SurfaceB.GetColorKey;

    j := height;
    while j >= 0 do
    begin
      i := width;
      while i >= 0 do
      begin
        BufferA := SurfaceA.GetAddress(xa + i, ya + j);
        BufferB := SurfaceB.GetAddress(xb + i, yb + j);

        if (PCardinal(BufferA)^ <> ColorKeyA) and (PCardinal(BufferB)^ <> ColorKeyB) then
        begin
          aX := aOverlap.Left + i;
          aY := aOverlap.Top + j;
          Exit(True);
        end;

        Dec(i);
      end;

      Dec(j);
    end;

  finally
    SurfaceB.UnLock(nil);
    SurfaceA.Unlock(nil);
  end;
end;

function TCollision.GetAccuracy(aTotal: integer): integer;
begin
  case FAccuracy of
    caLow:
    begin
      result := Round(aTotal * 0.15);
    end;

    caHigh:
    begin
      result := Round(aTotal * 0.65);
    end;

    caMax:
    begin
      result := aTotal;
    end
    else
      result := Round(aTotal * 0.40);
  end;
end;

function TCollision.GetBB: IShape;
var
  nx, ny, ScaledWidth, ScaledHeight, cx, cy,
  angle, x, y, z, zoom: TFloat;
  matrix: TMatrix;
  vector: TVector;
  surface: ISurface;
  //bb: TRect;
  width, height: integer;

begin
  FCollider.GetInfo(x, y, z, zoom, angle);
  surface := FCollider.GetSurface;

  //width := (bb.Right - bb.Left);
  //height := (bb.Bottom - bb.Top);
  width := surface.GetWidth;
  height := surface.GetHeight;
  nx := zoom / 100;
  ny := zoom / 100;
  ScaledWidth := width * nx / 2;
  ScaledHeight := height * ny / 2;
  //cx := bb.Left + ScaledWidth;
  //cy := bb.Top + ScaledHeight;
  cx := x + ScaledWidth;
  cy := y + ScaledHeight;
  matrix := TMatrix.Create(0, 0, -angle);

  //1   2
  //
  //4   3

  //1
  vector.Rotate(TVector.Create(-ScaledWidth, -ScaledHeight, 0), matrix);
  FBB.GetVertex(0).ClippedVertex := TVector.Create(cx + vector.X, cy + vector.Y, z);

  //2
  vector.Rotate(TVector.Create(ScaledWidth, -ScaledHeight, 0), matrix);
  FBB.GetVertex(1).ClippedVertex := TVector.Create(cx + vector.X, cy + vector.Y, z);

  //3
  vector.Rotate(TVector.Create(ScaledWidth, ScaledHeight, 0), matrix);
  FBB.GetVertex(2).ClippedVertex := TVector.Create(cx + vector.X, cy + vector.Y, z);

  //4
  vector.Rotate(TVector.Create(-ScaledWidth, ScaledHeight, 0), matrix);
  FBB.GetVertex(3).ClippedVertex := TVector.Create(cx + vector.X, cy + vector.Y, z);

  result := FBB;
end;

function TCollision.GetCurrentShape: IShape;
begin
  Exit(FCurrentShape);
end;

procedure TCollision.SetCurrentShapeAsCustom;
begin
  FCurrentShape := FShape;
end;

procedure TCollision.SetCurrentShapeAsBB;
begin
  //Fast Bounding Boxes
  FCurrentShape := FBB;
end;

function TCollision.GetRect(aShape: IShape): TRect;
var
  v: TVector;
  i: Integer;

begin
  v := aShape.GetVertex(0).ClippedVertex;

  result.Left := Trunc(v.X);
  result.Right := result.Left;
  result.Top := Trunc(v.Y);
  result.Bottom := result.Top;

  for i := 1 to aShape.GetSides - 1 do
  begin
    v := aShape.GetVertex(i).ClippedVertex;

    if v.X < result.Left then
      result.Left := Trunc(v.X)
    else
      if v.X > result.Right then
        result.Right := Trunc(v.X);

    if v.Y < result.Top then
      result.Top := Trunc(v.Y)
    else
      if v.Y > result.Bottom then
        result.Bottom := Trunc(v.Y);
  end;
end;

procedure TCollision.Reset;
begin
  FSiluoette := nil;
end;

procedure TCollision.CheckCollider;
begin
  if FCollider = nil then
    raise Exception.Create('Collider not assigned');
end;

end.

Thanks to SyntaxHighlighter http://alexgorbatchev.com/SyntaxHighlighter/manual/themes/

What do you think mr. stranger?

No comments:

Post a Comment