DEADSOFTWARE

Convert forms resources from Delphi to Lazarus format
[d2df-editor.git] / src / shared / MAPREADER.pas
1 unit MAPREADER;
3 {$INCLUDE ../shared/a_modes.inc}
5 {
6 -----------------------------------
7 MAPREADER.PAS ÂÅÐÑÈß ÎÒ 13.11.07
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 TMapReader = class(TObject)
27 private
28 FError: Byte;
29 FVersion: Byte;
30 FDataBlocks: TDataBlocksArray;
31 function GetBlocks(BlocksType: Byte): TDataBlocksArray;
32 public
33 constructor Create();
34 destructor Destroy(); override;
35 function LoadMap(Data: Pointer): Boolean;
36 procedure FreeMap();
37 function HandledVersion(): Byte; virtual;
39 property GetError: Byte read FError;
40 property GetVersion: Byte read FVersion;
41 end;
43 TMapReader_1 = class(TMapReader)
44 private
45 public
46 function GetMapHeader(): TMapHeaderRec_1;
47 function GetTextures(): TTexturesRec1Array;
48 function GetPanels(): TPanelsRec1Array;
49 function GetItems(): TItemsRec1Array;
50 function GetAreas(): TAreasRec1Array;
51 function GetMonsters(): TMonsterRec1Array;
52 function GetTriggers(): TTriggersRec1Array;
53 function HandledVersion(): Byte; override;
54 end;
56 const
57 MAP_ERROR_NONE = $00;
58 MAP_ERROR_SIGNATURE = $01;
59 MAP_ERROR_VERSION = $02;
61 NNF_NO_NAME = 0;
62 NNF_NAME_BEFORE = 1;
63 NNF_NAME_EQUALS = 2;
64 NNF_NAME_AFTER = 3;
66 function g_Texture_NumNameFindStart(name: String): Boolean;
67 function g_Texture_NumNameFindNext(var newName: String): Byte;
69 implementation
71 uses
72 SysUtils, BinEditor;
74 var
75 NNF_PureName: String; // Èìÿ òåêñòóðû áåç öèôð â êîíöå
76 NNF_FirstNum: Integer; // ×èñëî ó íà÷àëüíîé òåêñòóðû
77 NNF_CurrentNum: Integer; // Ñëåäóþùåå ÷èñëî ó òåêñòóðû
79 function g_Texture_NumNameFindStart(name: String): Boolean;
80 var
81 i: Integer;
83 begin
84 Result := False;
85 NNF_PureName := '';
86 NNF_FirstNum := -1;
87 NNF_CurrentNum := -1;
89 for i := Length(name) downto 1 do
90 if (name[i] = '_') then // "_" - ñèìâîë íà÷àëà íîìåðíîãî ïîñòôèêñà
91 begin
92 if i = Length(name) then
93 begin // Íåò öèôð â êîíöå ñòðîêè
94 Exit;
95 end
96 else
97 begin
98 NNF_PureName := Copy(name, 1, i);
99 Delete(name, 1, i);
100 Break;
101 end;
102 end;
104 // Íå ïåðåâåñòè â ÷èñëî:
105 if not TryStrToInt(name, NNF_FirstNum) then
106 Exit;
108 NNF_CurrentNum := 0;
110 Result := True;
111 end;
113 function g_Texture_NumNameFindNext(var newName: String): Byte;
114 begin
115 if (NNF_PureName = '') or (NNF_CurrentNum < 0) then
116 begin
117 newName := '';
118 Result := NNF_NO_NAME;
119 Exit;
120 end;
122 newName := NNF_PureName + IntToStr(NNF_CurrentNum);
124 if NNF_CurrentNum < NNF_FirstNum then
125 Result := NNF_NAME_BEFORE
126 else
127 if NNF_CurrentNum > NNF_FirstNum then
128 Result := NNF_NAME_AFTER
129 else
130 Result := NNF_NAME_EQUALS;
132 Inc(NNF_CurrentNum);
133 end;
135 { T M a p R e a d e r _ 1 : }
137 function TMapReader_1.GetAreas(): TAreasRec1Array;
138 var
139 TempDataBlocks: TDataBlocksArray;
140 a: Integer;
141 b, Size: LongWord;
142 begin
143 Result := nil;
145 TempDataBlocks := GetBlocks(BLOCK_AREAS);
147 if TempDataBlocks = nil then Exit;
149 size := SizeOf(TAreaRec_1);
151 for a := 0 to High(TempDataBlocks) do
152 for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
153 begin
154 SetLength(Result, Length(Result)+1);
155 CopyMemory(@Result[High(Result)], Pointer(PtrUInt(TempDataBlocks[a].Data)+b*size), size);
156 end;
158 TempDataBlocks := nil;
159 end;
161 function TMapReader_1.GetItems(): TItemsRec1Array;
162 var
163 TempDataBlocks: TDataBlocksArray;
164 a: Integer;
165 b, Size: LongWord;
166 begin
167 Result := nil;
169 TempDataBlocks := GetBlocks(BLOCK_ITEMS);
171 if TempDataBlocks = nil then Exit;
173 size := SizeOf(TItemRec_1);
175 for a := 0 to High(TempDataBlocks) do
176 for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
177 begin
178 SetLength(Result, Length(Result)+1);
179 CopyMemory(@Result[High(Result)], Pointer(PtrUInt(TempDataBlocks[a].Data)+b*size), size);
180 end;
182 TempDataBlocks := nil;
183 end;
185 function TMapReader_1.GetMapHeader(): TMapHeaderRec_1;
186 var
187 TempDataBlocks: TDataBlocksArray;
188 begin
189 ZeroMemory(@Result, SizeOf(TMapHeaderRec_1));
191 TempDataBlocks := GetBlocks(BLOCK_HEADER);
193 if TempDataBlocks = nil then Exit;
195 CopyMemory(@Result, TempDataBlocks[0].Data, SizeOf(TMapHeaderRec_1));
197 TempDataBlocks := nil;
198 end;
200 function TMapReader_1.GetMonsters(): TMonsterRec1Array;
201 var
202 TempDataBlocks: TDataBlocksArray;
203 a: Integer;
204 b, Size: LongWord;
205 begin
206 Result := nil;
208 TempDataBlocks := GetBlocks(BLOCK_MONSTERS);
210 if TempDataBlocks = nil then Exit;
212 size := SizeOf(TMonsterRec_1);
214 for a := 0 to High(TempDataBlocks) do
215 for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
216 begin
217 SetLength(Result, Length(Result)+1);
218 CopyMemory(@Result[High(Result)], Pointer(PtrUInt(TempDataBlocks[a].Data)+b*size), size);
219 end;
221 TempDataBlocks := nil;
222 end;
224 function TMapReader_1.GetPanels(): TPanelsRec1Array;
225 var
226 TempDataBlocks: TDataBlocksArray;
227 a: Integer;
228 b, Size: LongWord;
229 begin
230 Result := nil;
232 TempDataBlocks := GetBlocks(BLOCK_PANELS);
234 if TempDataBlocks = nil then Exit;
236 size := SizeOf(TPanelRec_1);
238 for a := 0 to High(TempDataBlocks) do
239 for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
240 begin
241 SetLength(Result, Length(Result)+1);
242 CopyMemory(@Result[High(Result)], Pointer(PtrUInt(TempDataBlocks[a].Data)+b*size), size);
243 end;
245 TempDataBlocks := nil;
246 end;
248 function TMapReader_1.GetTextures(): TTexturesRec1Array;
249 var
250 TempDataBlocks: TDataBlocksArray;
251 a: Integer;
252 b, Size: LongWord;
253 begin
254 Result := nil;
256 TempDataBlocks := GetBlocks(BLOCK_TEXTURES);
258 if TempDataBlocks = nil then Exit;
260 size := SizeOf(TTextureRec_1);
262 for a := 0 to High(TempDataBlocks) do
263 for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
264 begin
265 SetLength(Result, Length(Result)+1);
266 CopyMemory(@Result[High(Result)], Pointer(PtrUInt(TempDataBlocks[a].Data)+b*size), size);
267 end;
269 TempDataBlocks := nil;
270 end;
272 function TMapReader_1.GetTriggers(): TTriggersRec1Array;
273 var
274 TempDataBlocks: TDataBlocksArray;
275 a: Integer;
276 b, Size: LongWord;
277 begin
278 Result := nil;
280 TempDataBlocks := GetBlocks(BLOCK_TRIGGERS);
282 if TempDataBlocks = nil then Exit;
284 size := SizeOf(TTriggerRec_1);
286 for a := 0 to High(TempDataBlocks) do
287 for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
288 begin
289 SetLength(Result, Length(Result)+1);
290 CopyMemory(@Result[High(Result)], Pointer(PtrUInt(TempDataBlocks[a].Data)+b*size), size);
291 end;
293 TempDataBlocks := nil;
294 end;
296 function TMapReader_1.HandledVersion: Byte;
297 begin
298 Result := $01;
299 end;
301 { T M a p R e a d e r : }
303 constructor TMapReader.Create();
304 begin
305 FDataBlocks := nil;
306 FError := MAP_ERROR_NONE;
307 FVersion := $00;
308 end;
310 destructor TMapReader.Destroy();
311 begin
312 FreeMap();
314 inherited;
315 end;
317 procedure TMapReader.FreeMap();
318 var
319 a: Integer;
320 begin
321 if FDataBlocks <> nil then
322 for a := 0 to High(FDataBlocks) do
323 if FDataBlocks[a].Data <> nil then FreeMem(FDataBlocks[a].Data);
325 FDataBlocks := nil;
326 FVersion := $00;
327 FError := MAP_ERROR_NONE;
328 end;
330 function TMapReader.GetBlocks(BlocksType: Byte): TDataBlocksArray;
331 var
332 a: Integer;
333 begin
334 Result := nil;
336 if FDataBlocks = nil then Exit;
338 for a := 0 to High(FDataBlocks) do
339 if FDataBlocks[a].Block.BlockType = BlocksType then
340 begin
341 SetLength(Result, Length(Result)+1);
342 Result[High(Result)] := FDataBlocks[a];
343 end;
344 end;
346 function TMapReader.HandledVersion(): Byte;
347 begin
348 Result := $00;
349 end;
351 function TMapReader.LoadMap(Data: Pointer): Boolean;
352 var
353 adr: LongWord;
354 _id: Integer;
355 Sign: array[0..2] of Char;
356 Ver: Byte;
357 begin
358 Result := False;
360 CopyMemory(@Sign[0], Data, 3);
361 if Sign <> MAP_SIGNATURE then
362 begin
363 FError := MAP_ERROR_SIGNATURE;
364 Exit;
365 end;
366 adr := 3;
368 CopyMemory(@Ver, Pointer(PtrUInt(Data)+adr), 1);
369 FVersion := Ver;
370 if Ver > HandledVersion() then
371 begin
372 FError := MAP_ERROR_VERSION;
373 Exit;
374 end;
375 adr := adr+1;
377 repeat
378 SetLength(FDataBlocks, Length(FDataBlocks)+1);
379 _id := High(FDataBlocks);
381 CopyMemory(@FDataBlocks[_id].Block, Pointer(PtrUInt(Data)+adr), SizeOf(TBlock));
382 adr := adr+SizeOf(TBlock);
384 FDataBlocks[_id].Data := GetMemory(FDataBlocks[_id].Block.BlockSize);
386 CopyMemory(FDataBlocks[_id].Data, Pointer(PtrUInt(Data)+adr), FDataBlocks[_id].Block.BlockSize);
388 adr := adr+FDataBlocks[_id].Block.BlockSize;
389 until FDataBlocks[_id].Block.BlockType = BLOCK_NONE;
391 Result := True;
392 end;
394 end.