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
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
Games:
Seafox
Pages:
Syntax Error Software itch.io page
Online Chess
http://gameknot.com/#paul_nicholls
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
Games:
Seafox
Pages:
Syntax Error Software itch.io page
Online Chess
http://gameknot.com/#paul_nicholls
Here is some actual working code.
Again, replace "LESS_THAN" with the less than character.
This now includes moving left and right as well.
[pascal]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;[/pascal]
This is how I am using it:
[pascal] 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;
[/pascal]
[pascal]
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);
[/pascal]
where TimeSlice is the time for the last frame in seconds (floating point)
Cheers,
Paul
Games:
Seafox
Pages:
Syntax Error Software itch.io page
Online Chess
http://gameknot.com/#paul_nicholls
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.
: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!
are you a c++ coder? :shock:Originally Posted by Ixy
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;
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.
hi folks!
after reading that post i fell like i should start making a platformer
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 ops:
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
unit '__pf_simpleplayer'
Code: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: tdanjetx; ftm: tdxtexturemanager; fnameintl: string; fstretch_x, fstretch_y: single; fx, fy: integer; fpos_x, fpos_y: single; fwidth, fheight: integer; procedure setdjx(const value: tdanjetx); procedure setnameintl(const value: string); procedure settm(const value: tdxtexturemanager); procedure setstretch_x(const value: single); procedure setstretch_y(const value: single); procedure setx(const value: integer); procedure sety(const value: integer); procedure setpos_x(const value: single); procedure setpos_y(const value: single); published property djx: tdanjetx read fdjx write setdjx; property texturemanager: tdxtexturemanager read ftm write settm; property nameintl: string read fnameintl write setnameintl; property stretch_x: single read fstretch_x write setstretch_x; property stretch_y: single read fstretch_y write setstretch_y; property x: integer read fx write setx; property y: integer read fy write sety; property width: integer read fwidth; property height: integer read fheight; property pos_x: single read fpos_x write setpos_x; property pos_y: single read fpos_y write setpos_y; end; implementation { tpf_simpleplayer } constructor tpf_simpleplayer.create; begin fdjx:= nil; ftm:= nil; fwidth:= 32; fheight:= 64; fstretch_x:= 1; fstretch_y:= 1; end; procedure tpf_simpleplayer.render; begin if fdjx= nil then exit; if ftm= nil then exit; if ftm.djxtl.Find(fnameintl)<> nil then begin //player stretchen { ftm.djxtl.Find(fnameintl).Draw4col( (fx* ftile_width)* fstretch_x, (fy* ftile_height)* fstretch_y, (fx* ftile_width)* fstretch_x+ ftile_width* fstretch_x, (fy* ftile_height)* fstretch_y, (fx* ftile_width)* fstretch_x+ ftile_width* fstretch_x, (fy* ftile_height)* fstretch_y+ ftile_height* fstretch_y, (fx* ftile_width)* fstretch_x, (fy* ftile_height)* fstretch_y+ ftile_height* fstretch_y, djxcolor(clwhIte), djxcolor(clwhIte), djxcolor(clwhIte), djxcolor(clwhIte) ); } ftm.djxtl.Find(fnameintl).Draw4col( (fpos_x- fwidth/ 2)* fstretch_x, (fpos_y- fheight/ 2)* fstretch_y, (fpos_x+ fwidth/ 2)* fstretch_x, (fpos_y- fheight/ 2)* fstretch_y, (fpos_x+ fwidth/ 2)* fstretch_x, (fpos_y+ fheight/ 2)* fstretch_y, (fpos_x- fwidth/ 2)* fstretch_x, (fpos_y+ fheight/ 2)* fstretch_y, djxcolor(clwhIte), djxcolor(clwhIte), djxcolor(clwhIte), djxcolor(clwhIte) ); //kreuz auf fpos fdjx.Primitives2D.Line(fpos_x- 5, fpos_y- 5, fpos_x+ 5, fpos_y+ 5, djxcolor(clwhite)); fdjx.Primitives2D.Line(fpos_x+ 5, fpos_y- 5, fpos_x- 5, fpos_y+ 5, djxcolor(clwhite)); end; end; procedure tpf_simpleplayer.setdjx(const value: tdanjetx); begin fdjx:= value; end; procedure tpf_simpleplayer.setnameintl(const value: string); begin fnameintl:= value; end; procedure tpf_simpleplayer.setpos_x(const value: single); begin fpos_x:= value; end; procedure tpf_simpleplayer.setpos_y(const value: single); begin fpos_y:= value; end; procedure tpf_simpleplayer.setstretch_x(const value: single); begin fstretch_x:= value; end; procedure tpf_simpleplayer.setstretch_y(const value: single); begin fstretch_y:= value; end; procedure tpf_simpleplayer.settm(const value: tdxtexturemanager); begin ftm:= value; end; procedure tpf_simpleplayer.setx(const value: integer); begin fx:= value; end; procedure tpf_simpleplayer.sety(const value: integer); begin fy:= value; end; end.
unit '__pf_simplemap'
Code:unit __pf_simplemap; // http://pascalgamedevelopment.com/viewtopic.php?p=45392#45392 //platformer threat // http://www.tonypa.pri.ee/tbw/start.html //tile based games tutorial // http://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: integer; walkable: boolean; end; type tarrrectile= array of array of trectile; type tpf_simplemap= class public constructor create; procedure render; procedure loadfromtextfile(filename: string); private fdjx: tdanjetx; ftm: tdxtexturemanager; fnameintl: string; fpattern: tarrrectile; ftile_width, ftile_height: integer; fstretch_x, fstretch_y: single; fwidth, fheight: integer; procedure setdjx(const value: tdanjetx); procedure settm(const value: tdxtexturemanager); procedure setnameintl(const value: string); procedure setstretch_x(const value: single); procedure setstretch_y(const value: single); procedure pattern_fill; published property djx: tdanjetx read fdjx write setdjx; property texturemanager: tdxtexturemanager read ftm write settm; property nameintl: string read fnameintl write setnameintl; property stretch_x: single read fstretch_x write setstretch_x; property stretch_y: single read fstretch_y write setstretch_y; property tile_width: integer read ftile_width; property tile_height: integer read ftile_height; property pattern: tarrrectile read fpattern; property width: integer read fwidth; property height: integer read fheight; end; implementation { tpf_simplemap } constructor tpf_simplemap.create; begin fdjx:= nil; ftm:= nil; ftile_width:= 32; ftile_height:= 32; fstretch_x:= 1; fstretch_y:= 1; fwidth:= 0; fheight:= 0; //pattern_fill; end; procedure tpf_simplemap.loadfromtextfile(filename: string); var sl_file: tstringlist; s_zeile: string; x, y, i, j, h, hi: integer; begin //pattern aus einer einfachen textdatei laden setlength(fpattern, 0); if fileexists(filename) then begin sl_file:= tstringlist.create; sl_file.LoadFromFile(filename); if sl_file.Count> 0 then begin for i:= 0 to sl_file.count- 1 do begin s_zeile:= trim(sl_file[i]); if s_zeile= '' then continue; setlength(fpattern, length(fpattern)+ 1); h:= high(fpattern); setlength(fpattern[h], 0); for j:= 1 to length(s_zeile) do begin setlength(fpattern[h], length(fpattern[h])+ 1); hi:= high(fpattern[h]); if s_zeile[j]= '1' then begin fpattern[h, hi].idx:= 1; fpattern[h, hi].walkable:= false; end else begin fpattern[h, hi].idx:= 0; fpattern[h, hi].walkable:= true; end; end; end; end; sl_file.free; end; fheight:= length(fpattern); fwidth:= length(fpattern[0]); end; procedure tpf_simplemap.pattern_fill; var x, y: integer; begin //pattern zuf?§llig bef?ºllen setlength(fpattern, 20); for x:= low(fpattern) to high(fpattern) do begin setlength(fpattern[x], 15); for y:= low(fpattern[x]) to high(fpattern[x]) do begin fpattern[x, y].idx:= 0; fpattern[x, y].walkable:= true; randomize; if random(100)> 90 then begin fpattern[x, y].idx:= 1; fpattern[x, y].walkable:= false; end; end; end; end; procedure tpf_simplemap.render; var x, y: integer; begin if fdjx= nil then exit; if ftm= nil then exit; for y:= low(fpattern) to high(fpattern) do begin for x:= low(fpattern[y]) to high(fpattern[y]) do begin if fpattern[y, x].idx= 1 then begin if ftm.djxtl.Find(fnameintl)<> nil then begin //tiles stretchen ftm.djxtl.Find(fnameintl).Draw4col( (x* ftile_width)* fstretch_x, (y* ftile_height)* fstretch_y, (x* ftile_width)* fstretch_x+ ftile_width* fstretch_x, (y* ftile_height)* fstretch_y, (x* ftile_width)* fstretch_x+ ftile_width* fstretch_x, (y* ftile_height)* fstretch_y+ ftile_height* fstretch_y, (x* ftile_width)* fstretch_x, (y* ftile_height)* fstretch_y+ ftile_height* fstretch_y, djxcolor(clwhIte), djxcolor(clwhIte), djxcolor(clwhIte), djxcolor(clwhIte) ); end; end; end; end; end; procedure tpf_simplemap.setdjx(const value: tdanjetx); begin fdjx:= value; end; procedure tpf_simplemap.setnameintl(const value: string); begin fnameintl:= value; end; procedure tpf_simplemap.setstretch_x(const value: single); begin fstretch_x:= value; end; procedure tpf_simplemap.setstretch_y(const value: single); begin fstretch_y:= value; end; procedure tpf_simplemap.settm(const value: tdxtexturemanager); begin ftm:= value; end; end.
Bookmarks