src/shared/MAPDEF.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE a_modes.inc}
  17 {$M+}
  18 unit MAPDEF;
  19
  20 {
  21 -----------------------------------
  22 MAPDEF.PAS ÂÅÐÑÈß ÎÒ 22.03.09
  23
  24 Ïîääåðæêà êàðò âåðñèè 1
  25 -----------------------------------
  26 }
  27
  28 interface
  29
  30 uses
  31   xdynrec;
  32
  33
  34 const
  35   MAP_SIGNATURE = 'MAP';
  36
  37
  38 const
  39   TEXTURE_NAME_WATER = '_water_0';
  40   TEXTURE_NAME_ACID1 = '_water_1';
  41   TEXTURE_NAME_ACID2 = '_water_2';
  42
  43
  44 type
  45   TDFPoint = packed record
  46     X, Y: LongInt;
  47   end;
  48
  49   Char16     = packed array[0..15] of Char;
  50   Char32     = packed array[0..31] of Char;
  51   Char64     = packed array[0..63] of Char;
  52   Char100    = packed array[0..99] of Char;
  53   Char256    = packed array[0..255] of Char;
  54   Byte128    = packed array[0..127] of Byte;
  55
  56 {$INCLUDE mapdef.inc}
  57
  58 type
  59   TTexturesRec1Array = array of TTextureRec_1;
  60   TPanelsRec1Array = array of TPanelRec_1;
  61   TItemsRec1Array = array of TItemRec_1;
  62   TMonsterRec1Array = array of TMonsterRec_1;
  63   TAreasRec1Array = array of TAreaRec_1;
  64   TTriggersRec1Array = array of TTriggerRec_1;
  65
  66
  67 function GetMapHeader (rec: TDynRecord): TMapHeaderRec_1;
  68 function GetTextures (rec: TDynRecord): TTexturesRec1Array;
  69 function GetPanels (rec: TDynRecord): TPanelsRec1Array;
  70 function GetItems (rec: TDynRecord): TItemsRec1Array;
  71 function GetAreas (rec: TDynRecord): TAreasRec1Array;
  72 function GetMonsters (rec: TDynRecord): TMonsterRec1Array;
  73 function GetTriggers (rec: TDynRecord): TTriggersRec1Array;
  74
  75
  76 implementation
  77
  78 uses
  79   {e_log,} xparser, xstreams;
  80
  81
  82 function GetMapHeader (rec: TDynRecord): TMapHeaderRec_1;
  83 var
  84   ws: TSFSMemoryChunkStream = nil;
  85 begin
  86   FillChar(result, sizeof(result), 0);
  87   if (rec = nil) then exit;
  88   try
  89     ws := TSFSMemoryChunkStream.Create(@result, sizeof(result));
  90     rec.writeBinTo(ws, -1, true); // only fields
  91   except // sorry
  92     FillChar(result, sizeof(result), 0);
  93   end;
  94   ws.Free();
  95 end;
  96
  97
  98 function GetTextures (rec: TDynRecord): TTexturesRec1Array;
  99 var
 100   ws: TSFSMemoryChunkStream = nil;
 101   fld: TDynField;
 102   f: Integer;
 103 begin
 104   result := nil;
 105   fld := rec.field['texture'];
 106   if (fld = nil) or (fld.baseType <> fld.TType.TList) or (fld.list.count = 0) then exit;
 107   ws := TSFSMemoryChunkStream.Create(nil, 0);
 108   try
 109     SetLength(result, fld.list.count);
 110     for f := 0 to fld.list.count-1 do
 111     begin
 112       FillChar(result[f], sizeof(result[f]), 0);
 113       ws.setup(@result[f], sizeof(result[f]));
 114       fld.list[f].writeBinTo(ws, -1, true); // only fields
 115     end;
 116   except
 117     result := nil;
 118   end;
 119   ws.Free();
 120 end;
 121
 122
 123 function GetPanels (rec: TDynRecord): TPanelsRec1Array;
 124 var
 125   ws: TSFSMemoryChunkStream = nil;
 126   fld: TDynField;
 127   f: Integer;
 128 begin
 129   result := nil;
 130   fld := rec.field['panel'];
 131   if (fld = nil) or (fld.baseType <> fld.TType.TList) or (fld.list.count = 0) then exit;
 132   ws := TSFSMemoryChunkStream.Create(nil, 0);
 133   try
 134     SetLength(result, fld.list.count);
 135     for f := 0 to fld.list.count-1 do
 136     begin
 137       FillChar(result[f], sizeof(result[f]), 0);
 138       ws.setup(@result[f], sizeof(result[f]));
 139       fld.list[f].writeBinTo(ws, -1, true); // only fields
 140     end;
 141   except
 142     result := nil;
 143   end;
 144   ws.Free();
 145 end;
 146
 147
 148 function GetItems (rec: TDynRecord): TItemsRec1Array;
 149 var
 150   ws: TSFSMemoryChunkStream = nil;
 151   fld: TDynField;
 152   f: Integer;
 153 begin
 154   result := nil;
 155   fld := rec.field['item'];
 156   if (fld = nil) or (fld.baseType <> fld.TType.TList) or (fld.list.count = 0) then exit;
 157   ws := TSFSMemoryChunkStream.Create(nil, 0);
 158   try
 159     SetLength(result, fld.list.count);
 160     for f := 0 to fld.list.count-1 do
 161     begin
 162       FillChar(result[f], sizeof(result[f]), 0);
 163       ws.setup(@result[f], sizeof(result[f]));
 164       fld.list[f].writeBinTo(ws, -1, true); // only fields
 165     end;
 166   except
 167     result := nil;
 168   end;
 169   ws.Free();
 170 end;
 171
 172
 173 function GetAreas (rec: TDynRecord): TAreasRec1Array;
 174 var
 175   ws: TSFSMemoryChunkStream = nil;
 176   fld: TDynField;
 177   f: Integer;
 178 begin
 179   result := nil;
 180   fld := rec.field['area'];
 181   if (fld = nil) or (fld.baseType <> fld.TType.TList) or (fld.list.count = 0) then exit;
 182   ws := TSFSMemoryChunkStream.Create(nil, 0);
 183   try
 184     SetLength(result, fld.list.count);
 185     for f := 0 to fld.list.count-1 do
 186     begin
 187       FillChar(result[f], sizeof(result[f]), 0);
 188       ws.setup(@result[f], sizeof(result[f]));
 189       fld.list[f].writeBinTo(ws, -1, true); // only fields
 190     end;
 191   except
 192     result := nil;
 193   end;
 194   ws.Free();
 195 end;
 196
 197
 198 function GetMonsters (rec: TDynRecord): TMonsterRec1Array;
 199 var
 200   ws: TSFSMemoryChunkStream = nil;
 201   fld: TDynField;
 202   f: Integer;
 203 begin
 204   result := nil;
 205   fld := rec.field['monster'];
 206   if (fld = nil) or (fld.baseType <> fld.TType.TList) or (fld.list.count = 0) then exit;
 207   ws := TSFSMemoryChunkStream.Create(nil, 0);
 208   try
 209     SetLength(result, fld.list.count);
 210     for f := 0 to fld.list.count-1 do
 211     begin
 212       FillChar(result[f], sizeof(result[f]), 0);
 213       ws.setup(@result[f], sizeof(result[f]));
 214       fld.list[f].writeBinTo(ws, -1, true); // only fields
 215     end;
 216   except
 217     result := nil;
 218   end;
 219   ws.Free();
 220 end;
 221
 222
 223 function GetTriggers (rec: TDynRecord): TTriggersRec1Array;
 224 var
 225   ws: TSFSMemoryChunkStream = nil;
 226   fld: TDynField;
 227   f: Integer;
 228   //wr: TTextWriter;
 229   //fo: File;
 230 begin
 231   result := nil;
 232   fld := rec.field['trigger'];
 233   if (fld = nil) or (fld.baseType <> fld.TType.TList) or (fld.list.count = 0) then exit;
 234   ws := TSFSMemoryChunkStream.Create(nil, 0);
 235   try
 236     //wr := TFileTextWriter.Create('z00.txt');
 237     SetLength(result, fld.list.count);
 238     for f := 0 to fld.list.count-1 do
 239     begin
 240       FillChar(result[f], sizeof(result[f]), 0);
 241       //e_LogWritefln(': trigger #%s; TexturePanel=%s', [f, result[f].TexturePanel]);
 242       ws.setup(@result[f], sizeof(result[f]));
 243       fld.list[f].writeBinTo(ws, -1, true); // only fields
 244       {
 245       e_LogWritefln(': trigger #%s; X=%s; Y=%s; Width=%s; Height=%s; Enabled=%s; TexturePanel=%s; TriggerType=%s; ActivateType=%s; Keys=%s', [f,
 246        result[f].X,
 247        result[f].Y,
 248        result[f].Width,
 249        result[f].Height,
 250        result[f].Enabled,
 251        result[f].TexturePanel,
 252        result[f].TriggerType,
 253        result[f].ActivateType,
 254        result[f].Keys
 255        ]);
 256       //e_LogWritefln('***'#10'%s'#10'***', [);
 257       fld.list[f].writeTo(wr);
 258       if (f = 0) then
 259       begin
 260         AssignFile(fo, 'z00.bin');
 261         Rewrite(fo, 1);
 262         BlockWrite(fo, result[f], sizeof(result[f]));
 263         CloseFile(fo);
 264       end;
 265       }
 266     end;
 267     //wr.Free();
 268   except
 269     result := nil;
 270   end;
 271   ws.Free();
 272 end;
 273
 274
 275 end.