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?
