DEADSOFTWARE

Add contours
[d2df-editor.git] / src / shared / MAPWRITER.pas
1 unit MAPWRITER;
3 {$INCLUDE ../shared/a_modes.inc}
5 {
6 -----------------------------------
7 MAPWRITER.PAS ÂÅÐÑÈß ÎÒ 24.09.06
9 Ïîääåðæêà êàðò âåðñèè 1
10 -----------------------------------
11 }
13 interface
15 uses
16 MAPSTRUCT;
18 type
19 TDataBlock = packed record
20 Block: TBlock;
21 Data: Pointer;
22 end;
24 TDataBlocksArray = packed array of TDataBlock;
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;
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;
50 implementation
52 uses
53 BinEditor, SysUtils;
55 { TMapWriter }
57 constructor TMapWriter.Create();
58 begin
59 FDataBlocks := nil;
60 end;
62 destructor TMapWriter.Destroy();
63 begin
64 FreeMap();
66 inherited;
67 end;
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);
77 FDataBlocks := nil;
78 end;
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);
89 if FDataBlocks <> nil then
90 for a := 0 to High(FDataBlocks) do
91 b := b+FDataBlocks[a].Block.BlockSize;
93 Result := b;
95 GetMem(Data, b);
97 Sign := MAP_SIGNATURE;
98 CopyMemory(Data, @Sign[0], 3);
99 c := 3;
101 Ver := HandledVersion();
102 CopyMemory(Pointer(PtrUInt(Data)+c), @Ver, 1);
103 c := c+1;
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;
114 ZeroMemory(Pointer(PtrUInt(Data)+c), SizeOf(TBlock));
115 end;
117 function TMapWriter.HandledVersion(): Byte;
118 begin
119 Result := $00;
120 end;
122 { TMapWriter_1 }
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;
134 SetLength(FDataBlocks, Length(FDataBlocks)+1);
136 size := SizeOf(TAreaRec_1);
138 with FDataBlocks[High(FDataBlocks)] do
139 begin
140 Block.BlockType := BLOCK_AREAS;
141 Block.Reserved := $00000000;
142 Block.BlockSize := LongWord(Length(Areas))*size;
144 Data := GetMemory(Block.BlockSize);
146 for a := 0 to High(Areas) do
147 CopyMemory(Pointer(PtrUInt(Data)+a*Size), @Areas[a], size);
148 end;
150 Result := True;
151 end;
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;
163 SetLength(FDataBlocks, Length(FDataBlocks)+1);
165 size := SizeOf(TItemRec_1);
167 with FDataBlocks[High(FDataBlocks)] do
168 begin
169 Block.BlockType := BLOCK_ITEMS;
170 Block.Reserved := $00000000;
171 Block.BlockSize := LongWord(Length(Items))*size;
173 Data := GetMemory(Block.BlockSize);
175 for a := 0 to High(Items) do
176 CopyMemory(Pointer(PtrUInt(Data)+a*size), @Items[a], size);
177 end;
179 Result := True;
180 end;
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;
192 SetLength(FDataBlocks, Length(FDataBlocks)+1);
194 size := SizeOf(TMonsterRec_1);
196 with FDataBlocks[High(FDataBlocks)] do
197 begin
198 Block.BlockType := BLOCK_MONSTERS;
199 Block.Reserved := $00000000;
200 Block.BlockSize := LongWord(Length(Monsters))*size;
202 Data := GetMemory(Block.BlockSize);
204 for a := 0 to High(Monsters) do
205 CopyMemory(Pointer(PtrUInt(Data)+a*Size), @Monsters[a], size);
206 end;
208 Result := True;
209 end;
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;
221 SetLength(FDataBlocks, Length(FDataBlocks)+1);
223 size := SizeOf(TPanelRec_1);
225 with FDataBlocks[High(FDataBlocks)] do
226 begin
227 Block.BlockType := BLOCK_PANELS;
228 Block.Reserved := $00000000;
229 Block.BlockSize := LongWord(Length(Panels))*size;
231 Data := GetMemory(Block.BlockSize);
233 for a := 0 to High(Panels) do
234 CopyMemory(Pointer(PtrUInt(Data)+a*size), @Panels[a], size);
235 end;
237 Result := True;
238 end;
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;
250 SetLength(FDataBlocks, Length(FDataBlocks)+1);
252 size := SizeOf(TTextureRec_1);
254 with FDataBlocks[High(FDataBlocks)] do
255 begin
256 Block.BlockType := BLOCK_TEXTURES;
257 Block.Reserved := $00000000;
258 Block.BlockSize := LongWord(Length(Textures))*size;
260 Data := GetMemory(Block.BlockSize);
262 for a := 0 to High(Textures) do
263 CopyMemory(Pointer(PtrUInt(Data)+a*size), @Textures[a], size);
264 end;
266 Result := True;
267 end;
269 function TMapWriter_1.AddTriggers(Triggers: TTriggersRec1Array): Boolean;
270 var
271 a, size: LongWord;
272 begin
273 if Triggers = nil then
274 begin
275 Result := True;
276 Exit;
277 end;
279 SetLength(FDataBlocks, Length(FDataBlocks)+1);
281 size := SizeOf(TTriggerRec_1);
283 with FDataBlocks[High(FDataBlocks)] do
284 begin
285 Block.BlockType := BLOCK_TRIGGERS;
286 Block.Reserved := $00000000;
287 Block.BlockSize := LongWord(Length(Triggers))*size;
289 Data := GetMemory(Block.BlockSize);
291 for a := 0 to High(Triggers) do
292 CopyMemory(Pointer(PtrUInt(Data)+a*size), @Triggers[a], size);
293 end;
295 Result := True;
296 end;
298 function TMapWriter_1.AddHeader(MapHeader: TMapHeaderRec_1): Boolean;
299 var
300 size: LongWord;
301 begin
302 SetLength(FDataBlocks, Length(FDataBlocks)+1);
304 size := SizeOf(TMapHeaderRec_1);
306 with FDataBlocks[High(FDataBlocks)] do
307 begin
308 Block.BlockType := BLOCK_HEADER;
309 Block.Reserved := $00000000;
310 Block.BlockSize := size;
312 Data := GetMemory(Block.BlockSize);
314 CopyMemory(Pointer(PtrUInt(Data)), @MapHeader, size);
315 end;
317 Result := True;
318 end;
320 function TMapWriter_1.HandledVersion(): Byte;
321 begin
322 Result := $01;
323 end;
325 end.