Code:
unit Main;
interface
uses
Windows,Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, AdDraws, AdClasses, AdTypes, AdPerformanceCounter, AdDevIL,AdSprites,Math;
type
TTileInfo = Record
iswall : boolean;
end;
TCorners = record
Up : Integer; // object's top edge map tile index
Down : Integer; // object's bottom edge map tile index
Left : Integer; // object's left edge map tile index
Right : Integer; // object's right edge map tile index
WallUL : Boolean; // is or isn't a wall at object's top left corner
WallUR : Boolean; // is or isn't a wall at object's top right corner
WallDL : Boolean; // is or isn't a wall at object's bottom left corner
WallDR : Boolean; // is or isn't a wall at object's bottom right corner
end;
TPlatform = class(TImageSprite)
private
protected
procedure DoMove(TimeGap: Double); override;
procedure DoCollision(Sprite:TSprite; var Done:boolean); override;
public
constructor Create(AParent:TSprite);override;
end;
TBlurp = class(TImageSprite)
private
vx,vy : Single; //current velocity in pixels/second
protected
procedure DoMove(TimeGap: Double);override;
procedure DoCollision(Sprite:TSprite; var Done:boolean);override;
public
constructor Create(AParent:Tsprite);override;
end;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
AdDraw:TAdDraw;
AdSpriteEngine:TSpriteEngine;
AdImageList:TAdImageList;
AdPerCounter:TAdPerformanceCounter;
AdPixelCollisionTester: TAdSpritePixelCollisionTester;
Blurp:TBlurp;
procedure Idle(Sender:TObject; var Done:boolean);
procedure LoadLevel;
function GetCorners(aSpr: TSprite): TCorners;
function WallAt(x,y: Integer): Boolean;
end;
var
Form1: TForm1;
TileInfo : array [1..39, 0..28 ] of TTileInfo;
ActTime : double;
szam : integer;
implementation
{$R *.dfm}
procedure TForm1.LoadLevel;
var
level:TStringList;
ax,ay:integer;
begin
level := TStringList.Create;
level.LoadFromFile(ExtractFilePath(Application.ExeName)+'level2.txt');
for ay := 0 to level.Count-1 do
begin
for ax := 1 to length(level[ay]) do
begin
case level[ay][ax] of
'x':
begin
TileInfo[ax,ay].iswall:=true;
with TPlatform.Create(AdSpriteEngine) do
begin
Image := AdImageList.Find('Kocka');
x := ax*64;
y := ay*64;
z := 0;
end;
end;
'X':
begin
TileInfo[ax,ay].iswall:=true;
with TPlatForm.Create(AdSpriteEngine) do
begin
Image := AdImageList.Find('Kocka2');
x := ax*64;
y := ay*64;
z := 0;
end;
end;
'-': TileInfo[ax,ay].iswall:=false;
end;
end;
end;
level.Free;
end;
constructor TPlatform.Create(AParent: TSprite);
begin
inherited;
end;
constructor TBlurp.Create(AParent: TSprite);
begin
inherited;
end;
procedure TBlurp.DoMove(TimeGap: Double);
var
cnrs: TCorners;
begin
inherited;
cnrs := Form1.GetCorners(self);
if vy < 0 then
// moving up
begin
if not cnrs.WallUL and not cnrs.WallUR then
// not obstructed so move normally
y := y + vy * TimeGap
else
// hit tile so move to edge of tile and stop
begin
vy := 0;
// y := cnrs.Up * 64 + 64 {+ Height};
end;
end
else
if vy > 0 then
// moving down
begin
if not cnrs.WallDL and not cnrs.WallDR then
// not obstructed so move normally
y := y + vy * TimeGap
else
// hit tile so move to edge of tile and stop
begin
vy := 0;
// y := cnrs.Down * 64 - Height;
end;
end;
cnrs := Form1.GetCorners(self);
if vx < 0 then
// moving left
begin
if not cnrs.WallUL and not cnrs.WallDL then
// not obstructed so move normally
x := x + vx * TimeGap
else
// hit tile so move to edge of tile and stop
begin
vx := 0;
// x := cnrs.Left * 64 + 64 + Width;
end;
end
else
if vx > 0 then
// moving right
begin
if not cnrs.WallUR and not cnrs.WallDR then
// not obstructed so move normally
x := x + vx * TimeGap
else
// hit tile so move to edge of tile and stop
begin
vx := 0;
// x := cnrs.Right * 64 - Width;
end;
end;
// Collision;
end;
function TForm1.WallAt(x,y: Integer): Boolean;
// tests for the presence of a wall at a tile location
begin
Result := True;
Result := TileInfo[x,y].IsWall;
end;
function TForm1.GetCorners(aSpr: TSprite): TCorners;
// get object corners, includes velocity!
begin
// calculate tile index for each object corner
Result.Left := Math.Floor((aSpr.x -4) / 64);
Result.Right := Math.Floor((aSpr.x + aSpr.Width) / 64);
Result.Up := Math.Floor((aSpr.y -4) / 64);
Result.Down := Math.Floor((aSpr.y + aSpr.Height) / 64);
// if true then there is a wall there
Result.WallUL := WallAt(Result.Left ,Result.Up);
Result.WallUR := WallAt(Result.Right ,Result.Up);
Result.WallDL := WallAt(Result.Left ,Result.Down);
Result.WallDR := WallAt(Result.Right ,Result.Down);
end;
procedure TPlatform.DoMove(TimeGap : Double);
begin
inherited;
Collision;
end;
procedure TBlurp.DoCollision(Sprite:TSprite; var Done:boolean);
begin
end;
procedure TPlatform.DoCollision(Sprite:TSprite; var Done:boolean);
begin
end;
procedure TForm1.FormCreate(Sender: TObject);
var i: integer;
begin
AdPerCounter := TAdPerformanceCounter.Create;
AdDraw := TAdDraw.Create(self);
AdDraw.DllName := 'AndorraDX93D.dll';
if AdDraw.Initialize then
begin
Application.OnIdle := Idle;
AdImageList := TAdImageList.Create(AdDraw);
AdImageList.LoadFromFile('BackGround.ail');
//create the SpriteEngine
AdSpriteEngine := TSpriteEngine.Create(nil);
AdSpriteEngine.Surface := AdDraw;
//Create the collision tester
AdPixelCollisionTester := TAdSpritePixelCollisionTester.Create(AdDraw);
LoadLevel;
//create TImageSprite
Randomize;
Blurp := TBlurp.Create(AdSpriteEngine);
with Blurp.Create(AdSpriteEngine) do
begin
Image := AdImageList.Find('Hero');
X := 128;
Y := 128;
Z := 0;
CollisionTester := AdPixelCollisionTester;
end;
// ************* hater *********************************
end
else
begin
ShowMessage('Error while initializing Andorra 2D. Try to use another display'+
'mode or use another video adapter.');
halt; //<-- Completely shuts down the application
end;
end;
procedure TForm1.Idle(Sender: TObject; var Done: boolean);
var cnrs: TCorners;
szar: boolean;
begin
if AdDraw.CanDraw then // Only continue, if drawing is possible
begin
AdPerCounter.Calculate;
AdPerCounter.MaximumFrameRate:=60;
AdDraw.ClearSurface(clBlack); // Fill the surface with black color
AdDraw.BeginScene;
// Here you need to perform all drawing operations later
ActTime := ActTime + AdPerCounter.TimeGap;
if ActTime > 100 then
begin
Blurp.vx:=0;
Blurp.vy:=0;
if GetKeyState(VK_LEFT) < 0 then
begin
Blurp.vx:=-14;
end;
if GetKeyState(VK_RIGHT) < 0 then
begin
Blurp.vx:=+14;
end;
if GetKeyState(VK_UP) < 0 then
begin
Blurp.vy:=-14
end;
if GetKeyState(VK_DOWN) < 0 then
begin
Blurp.vy:=14
end;
ActTime := 0;
end;
AdSpriteEngine.Draw;
AdSpriteEngine.Move(25/1000);
AdSpriteEngine.Dead;
// debug
cnrs:=GetCorners(Blurp);
AdDraw.Canvas.Textout(0,40,'Up left: '+booltostr(cnrs.WallUL,true));
AdDraw.Canvas.Textout(0,60,'Up right: '+booltostr(cnrs.WallUR,true));
AdDraw.Canvas.Textout(0,80,'Bottom left: '+booltostr(cnrs.WallDL,true));
AdDraw.Canvas.Textout(0,100,'Bottom right: '+booltostr(cnrs.WallDR,true));
AdDraw.Canvas.TextOut(0,120,'Tile Tipus:' +inttostr(szam));
AdDraw.EndScene;
AdDraw.Flip; // Draws you result on the screen. Otherwise, you would not see anything
end;
Done := false; // Important, otherwise the function will not be called in every loop
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
AdSpriteEngine.Free;
AdImageList.Free;
AdPerCounter.Free;
AdDraw.Free;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_ESCAPE then Close;
end;
end.
Bookmarks