PDA

View Full Version : Making a platform game - few questions



Ixy
02-02-2009, 09:32 PM
I'm using SDL, and it's a 2D platform game.

1. Screen scrolling? Is it like this - you draw a level with a resolution of, let's say, 10000 x 2000 and then while moving the player, you move a rectangle on the background surface and blit it on the screen?

2. Okay, so background is not a problem (presuming that I got this scrolling thing right), so I wanna know about drawing the platforms. Do I draw them all at once with a black (or white, or whatever) background, which I eliminate with colorkey?

3. When jumping, how do I detect if there's floor underneath the player? You don't have to write a code, I'm just stuck at the logistics part.

4. Player sprites. I draw a couple of player sprites in different positions, then I load the first one into a player var and blit it on the screen. When I need a different sprite, I just load a different rectangular position off the BMP file (the one that contains the sprite I need) into the var and blit it on the screen, right?

Hmmm, what else?
I think it's all for now. :D

paul_nicholls
02-02-2009, 09:49 PM
Hi Ixy, perhaps the below site will help you

http://www.tonypa.pri.ee/tbw/start.html

It is a site about tile based games written using Macromedia Flash, but I used the info for a Delphi/freepascal 2d tile platform game I started writing just fine :)

cheers,
Paul

User137
02-02-2009, 09:51 PM
Tilemap is the easiest way to go. You can make a tile specific collision or physics behaviour. This map should cover most if not all sprites and problem about calculating how to hit floor. This is how most of Mario games are done.

Dynamic spritemap is much more complicated thing to code even though it would allow tile/sprite placing anywhere. Most modern rpg/mmorpg games use something like this.

Ixy
02-02-2009, 10:01 PM
Thanks.
@ paul: can that tutorial be applied to all tile based platform games? Because, I see they're talking about isometric 2D games, mine is Mario-like, from the side.

Tiles? Got it. :D
I'll examine this tutorial really good, then get to work. ;)

NecroDOME
04-02-2009, 11:37 AM
as you described that is what we did in Uber Zombie. We have a level, thats a big texture of the whole level. For collision detection we have a 'collision texture (c) tm)' that defines in color codes what's what. For example red is ground, green is ceiling and yellow is a wall. However this can be enything you like and works well for small levels.

If you want a big level i guess you can do the same with tiles.

(My website is currently down so I cannot show off any examples, but here are some screenshots: http://www.greatgamesexperiment.com/game/UberZombie )

jdarling
04-02-2009, 04:03 PM
This might help you out a bit: http://eonclash.com/ViewProduct.php?ProductID=29

Its a very simple side scroller implemented with SDL using FPC. It loads the "map.txt" file and displays it on the screen. You can scroll left and right across the map easily enough.

To add a background you would need to modify game.pas and in GameFrame add the background draw before the map.Display function is called. Of course you would also have to add the player sprite and etc...

Hope it helps.

Ixy
04-02-2009, 10:43 PM
New problem (haven't solved the old ones, but i'll take care of this first).

I've implemented "gravity" for my jumps using something similar to this (http://www.gamedev.net/reference/articles/article694.asp).

The thing is now that my jumps are too fast in comparison to regular movement.
But they're not so fast as the regular movement is slow.

So my question is - how to speed up movement? I haven't used delay at all...

arthurprs
05-02-2009, 01:17 AM
New problem (haven't solved the old ones, but i'll take care of this first).

I've implemented "gravity" for my jumps using something similar to this (http://www.gamedev.net/reference/articles/article694.asp).

The thing is now that my jumps are too fast in comparison to regular movement.
But they're not so fast as the regular movement is slow.

So my question is - how to speed up movement? I haven't used delay at all...

it's hard to tell anything if we don't see any code :?

User137
05-02-2009, 01:40 PM
Are you using vectors or angles? Jumping and gravity only affects the Y component of player movement and acceleration vectors.

jdarling
05-02-2009, 02:42 PM
How about an updated Demo with Physics using APE. Download from http://eonclash.com/ViewProduct.php?ProductID=29

Character can move around within the world and jump between platforms. I have to admit, using a real physics engine like APE is major overkill, but in the end its a nice effect.

PS: You really do need to post up some code and/or screenies for anyone to be much help.

Traveler
05-02-2009, 03:54 PM
Jeremy, is your file correct? I've tried it but all I see is a black environment with a few tiles, nothing more...

jdarling
05-02-2009, 04:50 PM
There seems to be a problem with my OpenGL libraries I compiled with. If you ran from the batch file thats about all you see :(. I've updated the zip and removed the batch file. Try just running ss.exe and see what happens.

You might also try building in Lazarus with your OpenGL libraries and see if that makes things work better. Guess one of these days I will have to find the updated OpenGL libraries for FPC LOL

Ixy
08-02-2009, 01:00 PM
Okay, this is just part of the code which involves jumping. It's not finished yet (as there's no floor detection yet, because I'm still working on a map system :D).


acceleration:= 6;

if pressed_space (*this is pseudo code, as you all know what happens here :D*) then begin
if jump = false then begin
velocity:= 50;
jump:= true;
end;
end;

(*this is not pseudo any more :) *)
if jump = true then begin
player.y:= player.y - velocity;
velocity:= velocity - acceleration;

if player_y_beforejump - player.y < 0 then begin
player.y := player_y_beforejump;
jump := false;
end;

And then it blits the player sprite with the destination rectangle of "player".

The thing is that the player jumps and falls too fast. I tried speeding up the movement and then delaying the whole thing, but it doesn't look smooth.

Also, as I said, I'm working on a map system.
I'm thinking of doing the same thing as jdarling - tiles through text files.
But I need a little help with this too. :D
I tried examining your side scroller code, but I really can't figure half of it out. I have a hard time understanding other peoples' codes. :)
So, I'll try this - reading characters from a text file. If it reads out ' ' then dstrect.x increases by the width of a tile. If it reads out eoln, then dstrect.x becomes 0, and dstrect.y increases by the height of a tile.
When it reads out '1', or '2' or something like that, it blits a tile (which kind - depending on which number it reads out) to dstrect onto the screen surface.

Haven't tried it yet (haven't had time), but theoretically, I see only one problem - how to scroll those tiles?
Or am I completely wrong here? :D

User137
08-02-2009, 03:15 PM
For tiles, you can have them fixed size and forget special ruling if want to keep it simple. Found this with google:
http://www.savware.net/images/RPG_Tiles_01.png
Combining base blocks you can create any forms of structures. If you want to make a building that is size 2x3 tiles, have those 6 tiles be in texture but make editor put all 6 as a group same time.

Physics loop might look something like this (assuming floor is at 0 and sky is in positive side of numbers):
uses math... // maybe need for Min() Max() unless make them yourself

with player do begin
oldX:=x; // These may be useful in collision though
oldY:=y; // they are not needed in this example yet
speedX:=speedX*0.95; // closer to 1 movement decelerates slower
speedY:=speedY-gravity;
if pressLeft then speedX:=max(-2,speedX-0.5);
if pressRight then speedX:=min(2,speedX+0.5);
if pressJump and TouchGround then begin // EDIT: oops forgot the key
TouchGround:=false;
speedY:=2; // Whatever jumpspeed is
end;
x:=x+speedX;
y:=y+speedY;

TouchGround:=false;
if y<FloorLevel then begin
Touchground:=true;
y:=FloorLevel;
speedY:=0;
end;
end;

DraculaLin
08-02-2009, 03:27 PM
If you don't mind.
Download the rar file from the last post.
http://www.pascalgamedevelopment.com/viewtopic.php?t=5547

That engine contains large numbers of example.Include map,scrolling,sprites,jump,collision....etc.

WILL
09-02-2009, 04:03 AM
If you would like, I could email you my cyber-crisis source. I used JEDI-SDL for my controls and other things and OpenGL for my graphics routines. I had all the code in to allow the player to run, jump and fall with varying gravity levels. I also added in platforms which you could jump down off of and ladders. I have no major plans for it now, but it could be of use to you if you want to check it out?

paul_nicholls
10-02-2009, 02:21 AM
There seems to be a problem with my OpenGL libraries I compiled with. If you ran from the batch file thats about all you see :(. I've updated the zip and removed the batch file. Try just running ss.exe and see what happens.

You might also try building in Lazarus with your OpenGL libraries and see if that makes things work better. Guess one of these days I will have to find the updated OpenGL libraries for FPC LOL

Hi Jeremy :-)
I downloaded your updated side scroller example with APE and it works nicely :-)
I opened it up in Lazarus, built all, and ran it...and voila! :)

I know it is only an example, but I noticed that the character 'bounces' a bit vertically and can only jump when he has settled vertically.

cheers,
Paul

jdarling
10-02-2009, 10:56 PM
The bounce comes straight from the physics engine itself. I started cleaning this up in the latest version (not posted yet), but the truth is that its difficult to figure out when a character has quit jumping when your using a 3rd party physics engine :). Now I'm basically checking for 3 frames to see if your Y vector has changed, if it hasn't then you can jump again.

You could lower the bounce by raising the rigidity of the map and player objects.

Ixy
11-02-2009, 08:28 PM
I think that my only problem now is collision detection. How to detect floor while jumping etc...
To help you out with giving advice, my map system is like this:
I'm using tiles. There is a BMP file with all the tiles' textures in it, and I have a variable "tile" that's array of TSDL_Rect (one "tile" = one tile).
When reading out the map from a text file, I do it like this - if it finds ' ', then it just increases the x coordinate of destination rect (and there is an array of destination rect, one for each tile). If it finds '1', then it blits that tile to the map surface at destination rect and so on.

So how do I detect the floor? I think that checking every frame if player y coordinate is the same as tiles' (and if it is, then if x coordinates fit) is a really bad idea. :D

paul_nicholls
11-02-2009, 10:40 PM
I think that my only problem now is collision detection. How to detect floor while jumping etc...
To help you out with giving advice, my map system is like this:
I'm using tiles. There is a BMP file with all the tiles' textures in it, and I have a variable "tile" that's array of TSDL_Rect (one "tile" = one tile).
When reading out the map from a text file, I do it like this - if it finds ' ', then it just increases the x coordinate of destination rect (and there is an array of destination rect, one for each tile). If it finds '1', then it blits that tile to the map surface at destination rect and so on.

