DEADSOFTWARE

FPC3.2.0 compat patch by deaddoomer
[d2df-sdl.git] / src / shared / MAPDEF.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, version 3 of the License ONLY.
6 *
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
11 *
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
14 *)
15 {$INCLUDE a_modes.inc}
16 {$M+}
17 unit MAPDEF;
19 interface
21 uses
22 xdynrec;
25 const
26 MAP_SIGNATURE = 'MAP';
29 const
30 TEXTURE_NAME_WATER = '_water_0';
31 TEXTURE_NAME_ACID1 = '_water_1';
32 TEXTURE_NAME_ACID2 = '_water_2';
35 type
36 TDFPoint = packed record
37 public
38 X, Y: LongInt;
40 public
41 constructor Create (ax, ay: LongInt);
43 function isZero (): Boolean; inline;
44 end;
46 TDFSize = packed record
47 public
48 w, h: LongInt;
50 public
51 constructor Create (aw, ah: LongInt);
53 function isZero (): Boolean; inline;
54 function isValid (): Boolean; inline;
55 end;
57 TDFColor = packed record
58 public
59 r, g, b, a: Byte; // a: 0 is transparent, 255 is opaque
61 public
62 constructor Create (ar, ag, ab: LongInt; aa: LongInt=0);
64 function isTransparent (): Boolean; inline;
65 function isOpaque (): Boolean; inline;
66 function isBlack (): Boolean; inline;
67 function isWhite (): Boolean; inline;
68 end;
70 {$INCLUDE mapdef.inc}
72 // various helpers to access map structures
73 type
74 TDynFieldHelper = class helper for TDynField
75 public
76 function getRGBA (): TDFColor; inline;
77 procedure setRGBA (const v: TDFColor); inline;
79 public
80 property rgba: TDFColor read getRGBA write setRGBA; // for `TColor`
81 end;
83 TDynRecordHelper = class helper for TDynRecord
84 private
85 function getFieldWithType (const aname: AnsiString; atype: TDynField.TType): TDynField; inline;
87 function getPanelByIdx (idx: Integer): TDynRecord; inline;
89 function getTexturePanel (): Integer; inline;
90 function getTexturePanelRec (): TDynRecord; inline;
92 function getPanelIndex (pan: TDynRecord): Integer;
94 function getPointField (const aname: AnsiString): TDFPoint; inline;
95 function getSizeField (const aname: AnsiString): TDFSize; inline;
97 public
98 function panelCount (): Integer; inline;
100 // header
101 function mapName (): AnsiString; inline;
102 function mapAuthor (): AnsiString; inline;
103 function mapDesc (): AnsiString; inline;
104 function musicName (): AnsiString; inline;
105 function skyName (): AnsiString; inline;
107 // panel
108 function X (): Integer; inline;
109 function Y (): Integer; inline;
110 function Width (): Word; inline;
111 function Height (): Word; inline;
112 function TextureNum (): Word; inline;
113 function TextureRec (): TDynRecord; inline;
114 function PanelType (): Word; inline;
115 function Alpha (): Byte; inline;
116 function Flags (): Byte; inline;
118 function moveSpeed (): TDFPoint; inline;
119 function moveStart (): TDFPoint; inline;
120 function moveEnd (): TDFPoint; inline;
122 function moveOnce (): Boolean; inline;
124 function sizeSpeed (): TDFSize; inline;
125 function sizeEnd (): TDFSize; inline;
127 function endPosTrig (): Integer; inline;
128 function endSizeTrig (): Integer; inline;
130 // texture
131 function Resource (): AnsiString; inline;
132 function Anim (): Boolean; inline;
134 // item
135 function ItemType (): Byte; inline;
136 function Options (): Byte; inline;
138 // monster
139 function MonsterType (): Byte; inline; // type, ubyte
140 function Direction (): Byte; inline; // direction, ubyte
142 // area
143 function AreaType (): Byte; inline; // type, ubyte
144 //function Direction (): Byte; inline; // direction, ubyte
146 // trigger
147 function trigRec (): TDynRecord; {inline;}
148 function Enabled (): Boolean; inline; // enabled, bool
149 function TriggerType (): Byte; inline; // type, ubyte
150 function ActivateType (): Byte; inline; // activatetype, ubyte
151 function Keys (): Byte; inline; // keys, ubyte
152 //function DATA (): Byte128; inline; // triggerdata, trigdata[128]; // the only special nested structure
154 {$INCLUDE mapdef_help.inc}
155 function trigMonsterId (): Integer; inline;
156 function trigPanelId (): Integer; inline; // panel index in list
157 function trigPanelRec (): TDynRecord; inline;
159 private
160 // user fields
161 function getUserPanelId (): Integer; inline;
162 procedure setUserPanelId (v: Integer); inline;
164 function getUserTrigRef (): Boolean; inline;
165 procedure setUserTrigRef (v: Boolean); inline;
167 public
168 property panel[idx: Integer]: TDynRecord read getPanelByIdx;
169 property panelIndex[pan: TDynRecord]: Integer read getPanelIndex;
170 // triggers
171 property tgPanelId: Integer read trigPanelId;
172 property tgPanelRec: TDynRecord read trigPanelRec;
173 property TexturePanelId: Integer read getTexturePanel; // texturepanel, int
174 property TexturePanelRec: TDynRecord read getTexturePanelRec;
175 // user fields
176 property userPanelId: Integer read getUserPanelId write setUserPanelId;
177 property userPanelTrigRef: Boolean read getUserTrigRef write setUserTrigRef;
178 end;
180 implementation
182 uses
183 SysUtils, {e_log,} utils, xparser, xstreams;
186 // ////////////////////////////////////////////////////////////////////////// //
187 constructor TDFPoint.Create (ax, ay: LongInt); begin X := ax; Y := ay; end;
188 function TDFPoint.isZero (): Boolean; inline; begin result := (X = 0) and (Y = 0); end;
191 constructor TDFSize.Create (aw, ah: LongInt); begin w := aw; h := ah; end;
192 function TDFSize.isZero (): Boolean; inline; begin result := (w = 0) and (h = 0); end;
193 function TDFSize.isValid (): Boolean; inline; begin result := (w > 0) and (h > 0); end;
195 constructor TDFColor.Create (ar, ag, ab: LongInt; aa: LongInt=0);
196 begin
197 if (ar < 0) then r := 0 else if (ar > 255) then r := 255 else r := Byte(ar);
198 if (ag < 0) then g := 0 else if (ag > 255) then g := 255 else g := Byte(ag);
199 if (ab < 0) then b := 0 else if (ab > 255) then b := 255 else b := Byte(ab);
200 if (aa < 0) then a := 0 else if (aa > 255) then a := 255 else a := Byte(aa);
201 end;
202 function TDFColor.isTransparent (): Boolean; inline; begin result := (a = 0); end;
203 function TDFColor.isOpaque (): Boolean; inline; begin result := (a = 255); end;
204 function TDFColor.isBlack (): Boolean; inline; begin result := (r = 0) and (g = 0) and (b = 0); end;
205 function TDFColor.isWhite (): Boolean; inline; begin result := (r = 255) and (g = 255) and (b = 255); end;
208 // ////////////////////////////////////////////////////////////////////////// //
209 function TDynFieldHelper.getRGBA (): TDFColor; inline; begin result := TDFColor.Create(red, green, blue, alpha); end;
210 procedure TDynFieldHelper.setRGBA (const v: TDFColor); inline; begin red := v.r; green := v.g; blue := v.b; alpha := v.a; end;
213 // ////////////////////////////////////////////////////////////////////////// //
214 function TDynRecordHelper.getUserPanelId (): Integer; inline;
215 var
216 fld: TDynField;
217 begin
218 fld := field['userPanelId'];
219 //if (fld = nil) or (fld.baseType <> TDynField.TType.TInt) then result := -1 else result := fld.ival;
220 if (fld = nil) then result := -1 else result := Integer(fld.value);
221 end;
224 procedure TDynRecordHelper.setUserPanelId (v: Integer); inline;
225 begin
226 user['userPanelId'] := v;
227 end;
230 function TDynRecordHelper.getUserTrigRef (): Boolean; inline;
231 var
232 fld: TDynField;
233 begin
234 fld := field['userPanelTrigRef'];
235 if (fld = nil) then result := false else result := Boolean(fld.value);
236 //if (fld = nil) or (fld.baseType <> TDynField.TType.TBool) then result := false else result := (fld.ival <> 0);
237 end;
240 procedure TDynRecordHelper.setUserTrigRef (v: Boolean); inline;
241 begin
242 user['userPanelTrigRef'] := v;
243 end;
246 // ////////////////////////////////////////////////////////////////////////// //
247 function TDynRecordHelper.moveSpeed (): TDFPoint; inline; begin result := getPointField('move_speed'); end;
248 function TDynRecordHelper.moveStart (): TDFPoint; inline; begin result := getPointField('move_start'); end;
249 function TDynRecordHelper.moveEnd (): TDFPoint; inline; begin result := getPointField('move_end'); end;
251 function TDynRecordHelper.sizeSpeed (): TDFSize; inline; begin result := getSizeField('size_speed'); end;
252 function TDynRecordHelper.sizeEnd (): TDFSize; inline; begin result := getSizeField('size_end'); end;
254 function TDynRecordHelper.moveOnce (): Boolean; inline; begin result := (getFieldWithType('move_once', TDynField.TType.TBool).ival <> 0); end;
257 function TDynRecordHelper.endPosTrig (): Integer; inline;
258 var
259 fld: TDynField;
260 begin
261 fld := getFieldWithType('end_pos_trigger', TDynField.TType.TInt);
262 result := fld.recrefIndex;
263 end;
265 function TDynRecordHelper.endSizeTrig (): Integer; inline;
266 var
267 fld: TDynField;
268 begin
269 fld := getFieldWithType('end_size_trigger', TDynField.TType.TInt);
270 result := fld.recrefIndex;
271 end;
274 // ////////////////////////////////////////////////////////////////////////// //
275 function TDynRecordHelper.getFieldWithType (const aname: AnsiString; atype: TDynField.TType): TDynField; inline;
276 begin
277 result := field[aname];
278 if (result = nil) then raise Exception.Create(Format('field ''%s'' not found in record ''%s'' of type ''%s''', [aname, typeName, id]));
279 if (result.baseType <> atype) then raise Exception.Create(Format('field ''%s'' in record ''%s'' of type ''%s'' has invalid data type', [aname, typeName, id]));
280 end;
283 function TDynRecordHelper.getPointField (const aname: AnsiString): TDFPoint; inline;
284 var
285 fld: TDynField;
286 begin
287 fld := field[aname];
288 if (fld = nil) then raise Exception.Create(Format('field ''%s'' not found in record ''%s'' of type ''%s''', [aname, typeName, id]));
289 if (fld.baseType <> fld.TType.TPoint) then raise Exception.Create(Format('field ''%s'' in record ''%s'' of type ''%s'' has invalid data type', [aname, typeName, id]));
290 result := TDFPoint.Create(fld.ival, fld.ival2);
291 end;
294 function TDynRecordHelper.getSizeField (const aname: AnsiString): TDFSize; inline;
295 var
296 fld: TDynField;
297 begin
298 fld := field[aname];
299 if (fld = nil) then raise Exception.Create(Format('field ''%s'' not found in record ''%s'' of type ''%s''', [aname, typeName, id]));
300 if (fld.baseType <> fld.TType.TSize) and (fld.baseType <> fld.TType.TPoint) then raise Exception.Create(Format('field ''%s'' in record ''%s'' of type ''%s'' has invalid data type', [aname, typeName, id]));
301 result := TDFSize.Create(fld.ival, fld.ival2);
302 end;
305 function TDynRecordHelper.getPanelByIdx (idx: Integer): TDynRecord; inline;
306 var
307 fld: TDynField;
308 begin
309 fld := headerRec['panel'];
310 if (fld <> nil) then result := fld.itemAt[idx] else result := nil;
311 end;
314 function TDynRecordHelper.getPanelIndex (pan: TDynRecord): Integer;
315 var
316 fld: TDynField;
317 f: Integer;
318 begin
319 result := -1;
320 if (pan <> nil) then
321 begin
322 fld := headerRec['panel'];
323 if (fld <> nil) then
324 begin
325 for f := 0 to fld.count-1 do if (fld.itemAt[f] = pan) then begin result := f; exit; end;
326 end;
327 end;
328 end;
331 function TDynRecordHelper.panelCount (): Integer; inline;
332 var
333 fld: TDynField;
334 begin
335 fld := headerRec['panel'];
336 if (fld <> nil) then result := fld.count else result := 0;
337 end;
340 function TDynRecordHelper.TextureNum (): Word; inline;
341 var
342 idx: Integer;
343 fld: TDynField;
344 begin
345 fld := getFieldWithType('texture', TDynField.TType.TUShort);
346 idx := fld.recrefIndex;
347 if (idx < 0) then result := Word(TEXTURE_NONE) else result := Word(idx);
348 end;
351 // ////////////////////////////////////////////////////////////////////////// //
352 // trigger
353 function TDynRecordHelper.trigRec (): TDynRecord; {inline;}
354 var
355 fld: TDynField;
356 begin
357 fld := getFieldWithType('triggerdata', TDynField.TType.TTrigData);
358 if (fld <> nil) then result := fld.recref else result := nil;
359 end;
361 function TDynRecordHelper.trigMonsterId (): Integer; inline;
362 var
363 fld: TDynField;
364 begin
365 result := -1;
366 fld := field['monsterid'];
367 if (fld = nil) then exit;
368 if (fld.baseType <> TDynField.TType.TInt) then exit;
369 if (fld.recref = nil) then exit;
370 result := fld.recrefIndex;
371 end;
373 function TDynRecordHelper.trigPanelRec (): TDynRecord; inline;
374 var
375 fld: TDynField;
376 begin
377 result := nil;
378 fld := field['panelid'];
379 if (fld = nil) then exit;
380 if (fld.baseType <> TDynField.TType.TInt) then exit;
381 result := fld.recref;
382 if (result <> nil) and (result.typeName <> 'panel') then result := nil;
383 end;
385 // panel index in list
386 function TDynRecordHelper.trigPanelId (): Integer; inline;
387 var
388 fld: TDynField;
389 begin
390 result := -1;
391 fld := field['panelid'];
392 if (fld = nil) then exit;
393 if (fld.baseType <> TDynField.TType.TInt) then exit;
394 if (fld.recref = nil) then exit;
395 if (fld.recref.typeName <> 'panel') then exit;
396 result := fld.recrefIndex;
397 end;
399 function TDynRecordHelper.getTexturePanelRec (): TDynRecord;
400 var
401 fld: TDynField;
402 begin
403 result := nil;
404 fld := field['texture_panel'];
405 if (fld = nil) then exit;
406 if (fld.baseType <> TDynField.TType.TInt) then exit;
407 result := fld.recref;
408 if (result <> nil) and (result.typeName <> 'panel') then result := nil;
409 end;
411 function TDynRecordHelper.getTexturePanel (): Integer;
412 var
413 fld: TDynField;
414 begin
415 result := -1;
416 fld := field['texture_panel'];
417 if (fld = nil) then exit;
418 if (fld.baseType <> TDynField.TType.TInt) then exit;
419 if (fld.recref = nil) then exit;
420 if (fld.recref.typeName <> 'panel') then exit;
421 result := fld.recrefIndex;
422 end;
425 // ////////////////////////////////////////////////////////////////////////// //
426 function TDynRecordHelper.mapName (): AnsiString; inline; begin result := utf2win(getFieldWithType('name', TDynField.TType.TChar).sval); end;
427 function TDynRecordHelper.mapAuthor (): AnsiString; inline; begin result := utf2win(getFieldWithType('author', TDynField.TType.TChar).sval); end;
428 function TDynRecordHelper.mapDesc (): AnsiString; inline; begin result := utf2win(getFieldWithType('description', TDynField.TType.TChar).sval); end;
429 function TDynRecordHelper.musicName (): AnsiString; inline; begin result := utf2win(getFieldWithType('music', TDynField.TType.TChar).sval); end;
430 function TDynRecordHelper.skyName (): AnsiString; inline; begin result := utf2win(getFieldWithType('sky', TDynField.TType.TChar).sval); end;
431 function TDynRecordHelper.X (): Integer; inline; begin result := getFieldWithType('position', TDynField.TType.TPoint).ival; end;
432 function TDynRecordHelper.Y (): Integer; inline; begin result := getFieldWithType('position', TDynField.TType.TPoint).ival2; end;
433 function TDynRecordHelper.Width (): Word; inline; begin result := Word(getFieldWithType('size', TDynField.TType.TSize).ival); end;
434 function TDynRecordHelper.Height (): Word; inline; begin result := Word(getFieldWithType('size', TDynField.TType.TSize).ival2); end;
435 function TDynRecordHelper.PanelType (): Word; inline; begin result := Word(getFieldWithType('type', TDynField.TType.TUShort).ival); end;
436 function TDynRecordHelper.TextureRec (): TDynRecord; inline; begin result := getFieldWithType('texture', TDynField.TType.TUShort).recref; end;
437 function TDynRecordHelper.Alpha (): Byte; inline; begin result := Byte(getFieldWithType('alpha', TDynField.TType.TUByte).ival); end;
438 function TDynRecordHelper.Flags (): Byte; inline; begin result := Byte(getFieldWithType('flags', TDynField.TType.TUByte).ival); end;
439 function TDynRecordHelper.Resource (): AnsiString; inline; begin result := utf2win(getFieldWithType('path', TDynField.TType.TChar).sval); end;
440 function TDynRecordHelper.Anim (): Boolean; inline; begin result := (getFieldWithType('animated', TDynField.TType.TBool).ival <> 0); end;
441 function TDynRecordHelper.ItemType (): Byte; inline; begin result := Byte(getFieldWithType('type', TDynField.TType.TUByte).ival); end;
442 function TDynRecordHelper.Options (): Byte; inline; begin result := Byte(getFieldWithType('options', TDynField.TType.TUByte).ival); end;
443 function TDynRecordHelper.MonsterType (): Byte; inline; begin result := Byte(getFieldWithType('type', TDynField.TType.TUByte).ival); end;
444 function TDynRecordHelper.Direction (): Byte; inline; begin result := Byte(getFieldWithType('direction', TDynField.TType.TUByte).ival); end;
445 function TDynRecordHelper.AreaType (): Byte; inline; begin result := Byte(getFieldWithType('type', TDynField.TType.TUByte).ival); end;
446 function TDynRecordHelper.Enabled (): Boolean; inline; begin result := (getFieldWithType('enabled', TDynField.TType.TBool).ival <> 0); end;
447 function TDynRecordHelper.TriggerType (): Byte; inline; begin result := Byte(getFieldWithType('type', TDynField.TType.TUByte).ival); end;
448 function TDynRecordHelper.ActivateType (): Byte; inline; begin result := Byte(getFieldWithType('activate_type', TDynField.TType.TUByte).ival); end;
449 function TDynRecordHelper.Keys (): Byte; inline; begin result := Byte(getFieldWithType('keys', TDynField.TType.TUByte).ival); end;
451 {$INCLUDE mapdef_impl.inc}
454 end.