src/sheditor/MAPWRITER.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 MAPWRITER;
  18
  19 {
  20 -----------------------------------
  21 MAPWRITER.PAS ÂÅÐÑÈß ÎÒ 24.09.06
  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   TMapWriter = class(TObject)
  41    private
  42     FDataBlocks: TDataBlocksArray;
  43    public
  44     constructor Create();
  45     destructor Destroy(); override;
  46     procedure FreeMap();
  47     function SaveMap(var Data: Pointer): LongWord;
  48     function HandledVersion(): Byte; virtual;
  49   end;
  50
  51   TMapWriter_1 = class(TMapWriter)
  52    public
  53     function AddTextures(Textures: TTexturesRec1Array): Boolean;
  54     function AddPanels(Panels: TPanelsRec1Array): Boolean;
  55     function AddItems(Items: TItemsRec1Array): Boolean;
  56     function AddMonsters(Monsters: TMonsterRec1Array): Boolean;
  57     function AddAreas(Areas: TAreasRec1Array): Boolean;
  58     function AddTriggers(Triggers: TTriggersRec1Array): Boolean;
  59     function AddHeader(MapHeader: TMapHeaderRec_1): Boolean;
  60     function HandledVersion(): Byte; override;
  61   end;
  62
  63
  64 implementation
  65
  66 uses
  67   BinEditor, SysUtils;
  68
  69 { TMapWriter }
  70
  71 constructor TMapWriter.Create();
  72 begin
  73  FDataBlocks := nil;
  74 end;
  75
  76 destructor TMapWriter.Destroy();
  77 begin
  78  FreeMap();
  79
  80  inherited;
  81 end;
  82
  83 procedure TMapWriter.FreeMap();
  84 var
  85   a: Integer;
  86 begin
  87  if FDataBlocks <> nil then
  88   for a := 0 to High(FDataBlocks) do
  89    if FDataBlocks[a].Data <> nil then FreeMem(FDataBlocks[a].Data);
  90
  91  FDataBlocks := nil;
  92 end;
  93
  94 function TMapWriter.SaveMap(var Data: Pointer): LongWord;
  95 var
  96   a: Integer;
  97   b, c: LongWord;
  98   Sign: array[0..2] of Char;
  99   Ver: Byte;
 100 begin
 101  b := 3+1+SizeOf(TBlock)*(Length(FDataBlocks)+1);
 102
 103  if FDataBlocks <> nil then
 104   for a := 0 to High(FDataBlocks) do
 105    b := b+FDataBlocks[a].Block.BlockSize;
 106
 107  Result := b;
 108
 109  GetMem(Data, b);
 110
 111  Sign := MAP_SIGNATURE;
 112  CopyMemory(Data, @Sign[0], 3);
 113  c := 3;
 114
 115  Ver := HandledVersion();
 116  CopyMemory(Pointer(LongWord(Data)+c), @Ver, 1);
 117  c := c+1;
 118
 119  if FDataBlocks <> nil then
 120   for a := 0 to High(FDataBlocks) do
 121   begin
 122    CopyMemory(Pointer(LongWord(Data)+c), @FDataBlocks[a].Block, SizeOf(TBlock));
 123    c := c+SizeOf(TBlock);
 124    CopyMemory(Pointer(LongWord(Data)+c), FDataBlocks[a].Data, FDataBlocks[a].Block.BlockSize);
 125    c := c+FDataBlocks[a].Block.BlockSize;
 126   end;
 127
 128  ZeroMemory(Pointer(LongWord(Data)+c), SizeOf(TBlock));
 129 end;
 130
 131 function TMapWriter.HandledVersion(): Byte;
 132 begin
 133  Result := $00;
 134 end;
 135
 136 { TMapWriter_1 }
 137
 138 function TMapWriter_1.AddAreas(Areas: TAreasRec1Array): Boolean;
 139 var
 140   a, size: LongWord;
 141 begin
 142  if Areas = nil then
 143  begin
 144   Result := True;
 145   Exit;
 146  end;
 147
 148  SetLength(FDataBlocks, Length(FDataBlocks)+1);
 149
 150  size := SizeOf(TAreaRec_1);
 151
 152  with FDataBlocks[High(FDataBlocks)] do
 153  begin
 154   Block.BlockType := BLOCK_AREAS;
 155   Block.Reserved := $00000000;
 156   Block.BlockSize := LongWord(Length(Areas))*size;
 157
 158   Data := GetMemory(Block.BlockSize);
 159
 160   for a := 0 to High(Areas) do
 161    CopyMemory(Pointer(LongWord(Data)+a*Size), @Areas[a], size);
 162  end;
 163
 164  Result := True;
 165 end;
 166
 167 function TMapWriter_1.AddItems(Items: TItemsRec1Array): Boolean;
 168 var
 169   a, size: LongWord;
 170 begin
 171  if Items = nil then
 172  begin
 173   Result := True;
 174   Exit;
 175  end;
 176
 177  SetLength(FDataBlocks, Length(FDataBlocks)+1);
 178
 179  size := SizeOf(TItemRec_1);
 180
 181  with FDataBlocks[High(FDataBlocks)] do
 182  begin
 183   Block.BlockType := BLOCK_ITEMS;
 184   Block.Reserved := $00000000;
 185   Block.BlockSize := LongWord(Length(Items))*size;
 186
 187   Data := GetMemory(Block.BlockSize);
 188
 189   for a := 0 to High(Items) do
 190    CopyMemory(Pointer(LongWord(Data)+a*size), @Items[a], size);
 191  end;
 192
 193  Result := True;
 194 end;
 195
 196 function TMapWriter_1.AddMonsters(Monsters: TMonsterRec1Array): Boolean;
 197 var
 198   a, size: LongWord;
 199 begin
 200  if Monsters = nil then
 201  begin
 202   Result := True;
 203   Exit;
 204  end;
 205
 206  SetLength(FDataBlocks, Length(FDataBlocks)+1);
 207
 208  size := SizeOf(TMonsterRec_1);
 209
 210  with FDataBlocks[High(FDataBlocks)] do
 211  begin
 212   Block.BlockType := BLOCK_MONSTERS;
 213   Block.Reserved := $00000000;
 214   Block.BlockSize := LongWord(Length(Monsters))*size;
 215
 216   Data := GetMemory(Block.BlockSize);
 217
 218   for a := 0 to High(Monsters) do
 219    CopyMemory(Pointer(LongWord(Data)+a*Size), @Monsters[a], size);
 220  end;
 221
 222  Result := True;
 223 end;
 224
 225 function TMapWriter_1.AddPanels(Panels: TPanelsRec1Array): Boolean;
 226 var
 227   a, size: LongWord;
 228 begin
 229  if Panels = nil then
 230  begin
 231   Result := True;
 232   Exit;
 233  end;
 234
 235  SetLength(FDataBlocks, Length(FDataBlocks)+1);
 236
 237  size := SizeOf(TPanelRec_1);
 238
 239  with FDataBlocks[High(FDataBlocks)] do
 240  begin
 241   Block.BlockType := BLOCK_PANELS;
 242   Block.Reserved := $00000000;
 243   Block.BlockSize := LongWord(Length(Panels))*size;
 244
 245   Data := GetMemory(Block.BlockSize);
 246
 247   for a := 0 to High(Panels) do
 248    CopyMemory(Pointer(LongWord(Data)+a*size), @Panels[a], size);
 249  end;
 250
 251  Result := True;
 252 end;
 253
 254 function TMapWriter_1.AddTextures(Textures: TTexturesRec1Array): Boolean;
 255 var
 256   a, size: LongWord;
 257 begin
 258  if Textures = nil then
 259  begin
 260   Result := True;
 261   Exit;
 262  end;
 263
 264  SetLength(FDataBlocks, Length(FDataBlocks)+1);
 265
 266  size := SizeOf(TTextureRec_1);
 267
 268  with FDataBlocks[High(FDataBlocks)] do
 269  begin
 270   Block.BlockType := BLOCK_TEXTURES;
 271   Block.Reserved := $00000000;
 272   Block.BlockSize := LongWord(Length(Textures))*size;
 273
 274   Data := GetMemory(Block.BlockSize);
 275
 276   for a := 0 to High(Textures) do
 277    CopyMemory(Pointer(LongWord(Data)+a*size), @Textures[a], size);
 278  end;
 279
 280  Result := True;
 281 end;
 282
 283 function TMapWriter_1.AddTriggers(Triggers: TTriggersRec1Array): Boolean;
 284 var
 285   a, size: LongWord;
 286 begin
 287  if Triggers = nil then
 288  begin
 289   Result := True;
 290   Exit;
 291  end;
 292
 293  SetLength(FDataBlocks, Length(FDataBlocks)+1);
 294
 295  size := SizeOf(TTriggerRec_1);
 296
 297  with FDataBlocks[High(FDataBlocks)] do
 298  begin
 299   Block.BlockType := BLOCK_TRIGGERS;
 300   Block.Reserved := $00000000;
 301   Block.BlockSize := LongWord(Length(Triggers))*size;
 302
 303   Data := GetMemory(Block.BlockSize);
 304
 305   for a := 0 to High(Triggers) do
 306    CopyMemory(Pointer(LongWord(Data)+a*size), @Triggers[a], size);
 307  end;
 308
 309  Result := True;
 310 end;
 311
 312 function TMapWriter_1.AddHeader(MapHeader: TMapHeaderRec_1): Boolean;
 313 var
 314   size: LongWord;
 315 begin
 316  SetLength(FDataBlocks, Length(FDataBlocks)+1);
 317
 318  size := SizeOf(TMapHeaderRec_1);
 319
 320  with FDataBlocks[High(FDataBlocks)] do
 321  begin
 322   Block.BlockType := BLOCK_HEADER;
 323   Block.Reserved := $00000000;
 324   Block.BlockSize := size;
 325
 326   Data := GetMemory(Block.BlockSize);
 327
 328   CopyMemory(Pointer(LongWord(Data)), @MapHeader, size);
 329  end;
 330
 331  Result := True;
 332 end;
 333
 334 function TMapWriter_1.HandledVersion(): Byte;
 335 begin
 336  Result := $01;
 337 end;
 338
 339 end.