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