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