src/shared/MAPREADER.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 {$MODE DELPHI}
  17 unit MAPREADER;
  18
  19 {
  20 -----------------------------------
  21 MAPREADER.PAS ÂÅÐÑÈß ÎÒ 13.11.07
  22
  23 Ïîääåðæêà êàðò âåðñèè 1
  24 -----------------------------------
  25 }
  26
  27 interface
  28
  29 uses
  30   MAPSTRUCT;
  31
  32 type
  33   TDataBlock = packed record
  34    Block: TBlock;
  35    Data:  Pointer;
  36   end;
  37
  38   TDataBlocksArray = packed array of TDataBlock;
  39
  40   TMapReader = class(TObject)
  41    private
  42     FError: Byte;
  43     FVersion: Byte;
  44     FDataBlocks: TDataBlocksArray;
  45     function GetBlocks(BlocksType: Byte): TDataBlocksArray;
  46    public
  47     constructor Create();
  48     destructor Destroy(); override;
  49     function LoadMap(Data: Pointer): Boolean;
  50     procedure FreeMap();
  51     function HandledVersion(): Byte; virtual;
  52
  53     property GetError: Byte read FError;
  54     property GetVersion: Byte read FVersion;
  55   end;
  56
  57   TMapReader_1 = class(TMapReader)
  58    private
  59    public
  60     function GetMapHeader(): TMapHeaderRec_1;
  61     function GetTextures(): TTexturesRec1Array;
  62     function GetPanels(): TPanelsRec1Array;
  63     function GetItems(): TItemsRec1Array;
  64     function GetAreas(): TAreasRec1Array;
  65     function GetMonsters(): TMonsterRec1Array;
  66     function GetTriggers(): TTriggersRec1Array;
  67     function HandledVersion(): Byte; override;
  68   end;
  69
  70 const
  71   MAP_ERROR_NONE      = $00;
  72   MAP_ERROR_SIGNATURE = $01;
  73   MAP_ERROR_VERSION   = $02;
  74
  75   NNF_NO_NAME         = 0;
  76   NNF_NAME_BEFORE     = 1;
  77   NNF_NAME_EQUALS     = 2;
  78   NNF_NAME_AFTER      = 3;
  79
  80 function g_Texture_NumNameFindStart(name: String): Boolean;
  81 function g_Texture_NumNameFindNext(var newName: String): Byte;
  82
  83 implementation
  84
  85 uses
  86   SysUtils, BinEditor;
  87
  88 var
  89   NNF_PureName: String; // Èìÿ òåêñòóðû áåç öèôð â êîíöå
  90   NNF_FirstNum: Integer; // ×èñëî ó íà÷àëüíîé òåêñòóðû
  91   NNF_CurrentNum: Integer; // Ñëåäóþùåå ÷èñëî ó òåêñòóðû
  92
  93 function g_Texture_NumNameFindStart(name: String): Boolean;
  94 var
  95   i: Integer;
  96
  97 begin
  98   Result := False;
  99   NNF_PureName := '';
 100   NNF_FirstNum := -1;
 101   NNF_CurrentNum := -1;
 102
 103   for i := Length(name) downto 1 do
 104     if (name[i] = '_') then // "_" - ñèìâîë íà÷àëà íîìåðíîãî ïîñòôèêñà
 105     begin
 106       if i = Length(name) then
 107         begin // Íåò öèôð â êîíöå ñòðîêè
 108           Exit;
 109         end
 110       else
 111         begin
 112           NNF_PureName := Copy(name, 1, i);
 113           Delete(name, 1, i);
 114           Break;
 115         end;
 116     end;
 117
 118 // Íå ïåðåâåñòè â ÷èñëî:
 119   if not TryStrToInt(name, NNF_FirstNum) then
 120     Exit;
 121
 122   NNF_CurrentNum := 0;
 123
 124   Result := True;
 125 end;
 126
 127 function g_Texture_NumNameFindNext(var newName: String): Byte;
 128 begin
 129   if (NNF_PureName = '') or (NNF_CurrentNum < 0) then
 130   begin
 131     newName := '';
 132     Result := NNF_NO_NAME;
 133     Exit;
 134   end;
 135
 136   newName := NNF_PureName + IntToStr(NNF_CurrentNum);
 137
 138   if NNF_CurrentNum < NNF_FirstNum then
 139     Result := NNF_NAME_BEFORE
 140   else
 141     if NNF_CurrentNum > NNF_FirstNum then
 142       Result := NNF_NAME_AFTER
 143     else
 144       Result := NNF_NAME_EQUALS;
 145
 146   Inc(NNF_CurrentNum);
 147 end;
 148
 149 { T M a p R e a d e r _ 1 : }
 150
 151 function TMapReader_1.GetAreas(): TAreasRec1Array;
 152 var
 153   TempDataBlocks: TDataBlocksArray;
 154   a: Integer;
 155   b, Size: LongWord;
 156 begin
 157  Result := nil;
 158
 159  TempDataBlocks := GetBlocks(BLOCK_AREAS);
 160
 161  if TempDataBlocks = nil then Exit;
 162
 163  size := SizeOf(TAreaRec_1);
 164
 165  for a := 0 to High(TempDataBlocks) do
 166   for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
 167   begin
 168    SetLength(Result, Length(Result)+1);
 169    CopyMemory(@Result[High(Result)], Pointer(LongWord(TempDataBlocks[a].Data)+b*size), size);
 170   end;
 171
 172  TempDataBlocks := nil;
 173 end;
 174
 175 function TMapReader_1.GetItems(): TItemsRec1Array;
 176 var
 177   TempDataBlocks: TDataBlocksArray;
 178   a: Integer;
 179   b, Size: LongWord;
 180 begin
 181  Result := nil;
 182
 183  TempDataBlocks := GetBlocks(BLOCK_ITEMS);
 184
 185  if TempDataBlocks = nil then Exit;
 186
 187  size := SizeOf(TItemRec_1);
 188
 189  for a := 0 to High(TempDataBlocks) do
 190   for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
 191   begin
 192    SetLength(Result, Length(Result)+1);
 193    CopyMemory(@Result[High(Result)], Pointer(LongWord(TempDataBlocks[a].Data)+b*size), size);
 194   end;
 195
 196  TempDataBlocks := nil;
 197 end;
 198
 199 function TMapReader_1.GetMapHeader(): TMapHeaderRec_1;
 200 var
 201   TempDataBlocks: TDataBlocksArray;
 202 begin
 203  ZeroMemory(@Result, SizeOf(TMapHeaderRec_1));
 204
 205  TempDataBlocks := GetBlocks(BLOCK_HEADER);
 206
 207  if TempDataBlocks = nil then Exit;
 208
 209  CopyMemory(@Result, TempDataBlocks[0].Data, SizeOf(TMapHeaderRec_1));
 210
 211  TempDataBlocks := nil;
 212 end;
 213
 214 function TMapReader_1.GetMonsters(): TMonsterRec1Array;
 215 var
 216   TempDataBlocks: TDataBlocksArray;
 217   a: Integer;
 218   b, Size: LongWord;
 219 begin
 220  Result := nil;
 221
 222  TempDataBlocks := GetBlocks(BLOCK_MONSTERS);
 223
 224  if TempDataBlocks = nil then Exit;
 225
 226  size := SizeOf(TMonsterRec_1);
 227
 228  for a := 0 to High(TempDataBlocks) do
 229   for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
 230   begin
 231    SetLength(Result, Length(Result)+1);
 232    CopyMemory(@Result[High(Result)], Pointer(LongWord(TempDataBlocks[a].Data)+b*size), size);
 233   end;
 234
 235  TempDataBlocks := nil;
 236 end;
 237
 238 function TMapReader_1.GetPanels(): TPanelsRec1Array;
 239 var
 240   TempDataBlocks: TDataBlocksArray;
 241   a: Integer;
 242   b, Size: LongWord;
 243 begin
 244  Result := nil;
 245
 246  TempDataBlocks := GetBlocks(BLOCK_PANELS);
 247
 248  if TempDataBlocks = nil then Exit;
 249
 250  size := SizeOf(TPanelRec_1);
 251
 252  for a := 0 to High(TempDataBlocks) do
 253   for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
 254   begin
 255    SetLength(Result, Length(Result)+1);
 256    CopyMemory(@Result[High(Result)], Pointer(LongWord(TempDataBlocks[a].Data)+b*size), size);
 257   end;
 258
 259  TempDataBlocks := nil;
 260 end;
 261
 262 function TMapReader_1.GetTextures(): TTexturesRec1Array;
 263 var
 264   TempDataBlocks: TDataBlocksArray;
 265   a: Integer;
 266   b, Size: LongWord;
 267 begin
 268  Result := nil;
 269
 270  TempDataBlocks := GetBlocks(BLOCK_TEXTURES);
 271
 272  if TempDataBlocks = nil then Exit;
 273
 274  size := SizeOf(TTextureRec_1);
 275
 276  for a := 0 to High(TempDataBlocks) do
 277   for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
 278   begin
 279    SetLength(Result, Length(Result)+1);
 280    CopyMemory(@Result[High(Result)], Pointer(LongWord(TempDataBlocks[a].Data)+b*size), size);
 281   end;
 282
 283  TempDataBlocks := nil;
 284 end;
 285
 286 function TMapReader_1.GetTriggers(): TTriggersRec1Array;
 287 var
 288   TempDataBlocks: TDataBlocksArray;
 289   a: Integer;
 290   b, Size: LongWord;
 291 begin
 292  Result := nil;
 293
 294  TempDataBlocks := GetBlocks(BLOCK_TRIGGERS);
 295
 296  if TempDataBlocks = nil then Exit;
 297
 298  size := SizeOf(TTriggerRec_1);
 299
 300  for a := 0 to High(TempDataBlocks) do
 301   for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
 302   begin
 303    SetLength(Result, Length(Result)+1);
 304    CopyMemory(@Result[High(Result)], Pointer(LongWord(TempDataBlocks[a].Data)+b*size), size);
 305   end;
 306
 307  TempDataBlocks := nil;
 308 end;
 309
 310 function TMapReader_1.HandledVersion: Byte;
 311 begin
 312  Result := $01;
 313 end;
 314
 315 { T M a p R e a d e r : }
 316
 317 constructor TMapReader.Create();
 318 begin
 319  FDataBlocks := nil;
 320  FError := MAP_ERROR_NONE;
 321  FVersion := $00;
 322 end;
 323
 324 destructor TMapReader.Destroy();
 325 begin
 326  FreeMap();
 327
 328  inherited;
 329 end;
 330
 331 procedure TMapReader.FreeMap();
 332 var
 333   a: Integer;
 334 begin
 335  if FDataBlocks <> nil then
 336   for a := 0 to High(FDataBlocks) do
 337    if FDataBlocks[a].Data <> nil then FreeMem(FDataBlocks[a].Data);
 338
 339  FDataBlocks := nil;
 340  FVersion := $00;
 341  FError := MAP_ERROR_NONE;
 342 end;
 343
 344 function TMapReader.GetBlocks(BlocksType: Byte): TDataBlocksArray;
 345 var
 346   a: Integer;
 347 begin
 348  Result := nil;
 349
 350  if FDataBlocks = nil then Exit;
 351
 352  for a := 0 to High(FDataBlocks) do
 353   if FDataBlocks[a].Block.BlockType = BlocksType then
 354   begin
 355    SetLength(Result, Length(Result)+1);
 356    Result[High(Result)] := FDataBlocks[a];
 357   end;
 358 end;
 359
 360 function TMapReader.HandledVersion(): Byte;
 361 begin
 362  Result := $00;
 363 end;
 364
 365 function TMapReader.LoadMap(Data: Pointer): Boolean;
 366 var
 367   adr: LongWord;
 368   _id: Integer;
 369   Sign: array[0..2] of Char;
 370   Ver: Byte;
 371 begin
 372  Result := False;
 373
 374  CopyMemory(@Sign[0], Data, 3);
 375  if Sign <> MAP_SIGNATURE then
 376  begin
 377   FError := MAP_ERROR_SIGNATURE;
 378   Exit;
 379  end;
 380  adr := 3;
 381
 382  CopyMemory(@Ver, Pointer(LongWord(Data)+adr), 1);
 383  FVersion := Ver;
 384  if Ver > HandledVersion() then
 385  begin
 386   FError := MAP_ERROR_VERSION;
 387   Exit;
 388  end;
 389  adr := adr+1;
 390
 391  repeat
 392   SetLength(FDataBlocks, Length(FDataBlocks)+1);
 393   _id := High(FDataBlocks);
 394
 395   CopyMemory(@FDataBlocks[_id].Block, Pointer(LongWord(Data)+adr), SizeOf(TBlock));
 396   adr := adr+SizeOf(TBlock);
 397
 398   FDataBlocks[_id].Data := GetMemory(FDataBlocks[_id].Block.BlockSize);
 399
 400   CopyMemory(FDataBlocks[_id].Data, Pointer(LongWord(Data)+adr), FDataBlocks[_id].Block.BlockSize);
 401
 402   adr := adr+FDataBlocks[_id].Block.BlockSize;
 403  until FDataBlocks[_id].Block.BlockType = BLOCK_NONE;
 404
 405  Result := True;
 406 end;
 407
 408 end.