So how do I detect the floor? I think that checking every frame if player y coordinate is the same as tiles' (and if it is, then if x coordinates fit) is a really bad idea. :D

I do it this way.

My tiles are in a 2d array, and the top left corner of the map is (0,0)

What I do is each update I check the character's position and velocity.

Below is some code I typed in off the top of my head. Untested but you should get the idea :-)

It doesn't add acceleration due to gravity to the vertical velocity (vy) and doesn't include the x direction checks but you should be able to work it out.

Const
{................................................. .............................}
cMapWidth = 50;
cMapHeight = 25;
cTileWidth = 32;
cTileHeight = 32;
{................................................. .............................}

Type
{................................................. .............................}
TTile = Record
id : Integer;
IsSolid : Boolean;
End;
{................................................. .............................}

{................................................. .............................}
TPlayer = Class
x : Single;
y : Single;
vx : Single;
vy : Single;
w : Integer;
h : Integer;
Procedure Update(Const ATimeSlice : Single);
End;
{................................................. .............................}

Var
Tiles : Array[0..cMapHeight - 1,0..cMapWidth - 1] Of TTile;
{................................................. .............................}

{................................................. .............................}
Function SolidTileAt(Const x,y : Single) : Boolean;
Var
tx : Integer;
ty : Integer;
Begin
Result := True;
tx := Floor(x / cTileWidth);
ty := Floor(y / cTileHeight);
If tx LESS_THAN 0 Then Exit;
If ty LESS_THAN 0 Then Exit;
If tx >= cMapWidth Then Exit;
If ty >= cMapHeight Then Exit;
Result := Tiles[ty,tx].IsSolid;
End;
{................................................. .............................}

{................................................. .............................}
Procedure TPlayer.Update(Const ATimeSlice : Single);
Var
SolidUL : Boolean; // upper left player corner tile is solid (wall)
SolidUR : Boolean; // upper right player corner tile is solid (wall)
SolidDL : Boolean; // lower left player corner tile is solid (wall)
SolidDR : Boolean; // lower right player corner tile is solid (wall)
ty : Integer; // tile y coordinate in tile array
ny : Single; // new y pos including current vertical velocity, vy
Begin
If vy LESS_THAN 0 Then
//moving up
Begin
ny := y + vy * ATimeSlice;
SolidUL := SolidTileAt(x - w/2,ny);
SolidUR := SolidTileAt(x + w/2,ny);
If SolidUL Or SolidUR Then
// set y to bottom of tile
Begin
ty := Floor(ny);
y := ty * cTileHeight + cTileHeight;
End
Else
y := y + vy;
End
Else
If vy > 0 Then
//moving down
Begin
ny := y + vy * ATimeSlice;
SolidDL := SolidTileAt(x - w/2,ny);
SolidDR := SolidTileAt(x + w/2,ny);
If SolidDL Or SolidDR Then
// set y to top of tile + player height
Begin
ty := Floor(ny);
y := ty * cTileHeight + h / 2;
End
Else
y := y + vy;
End;
// add gravity to vy here and cap to max velocity so not faster than tile height;
End;
{................................................. .............................}

{................................................. .............................}


cheers,
Paul

paul_nicholls
11-02-2009, 10:42 PM
PS. change LESS_THAN to < in the above post.

