Code:
unit Main;
interface
uses
Windows,Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, AdDraws, AdClasses, AdTypes, AdPerformanceCounter, AdDevIL,AdSprites,Math;
type
//Types that are used to tell the character which key has been pressed
TKey = (kyUp, kyDown, kyLeft, kyRight);
TKeys = set of TKey;
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
FKeys:TKeys;
X_Direction:double;
Y_Direction:double;
isfalling:boolean;
iswall:boolean;
protected
procedure DoMove(TimeGap: Double);override;
procedure DoCollision(Sprite:TSprite; var Done:boolean);override;
public
constructor Create(AParent:Tsprite);override;
procedure SetKeys(Keys:TKeys);
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;
procedure TBlurp.SetKeys(Keys: TKeys);
begin
if Keys = FKeys then exit;
FKeys := Keys;
if kyRight in Keys then x_direction:=1.5;
if kyLeft in Keys then x_direction:=-1.5;
if kyUp in Keys then y_direction:=-1.5;
if kyDown in Keys then y_direction:=1.5;
if Keys = [] then
begin
x_direction:=0;
y_direction:=0;
end;
end;
constructor TPlatform.Create(AParent: TSprite);
begin
inherited;
end;
constructor TBlurp.Create(AParent: TSprite);
begin
inherited;
end;
procedure TBlurp.DoMove(TimeGap: Double);
begin
inherited;
{ X:=X+X_direction;
Y:=Y+Y_direction; }
{ if X <= 0 then X:=0;
if X > 640-Image.Width then X:=640-Image.Width;
if Y < 0 then Y:=0;
if Y > 480-Image.Height then Y:=480-Image.Height; }
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
if Sprite is TPlatform then
begin
isFalling:=false;
end;
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';
with AdDraw.Display do
begin
{ Width := 640;
Height := 480;
BitDepth := ad16Bit; //The colour depth. The values "ad16Bit" and "ad32Bit" are allowed here.
DisplayMode := dmFullscreen; }
end;
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;
SetKeys([]);
isfalling:=true;
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 keys: TKeys;
cnrs: TCorners;
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 > 25 then
begin
cnrs := GetCorners(Blurp);
keys := [];
if GetKeyState(VK_LEFT) < 0 then
begin
if not cnrs.WallUL and not cnrs.WallDL then
begin
Blurp.X:=Blurp.X-4;
AdSpriteEngine.X:=AdSpriteEngine.X+4;
end;
end;
if GetKeyState(VK_RIGHT) < 0 then
begin
if not cnrs.WallUR and not cnrs.WallDR then
begin
Blurp.X:=Blurp.X+4;
AdSpriteEngine.X:=AdSpriteEngine.X-4;
end;
end;
if GetKeyState(VK_UP) < 0 then
begin
if not cnrs.WallUL and not cnrs.WallUR then
begin
Blurp.y := Blurp.y - 4;
AdSpriteEngine.Y:=AdSpriteEngine.Y+4;
end;
end;
if GetKeyState(VK_DOWN) < 0 then
begin
if not cnrs.WallDL and not cnrs.WallDR then
begin
Blurp.Y:=Blurp.Y+4;
AdSpriteEngine.Y:=AdSpriteEngine.Y-4;
end;
end;
Blurp.SetKeys(Keys);
ActTime := 0;
end;
{ if Blurp.isfalling = true then
begin
Blurp.Y:=Blurp.Y+1;
end;
Blurp.isfalling:=true;}
AdSpriteEngine.Draw;
AdSpriteEngine.Move(25/1000);
AdSpriteEngine.Dead;
// debug
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.
and zipped is the entire project... 
Reply With Quote
Bookmarks