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&#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.