I had to change it because the code kept getting screwing up as it thought the <and> meant some special part :(

cheers,
Paul

paul_nicholls
12-02-2009, 11:31 PM
If it isn't obvious, the top left of the sprite is at (x - w / 2),(y - h / 2), so this means the center of the sprite is at x,y

cheers,
Paul

paul_nicholls
13-02-2009, 11:24 AM
Here is some actual working code.

Again, replace "LESS_THAN" with the less than character.

This now includes moving left and right as well.

Const
{................................................. .............................}
cMapWidth = 20;
cMapHeight = 20;
cTileWidth = 20;
cTileHeight = 16;
{................................................. .............................}

Type
{................................................. .............................}
TTile = Record
id : Integer;
IsSolid : Boolean;
End;
{................................................. .............................}

{................................................. .............................}
TPoint = Record
x,y : Integer;
End;
{................................................. .............................}

{................................................. .............................}
TPlayer = Class
Public
x : Single;
y : Single;
vx : Single;
vy : Single;
w : Integer;
h : Integer;
CnrUL : TPoint; // upper left tile (x,y) player is over
CnrUR : TPoint; // upper right tile (x,y) player is over
CnrLL : TPoint; // lower left tile (x,y) player is over
CnrLR : TPoint; // lower right tile (x,y) player is over
Private
Procedure GetCornersAt(Const ax,ay : Single);
Public
Procedure Update(Const ATimeSlice : Single);
End;
{................................................. .............................}

Var
Tiles : Array[0..cMapHeight - 1,0..cMapWidth - 1] Of TTile;
{................................................. .............................}

{................................................. .............................}
Function Floor(X : Extended) : Integer;
Begin
Result := Integer(Trunc(X));
If Frac(X) LESS_THAN 0 Then Dec(Result);
End;
{................................................. .............................}

{................................................. .............................}
Function TileIsWalkable(Const tx,ty : Integer) : Boolean;
Begin
Result := False;
If tx LESS_THAN 0 Then Exit;
If ty LESS_THAN 0 Then Exit;
If tx >= cMapWidth Then Exit;
If ty >= cMapHeight Then Exit;
Result := Not Tiles[ty,tx].IsSolid;
End;
{................................................. .............................}

{................................................. .............................}
Function ClampValue(Const n,l,u : Integer) : Integer;
Begin
Result := n;
If Result LESS_THAN l Then Result := l
Else
If Result > u Then Result := u;
End;
{................................................. .............................}

{................................................. .............................}
Procedure TPLayer.GetCornersAt(Const ax,ay : Single);
{
|
|
-,- | +,-

-------|-------

-,+ | +,+
|
|
}
Begin
CnrUL.x := Floor((ax - w/2) / cTileWidth);
CnrUL.y := Floor((ay - h/2) / cTileHeight);

CnrUR.x := Floor((ax + w/2) / cTileWidth);
CnrUR.y := Floor((ay - h/2) / cTileHeight);

CnrLR.x := Floor((ax + w/2) / cTileWidth);
CnrLR.y := Floor((ay + h/2) / cTileHeight);

CnrLL.x := Floor((ax - w/2) / cTileWidth);
CnrLL.y := Floor((ay + h/2) / cTileHeight);

CnrUL.x := ClampValue(CnrUL.x,0,cMapWidth - 1);
CnrUR.x := ClampValue(CnrUR.x,0,cMapWidth - 1);
CnrLR.x := ClampValue(CnrLR.x,0,cMapWidth - 1);
CnrLL.x := ClampValue(CnrLL.x,0,cMapWidth - 1);

CnrUL.y := ClampValue(CnrUL.y,0,cMapHeight - 1);
CnrUR.y := ClampValue(CnrUR.y,0,cMapHeight - 1);
CnrLR.y := ClampValue(CnrLR.y,0,cMapHeight - 1);
CnrLL.y := ClampValue(CnrLL.y,0,cMapHeight - 1);
End;
{................................................. .............................}

{................................................. .............................}
Procedure TPlayer.Update(Const ATimeSlice : Single);
Var
TileIsWalkableUL : Boolean; // upper left player corner tile is walkable
TileIsWalkableUR : Boolean; // upper right player corner tile is walkable
TileIsWalkableLL : Boolean; // lower left player corner tile is walkable
TileIsWalkableLR : Boolean; // lower right player corner tile is walkable
Begin
GetCornersAt(x,y + vy * ATimeSlice);
If vy LESS_THAN 0 Then
//moving up
Begin
TileIsWalkableUL := TileIsWalkable(CnrUL.x,CnrUL.y);
TileIsWalkableUR := TileIsWalkable(CnrUR.x,CnrUR.y);
If TileIsWalkableUL And TileIsWalkableUR Then
y := y + vy * ATimeSlice
Else
// move player to touch tiles(s) above
y := CnrUL.y * cTileHeight + cTileHeight + h/2 + 0.01;
End
Else
If vy > 0 Then
//moving down
Begin
TileIsWalkableLL := TileIsWalkable(CnrLL.x,CnrLL.y);
TileIsWalkableLR := TileIsWalkable(CnrLR.x,CnrLR.y);
If TileIsWalkableLL And TileIsWalkableLR Then
y := y + vy * ATimeSlice
Else
// move player to sit on tile(s) below
y := CnrLR.y * cTileHeight - h/2 - 0.01;
End;

GetCornersAt(x + vx * ATimeSlice,y);
If vx LESS_THAN 0 Then
//moving left
Begin
TileIsWalkableUL := TileIsWalkable(CnrUL.x,CnrUL.y);
TileIsWalkableLL := TileIsWalkable(CnrLL.x,CnrLL.y);
If TileIsWalkableUL And TileIsWalkableLL Then
x := x + vx * ATimeSlice
Else
// move player to touch tiles(s) on left
x := CnrUL.x * cTileWidth + cTileWidth + w/2 + 0.01;
End
Else
If vx > 0 Then
//moving right
Begin
TileIsWalkableUR := TileIsWalkable(CnrUR.x,CnrUR.y);
TileIsWalkableLR := TileIsWalkable(CnrLR.x,CnrLR.y);
If TileIsWalkableUR And TileIsWalkableLR Then
x := x + vx * ATimeSlice
Else
// move player to touch tile(s) on right
x := CnrUR.x * cTileWidth - w/2 - 0.01;
End;
// add gravity to vy here and cap to max velocity so not faster than tile height;
End;

This is how I am using it:

FPlayer := TPlayer.Create;
FPlayer.w := cTileWidth - 5;
FPlayer.h := cTileHeight - 5;
FPlayer.x := cMapWidth * cTileWidth / 2;
FPlayer.y := cMapHeight * cTileHeight / 2;
FPlayer.vx := 0;
FPlayer.vy := 0;




FPlayer.vx := 0;
FPlayer.vy := 0;
If FMoveUp Then
FPlayer.vy := -cPlayerSpeed
Else
If FMoveDown Then
FPlayer.vy := +cPlayerSpeed;

If FMoveLeft Then
FPlayer.vx := -cPlayerSpeed
Else
If FMoveRight Then
FPlayer.vx := +cPlayerSpeed;

FPlayer.Update(TimeSlice);


where TimeSlice is the time for the last frame in seconds (floating point)

Cheers,
Paul

Ixy
14-02-2009, 11:24 AM
Thanks.
I'm still trying to figure out what you did here, as I'm not really used to using classes and such.

But I'll figure it out. :D

Ixy
15-02-2009, 02:06 PM
:cry:

Still stuck with this.
I just can't follow your code, as I don't understand some parts of it (for example, how can variable Result have an integer value in Floor Function, while it's a boolean in TileIsWalkable function. And from what I see here, Result is a global var... :?

If it's possible, could you write just pseudo code? Or just explain without the code exactly what you did. I just need a procedure for checking if player is standing on a solid tile (and if a tile left or right from him is walkable).

I have solved gravity, acceleration, movement (left, right etc...) and that kind of stuff.

Thanks for your help! :wink:

Memphis
15-02-2009, 06:56 PM
:cry:

Still stuck with this.
I just can't follow your code, as I don't understand some parts of it (for example, how can variable Result have an integer value in Floor Function, while it's a boolean in TileIsWalkable function. And from what I see here, Result is a global var... :?

If it's possible, could you write just pseudo code? Or just explain without the code exactly what you did. I just need a procedure for checking if player is standing on a solid tile (and if a tile left or right from him is walkable).

I have solved gravity, acceleration, movement (left, right etc...) and that kind of stuff.

Thanks for your help! :wink:

are you a c++ coder? :shock:

Result is not a global variable, inside a function it works like return

return 1; is the same as Result := 1, only difference is delphi does not ret on a result, where as c/c++ does.

to be more precise, Result is a local variable (as the function return type), that is returned at the end of the function, or at an exit.

;MM;

Ixy
15-02-2009, 07:44 PM
:D

No, I'm not a c coder, but I never came across something like that.
I'm still in high school, and they don't teach us anything but basic programming. :(

efilnukefesin
15-02-2009, 08:56 PM
hi folks!

after reading that post i fell like i should start making a platformer :D

well, i also got stuck after reading tonypa's tutorial while implementing the corners stuff. well, half stuck, my player still could move to the left :oops:

what i want to say is thanks paul nicholls, i implemented your code into mine and it's working fine! now i just have to find out why and clean up the mess i left :) so thanks a lot!

different to paul, i have two classes tsimpleplayer and tsimplemap which are both controlled by a class named tsimplegame, where i do all this collision stuff.

i think i'll post the source, just to copy and paste :wink:

efilnukefesin
15-02-2009, 08:58 PM
unit '__pf_simpleplayer'



unit __pf_simpleplayer;

interface

uses Windows,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
DJXTimer,
DJX,
ExtCtrls,
djxclasses,
d3dx9,
StdCtrls,
DJXFonts,
ComCtrls,
djxlandscape,
djxtextures,
Direct3D9,
djxrender,
djxmeshes,
DJXMaterials,
DJXLights,
__dxtexturemanager;

type tpf_simpleplayer= class
public
constructor create;

procedure render;
private
fdjx&#58; tdanjetx;
ftm&#58; tdxtexturemanager;
fnameintl&#58; string;
fstretch_x,
fstretch_y&#58; single;

fx,
fy&#58; integer;

fpos_x,
fpos_y&#58; single;

fwidth,
fheight&#58; integer;

procedure setdjx&#40;const value&#58; tdanjetx&#41;;
procedure setnameintl&#40;const value&#58; string&#41;;
procedure settm&#40;const value&#58; tdxtexturemanager&#41;;
procedure setstretch_x&#40;const value&#58; single&#41;;
procedure setstretch_y&#40;const value&#58; single&#41;;
procedure setx&#40;const value&#58; integer&#41;;
procedure sety&#40;const value&#58; integer&#41;;
procedure setpos_x&#40;const value&#58; single&#41;;
procedure setpos_y&#40;const value&#58; single&#41;;
published
property djx&#58; tdanjetx read fdjx write setdjx;
property texturemanager&#58; tdxtexturemanager read ftm write settm;
property nameintl&#58; string read fnameintl write setnameintl;
property stretch_x&#58; single read fstretch_x write setstretch_x;
property stretch_y&#58; single read fstretch_y write setstretch_y;
property x&#58; integer read fx write setx;
property y&#58; integer read fy write sety;
property width&#58; integer read fwidth;
property height&#58; integer read fheight;
property pos_x&#58; single read fpos_x write setpos_x;
property pos_y&#58; single read fpos_y write setpos_y;
end;

implementation

&#123; tpf_simpleplayer &#125;

constructor tpf_simpleplayer.create;
begin
fdjx&#58;= nil;
ftm&#58;= nil;

fwidth&#58;= 32;
fheight&#58;= 64;

fstretch_x&#58;= 1;
fstretch_y&#58;= 1;
end;

procedure tpf_simpleplayer.render;
begin
if fdjx= nil then exit;
if ftm= nil then exit;

if ftm.djxtl.Find&#40;fnameintl&#41;<> nil then begin
//player stretchen
&#123;
ftm.djxtl.Find&#40;fnameintl&#41;.Draw4col&#40;
&#40;fx* ftile_width&#41;* fstretch_x,
&#40;fy* ftile_height&#41;* fstretch_y,
&#40;fx* ftile_width&#41;* fstretch_x+ ftile_width* fstretch_x,
&#40;fy* ftile_height&#41;* fstretch_y,
&#40;fx* ftile_width&#41;* fstretch_x+ ftile_width* fstretch_x,
&#40;fy* ftile_height&#41;* fstretch_y+ ftile_height* fstretch_y,
&#40;fx* ftile_width&#41;* fstretch_x,
&#40;fy* ftile_height&#41;* fstretch_y+ ftile_height* fstretch_y,
djxcolor&#40;clwhIte&#41;,
djxcolor&#40;clwhIte&#41;,
djxcolor&#40;clwhIte&#41;,
djxcolor&#40;clwhIte&#41;
&#41;;
&#125;
ftm.djxtl.Find&#40;fnameintl&#41;.Draw4col&#40;
&#40;fpos_x- fwidth/ 2&#41;* fstretch_x,
&#40;fpos_y- fheight/ 2&#41;* fstretch_y,
&#40;fpos_x+ fwidth/ 2&#41;* fstretch_x,
&#40;fpos_y- fheight/ 2&#41;* fstretch_y,
&#40;fpos_x+ fwidth/ 2&#41;* fstretch_x,
&#40;fpos_y+ fheight/ 2&#41;* fstretch_y,
&#40;fpos_x- fwidth/ 2&#41;* fstretch_x,
&#40;fpos_y+ fheight/ 2&#41;* fstretch_y,
djxcolor&#40;clwhIte&#41;,
djxcolor&#40;clwhIte&#41;,
djxcolor&#40;clwhIte&#41;,
djxcolor&#40;clwhIte&#41;
&#41;;

//kreuz auf fpos
fdjx.Primitives2D.Line&#40;fpos_x- 5, fpos_y- 5, fpos_x+ 5, fpos_y+ 5, djxcolor&#40;clwhite&#41;&#41;;
fdjx.Primitives2D.Line&#40;fpos_x+ 5, fpos_y- 5, fpos_x- 5, fpos_y+ 5, djxcolor&#40;clwhite&#41;&#41;;
end;
end;

procedure tpf_simpleplayer.setdjx&#40;const value&#58; tdanjetx&#41;;
begin
fdjx&#58;= value;
end;

procedure tpf_simpleplayer.setnameintl&#40;const value&#58; string&#41;;
begin
fnameintl&#58;= value;
end;

procedure tpf_simpleplayer.setpos_x&#40;const value&#58; single&#41;;
begin
fpos_x&#58;= value;
end;

procedure tpf_simpleplayer.setpos_y&#40;const value&#58; single&#41;;
begin
fpos_y&#58;= value;
end;

procedure tpf_simpleplayer.setstretch_x&#40;const value&#58; single&#41;;
begin
fstretch_x&#58;= value;
end;

procedure tpf_simpleplayer.setstretch_y&#40;const value&#58; single&#41;;
begin
fstretch_y&#58;= value;
end;

procedure tpf_simpleplayer.settm&#40;const value&#58; tdxtexturemanager&#41;;
begin
ftm&#58;= value;
end;

procedure tpf_simpleplayer.setx&#40;const value&#58; integer&#41;;
begin
fx&#58;= value;
end;

procedure tpf_simpleplayer.sety&#40;const value&#58; integer&#41;;
begin
fy&#58;= value;
end;

end.

efilnukefesin
15-02-2009, 08:59 PM
unit '__pf_simplemap'



unit __pf_simplemap;

// http&#58;//pascalgamedevelopment.com/viewtopic.php?p=45392#45392 //platformer threat
// http&#58;//www.tonypa.pri.ee/tbw/start.html //tile based games tutorial
// http&#58;//www.gamedev.net/reference/articles/article694.asp //gravity

interface

uses Windows,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
DJXTimer,
DJX,
ExtCtrls,
djxclasses,
d3dx9,
StdCtrls,
DJXFonts,
ComCtrls,
djxlandscape,
djxtextures,
Direct3D9,
djxrender,
djxmeshes,
DJXMaterials,
DJXLights,
__dxtexturemanager;

type trectile= record
idx&#58; integer;
walkable&#58; boolean;
end;

type tarrrectile= array of array of trectile;

type tpf_simplemap= class
public
constructor create;

procedure render;

procedure loadfromtextfile&#40;filename&#58; string&#41;;
private
fdjx&#58; tdanjetx;
ftm&#58; tdxtexturemanager;
fnameintl&#58; string;

fpattern&#58; tarrrectile;

ftile_width,
ftile_height&#58; integer;

fstretch_x,
fstretch_y&#58; single;

fwidth,
fheight&#58; integer;

procedure setdjx&#40;const value&#58; tdanjetx&#41;;
procedure settm&#40;const value&#58; tdxtexturemanager&#41;;
procedure setnameintl&#40;const value&#58; string&#41;;
procedure setstretch_x&#40;const value&#58; single&#41;;
procedure setstretch_y&#40;const value&#58; single&#41;;

procedure pattern_fill;

published
property djx&#58; tdanjetx read fdjx write setdjx;
property texturemanager&#58; tdxtexturemanager read ftm write settm;
property nameintl&#58; string read fnameintl write setnameintl;
property stretch_x&#58; single read fstretch_x write setstretch_x;
property stretch_y&#58; single read fstretch_y write setstretch_y;
property tile_width&#58; integer read ftile_width;
property tile_height&#58; integer read ftile_height;
property pattern&#58; tarrrectile read fpattern;
property width&#58; integer read fwidth;
property height&#58; integer read fheight;
end;

implementation

&#123; tpf_simplemap &#125;

constructor tpf_simplemap.create;
begin
fdjx&#58;= nil;
ftm&#58;= nil;

ftile_width&#58;= 32;
ftile_height&#58;= 32;

fstretch_x&#58;= 1;
fstretch_y&#58;= 1;

fwidth&#58;= 0;
fheight&#58;= 0;

//pattern_fill;
end;

procedure tpf_simplemap.loadfromtextfile&#40;filename&#58; string&#41;;
var sl_file&#58; tstringlist;
s_zeile&#58; string;
x,
y,
i,
j,
h,
hi&#58; integer;
begin
//pattern aus einer einfachen textdatei laden
setlength&#40;fpattern, 0&#41;;

if fileexists&#40;filename&#41; then begin
sl_file&#58;= tstringlist.create;

sl_file.LoadFromFile&#40;filename&#41;;

if sl_file.Count> 0 then begin
for i&#58;= 0 to sl_file.count- 1 do begin
s_zeile&#58;= trim&#40;sl_file&#91;i&#93;&#41;;

if s_zeile= '' then continue;

setlength&#40;fpattern, length&#40;fpattern&#41;+ 1&#41;;
h&#58;= high&#40;fpattern&#41;;
setlength&#40;fpattern&#91;h&#93;, 0&#41;;
for j&#58;= 1 to length&#40;s_zeile&#41; do begin
setlength&#40;fpattern&#91;h&#93;, length&#40;fpattern&#91;h&#93;&#41;+ 1&#41;;
hi&#58;= high&#40;fpattern&#91;h&#93;&#41;;

if s_zeile&#91;j&#93;= '1' then begin
fpattern&#91;h, hi&#93;.idx&#58;= 1;
fpattern&#91;h, hi&#93;.walkable&#58;= false;
end
else begin
fpattern&#91;h, hi&#93;.idx&#58;= 0;
fpattern&#91;h, hi&#93;.walkable&#58;= true;
end;
end;
end;
end;

sl_file.free;
end;

fheight&#58;= length&#40;fpattern&#41;;
fwidth&#58;= length&#40;fpattern&#91;0&#93;&#41;;
end;

procedure tpf_simplemap.pattern_fill;
var x,
y&#58; integer;
begin
//pattern zuf?§llig bef?ēllen
setlength&#40;fpattern, 20&#41;;
for x&#58;= low&#40;fpattern&#41; to high&#40;fpattern&#41; do begin
setlength&#40;fpattern&#91;x&#93;, 15&#41;;
for y&#58;= low&#40;fpattern&#91;x&#93;&#41; to high&#40;fpattern&#91;x&#93;&#41; do begin
fpattern&#91;x, y&#93;.idx&#58;= 0;
fpattern&#91;x, y&#93;.walkable&#58;= true;
randomize;
if random&#40;100&#41;> 90 then begin
fpattern&#91;x, y&#93;.idx&#58;= 1;
fpattern&#91;x, y&#93;.walkable&#58;= false;
end;
end;
end;
end;

procedure tpf_simplemap.render;
var x,
y&#58; integer;
begin
if fdjx= nil then exit;
if ftm= nil then exit;

for y&#58;= low&#40;fpattern&#41; to high&#40;fpattern&#41; do begin
for x&#58;= low&#40;fpattern&#91;y&#93;&#41; to high&#40;fpattern&#91;y&#93;&#41; do begin
if fpattern&#91;y, x&#93;.idx= 1 then begin

if ftm.djxtl.Find&#40;fnameintl&#41;<> nil then begin
//tiles stretchen
ftm.djxtl.Find&#40;fnameintl&#41;.Draw4col&#40;
&#40;x* ftile_width&#41;* fstretch_x,
&#40;y* ftile_height&#41;* fstretch_y,
&#40;x* ftile_width&#41;* fstretch_x+ ftile_width* fstretch_x,
&#40;y* ftile_height&#41;* fstretch_y,
&#40;x* ftile_width&#41;* fstretch_x+ ftile_width* fstretch_x,
&#40;y* ftile_height&#41;* fstretch_y+ ftile_height* fstretch_y,
&#40;x* ftile_width&#41;* fstretch_x,
&#40;y* ftile_height&#41;* fstretch_y+ ftile_height* fstretch_y,
djxcolor&#40;clwhIte&#41;,
djxcolor&#40;clwhIte&#41;,
djxcolor&#40;clwhIte&#41;,
djxcolor&#40;clwhIte&#41;
&#41;;
end;

end;
end;
end;
end;

procedure tpf_simplemap.setdjx&#40;const value&#58; tdanjetx&#41;;
begin
fdjx&#58;= value;
end;

procedure tpf_simplemap.setnameintl&#40;const value&#58; string&#41;;
begin
fnameintl&#58;= value;
end;

procedure tpf_simplemap.setstretch_x&#40;const value&#58; single&#41;;
begin
fstretch_x&#58;= value;
end;

procedure tpf_simplemap.setstretch_y&#40;const value&#58; single&#41;;
begin
fstretch_y&#58;= value;
end;

procedure tpf_simplemap.settm&#40;const value&#58; tdxtexturemanager&#41;;
begin
ftm&#58;= value;
end;

end.

efilnukefesin
15-02-2009, 09:00 PM
unit '__pf_simplegame' (class tpf_simplegame is NOT USED ANY MORE)



unit __pf_simplegame;

interface

uses Windows,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
DJXTimer,
DJX,
ExtCtrls,
djxclasses,
d3dx9,
StdCtrls,
DJXFonts,
ComCtrls,
djxlandscape,
djxtextures,
Direct3D9,
djxrender,
djxmeshes,
DJXMaterials,
DJXLights,
__dxtexturemanager,

udirectinput,
directinput,

__pf_simplemap,
__pf_simpleplayer;

const GUID_NULL&#58; tguid= '&#123;00000000-0000-0000-0000-000000000000&#125;';

type tpf_simplegamestate= &#40;
pfs_playing,
pfs_quit
&#41;;

type tpf_corners= record
upperleft,
lowerleft,
upperright,
lowerright&#58; boolean;
end;

type tpf_simplegame= class
public
constructor create&#40;handle&#58; hwnd&#41;;

procedure render;

procedure process;

//map-funktionen
procedure load_textmap&#40;const filename&#58; string&#41;;
function map_gettilepos&#40;const pos_x, pos_y&#58; single&#41;&#58; tpoint;
function map_getwalkable&#40;const pos_x, pos_y&#58; single&#41;&#58; boolean;

//player-funktionen
procedure move_player&#40;const dir_x, dir_y&#58; integer&#41;;

procedure di_activate;
procedure di_deactivate;
procedure di_keydown;
private
fhandle&#58; hwnd; //handle des mutterfensters f?ēr di

fdjx&#58; tdanjetx;
fsimplemap&#58; tpf_simplemap;
fsimpleplayer&#58; tpf_simpleplayer;
ftm&#58; tdxtexturemanager;

fstretch_x,
fstretch_y&#58; single;

fgamestate&#58; tpf_simplegamestate;

//dinput
di_obj&#58; tdiobject;
di_key&#58; tkeyboardinput;
di_joy&#58; TJoystickInput;

//eigene funktionen
procedure player_corners&#40;const x, y&#58; single; out corners&#58; tpf_corners&#41;;

//properties
procedure setdjx&#40;const value&#58; tdanjetx&#41;;
procedure settm&#40;const value&#58; tdxtexturemanager&#41;;
procedure setstretch_x&#40;const value&#58; single&#41;;
procedure setstretch_y&#40;const value&#58; single&#41;;
function getplayerpos&#58; tpoint;
published
property djx&#58; tdanjetx read fdjx write setdjx;
property texturemanager&#58; tdxtexturemanager read ftm write settm;
property stretch_x&#58; single read fstretch_x write setstretch_x;
property stretch_y&#58; single read fstretch_y write setstretch_y;
property state&#58; tpf_simplegamestate read fgamestate;
property playerpos&#58; tpoint read getplayerpos;
end;

type tpf_simplegame_2= class
public
constructor create&#40;handle&#58; hwnd&#41;;

procedure render;

procedure process;

//map-funktionen
procedure load_textmap&#40;const filename&#58; string&#41;;
function map_gettilepos&#40;const pos_x, pos_y&#58; single&#41;&#58; tpoint;
function map_getwalkable&#40;const pos_x, pos_y&#58; single&#41;&#58; boolean;

//player-funktionen
procedure move_player&#40;const dir_x, dir_y&#58; integer&#41;;

procedure di_activate;
procedure di_deactivate;
procedure di_keydown;
private
fhandle&#58; hwnd; //handle des mutterfensters f?ēr di

fdjx&#58; tdanjetx;
fsimplemap&#58; tpf_simplemap;
fsimpleplayer&#58; tpf_simpleplayer;
ftm&#58; tdxtexturemanager;

fstretch_x,
fstretch_y&#58; single;

fgamestate&#58; tpf_simplegamestate;

//dinput
di_obj&#58; tdiobject;
di_key&#58; tkeyboardinput;
di_joy&#58; TJoystickInput;

//corners
CnrUL &#58; TPoint; // upper left tile &#40;x,y&#41; player is over
CnrUR &#58; TPoint; // upper right tile &#40;x,y&#41; player is over
CnrLL &#58; TPoint; // lower left tile &#40;x,y&#41; player is over
CnrLR &#58; TPoint; // lower right tile &#40;x,y&#41; player is over

vx,
vy&#58; single;

//eigene funktionen
procedure player_corners&#40;const x, y&#58; single; out corners&#58; tpf_corners&#41;;

//properties
procedure setdjx&#40;const value&#58; tdanjetx&#41;;
procedure settm&#40;const value&#58; tdxtexturemanager&#41;;
procedure setstretch_x&#40;const value&#58; single&#41;;
procedure setstretch_y&#40;const value&#58; single&#41;;
function getplayerpos&#58; tpoint;

function ClampValue&#40;const n, l, u &#58; integer&#41;&#58; integer;
function Floor&#40;X &#58; extended&#41;&#58; integer;
procedure GetCornersAt&#40;const ax, ay &#58; single&#41;;
procedure update&#40;const ATimeSlice &#58; single&#41;;
function TileIsWalkable&#40;const tx,ty &#58; Integer&#41; &#58; boolean;
published
property djx&#58; tdanjetx read fdjx write setdjx;
property texturemanager&#58; tdxtexturemanager read ftm write settm;
property stretch_x&#58; single read fstretch_x write setstretch_x;
property stretch_y&#58; single read fstretch_y write setstretch_y;
property state&#58; tpf_simplegamestate read fgamestate;
property playerpos&#58; tpoint read getplayerpos;
end;

implementation

&#123; tpf_simplegame &#125;

constructor tpf_simplegame.create&#40;handle&#58; hwnd&#41;;
begin
fhandle&#58;= handle;

fdjx&#58;= nil;

fsimplemap&#58;= tpf_simplemap.create;
fsimpleplayer&#58;= tpf_simpleplayer.create;

fsimplemap.nameintl&#58;= 'blackblock_32px';
fsimpleplayer.nameintl&#58;= 'redblock_64px';
&#123;
fsimpleplayer.x&#58;= 5;
fsimpleplayer.y&#58;= 5;
&#125;
fsimpleplayer.pos_x&#58;= 250;
fsimpleplayer.pos_y&#58;= 250;

fgamestate&#58;= pfs_playing;
end;

procedure tpf_simplegame.di_activate;
begin
di_obj&#58;= tdiobject.create;
di_key&#58;= tkeyboardinput.create;
di_key.DIObject&#58;= di_obj;
di_key.handle&#58;= fhandle;
di_key.init&#40;GUID_NULL&#41;;
di_key.Acquire; //jetzt gehts los
end;

procedure tpf_simplegame.di_deactivate;
begin
//freeandnil&#40;di_key.DIData&#41;;
freeandnil&#40;di_key&#41;;
freeandnil&#40;di_joy&#41;;
freeandnil&#40;di_obj&#41;;
end;

procedure tpf_simplegame.di_keydown;
var s&#58; string;
temp_dir_x,
temp_dir_y&#58; integer;
begin
//hier die controllerabfragen tun
s&#58;= '-';
temp_dir_x&#58;= 0;
temp_dir_y&#58;= 0;

di_key.DIData.GetState;
if tkeyboarddata&#40;di_key.didata&#41;.keydown&#40;DIK_LCONTROL&#41; then begin
s&#58;= 'lcontrol';
end;
if tkeyboarddata&#40;di_key.didata&#41;.keydown&#40;DIK_RCONTROL&#41; then begin
s&#58;= 'rcontrol';
end;
if tkeyboarddata&#40;di_key.didata&#41;.keydown&#40;DIK_SPACE&#41; then begin
s&#58;= 'space';
end;
if tkeyboarddata&#40;di_key.didata&#41;.keydown&#40;DIK_ESCAPE&#41; then begin
s&#58;= 'escape';
fgamestate&#58;= pfs_quit;
end;

if tkeyboarddata&#40;di_key.didata&#41;.keydown&#40;DIK_UPARROW&#41; then begin
s&#58;= 'UP';
temp_dir_y&#58;= -1;
end;
if tkeyboarddata&#40;di_key.didata&#41;.keydown&#40;DIK_DOWNARROW &#41; then begin
s&#58;= 'DOWN';
temp_dir_y&#58;= +1;
end;
if tkeyboarddata&#40;di_key.didata&#41;.keydown&#40;DIK_LEFTARROW &#41; then begin
s&#58;= 'LEFT';
temp_dir_x&#58;= -1;
end;
if tkeyboarddata&#40;di_key.didata&#41;.keydown&#40;DIK_RIGHTARRO W&#41; then begin
s&#58;= 'RIGHT';
temp_dir_x&#58;= +1;
end;

move_player&#40;temp_dir_x, temp_dir_y&#41;;
end;

function tpf_simplegame.getplayerpos&#58; tpoint;
begin
result.X&#58;= fsimpleplayer.x;
result.Y&#58;= fsimpleplayer.y;
end;

procedure tpf_simplegame.load_textmap&#40;const filename&#58; string&#41;;
begin
fsimplemap.loadfromtextfile&#40;filename&#41;;
end;

function tpf_simplegame.map_gettilepos&#40;const pos_x, pos_y&#58; single&#41;&#58; tpoint;
var p&#58; tpoint;
temp_x,
temp_y&#58; integer;
begin
p.X&#58;= -1;
p.Y&#58;= -1;

//***
temp_x&#58;= round&#40;pos_x/ fsimplemap.tile_width&#41;;
temp_y&#58;= round&#40;pos_y/ fsimplemap.tile_height&#41;;

temp_x&#58;= trunc&#40;pos_x/ fsimplemap.tile_width&#41;;
temp_y&#58;= trunc&#40;pos_y/ fsimplemap.tile_height&#41;;
//***

if &#40;temp_x>= low&#40;fsimplemap.pattern&#91;0&#93;&#41;&#41;and &#40;temp_x<high>= low&#40;fsimplemap.pattern&#41;&#41;and &#40;temp_y<high> -1&#41;and &#40;p.Y> -1&#41; then begin
result&#58;= fsimplemap.pattern&#91;p.y, p.x&#93;.walkable;
end
else begin
result&#58;= false;
end;
end;

procedure tpf_simplegame.player_corners&#40;const x, y&#58; single; out corners&#58; tpf_corners&#41;;
var temp_left,
temp_right,
temp_up,
temp_down&#58; single;
outofmap&#58; boolean;
begin
temp_left&#58;= x- &#40;fsimpleplayer.width/ 2&#41;;
temp_right&#58;= x+ &#40;fsimpleplayer.width/ 2&#41;;
temp_up&#58;= y- &#40;fsimpleplayer.height/ 2&#41;;
temp_down&#58;= y+ &#40;fsimpleplayer.height/ 2&#41;;

corners.upperleft&#58;= map_getwalkable&#40;temp_left, temp_up&#41;;
corners.upperright&#58;= map_getwalkable&#40;temp_right, temp_up&#41;;
corners.lowerleft&#58;= map_getwalkable&#40;temp_left, temp_down&#41;;
corners.lowerright&#58;= map_getwalkable&#40;temp_right, temp_down&#41;;
end;

procedure tpf_simplegame.move_player&#40;const dir_x, dir_y&#58; integer&#41;;
var corners&#58; tpf_corners;
temp_dir_x,
temp_dir_y&#58; integer;
begin
player_corners&#40;fsimpleplayer.pos_x+ dir_x, fsimpleplayer.pos_y+ dir_x, corners&#41;;

temp_dir_x&#58;= 0;
temp_dir_y&#58;= 0;

if dir_x= -1 then begin
if corners.upperleft and corners.lowerleft then begin
temp_dir_x&#58;= dir_x;
end
else begin
temp_dir_x&#58;= 0;
end;
end;

if dir_x= +1 then begin
if corners.upperright and corners.lowerright then begin
temp_dir_x&#58;= dir_x;
end
else begin
temp_dir_x&#58;= 0;
end;
end;

if dir_y= -1 then begin
if corners.upperleft and corners.upperright then begin
temp_dir_y&#58;= dir_y;
end
else begin
temp_dir_y&#58;= 0;
end;
end;

if dir_y= +1 then begin
if corners.lowerleft and corners.lowerright then begin
temp_dir_y&#58;= dir_y;
end
else begin
temp_dir_y&#58;= 0;
end;
end;

fsimpleplayer.pos_x&#58;= fsimpleplayer.pos_x+ temp_dir_x;
fsimpleplayer.pos_y&#58;= fsimpleplayer.pos_y+ temp_dir_y;
end;

procedure tpf_simplegame.process;
begin
//per gettickcount abfragen, abstand ca 10 ms oder was
//****
di_keydown;
end;

procedure tpf_simplegame.render;
begin
fsimplemap.render;
fsimpleplayer.render;
end;

procedure tpf_simplegame.setdjx&#40;const value&#58; tdanjetx&#41;;
begin
fdjx&#58;= value;

fsimplemap.djx&#58;= fdjx;
fsimpleplayer.djx&#58;= fdjx;
end;

procedure tpf_simplegame.setstretch_x&#40;const value&#58; single&#41;;
begin
fstretch_x&#58;= value;

fsimplemap.stretch_x&#58;= fstretch_x;
fsimpleplayer.stretch_x&#58;= fstretch_x;
end;

procedure tpf_simplegame.setstretch_y&#40;const value&#58; single&#41;;
begin
fstretch_y&#58;= value;

fsimplemap.stretch_y&#58;= fstretch_y;
fsimpleplayer.stretch_y&#58;= fstretch_y;
end;

procedure tpf_simplegame.settm&#40;const value&#58; tdxtexturemanager&#41;;
begin
ftm&#58;= value;

fsimplemap.texturemanager&#58;= ftm;
fsimpleplayer.texturemanager&#58;= ftm;
end;


&#123; tpf_simplegame_2 &#125;

constructor tpf_simplegame_2.create&#40;handle&#58; hwnd&#41;;
begin
fhandle&#58;= handle;

fdjx&#58;= nil;

fsimplemap&#58;= tpf_simplemap.create;
fsimpleplayer&#58;= tpf_simpleplayer.create;

fsimplemap.nameintl&#58;= 'blackblock_32px';
fsimpleplayer.nameintl&#58;= 'redblock_64px';
&#123;
fsimpleplayer.x&#58;= 5;
fsimpleplayer.y&#58;= 5;
&#125;
fsimpleplayer.pos_x&#58;= 150;
fsimpleplayer.pos_y&#58;= 250;

vx&#58;= 0;
vy&#58;= 0;

fgamestate&#58;= pfs_playing;
end;

procedure tpf_simplegame_2.di_activate;
begin
di_obj&#58;= tdiobject.create;
di_key&#58;= tkeyboardinput.create;
di_key.DIObject&#58;= di_obj;
di_key.handle&#58;= fhandle;
di_key.init&#40;GUID_NULL&#41;;
di_key.Acquire; //jetzt gehts los
end;

procedure tpf_simplegame_2.di_deactivate;
begin
//freeandnil&#40;di_key.DIData&#41;;
freeandnil&#40;di_key&#41;;
freeandnil&#40;di_joy&#41;;
freeandnil&#40;di_obj&#41;;
end;

procedure tpf_simplegame_2.di_keydown;
var s&#58; string;
temp_dir_x,
temp_dir_y&#58; integer;
begin
//hier die controllerabfragen tun
s&#58;= '-';
temp_dir_x&#58;= 0;
temp_dir_y&#58;= 0;

di_key.DIData.GetState;
if tkeyboarddata&#40;di_key.didata&#41;.keydown&#40;DIK_LCONTROL&#41; then begin
s&#58;= 'lcontrol';
end;
if tkeyboarddata&#40;di_key.didata&#41;.keydown&#40;DIK_RCONTROL&#41; then begin
s&#58;= 'rcontrol';
end;
if tkeyboarddata&#40;di_key.didata&#41;.keydown&#40;DIK_SPACE&#41; then begin
s&#58;= 'space';
end;
if tkeyboarddata&#40;di_key.didata&#41;.keydown&#40;DIK_ESCAPE&#41; then begin
s&#58;= 'escape';
fgamestate&#58;= pfs_quit;
end;

if tkeyboarddata&#40;di_key.didata&#41;.keydown&#40;DIK_UPARROW&#41; then begin
s&#58;= 'UP';
temp_dir_y&#58;= -1;
end;
if tkeyboarddata&#40;di_key.didata&#41;.keydown&#40;DIK_DOWNARROW &#41; then begin
s&#58;= 'DOWN';
temp_dir_y&#58;= +1;
end;
if tkeyboarddata&#40;di_key.didata&#41;.keydown&#40;DIK_LEFTARROW &#41; then begin
s&#58;= 'LEFT';
temp_dir_x&#58;= -1;
end;
if tkeyboarddata&#40;di_key.didata&#41;.keydown&#40;DIK_RIGHTARRO W&#41; then begin
s&#58;= 'RIGHT';
temp_dir_x&#58;= +1;
end;

//move_player&#40;temp_dir_x, temp_dir_y&#41;;
vx&#58;= temp_dir_x;
vy&#58;= temp_dir_y;
end;

function tpf_simplegame_2.getplayerpos&#58; tpoint;
begin
result.X&#58;= fsimpleplayer.x;
result.Y&#58;= fsimpleplayer.y;
end;

procedure tpf_simplegame_2.load_textmap&#40;const filename&#58; string&#41;;
begin
fsimplemap.loadfromtextfile&#40;filename&#41;;
end;

function tpf_simplegame_2.map_gettilepos&#40;const pos_x, pos_y&#58; single&#41;&#58; tpoint;
var p&#58; tpoint;
temp_x,
temp_y&#58; integer;
begin
p.X&#58;= -1;
p.Y&#58;= -1;

//***
temp_x&#58;= round&#40;pos_x/ fsimplemap.tile_width&#41;;
temp_y&#58;= round&#40;pos_y/ fsimplemap.tile_height&#41;;

temp_x&#58;= trunc&#40;pos_x/ fsimplemap.tile_width&#41;;
temp_y&#58;= trunc&#40;pos_y/ fsimplemap.tile_height&#41;;
//***

if &#40;temp_x>= low&#40;fsimplemap.pattern&#91;0&#93;&#41;&#41;and &#40;temp_x<high>= low&#40;fsimplemap.pattern&#41;&#41;and &#40;temp_y<high> -1&#41;and &#40;p.Y> -1&#41; then begin
result&#58;= fsimplemap.pattern&#91;p.y, p.x&#93;.walkable;
end
else begin
result&#58;= false;
end;
end;

procedure tpf_simplegame_2.player_corners&#40;const x, y&#58; single; out corners&#58; tpf_corners&#41;;
var temp_left,
temp_right,
temp_up,
temp_down&#58; single;
outofmap&#58; boolean;
begin
temp_left&#58;= x- &#40;fsimpleplayer.width/ 2&#41;;
temp_right&#58;= x+ &#40;fsimpleplayer.width/ 2&#41;;
temp_up&#58;= y- &#40;fsimpleplayer.height/ 2&#41;;
temp_down&#58;= y+ &#40;fsimpleplayer.height/ 2&#41;;

corners.upperleft&#58;= map_getwalkable&#40;temp_left, temp_up&#41;;
corners.upperright&#58;= map_getwalkable&#40;temp_right, temp_up&#41;;
corners.lowerleft&#58;= map_getwalkable&#40;temp_left, temp_down&#41;;
corners.lowerright&#58;= map_getwalkable&#40;temp_right, temp_down&#41;;
end;

procedure tpf_simplegame_2.move_player&#40;const dir_x, dir_y&#58; integer&#41;;
var corners&#58; tpf_corners;
temp_dir_x,
temp_dir_y&#58; integer;
begin
player_corners&#40;fsimpleplayer.pos_x+ dir_x, fsimpleplayer.pos_y+ dir_x, corners&#41;;

temp_dir_x&#58;= 0;
temp_dir_y&#58;= 0;

if dir_x= -1 then begin
if corners.upperleft and corners.lowerleft then begin
temp_dir_x&#58;= dir_x;
end
else begin
temp_dir_x&#58;= 0;
end;
end;

if dir_x= +1 then begin
if corners.upperright and corners.lowerright then begin
temp_dir_x&#58;= dir_x;
end
else begin
temp_dir_x&#58;= 0;
end;
end;

if dir_y= -1 then begin
if corners.upperleft and corners.upperright then begin
temp_dir_y&#58;= dir_y;
end
else begin
temp_dir_y&#58;= 0;
end;
end;

if dir_y= +1 then begin
if corners.lowerleft and corners.lowerright then begin
temp_dir_y&#58;= dir_y;
end
else begin
temp_dir_y&#58;= 0;
end;
end;

fsimpleplayer.pos_x&#58;= fsimpleplayer.pos_x+ temp_dir_x;
fsimpleplayer.pos_y&#58;= fsimpleplayer.pos_y+ temp_dir_y;
end;

procedure tpf_simplegame_2.process;
begin
//per gettickcount abfragen, abstand ca 10 ms oder was
//****
di_keydown;

update&#40;1&#41;;
end;

procedure tpf_simplegame_2.render;
begin
fsimplemap.render;
fsimpleplayer.render;
end;

procedure tpf_simplegame_2.setdjx&#40;const value&#58; tdanjetx&#41;;
begin
fdjx&#58;= value;

fsimplemap.djx&#58;= fdjx;
fsimpleplayer.djx&#58;= fdjx;
end;

procedure tpf_simplegame_2.setstretch_x&#40;const value&#58; single&#41;;
begin
fstretch_x&#58;= value;

fsimplemap.stretch_x&#58;= fstretch_x;
fsimpleplayer.stretch_x&#58;= fstretch_x;
end;

procedure tpf_simplegame_2.setstretch_y&#40;const value&#58; single&#41;;
begin
fstretch_y&#58;= value;

fsimplemap.stretch_y&#58;= fstretch_y;
fsimpleplayer.stretch_y&#58;= fstretch_y;
end;

procedure tpf_simplegame_2.settm&#40;const value&#58; tdxtexturemanager&#41;;
begin
ftm&#58;= value;

fsimplemap.texturemanager&#58;= ftm;
fsimpleplayer.texturemanager&#58;= ftm;
end;

function tpf_simplegame_2.TileIsWalkable&#40;const tx, ty&#58; Integer&#41;&#58; boolean;
begin
result&#58;= false;

If tx < 0 Then Exit;
If ty <0>= fsimplemap.width Then Exit;
If ty >= fsimplemap.height Then Exit;

if &#40;tx> -1&#41;and &#40;ty> -1&#41; then begin
result&#58;= fsimplemap.pattern&#91;ty, tx&#93;.walkable;
end
else begin
result&#58;= false;
end;
end;

function tpf_simplegame_2.ClampValue&#40;const n, l, u &#58; integer&#41;&#58; integer;
begin
Result &#58;= n;
If Result <l> u Then Result &#58;= u;
end;

function tpf_simplegame_2.Floor&#40;X&#58; extended&#41;&#58; integer;
begin
Result &#58;= Integer&#40;Trunc&#40;X&#41;&#41;;
If Frac&#40;X&#41; < 0 Then Dec&#40;Result&#41;;
end;

procedure tpf_simplegame_2.GetCornersAt&#40;const ax, ay&#58; single&#41;;
&#123;
|
|
-,- | +,-

-------|-------

-,+ | +,+
|
|
&#125;
begin
CnrUL.x &#58;= Floor&#40;&#40;ax - fsimpleplayer.width/2&#41; / fsimplemap.tile_width&#41;;
CnrUL.y &#58;= Floor&#40;&#40;ay - fsimpleplayer.height/2&#41; / fsimplemap.tile_height&#41;;

CnrUR.x &#58;= Floor&#40;&#40;ax + fsimpleplayer.width/2&#41; / fsimplemap.tile_width&#41;;
CnrUR.y &#58;= Floor&#40;&#40;ay - fsimpleplayer.height/2&#41; / fsimplemap.tile_height&#41;;

CnrLR.x &#58;= Floor&#40;&#40;ax + fsimpleplayer.width/2&#41; / fsimplemap.tile_width&#41;;
CnrLR.y &#58;= Floor&#40;&#40;ay + fsimpleplayer.height/2&#41; / fsimplemap.tile_height&#41;;

CnrLL.x &#58;= Floor&#40;&#40;ax - fsimpleplayer.width/2&#41; / fsimplemap.tile_width&#41;;
CnrLL.y &#58;= Floor&#40;&#40;ay + fsimpleplayer.height/2&#41; / fsimplemap.tile_height&#41;;

CnrUL.x &#58;= ClampValue&#40;CnrUL.x,0,fsimplemap.width - 1&#41;;
CnrUR.x &#58;= ClampValue&#40;CnrUR.x,0,fsimplemap.width - 1&#41;;
CnrLR.x &#58;= ClampValue&#40;CnrLR.x,0,fsimplemap.width - 1&#41;;
CnrLL.x &#58;= ClampValue&#40;CnrLL.x,0,fsimplemap.width - 1&#41;;

CnrUL.y &#58;= ClampValue&#40;CnrUL.y,0,fsimplemap.height - 1&#41;;
CnrUR.y &#58;= ClampValue&#40;CnrUR.y,0,fsimplemap.height - 1&#41;;
CnrLR.y &#58;= ClampValue&#40;CnrLR.y,0,fsimplemap.height - 1&#41;;
CnrLL.y &#58;= ClampValue&#40;CnrLL.y,0,fsimplemap.height - 1&#41;;
end;

procedure tpf_simplegame_2.update&#40;const ATimeSlice &#58; single&#41;;
var TileIsWalkableUL &#58; Boolean; // upper left player corner tile is walkable
TileIsWalkableUR &#58; Boolean; // upper right player corner tile is walkable
TileIsWalkableLL &#58; Boolean; // lower left player corner tile is walkable
TileIsWalkableLR &#58; Boolean; // lower right player corner tile is walkable
Begin
GetCornersAt&#40;fsimpleplayer.pos_x,fsimpleplayer.pos _y + vy * ATimeSlice&#41;;
If vy <0> 0 Then
//moving down
Begin
TileIsWalkableLL &#58;= TileIsWalkable&#40;CnrLL.x,CnrLL.y&#41;;
TileIsWalkableLR &#58;= TileIsWalkable&#40;CnrLR.x,CnrLR.y&#41;;
If TileIsWalkableLL And TileIsWalkableLR Then
fsimpleplayer.pos_y &#58;= fsimpleplayer.pos_y + vy * ATimeSlice
Else
// move player to sit on tile&#40;s&#41; below
fsimpleplayer.pos_y &#58;= CnrLR.y * fsimplemap.tile_height - fsimpleplayer.height/2 - 0.01;
End;

GetCornersAt&#40;fsimpleplayer.pos_x + vx * ATimeSlice,fsimpleplayer.pos_y&#41;;
If vx <0> 0 Then
//moving right
Begin
TileIsWalkableUR &#58;= TileIsWalkable&#40;CnrUR.x,CnrUR.y&#41;;
TileIsWalkableLR &#58;= TileIsWalkable&#40;CnrLR.x,CnrLR.y&#41;;
If TileIsWalkableUR And TileIsWalkableLR Then
fsimpleplayer.pos_x &#58;= fsimpleplayer.pos_x + vx * ATimeSlice
Else
// move player to touch tile&#40;s&#41; on right
fsimpleplayer.pos_x &#58;= CnrUR.x * fsimplemap.tile_width - fsimpleplayer.width/2 - 0.01;
End;
// add gravity to vy here and cap to max velocity so not faster than tile height;
End;

end.

efilnukefesin
15-02-2009, 09:01 PM
and the _main unit:



unit _main;

interface

uses Windows,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
DJXTimer,
DJX,
ExtCtrls,
djxclasses,
d3dx9,
StdCtrls,
DJXFonts,
ComCtrls,
djxlandscape,
djxtextures,
Direct3D9,
djxrender,
djxmeshes,
DJXMaterials,
DJXLights,
Buttons,
__dxtexturemanager,
__pf_simplegame,
__consts;

type
Tf_main = class&#40;TForm&#41;
p_djx&#58; TPanel;
djx_main&#58; TDanJetX;
djxt_main&#58; TDJXTimer;
djxfl_main&#58; TDJXFontList;
Label1&#58; TLabel;
procedure FormCreate&#40;Sender&#58; TObject&#41;;
procedure djxt_mainTimer&#40;Sender&#58; TObject&#41;;
procedure FormActivate&#40;Sender&#58; TObject&#41;;
procedure FormDeactivate&#40;Sender&#58; TObject&#41;;
procedure djxt_mainProcess&#40;Sender&#58; TObject&#41;;
private
programmpfad&#58; string;
texturemanager&#58; tdxtexturemanager;

simplegame&#58; tpf_simplegame_2;

faktor_x,
faktor_y&#58; single;

procedure renderdebuginfo;
public
&#123; Public-Deklarationen &#125;
end;

var f_main&#58; Tf_main;

implementation

uses __basics;

&#123;$R *.dfm&#125;

procedure Tf_main.FormCreate&#40;Sender&#58; TObject&#41;;
begin
programmpfad&#58;= getprogrampath;

//danjetx initialisieren
djx_main.Width&#58;= p_djx.Width;
djx_main.Height&#58;= p_djx.Height;
djx_main.InitParams.VertexProcessing&#58;= vpmixed;
djx_main.Start&#40;p_djx.Handle&#41;;

if not djx_main.Initialized then exit;

//fonts
djxfl_main.CreateFont&#40;'courier_14', 'courier new', 14&#41;;
djxfl_main.CreateFont&#40;'courier_16', 'courier new', 16&#41;;

//seitenverh?§ltnis-faktoren ausrechnen
faktor_x&#58;= djx_main.Width/ 640;
faktor_y&#58;= djx_main.Height/ 480;

//texturemanager
texturemanager&#58;= tdxtexturemanager.create;
texturemanager.djx&#58;= djx_main; //ZUERST djx zuweisen
texturemanager.path_textures&#58;= programmpfad+ 'textures\'; //DANN pfad einstellen

simplegame&#58;= tpf_simplegame_2.create&#40;handle&#41;;
simplegame.djx&#58;= djx_main;
simplegame.texturemanager&#58;= texturemanager;
simplegame.stretch_x&#58;= faktor_x;
simplegame.stretch_y&#58;= faktor_y;
simplegame.load_textmap&#40;programmpfad+ 'maps\map1.txt'&#41;;

//und timer an
djxt_main.enabled&#58;= true;
end;

procedure Tf_main.FormActivate&#40;Sender&#58; TObject&#41;;
begin
simplegame.di_activate;
end;

procedure Tf_main.FormDeactivate&#40;Sender&#58; TObject&#41;;
begin
simplegame.di_deactivate;
end;

procedure Tf_main.djxt_mainProcess&#40;Sender&#58; TObject&#41;;
begin
simplegame.process;

if simplegame.state= pfs_quit then close;

label1.caption&#58;= 'player pos '+ inttostr&#40;simplegame.playerpos.x&#41;+ '/'+ inttostr&#40;simplegame.playerpos.y&#41;;
end;

procedure Tf_main.djxt_mainTimer&#40;Sender&#58; TObject&#41;;
begin
djx_main.BeginRender;
djx_main.ClearScreen&#40;255, 255, 255&#41;;

//****
simplegame.render;

renderdebuginfo;
djx_main.EndRender&#40;&#41;;
end;

procedure Tf_main.renderdebuginfo;
begin
djxfl_main.Find&#40;'courier_16'&#41;.Print&#40;10, 10, 'debug info', djxcolor&#40;cllime&#41;, true&#41;;
djxfl_main.Find&#40;'courier_14'&#41;.Print&#40;10, 30, 'fps&#58; '+ inttostr&#40;djxt_main.fps&#41;, djxcolor&#40;cllime&#41;&#41;;
end;

end.

efilnukefesin
15-02-2009, 09:05 PM
oh and the map format is quite simple:



11111111111111111111
10000000000000000001
10000000000000000001
10000000000000000001
10000000000000000001
10000000000000000001
10000000000000000001
10000000111000000001
10000000000000000001
10000000000000000001
10000000000000000001
10000000000000000001
10000000000000000001
10000000000000000011
11111111111111111111


:D

where 1 is a block and 0 is nothing.

this __texturemanager-stuff is only a texturelist-handling thing, you can replace it by - in this case - a texture for the player and one texture for a block.

it's really basic right now, no gravity or different blocks implemented yet :D

also, you can replace the whole directinput-stuff by polling the keys in the keydown-events... i just wanted that implemented from the start because it's so much work to do that later on...

paul_nicholls
15-02-2009, 11:45 PM
hi folks!

after reading that post i fell like i should start making a platformer :D

well, i also got stuck after reading tonypa's tutorial while implementing the corners stuff. well, half stuck, my player still could move to the left :oops:

what i want to say is thanks paul nicholls, i implemented your code into mine and it's working fine! now i just have to find out why and clean up the mess i left :) so thanks a lot!

different to paul, i have two classes tsimpleplayer and tsimplemap which are both controlled by a class named tsimplegame, where i do all this collision stuff.

i think i'll post the source, just to copy and paste :wink:

Hi efilnukefesin,
that was an impressing amount of posts :-)

@Ixy: Perhaps this site (top part) may help with regards to the corner checks I do for the 'sprite' and the tile grid.

http://www.harveycartel.org/metanet/tutorials/tutorialB.html

contents:
SECTION 0: General Introduction
SECTION 1: Basic Tile Grid
SECTION 2: Advanced Tile Grid
SECTION 3: Object Grid
SECTION 4: Raycasting
SECTION 5: Conclusion / Source Code

There is also this tutorial page there as well:

http://www.harveycartel.org/metanet/tutorials/tutorialA.html which explains axis separation and collision stuff too.

contents:
SECTION 0: General Introduction
SECTION 1: Separating Axis Theorem
SECTION 2: Separating Axis Theorem for AABBs
SECTION 3: Separating Axis Theorem for Circles
SECTION 4: Separating Axis Theorem for Points
SECTION 5: Fast-Moving Objects
SECTION 6: Conclusion / Source Code

Unfortunately the source code is using Actionscript and I can't read the downloadable source code :(

cheers,
Paul

efilnukefesin
16-02-2009, 08:39 AM
@paul: well somehow you have to increase your number of posts :wink: perhaps i was a bit enthusiastic, too! but thanks anyway for showing the right direction!

paul_nicholls
16-02-2009, 11:44 AM
@paul: well somehow you have to increase your number of posts :wink: perhaps i was a bit enthusiastic, too! but thanks anyway for showing the right direction!

lol! No worries :)

One day I may try and write a tutorial on this stuff ;-)

cheers,
Paul

efilnukefesin
16-02-2009, 01:57 PM
yeah that would be definitely great, maybe i could help?
two people with few time give perhaps enough time to write a whole tutorial :D

paul_nicholls
19-02-2009, 05:51 AM
yeah that would be definitely great, maybe i could help?
two people with few time give perhaps enough time to write a whole tutorial :D

Thanks for the offer, I will see how I go first :)
cheers,
Paul

