Code:
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: tguid= '{00000000-0000-0000-0000-000000000000}';
type tpf_simplegamestate= (
pfs_playing,
pfs_quit
);
type tpf_corners= record
upperleft,
lowerleft,
upperright,
lowerright: boolean;
end;
type tpf_simplegame= class
public
constructor create(handle: hwnd);
procedure render;
procedure process;
//map-funktionen
procedure load_textmap(const filename: string);
function map_gettilepos(const pos_x, pos_y: single): tpoint;
function map_getwalkable(const pos_x, pos_y: single): boolean;
//player-funktionen
procedure move_player(const dir_x, dir_y: integer);
procedure di_activate;
procedure di_deactivate;
procedure di_keydown;
private
fhandle: hwnd; //handle des mutterfensters f?ēr di
fdjx: tdanjetx;
fsimplemap: tpf_simplemap;
fsimpleplayer: tpf_simpleplayer;
ftm: tdxtexturemanager;
fstretch_x,
fstretch_y: single;
fgamestate: tpf_simplegamestate;
//dinput
di_obj: tdiobject;
di_key: tkeyboardinput;
di_joy: TJoystickInput;
//eigene funktionen
procedure player_corners(const x, y: single; out corners: tpf_corners);
//properties
procedure setdjx(const value: tdanjetx);
procedure settm(const value: tdxtexturemanager);
procedure setstretch_x(const value: single);
procedure setstretch_y(const value: single);
function getplayerpos: tpoint;
published
property djx: tdanjetx read fdjx write setdjx;
property texturemanager: tdxtexturemanager read ftm write settm;
property stretch_x: single read fstretch_x write setstretch_x;
property stretch_y: single read fstretch_y write setstretch_y;
property state: tpf_simplegamestate read fgamestate;
property playerpos: tpoint read getplayerpos;
end;
type tpf_simplegame_2= class
public
constructor create(handle: hwnd);
procedure render;
procedure process;
//map-funktionen
procedure load_textmap(const filename: string);
function map_gettilepos(const pos_x, pos_y: single): tpoint;
function map_getwalkable(const pos_x, pos_y: single): boolean;
//player-funktionen
procedure move_player(const dir_x, dir_y: integer);
procedure di_activate;
procedure di_deactivate;
procedure di_keydown;
private
fhandle: hwnd; //handle des mutterfensters f?ēr di
fdjx: tdanjetx;
fsimplemap: tpf_simplemap;
fsimpleplayer: tpf_simpleplayer;
ftm: tdxtexturemanager;
fstretch_x,
fstretch_y: single;
fgamestate: tpf_simplegamestate;
//dinput
di_obj: tdiobject;
di_key: tkeyboardinput;
di_joy: TJoystickInput;
//corners
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
vx,
vy: single;
//eigene funktionen
procedure player_corners(const x, y: single; out corners: tpf_corners);
//properties
procedure setdjx(const value: tdanjetx);
procedure settm(const value: tdxtexturemanager);
procedure setstretch_x(const value: single);
procedure setstretch_y(const value: single);
function getplayerpos: tpoint;
function ClampValue(const n, l, u : integer): integer;
function Floor(X : extended): integer;
procedure GetCornersAt(const ax, ay : single);
procedure update(const ATimeSlice : single);
function TileIsWalkable(const tx,ty : Integer) : boolean;
published
property djx: tdanjetx read fdjx write setdjx;
property texturemanager: tdxtexturemanager read ftm write settm;
property stretch_x: single read fstretch_x write setstretch_x;
property stretch_y: single read fstretch_y write setstretch_y;
property state: tpf_simplegamestate read fgamestate;
property playerpos: tpoint read getplayerpos;
end;
implementation
{ tpf_simplegame }
constructor tpf_simplegame.create(handle: hwnd);
begin
fhandle:= handle;
fdjx:= nil;
fsimplemap:= tpf_simplemap.create;
fsimpleplayer:= tpf_simpleplayer.create;
fsimplemap.nameintl:= 'blackblock_32px';
fsimpleplayer.nameintl:= 'redblock_64px';
{
fsimpleplayer.x:= 5;
fsimpleplayer.y:= 5;
}
fsimpleplayer.pos_x:= 250;
fsimpleplayer.pos_y:= 250;
fgamestate:= pfs_playing;
end;
procedure tpf_simplegame.di_activate;
begin
di_obj:= tdiobject.create;
di_key:= tkeyboardinput.create;
di_key.DIObject:= di_obj;
di_key.handle:= fhandle;
di_key.init(GUID_NULL);
di_key.Acquire; //jetzt gehts los
end;
procedure tpf_simplegame.di_deactivate;
begin
//freeandnil(di_key.DIData);
freeandnil(di_key);
freeandnil(di_joy);
freeandnil(di_obj);
end;
procedure tpf_simplegame.di_keydown;
var s: string;
temp_dir_x,
temp_dir_y: integer;
begin
//hier die controllerabfragen tun
s:= '-';
temp_dir_x:= 0;
temp_dir_y:= 0;
di_key.DIData.GetState;
if tkeyboarddata(di_key.didata).keydown(DIK_LCONTROL) then begin
s:= 'lcontrol';
end;
if tkeyboarddata(di_key.didata).keydown(DIK_RCONTROL) then begin
s:= 'rcontrol';
end;
if tkeyboarddata(di_key.didata).keydown(DIK_SPACE) then begin
s:= 'space';
end;
if tkeyboarddata(di_key.didata).keydown(DIK_ESCAPE) then begin
s:= 'escape';
fgamestate:= pfs_quit;
end;
if tkeyboarddata(di_key.didata).keydown(DIK_UPARROW) then begin
s:= 'UP';
temp_dir_y:= -1;
end;
if tkeyboarddata(di_key.didata).keydown(DIK_DOWNARROW) then begin
s:= 'DOWN';
temp_dir_y:= +1;
end;
if tkeyboarddata(di_key.didata).keydown(DIK_LEFTARROW) then begin
s:= 'LEFT';
temp_dir_x:= -1;
end;
if tkeyboarddata(di_key.didata).keydown(DIK_RIGHTARROW) then begin
s:= 'RIGHT';
temp_dir_x:= +1;
end;
move_player(temp_dir_x, temp_dir_y);
end;
function tpf_simplegame.getplayerpos: tpoint;
begin
result.X:= fsimpleplayer.x;
result.Y:= fsimpleplayer.y;
end;
procedure tpf_simplegame.load_textmap(const filename: string);
begin
fsimplemap.loadfromtextfile(filename);
end;
function tpf_simplegame.map_gettilepos(const pos_x, pos_y: single): tpoint;
var p: tpoint;
temp_x,
temp_y: integer;
begin
p.X:= -1;
p.Y:= -1;
//***
temp_x:= round(pos_x/ fsimplemap.tile_width);
temp_y:= round(pos_y/ fsimplemap.tile_height);
temp_x:= trunc(pos_x/ fsimplemap.tile_width);
temp_y:= trunc(pos_y/ fsimplemap.tile_height);
//***
if (temp_x>= low(fsimplemap.pattern[0]))and (temp_x<high>= low(fsimplemap.pattern))and (temp_y<high> -1)and (p.Y> -1) then begin
result:= fsimplemap.pattern[p.y, p.x].walkable;
end
else begin
result:= false;
end;
end;
procedure tpf_simplegame.player_corners(const x, y: single; out corners: tpf_corners);
var temp_left,
temp_right,
temp_up,
temp_down: single;
outofmap: boolean;
begin
temp_left:= x- (fsimpleplayer.width/ 2);
temp_right:= x+ (fsimpleplayer.width/ 2);
temp_up:= y- (fsimpleplayer.height/ 2);
temp_down:= y+ (fsimpleplayer.height/ 2);
corners.upperleft:= map_getwalkable(temp_left, temp_up);
corners.upperright:= map_getwalkable(temp_right, temp_up);
corners.lowerleft:= map_getwalkable(temp_left, temp_down);
corners.lowerright:= map_getwalkable(temp_right, temp_down);
end;
procedure tpf_simplegame.move_player(const dir_x, dir_y: integer);
var corners: tpf_corners;
temp_dir_x,
temp_dir_y: integer;
begin
player_corners(fsimpleplayer.pos_x+ dir_x, fsimpleplayer.pos_y+ dir_x, corners);
temp_dir_x:= 0;
temp_dir_y:= 0;
if dir_x= -1 then begin
if corners.upperleft and corners.lowerleft then begin
temp_dir_x:= dir_x;
end
else begin
temp_dir_x:= 0;
end;
end;
if dir_x= +1 then begin
if corners.upperright and corners.lowerright then begin
temp_dir_x:= dir_x;
end
else begin
temp_dir_x:= 0;
end;
end;
if dir_y= -1 then begin
if corners.upperleft and corners.upperright then begin
temp_dir_y:= dir_y;
end
else begin
temp_dir_y:= 0;
end;
end;
if dir_y= +1 then begin
if corners.lowerleft and corners.lowerright then begin
temp_dir_y:= dir_y;
end
else begin
temp_dir_y:= 0;
end;
end;
fsimpleplayer.pos_x:= fsimpleplayer.pos_x+ temp_dir_x;
fsimpleplayer.pos_y:= 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(const value: tdanjetx);
begin
fdjx:= value;
fsimplemap.djx:= fdjx;
fsimpleplayer.djx:= fdjx;
end;
procedure tpf_simplegame.setstretch_x(const value: single);
begin
fstretch_x:= value;
fsimplemap.stretch_x:= fstretch_x;
fsimpleplayer.stretch_x:= fstretch_x;
end;
procedure tpf_simplegame.setstretch_y(const value: single);
begin
fstretch_y:= value;
fsimplemap.stretch_y:= fstretch_y;
fsimpleplayer.stretch_y:= fstretch_y;
end;
procedure tpf_simplegame.settm(const value: tdxtexturemanager);
begin
ftm:= value;
fsimplemap.texturemanager:= ftm;
fsimpleplayer.texturemanager:= ftm;
end;
{ tpf_simplegame_2 }
constructor tpf_simplegame_2.create(handle: hwnd);
begin
fhandle:= handle;
fdjx:= nil;
fsimplemap:= tpf_simplemap.create;
fsimpleplayer:= tpf_simpleplayer.create;
fsimplemap.nameintl:= 'blackblock_32px';
fsimpleplayer.nameintl:= 'redblock_64px';
{
fsimpleplayer.x:= 5;
fsimpleplayer.y:= 5;
}
fsimpleplayer.pos_x:= 150;
fsimpleplayer.pos_y:= 250;
vx:= 0;
vy:= 0;
fgamestate:= pfs_playing;
end;
procedure tpf_simplegame_2.di_activate;
begin
di_obj:= tdiobject.create;
di_key:= tkeyboardinput.create;
di_key.DIObject:= di_obj;
di_key.handle:= fhandle;
di_key.init(GUID_NULL);
di_key.Acquire; //jetzt gehts los
end;
procedure tpf_simplegame_2.di_deactivate;
begin
//freeandnil(di_key.DIData);
freeandnil(di_key);
freeandnil(di_joy);
freeandnil(di_obj);
end;
procedure tpf_simplegame_2.di_keydown;
var s: string;
temp_dir_x,
temp_dir_y: integer;
begin
//hier die controllerabfragen tun
s:= '-';
temp_dir_x:= 0;
temp_dir_y:= 0;
di_key.DIData.GetState;
if tkeyboarddata(di_key.didata).keydown(DIK_LCONTROL) then begin
s:= 'lcontrol';
end;
if tkeyboarddata(di_key.didata).keydown(DIK_RCONTROL) then begin
s:= 'rcontrol';
end;
if tkeyboarddata(di_key.didata).keydown(DIK_SPACE) then begin
s:= 'space';
end;
if tkeyboarddata(di_key.didata).keydown(DIK_ESCAPE) then begin
s:= 'escape';
fgamestate:= pfs_quit;
end;
if tkeyboarddata(di_key.didata).keydown(DIK_UPARROW) then begin
s:= 'UP';
temp_dir_y:= -1;
end;
if tkeyboarddata(di_key.didata).keydown(DIK_DOWNARROW) then begin
s:= 'DOWN';
temp_dir_y:= +1;
end;
if tkeyboarddata(di_key.didata).keydown(DIK_LEFTARROW) then begin
s:= 'LEFT';
temp_dir_x:= -1;
end;
if tkeyboarddata(di_key.didata).keydown(DIK_RIGHTARROW) then begin
s:= 'RIGHT';
temp_dir_x:= +1;
end;
//move_player(temp_dir_x, temp_dir_y);
vx:= temp_dir_x;
vy:= temp_dir_y;
end;
function tpf_simplegame_2.getplayerpos: tpoint;
begin
result.X:= fsimpleplayer.x;
result.Y:= fsimpleplayer.y;
end;
procedure tpf_simplegame_2.load_textmap(const filename: string);
begin
fsimplemap.loadfromtextfile(filename);
end;
function tpf_simplegame_2.map_gettilepos(const pos_x, pos_y: single): tpoint;
var p: tpoint;
temp_x,
temp_y: integer;
begin
p.X:= -1;
p.Y:= -1;
//***
temp_x:= round(pos_x/ fsimplemap.tile_width);
temp_y:= round(pos_y/ fsimplemap.tile_height);
temp_x:= trunc(pos_x/ fsimplemap.tile_width);
temp_y:= trunc(pos_y/ fsimplemap.tile_height);
//***
if (temp_x>= low(fsimplemap.pattern[0]))and (temp_x<high>= low(fsimplemap.pattern))and (temp_y<high> -1)and (p.Y> -1) then begin
result:= fsimplemap.pattern[p.y, p.x].walkable;
end
else begin
result:= false;
end;
end;
procedure tpf_simplegame_2.player_corners(const x, y: single; out corners: tpf_corners);
var temp_left,
temp_right,
temp_up,
temp_down: single;
outofmap: boolean;
begin
temp_left:= x- (fsimpleplayer.width/ 2);
temp_right:= x+ (fsimpleplayer.width/ 2);
temp_up:= y- (fsimpleplayer.height/ 2);
temp_down:= y+ (fsimpleplayer.height/ 2);
corners.upperleft:= map_getwalkable(temp_left, temp_up);
corners.upperright:= map_getwalkable(temp_right, temp_up);
corners.lowerleft:= map_getwalkable(temp_left, temp_down);
corners.lowerright:= map_getwalkable(temp_right, temp_down);
end;
procedure tpf_simplegame_2.move_player(const dir_x, dir_y: integer);
var corners: tpf_corners;
temp_dir_x,
temp_dir_y: integer;
begin
player_corners(fsimpleplayer.pos_x+ dir_x, fsimpleplayer.pos_y+ dir_x, corners);
temp_dir_x:= 0;
temp_dir_y:= 0;
if dir_x= -1 then begin
if corners.upperleft and corners.lowerleft then begin
temp_dir_x:= dir_x;
end
else begin
temp_dir_x:= 0;
end;
end;
if dir_x= +1 then begin
if corners.upperright and corners.lowerright then begin
temp_dir_x:= dir_x;
end
else begin
temp_dir_x:= 0;
end;
end;
if dir_y= -1 then begin
if corners.upperleft and corners.upperright then begin
temp_dir_y:= dir_y;
end
else begin
temp_dir_y:= 0;
end;
end;
if dir_y= +1 then begin
if corners.lowerleft and corners.lowerright then begin
temp_dir_y:= dir_y;
end
else begin
temp_dir_y:= 0;
end;
end;
fsimpleplayer.pos_x:= fsimpleplayer.pos_x+ temp_dir_x;
fsimpleplayer.pos_y:= 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(1);
end;
procedure tpf_simplegame_2.render;
begin
fsimplemap.render;
fsimpleplayer.render;
end;
procedure tpf_simplegame_2.setdjx(const value: tdanjetx);
begin
fdjx:= value;
fsimplemap.djx:= fdjx;
fsimpleplayer.djx:= fdjx;
end;
procedure tpf_simplegame_2.setstretch_x(const value: single);
begin
fstretch_x:= value;
fsimplemap.stretch_x:= fstretch_x;
fsimpleplayer.stretch_x:= fstretch_x;
end;
procedure tpf_simplegame_2.setstretch_y(const value: single);
begin
fstretch_y:= value;
fsimplemap.stretch_y:= fstretch_y;
fsimpleplayer.stretch_y:= fstretch_y;
end;
procedure tpf_simplegame_2.settm(const value: tdxtexturemanager);
begin
ftm:= value;
fsimplemap.texturemanager:= ftm;
fsimpleplayer.texturemanager:= ftm;
end;
function tpf_simplegame_2.TileIsWalkable(const tx, ty: Integer): boolean;
begin
result:= false;
If tx < 0 Then Exit;
If ty <0>= fsimplemap.width Then Exit;
If ty >= fsimplemap.height Then Exit;
if (tx> -1)and (ty> -1) then begin
result:= fsimplemap.pattern[ty, tx].walkable;
end
else begin
result:= false;
end;
end;
function tpf_simplegame_2.ClampValue(const n, l, u : integer): integer;
begin
Result := n;
If Result <l> u Then Result := u;
end;
function tpf_simplegame_2.Floor(X: extended): integer;
begin
Result := Integer(Trunc(X));
If Frac(X) < 0 Then Dec(Result);
end;
procedure tpf_simplegame_2.GetCornersAt(const ax, ay: single);
{
|
|
-,- | +,-
-------|-------
-,+ | +,+
|
|
}
begin
CnrUL.x := Floor((ax - fsimpleplayer.width/2) / fsimplemap.tile_width);
CnrUL.y := Floor((ay - fsimpleplayer.height/2) / fsimplemap.tile_height);
CnrUR.x := Floor((ax + fsimpleplayer.width/2) / fsimplemap.tile_width);
CnrUR.y := Floor((ay - fsimpleplayer.height/2) / fsimplemap.tile_height);
CnrLR.x := Floor((ax + fsimpleplayer.width/2) / fsimplemap.tile_width);
CnrLR.y := Floor((ay + fsimpleplayer.height/2) / fsimplemap.tile_height);
CnrLL.x := Floor((ax - fsimpleplayer.width/2) / fsimplemap.tile_width);
CnrLL.y := Floor((ay + fsimpleplayer.height/2) / fsimplemap.tile_height);
CnrUL.x := ClampValue(CnrUL.x,0,fsimplemap.width - 1);
CnrUR.x := ClampValue(CnrUR.x,0,fsimplemap.width - 1);
CnrLR.x := ClampValue(CnrLR.x,0,fsimplemap.width - 1);
CnrLL.x := ClampValue(CnrLL.x,0,fsimplemap.width - 1);
CnrUL.y := ClampValue(CnrUL.y,0,fsimplemap.height - 1);
CnrUR.y := ClampValue(CnrUR.y,0,fsimplemap.height - 1);
CnrLR.y := ClampValue(CnrLR.y,0,fsimplemap.height - 1);
CnrLL.y := ClampValue(CnrLL.y,0,fsimplemap.height - 1);
end;
procedure tpf_simplegame_2.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(fsimpleplayer.pos_x,fsimpleplayer.pos_y + vy * ATimeSlice);
If vy <0> 0 Then
//moving down
Begin
TileIsWalkableLL := TileIsWalkable(CnrLL.x,CnrLL.y);
TileIsWalkableLR := TileIsWalkable(CnrLR.x,CnrLR.y);
If TileIsWalkableLL And TileIsWalkableLR Then
fsimpleplayer.pos_y := fsimpleplayer.pos_y + vy * ATimeSlice
Else
// move player to sit on tile(s) below
fsimpleplayer.pos_y := CnrLR.y * fsimplemap.tile_height - fsimpleplayer.height/2 - 0.01;
End;
GetCornersAt(fsimpleplayer.pos_x + vx * ATimeSlice,fsimpleplayer.pos_y);
If vx <0> 0 Then
//moving right
Begin
TileIsWalkableUR := TileIsWalkable(CnrUR.x,CnrUR.y);
TileIsWalkableLR := TileIsWalkable(CnrLR.x,CnrLR.y);
If TileIsWalkableUR And TileIsWalkableLR Then
fsimpleplayer.pos_x := fsimpleplayer.pos_x + vx * ATimeSlice
Else
// move player to touch tile(s) on right
fsimpleplayer.pos_x := 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.
Bookmarks