src/shared/MAPWRITER.pas

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