Ixy
19-02-2009, 12:11 PM
:(

OMG nothing works at first. Everything needs tweaking.
I can't play sound effects. Music plays nicely, but as soon as I try to play a sound effect, it crashes with exitcode 216. So I commented out MIX_VOLUMECHUNK. And now it returns -1 when loading a wav file. :S

I'm sure that the path is correct...

efilnukefesin
19-02-2009, 01:00 PM
how do you load and play music/ sound effects?

Ixy
19-02-2009, 06:36 PM
music:= MIX_LoadMus ('path');
MIX_VolumeMusic (100);
MIXPlayMusic (music, -1);

sndeffect:= MIX_LoadWAV ('path');
MIX_PlayChannel (-1, sndeffect, 0);

paul_nicholls
19-02-2009, 11:28 PM
Hi Ixy, if it helps, here are my units I use for manipulating audio when using SDL_Mixer. Music load/play hasn't been aded yet, but it could easily be.



Unit EngineAudio;
{$IFDEF fpc}
{$mode delphi}
{$ENDIF}
{$H+}
Interface

Uses
Classes;

Type
{................................................. .............................}
TAudioModule = Class
Function InitAudio: Boolean; Virtual; Abstract;
Procedure RegisterSound_WAV(AName,AFileName: AnsiString); Overload; Virtual; Abstract;
Procedure RegisterSound_WAV(Const AName : AnsiString;
Const AStream : TMemoryStream); Overload; Virtual; AbStract;
Function PlaySound_WAV (AName : AnsiString) : Integer; Virtual; Abstract;
Procedure StopSound_WAV (AChannel: Integer); Virtual; Abstract;
Procedure RegisterMusic_WAV(AName,AFileName: AnsiString); Virtual; Abstract;
Function PlayMusic_WAV (AName : AnsiString): Boolean; Virtual; Abstract;
Procedure StopMusic_WAV; Virtual; Abstract;
Procedure CloseAudio; Virtual; Abstract;
End;
{................................................. .............................}

Implementation

End.




Unit EngineAudio_sdl_mixer;
{$IFDEF fpc}
{$mode delphi}
{$ENDIF}
{$H+}
Interface

Uses
EngineAudio,
Classes;

Type
{................................................. .............................}
TSoundInfo = Class
IsPhysicalFile : Boolean;
FileName : AnsiString;
Stream : TMemoryStream;
End;
{................................................. .............................}

{................................................. .............................}
TAudioModule_sdl_mixer = Class(TAudioModule)
Private
FSoundNames : TStringList;
FAudioInitialized : Boolean;
Public
Constructor Create;
Destructor Destroy; Override;
Function InitAudio: Boolean; Override;
Procedure RegisterSound_WAV(AName,AFileName: AnsiString); Override;
Procedure RegisterSound_WAV(Const AName : AnsiString;
Const AStream : TMemoryStream); Override;
Function PlaySound_WAV (AName : AnsiString) : Integer; Override;
Procedure StopSound_WAV (AChannel: Integer); Override;
Procedure RegisterMusic_WAV(AName,AFileName: AnsiString); Override;
Function PlayMusic_WAV (AName : AnsiString): Boolean; Override;
Procedure StopMusic_WAV; Override;
Procedure CloseAudio; Override;
End;
{................................................. .............................}

Implementation

Uses
SDL,
SDL_Mixer;

Const
{................................................. .............................}
cMaxSounds = 40;
{................................................. .............................}

Type
{................................................. .............................}
TSound = Class
Private
Sound : PMix_Chunk;
channel : Integer;
Public
Constructor Create;
Destructor Destroy; Override;
Function Playing : Boolean; Virtual;
End;
{................................................. .............................}

{................................................. .............................}
TMusic = Class(TSound)
Private
Music : PMix_Music;
Public
Constructor Create;
Destructor Destroy; Override;
Function Playing : Boolean; Override;
End;
{................................................. .............................}

Var
Sounds : Array[0..cMaxSounds - 1] Of TSound;
Music : TMusic;
{................................................. .............................}

{................................................. .............................}
Constructor TSound.Create;
Begin
Inherited Create;
Sound := Nil;
End;
{................................................. .............................}

{................................................. .............................}
Destructor TSound.Destroy;
Begin
If Sound <> Nil Then Mix_FreeChunk(Sound);
Inherited Destroy;
End;
{................................................. .............................}

{................................................. .............................}
Function TSound.Playing : Boolean;
Begin
Result := Mix_Playing(Channel) = 0;
End;
{................................................. .............................}

{................................................. .............................}
Constructor TMusic.Create;
Begin
Inherited Create;
Music := Nil;
End;
{................................................. .............................}

{................................................. .............................}
Destructor TMusic.Destroy;
Begin
If Music <> Nil Then Mix_FreeMusic(Music);
Inherited Destroy;
End;
{................................................. .............................}

{................................................. .............................}
Function TMusic.Playing : Boolean;
Begin
Result := Mix_PlayingMusic = 0;
End;
{................................................. .............................}

{................................................. .............................}
Constructor TAudioModule_sdl_mixer.Create;
Begin
Inherited Create;
FSoundNames := TStringList.Create;
FAudioInitialized := False;
End;
{................................................. .............................}

{................................................. .............................}
Destructor TAudioModule_sdl_mixer.Destroy;
Var
i : Integer;
si : TSoundInfo;
Begin
For i := 0 To FSoundNames.Count - 1 Do
Begin
si := TSoundInfo(FSoundNames.Objects[i]);
If Not si.IsPhysicalFile Then si.Stream.Free;
si.Free;
End;
FSoundNames.Free;
Inherited Destroy;
End;
{................................................. .............................}

{................................................. .............................}
Function TAudioModule_sdl_mixer.InitAudio: Boolean;
Begin
Result := False;

// Open the audio device
If Mix_OpenAudio(22050,AUDIO_S16SYS,2,512) < 0 Then
Begin
//fprintf(stderr, "Unable to open audio: %s\n", SDL_GetError());
Exit;
End;
Result := True;
FAudioInitialized := True;
End;
{................................................. .............................}

{................................................. .............................}
Procedure TAudioModule_sdl_mixer.CloseAudio;
Begin
If FAudioInitialized Then Mix_CloseAudio;
End;
{................................................. .............................}

{................................................. .............................}
Procedure TAudioModule_sdl_mixer.RegisterSound_WAV(AName,AFi leName : AnsiString);
Var
SoundInfo : TSoundInfo;
Begin
SoundInfo := TSoundInfo.Create;
SoundInfo.IsPhysicalFile := True;
SoundInfo.FileName := AFileName;
SoundInfo.Stream := Nil;
FSoundNames.AddObject(AName,SoundInfo);
End;
{................................................. .............................}

{................................................. .............................}
Procedure TAudioModule_sdl_mixer.RegisterSound_WAV(Const AName : AnsiString;
Const AStream : TMemoryStream);
Var
SoundInfo : TSoundInfo;
Begin
SoundInfo := TSoundInfo.Create;
SoundInfo.IsPhysicalFile := False;
SoundInfo.FileName := '';
SoundInfo.Stream := AStream;
FSoundNames.AddObject(AName,SoundInfo);
End;
{................................................. .............................}

{................................................. .............................}
Function TAudioModule_sdl_mixer.PlaySound_WAV(AName: AnsiString) : Integer;
Var
index : Integer;
Sound : TSound;
FileName : AnsiString;
i : Integer;
SoundInfo : TSoundInfo;
RWops : PSDL_RWops;
Begin
Result := -1;
If Not FAudioInitialized Then Exit;

// Look for an empty (or finished) sound slot
index := 0;
While index < cMaxSounds Do
Begin
If sounds[index] = Nil Then Break;
Inc(index);
End;
If index = cMaxSounds Then Exit;

i := FSoundNames.IndexOf(AName);
If i = -1 Then Exit;

Sound := TSound.Create;

SoundInfo := TSoundInfo(FSoundNames.Objects[i]);

If SoundInfo.IsPhysicalFile Then
Begin
FileName := SoundInfo.FileName;
// Load the sound file
Sound.Sound := Mix_LoadWAV(PChar(FileName));
If Sound.Sound = Nil Then
Begin
// fprintf(stderr, "Couldn't load %s: %s\n", file, SDL_GetError());
// return;
Sound.Free;
Exit;
End;
End
Else
Begin
If SoundInfo.Stream = Nil Then Exit;
If SoundInfo.Stream.Size = 0 Then Exit;
RWops := SDL_RWFromMem(SoundInfo.Stream.Memory,SoundInfo.St ream.Size);
If RWops = Nil Then Exit;
Sound.Sound := Mix_LoadWAV_RW(RWops, 0);
If Sound.Sound = Nil Then
Begin
SDL_FreeRW(RWops);
Sound.Free;
Exit;
End;
SDL_FreeRW(RWops);
End;
Sound.channel := Mix_PlayChannel(-1,Sound.Sound,0);
sounds[index] := Sound;
Result := Sound.channel;
End;
{................................................. .............................}

{................................................. .............................}
Procedure TAudioModule_sdl_mixer.StopSound_WAV(AChannel : Integer);
Begin
Mix_HaltChannel(AChannel);
End;
{................................................. .............................}

{................................................. .............................}
Procedure TAudioModule_sdl_mixer.RegisterMusic_WAV(AName,AFi leName: AnsiString);
Begin
End;
{................................................. .............................}

{................................................. .............................}
Function TAudioModule_sdl_mixer.PlayMusic_WAV(AName : AnsiString): Boolean;
Begin
Result := False;
End;
{................................................. .............................}

{................................................. .............................}
Procedure TAudioModule_sdl_mixer.StopMusic_WAV;
Begin
End;
{................................................. .............................}

{................................................. .............................}
Procedure InitSounds;
Var
i : Integer;
Begin
For i := 0 To cMaxSounds - 1 Do
Sounds[i] := Nil;
End;
{................................................. .............................}

{................................................. .............................}
Initialization
InitSounds;
{................................................. .............................}

{................................................. .............................}
End.

cheers,
Paul