DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Added support OpenGL ES 1.1 through nanoGL (have some bugs) and fix build for ARM
[d2df-sdl.git] / src / game / g_playermodel.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 {$INCLUDE ../shared/a_modes.inc}
17 {$M+}
18 unit g_playermodel;
19
20 interface
21
22 uses
23 {$IFDEF USE_MEMPOOL}mempool,{$ENDIF}
24 MAPDEF, g_textures, g_basic, g_weapons, e_graphics, utils;
25
26 const
27 A_STAND = 0;
28 A_WALK = 1;
29 A_DIE1 = 2;
30 A_DIE2 = 3;
31 A_ATTACK = 4;
32 A_SEEUP = 5;
33 A_SEEDOWN = 6;
34 A_ATTACKUP = 7;
35 A_ATTACKDOWN = 8;
36 A_PAIN = 9;
37 // EXTENDED
38 A_WALKATTACK = 10;
39 A_WALKSEEUP = 11;
40 A_WALKSEEDOWN = 12;
41 A_WALKATTACKUP = 13;
42 A_WALKATTACKDOWN = 14;
43 A_FISTSTAND = 15;
44 A_FISTWALK = 16;
45 A_FISTATTACK = 17;
46 A_FISTWALKATTACK = 18;
47 A_FISTSEEUP = 19;
48 A_FISTSEEDOWN = 20;
49 A_FISTATTACKUP = 21;
50 A_FISTATTACKDOWN = 22;
51
52 A_LASTBASE = A_PAIN;
53 A_LASTEXT = A_FISTATTACKDOWN;
54 A_LAST = A_LASTEXT;
55
56 MODELSOUND_PAIN = 0;
57 MODELSOUND_DIE = 1;
58
59 type
60 TModelInfo = record
61 Name: String;
62 Author: String;
63 Description: String;
64 HaveWeapon: Boolean;
65 end;
66
67 TModelSound = record
68 ID: DWORD;
69 Level: Byte;
70 end;
71
72 TGibSprite = record
73 ID: DWORD;
74 MaskID: DWORD;
75 Rect: TRectWH;
76 OnlyOne: Boolean;
77 end;
78
79 TModelSoundArray = Array of TModelSound;
80 TGibsArray = Array of TGibSprite;
81 TWeaponPoints = Array [WP_FIRST + 1..WP_LAST] of
82 Array [A_STAND..A_LAST] of
83 Array [TDirection.D_LEFT..TDirection.D_RIGHT] of Array of TDFPoint;
84
85 TPlayerModel = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
86 private
87 FName: String;
88 FDirection: TDirection;
89 FColor: TRGB;
90 FCurrentAnimation: Byte;
91 FAnim: Array [TDirection.D_LEFT..TDirection.D_RIGHT] of Array [A_STAND..A_LAST] of TAnimation;
92 FMaskAnim: Array [TDirection.D_LEFT..TDirection.D_RIGHT] of Array [A_STAND..A_LAST] of TAnimation;
93 FWeaponPoints: TWeaponPoints;
94 FPainSounds: TModelSoundArray;
95 FDieSounds: TModelSoundArray;
96 FSlopSound: Byte;
97 FCurrentWeapon: Byte;
98 FDrawWeapon: Boolean;
99 FFlag: Byte;
100 FFlagPoint: TDFPoint;
101 FFlagAngle: SmallInt;
102 FFlagAnim: TAnimation;
103 FFire: Boolean;
104 FFireCounter: Byte;
105
106 public
107 destructor Destroy(); override;
108 procedure ChangeAnimation(Animation: Byte; Force: Boolean = False);
109 function GetCurrentAnimation: TAnimation;
110 function GetCurrentAnimationMask: TAnimation;
111 procedure SetColor(Red, Green, Blue: Byte);
112 procedure SetWeapon(Weapon: Byte);
113 procedure SetFlag(Flag: Byte);
114 procedure SetFire(Fire: Boolean);
115 function PlaySound(SoundType, Level: Byte; X, Y: Integer): Boolean;
116 procedure Update();
117 procedure Draw(X, Y: Integer; Alpha: Byte = 0);
118
119 published
120 property Fire: Boolean read FFire;
121 property Direction: TDirection read FDirection write FDirection;
122 property Animation: Byte read FCurrentAnimation;
123 property Weapon: Byte read FCurrentWeapon;
124 property Name: String read FName;
125
126 public
127 property Color: TRGB read FColor write FColor;
128 end;
129
130 procedure g_PlayerModel_LoadData();
131 procedure g_PlayerModel_FreeData();
132 function g_PlayerModel_Load(FileName: String): Boolean;
133 function g_PlayerModel_GetNames(): SSArray;
134 function g_PlayerModel_GetInfo(ModelName: String): TModelInfo;
135 function g_PlayerModel_Get(ModelName: String): TPlayerModel;
136 function g_PlayerModel_GetAnim(ModelName: String; Anim: Byte; var _Anim, _Mask: TAnimation): Boolean;
137 function g_PlayerModel_GetGibs(ModelName: String; var Gibs: TGibsArray): Boolean;
138
139
140 implementation
141
142 uses
143 {$IFDEF USE_NANOGL}
144 nanoGL,
145 {$ELSE}
146 GL, GLExt,
147 {$ENDIF}
148 g_main, g_sound, g_console, SysUtils, g_player, CONFIG,
149 e_sound, g_options, g_map, Math, e_log, wadreader;
150
151 type
152 TPlayerModelInfo = record
153 Info: TModelInfo;
154 ModelSpeed: Array [A_STAND..A_PAIN] of Byte;
155 FlagPoint: TDFPoint;
156 FlagAngle: SmallInt;
157 WeaponPoints: TWeaponPoints;
158 Gibs: TGibsArray;
159 PainSounds: TModelSoundArray;
160 DieSounds: TModelSoundArray;
161 SlopSound: Byte;
162 end;
163
164 const
165 W_POS_NORMAL = 0;
166 W_POS_UP = 1;
167 W_POS_DOWN = 2;
168
169 W_ACT_NORMAL = 0;
170 W_ACT_FIRE = 1;
171
172 FLAG_BASEPOINT: TDFPoint = (X:16; Y:43);
173 FLAG_DEFPOINT: TDFPoint = (X:32; Y:16);
174 FLAG_DEFANGLE = -20;
175 WEAPONBASE: Array [WP_FIRST + 1..WP_LAST] of TDFPoint =
176 ((X:8; Y:4), (X:8; Y:8), (X:16; Y:16), (X:16; Y:24),
177 (X:16; Y:16), (X:24; Y:24), (X:16; Y:16), (X:24; Y:24),
178 (X:16; Y:16), (X:8; Y:8));
179
180 AnimNames: Array [A_STAND..A_LASTEXT] of String =
181 ('StandAnim','WalkAnim','Die1Anim','Die2Anim','AttackAnim',
182 'SeeUpAnim','SeeDownAnim','AttackUpAnim','AttackDownAnim','PainAnim',
183 // EXTENDED
184 'WalkAttackAnim', 'WalkSeeUpAnim', 'WalkSeeDownAnim',
185 'WalkAttackUpAnim', 'WalkAttackDownAnim', 'FistStandAnim', 'FistWalkAnim',
186 'FistAttackAnim', 'FistWalkAttackAnim', 'FistSeeUpAnim', 'FistSeeDownAnim',
187 'FistAttackUpAnim', 'FistAttackDownAnim');
188 WeapNames: Array [WP_FIRST + 1..WP_LAST] of String =
189 ('csaw', 'hgun', 'sg', 'ssg', 'mgun', 'rkt', 'plz', 'bfg', 'spl', 'flm');
190
191 var
192 WeaponID: Array [WP_FIRST + 1..WP_LAST] of
193 Array [W_POS_NORMAL..W_POS_DOWN] of
194 Array [W_ACT_NORMAL..W_ACT_FIRE] of DWORD;
195 PlayerModelsArray: Array of TPlayerModelInfo;
196
197 procedure g_PlayerModel_LoadData();
198 var
199 a: Integer;
200 begin
201 for a := WP_FIRST + 1 to WP_LAST do
202 begin
203 g_Texture_CreateWAD(WeaponID[a][W_POS_NORMAL][W_ACT_NORMAL], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a]));
204 g_Texture_CreateWAD(WeaponID[a][W_POS_NORMAL][W_ACT_FIRE], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_FIRE');
205 g_Texture_CreateWAD(WeaponID[a][W_POS_UP][W_ACT_NORMAL], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_UP');
206 g_Texture_CreateWAD(WeaponID[a][W_POS_UP][W_ACT_FIRE], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_UP_FIRE');
207 g_Texture_CreateWAD(WeaponID[a][W_POS_DOWN][W_ACT_NORMAL], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_DN');
208 g_Texture_CreateWAD(WeaponID[a][W_POS_DOWN][W_ACT_FIRE], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_DN_FIRE');
209 end;
210 end;
211
212 function GetPoint(var str: String; var point: TDFPoint): Boolean;
213 var
214 a, x, y: Integer;
215 s: String;
216 begin
217 Result := False;
218 x := 0;
219 y := 0;
220
221 str := Trim(str);
222 if Length(str) < 3 then
223 Exit;
224
225 for a := 1 to Length(str) do
226 if (str[a] = ',') or (a = Length(str)) then
227 begin
228 s := Copy(str, 1, a);
229 if s[Length(s)] = ',' then
230 SetLength(s, Length(s)-1);
231 Delete(str, 1, a);
232
233 if (Sscanf(s, '%d:%d', [@x, @y]) < 2) or
234 (x < -64) or (x > 128) or
235 (y < -64) or (y > 128) then
236 Exit;
237
238 point.X := x;
239 point.Y := y;
240
241 Break;
242 end;
243
244 Result := True;
245 end;
246
247 function GetWeapPoints(str: String; weapon: Byte; anim: Byte; dir: TDirection;
248 frames: Word; backanim: Boolean; var wpoints: TWeaponPoints): Boolean;
249 var
250 a, b, h: Integer;
251 begin
252 Result := False;
253
254 if frames = 0 then
255 Exit;
256
257 backanim := backanim and (frames > 2);
258
259 for a := 1 to frames do
260 begin
261 if not GetPoint(str, wpoints[weapon, anim, dir, a-1]) then
262 Exit;
263
264 with wpoints[weapon, anim, dir, a-1] do
265 begin
266 X := X - WEAPONBASE[weapon].X;
267 Y := Y - WEAPONBASE[weapon].Y;
268 if dir = TDirection.D_LEFT then
269 X := -X;
270 end;
271 end;
272
273 h := High(wpoints[weapon, anim, dir]);
274 if backanim then
275 for b := h downto frames do
276 wpoints[weapon, anim, dir, b] := wpoints[weapon, anim, dir, h-b+1];
277
278 Result := True;
279 end;
280
281 procedure ExtAnimFromBaseAnim(MName: String; AIdx: Integer);
282 const
283 CopyAnim: array [A_LASTBASE+1..A_LASTEXT] of Integer = (
284 A_WALK, A_WALK, A_WALK, A_WALK, A_WALK,
285 A_STAND, A_WALK, A_ATTACK, A_WALK, A_SEEUP, A_SEEDOWN,
286 A_ATTACKUP, A_ATTACKDOWN
287 );
288 var
289 OIdx, W, I: Integer;
290 D: TDirection;
291 AName, OName: String;
292 begin
293 // HACK: shitty workaround to duplicate base animations
294 // in place of extended, replace with something better later
295
296 Assert((AIdx > A_LASTBASE) and (AIdx <= A_LASTEXT));
297 OIdx := CopyAnim[AIdx];
298
299 AName := MName + '_RIGHTANIM' + IntToStr(AIdx);
300 OName := MName + '_RIGHTANIM' + IntToStr(OIdx);
301 Assert(g_Frames_Dup(AName, OName));
302 Assert(g_Frames_Dup(AName + '_MASK', OName + '_MASK'));
303 AName := MName + '_LEFTANIM' + IntToStr(AIdx);
304 OName := MName + '_LEFTANIM' + IntToStr(OIdx);
305 if g_Frames_Exists(AName) then
306 begin
307 g_Frames_Dup(AName, OName);
308 g_Frames_Dup(AName + '_MASK', OName + '_MASK');
309 end;
310
311 with PlayerModelsArray[High(PlayerModelsArray)] do
312 begin
313 for W := WP_FIRST + 1 to WP_LAST do
314 begin
315 for D := TDirection.D_LEFT to TDirection.D_RIGHT do
316 begin
317 SetLength(WeaponPoints[W, AIdx, D], Length(WeaponPoints[W, OIdx, D]));
318 for I := 0 to High(WeaponPoints[W, AIdx, D]) do
319 WeaponPoints[W, AIdx, D, I] := WeaponPoints[W, OIdx, D, I]
320 end;
321 end;
322 end;
323 end;
324
325 function g_PlayerModel_Load(FileName: string): Boolean;
326 var
327 ID: DWORD;
328 a, b, len, lenpd, lenpd2, aa, bb, f: Integer;
329 cc: TDirection;
330 config: TConfig;
331 pData, pData2: Pointer;
332 WAD: TWADFile;
333 s, aname: string;
334 prefix: string;
335 ok, chk: Boolean;
336 begin
337 e_WriteLog(Format('Loading player model: %s', [ExtractFileName(FileName)]), TMsgType.Notify);
338
339 Result := False;
340
341 WAD := TWADFile.Create;
342 WAD.ReadFile(FileName);
343
344 if {WAD.GetLastError <> DFWAD_NOERROR} not WAD.isOpen then
345 begin
346 WAD.Free();
347 Exit;
348 end;
349
350 if not WAD.GetResource('TEXT/MODEL', pData, len) then
351 begin
352 WAD.Free();
353 Exit;
354 end;
355
356 config := TConfig.CreateMem(pData, len);
357 FreeMem(pData);
358
359 s := config.ReadStr('Model', 'name', '');
360 if s = '' then
361 begin
362 config.Free();
363 WAD.Free();
364 Exit;
365 end;
366
367 SetLength(PlayerModelsArray, Length(PlayerModelsArray)+1);
368 ID := High(PlayerModelsArray);
369
370 prefix := FileName+':TEXTURES\';
371
372 with PlayerModelsArray[ID].Info do
373 begin
374 Name := s;
375 Author := config.ReadStr('Model', 'author', '');
376 Description := config.ReadStr('Model', 'description', '');
377 end;
378
379 for b := A_STAND to A_LAST do
380 begin
381 aname := s+'_RIGHTANIM'+IntToStr(b);
382 //e_LogWritefln('### MODEL FILE: [%s]', [prefix+config.ReadStr(AnimNames[b], 'resource', '')]);
383 if not (g_Frames_CreateWAD(nil, aname,
384 prefix+config.ReadStr(AnimNames[b], 'resource', ''),
385 64, 64, config.ReadInt(AnimNames[b], 'frames', 1),
386 config.ReadBool(AnimNames[b], 'backanim', False)) and
387 g_Frames_CreateWAD(nil, aname+'_MASK',
388 prefix+config.ReadStr(AnimNames[b], 'mask', ''),
389 64, 64, config.ReadInt(AnimNames[b], 'frames', 1),
390 config.ReadBool(AnimNames[b], 'backanim', False))) then
391 begin
392 if b <= A_LASTBASE then
393 begin
394 config.Free();
395 WAD.Free();
396 Exit;
397 end
398 else
399 begin
400 ExtAnimFromBaseAnim(s, b);
401 continue;
402 end;
403 end;
404
405 for aa := WP_FIRST + 1 to WP_LAST do
406 for bb := A_STAND to A_LAST do
407 for cc := TDirection.D_LEFT to TDirection.D_RIGHT do
408 begin
409 f := config.ReadInt(AnimNames[bb], 'frames', 1);
410 if config.ReadBool(AnimNames[bb], 'backanim', False) then
411 if f > 2 then f := 2*f-2;
412 SetLength(PlayerModelsArray[ID].WeaponPoints[aa, bb, cc], f);
413 end;
414
415 if (config.ReadStr(AnimNames[b], 'resource2', '') <> '') and
416 (config.ReadStr(AnimNames[b], 'mask2', '') <> '') then
417 begin
418 aname := s+'_LEFTANIM'+IntToStr(b);
419 g_Frames_CreateWAD(nil, aname,
420 prefix+config.ReadStr(AnimNames[b], 'resource2', ''),
421 64, 64, config.ReadInt(AnimNames[b], 'frames', 1),
422 config.ReadBool(AnimNames[b], 'backanim', False));
423
424 g_Frames_CreateWAD(nil, aname+'_MASK',
425 prefix+config.ReadStr(AnimNames[b], 'mask2', ''),
426 64, 64, config.ReadInt(AnimNames[b], 'frames', 1),
427 config.ReadBool(AnimNames[b], 'backanim', False));
428 end;
429
430 PlayerModelsArray[ID].ModelSpeed[b] := Max(1, config.ReadInt(AnimNames[b], 'waitcount', 1) div 3);
431 end;
432
433 with PlayerModelsArray[ID], config do
434 begin
435 prefix := FileName+':SOUNDS\';
436
437 a := 1;
438 repeat
439 s := config.ReadStr('Sound', 'pain'+IntToStr(a), '');
440 if s <> '' then
441 begin
442 SetLength(PainSounds, Length(PainSounds)+1);
443 g_Sound_CreateWAD(PainSounds[High(PainSounds)].ID, prefix+s);
444 PainSounds[High(PainSounds)].Level := config.ReadInt('Sound', 'painlevel'+IntToStr(a), 1);
445 end;
446 a := a+1;
447 until s = '';
448
449 a := 1;
450 repeat
451 s := config.ReadStr('Sound', 'die'+IntToStr(a), '');
452 if s <> '' then
453 begin
454 SetLength(DieSounds, Length(DieSounds)+1);
455 g_Sound_CreateWAD(DieSounds[High(DieSounds)].ID, prefix+s);
456 DieSounds[High(DieSounds)].Level := config.ReadInt('Sound', 'dielevel'+IntToStr(a), 1);
457 end;
458 a := a+1;
459 until s = '';
460
461 SlopSound := Min(Max(config.ReadInt('Sound', 'slop', 0), 0), 2);
462
463 SetLength(Gibs, ReadInt('Gibs', 'count', 0));
464
465 if (Gibs <> nil) and
466 (WAD.GetResource('TEXTURES/'+config.ReadStr('Gibs', 'resource', 'GIBS'), pData, lenpd)) and
467 (WAD.GetResource('TEXTURES/'+config.ReadStr('Gibs', 'mask', 'GIBSMASK'), pData2, lenpd2)) then
468 begin
469 for a := 0 to High(Gibs) do
470 if e_CreateTextureMemEx(pData, lenpd, Gibs[a].ID, a*32, 0, 32, 32) and
471 e_CreateTextureMemEx(pData2, lenpd2, Gibs[a].MaskID, a*32, 0, 32, 32) then
472 begin
473 Gibs[a].Rect := e_GetTextureSize2(Gibs[a].ID);
474 with Gibs[a].Rect do
475 if Height > 3 then Height := Height-1-Random(2);
476 Gibs[a].OnlyOne := config.ReadInt('Gibs', 'once', -1) = a+1;
477 end;
478
479 FreeMem(pData);
480 FreeMem(pData2);
481 end;
482
483 ok := True;
484 for aa := WP_FIRST + 1 to WP_LAST do
485 for bb := A_STAND to A_LAST do
486 if not (bb in [A_DIE1, A_DIE2, A_PAIN]) then
487 begin
488 chk := GetWeapPoints(config.ReadStr(AnimNames[bb], WeapNames[aa]+'_points', ''), aa, bb, TDirection.D_RIGHT,
489 config.ReadInt(AnimNames[bb], 'frames', 0),
490 config.ReadBool(AnimNames[bb], 'backanim', False),
491 WeaponPoints);
492 if ok and (not chk) and (aa = WEAPON_FLAMETHROWER) then
493 begin
494 // workaround for flamethrower
495 chk := GetWeapPoints(config.ReadStr(AnimNames[bb], WeapNames[WEAPON_PLASMA]+'_points', ''), aa, bb, TDirection.D_RIGHT,
496 config.ReadInt(AnimNames[bb], 'frames', 0),
497 config.ReadBool(AnimNames[bb], 'backanim', False),
498 WeaponPoints);
499 if chk then
500 for f := 0 to High(WeaponPoints[aa, bb, TDirection.D_RIGHT]) do
501 begin
502 case bb of
503 A_STAND, A_PAIN:
504 begin
505 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 6);
506 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 8);
507 end;
508 A_WALKATTACK, A_WALK:
509 begin
510 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 9);
511 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 9);
512 end;
513 A_ATTACK:
514 begin
515 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 5);
516 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 8);
517 end;
518 A_WALKSEEUP, A_SEEUP:
519 begin
520 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 5);
521 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 16);
522 end;
523 A_WALKSEEDOWN, A_SEEDOWN:
524 begin
525 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 6);
526 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 5);
527 end;
528 A_WALKATTACKUP, A_ATTACKUP:
529 begin
530 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 5);
531 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 16);
532 end;
533 A_WALKATTACKDOWN, A_ATTACKDOWN:
534 begin
535 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 6);
536 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 4);
537 end;
538 end;
539 end;
540 end;
541 ok := ok and (chk or (bb > A_LASTBASE));
542
543 if not GetWeapPoints(config.ReadStr(AnimNames[bb], WeapNames[aa]+'2_points', ''), aa, bb, TDirection.D_LEFT,
544 config.ReadInt(AnimNames[bb], 'frames', 0),
545 config.ReadBool(AnimNames[bb], 'backanim', False),
546 WeaponPoints) then
547 for f := 0 to High(WeaponPoints[aa, bb, TDirection.D_RIGHT]) do
548 begin
549 WeaponPoints[aa, bb, TDirection.D_LEFT, f].X := -WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X;
550 WeaponPoints[aa, bb, TDirection.D_LEFT, f].Y := WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y;
551 end;
552
553 if not ok then Break;
554 end;
555 {if ok then g_Console_Add(Info.Name+' weapon points ok')
556 else g_Console_Add(Info.Name+' weapon points fail');}
557 Info.HaveWeapon := ok;
558
559 s := config.ReadStr('Model', 'flag_point', '');
560 if not GetPoint(s, FlagPoint) then FlagPoint := FLAG_DEFPOINT;
561
562 FlagAngle := config.ReadInt('Model', 'flag_angle', FLAG_DEFANGLE);
563 end;
564
565 config.Free();
566 WAD.Free();
567
568 Result := True;
569 end;
570
571 function g_PlayerModel_Get(ModelName: String): TPlayerModel;
572 var
573 a: Integer;
574 b: Byte;
575 ID, ID2: DWORD;
576 begin
577 Result := nil;
578
579 if PlayerModelsArray = nil then Exit;
580
581 for a := 0 to High(PlayerModelsArray) do
582 if AnsiLowerCase(PlayerModelsArray[a].Info.Name) = AnsiLowerCase(ModelName) then
583 begin
584 Result := TPlayerModel.Create;
585
586 with PlayerModelsArray[a] do
587 begin
588 Result.FName := Info.Name;
589
590 for b := A_STAND to A_LAST do
591 begin
592 if not (g_Frames_Get(ID, Info.Name+'_RIGHTANIM'+IntToStr(b)) and
593 g_Frames_Get(ID2, Info.Name+'_RIGHTANIM'+IntToStr(b)+'_MASK')) then
594 begin
595 Result.Free();
596 Result := nil;
597 Exit;
598 end;
599
600 Result.FAnim[TDirection.D_RIGHT][b] := TAnimation.Create(ID, b in [A_STAND, A_WALK], ModelSpeed[b]);
601
602 Result.FMaskAnim[TDirection.D_RIGHT][b] := TAnimation.Create(ID2, b in [A_STAND, A_WALK], ModelSpeed[b]);
603
604 if g_Frames_Exists(Info.Name+'_LEFTANIM'+IntToStr(b)) and
605 g_Frames_Exists(Info.Name+'_LEFTANIM'+IntToStr(b)+'_MASK') then
606 if g_Frames_Get(ID, Info.Name+'_LEFTANIM'+IntToStr(b)) and
607 g_Frames_Get(ID2, Info.Name+'_LEFTANIM'+IntToStr(b)+'_MASK') then
608 begin
609 Result.FAnim[TDirection.D_LEFT][b] := TAnimation.Create(ID, b in [A_STAND, A_WALK], ModelSpeed[b]);
610
611 Result.FMaskAnim[TDirection.D_LEFT][b] := TAnimation.Create(ID2, b in [A_STAND, A_WALK], ModelSpeed[b]);
612 end;
613 end;
614
615 Result.FPainSounds := PainSounds;
616 Result.FDieSounds := DieSounds;
617 Result.FSlopSound := SlopSound;
618 Result.FDrawWeapon := Info.HaveWeapon;
619 Result.FWeaponPoints := WeaponPoints;
620
621 Result.FFlagPoint := FlagPoint;
622 Result.FFlagAngle := FlagAngle;
623
624 Break;
625 end;
626 end;
627 end;
628
629 function g_PlayerModel_GetAnim(ModelName: string; Anim: Byte; var _Anim, _Mask: TAnimation): Boolean;
630 var
631 a: Integer;
632 c: Boolean;
633 ID: DWORD;
634 begin
635 Result := False;
636
637 if PlayerModelsArray = nil then Exit;
638 for a := 0 to High(PlayerModelsArray) do
639 if PlayerModelsArray[a].Info.Name = ModelName then
640 with PlayerModelsArray[a] do
641 begin
642 if Anim in [A_STAND, A_WALK] then c := True else c := False;
643
644 if not g_Frames_Get(ID, Info.Name+'_RIGHTANIM'+IntToStr(Anim)) then
645 if not g_Frames_Get(ID, Info.Name+'_LEFTANIM'+IntToStr(Anim)) then Exit;
646
647 _Anim := TAnimation.Create(ID, c, ModelSpeed[Anim]);
648 _Anim.Speed := ModelSpeed[Anim];
649
650 if not g_Frames_Get(ID, Info.Name+'_RIGHTANIM'+IntToStr(Anim)+'_MASK') then
651 if not g_Frames_Get(ID, Info.Name+'_LEFTANIM'+IntToStr(Anim)+'_MASK') then Exit;
652
653 _Mask := TAnimation.Create(ID, c, ModelSpeed[Anim]);
654 _Mask.Speed := ModelSpeed[Anim];
655
656 Break;
657 end;
658
659 Result := True;
660 end;
661
662 function g_PlayerModel_GetGibs(ModelName: string; var Gibs: TGibsArray): Boolean;
663 var
664 a, i, b: Integer;
665 c: Boolean;
666 begin
667 Result := False;
668
669 if PlayerModelsArray = nil then Exit;
670 if gGibsCount = 0 then Exit;
671
672 c := False;
673
674 SetLength(Gibs, gGibsCount);
675
676 for a := 0 to High(PlayerModelsArray) do
677 if PlayerModelsArray[a].Info.Name = ModelName then
678 begin
679 for i := 0 to High(Gibs) do
680 begin
681 if c and (Length(PlayerModelsArray[a].Gibs) = 1) then
682 begin
683 SetLength(Gibs, i);
684 Break;
685 end;
686
687 repeat
688 b := Random(Length(PlayerModelsArray[a].Gibs));
689 until not (PlayerModelsArray[a].Gibs[b].OnlyOne and c);
690
691 Gibs[i] := PlayerModelsArray[a].Gibs[b];
692
693 if Gibs[i].OnlyOne then c := True;
694 end;
695
696 Result := True;
697 Break;
698 end;
699 end;
700
701 function g_PlayerModel_GetNames(): SSArray;
702 var
703 i: DWORD;
704 begin
705 Result := nil;
706
707 if PlayerModelsArray = nil then Exit;
708
709 for i := 0 to High(PlayerModelsArray) do
710 begin
711 SetLength(Result, Length(Result)+1);
712 Result[High(Result)] := PlayerModelsArray[i].Info.Name;
713 end;
714 end;
715
716 function g_PlayerModel_GetInfo(ModelName: string): TModelInfo;
717 var
718 a: Integer;
719 begin
720 FillChar(Result, SizeOf(Result), 0);
721 if PlayerModelsArray = nil then Exit;
722
723 for a := 0 to High(PlayerModelsArray) do
724 if PlayerModelsArray[a].Info.Name = ModelName then
725 begin
726 Result := PlayerModelsArray[a].Info;
727 Break;
728 end;
729 end;
730
731 procedure g_PlayerModel_FreeData();
732 var
733 i: DWORD;
734 a, b, c: Integer;
735 begin
736 for a := WP_FIRST + 1 to WP_LAST do
737 for b := W_POS_NORMAL to W_POS_DOWN do
738 for c := W_ACT_NORMAL to W_ACT_FIRE do
739 e_DeleteTexture(WeaponID[a][b][c]);
740
741 e_WriteLog('Releasing models...', TMsgType.Notify);
742
743 if PlayerModelsArray = nil then Exit;
744
745 for i := 0 to High(PlayerModelsArray) do
746 with PlayerModelsArray[i] do
747 begin
748 for a := A_STAND to A_LAST do
749 begin
750 g_Frames_DeleteByName(Info.Name+'_LEFTANIM'+IntToStr(a));
751 g_Frames_DeleteByName(Info.Name+'_LEFTANIM'+IntToStr(a)+'_MASK');
752 g_Frames_DeleteByName(Info.Name+'_RIGHTANIM'+IntToStr(a));
753 g_Frames_DeleteByName(Info.Name+'_RIGHTANIM'+IntToStr(a)+'_MASK');
754 end;
755
756 if PainSounds <> nil then
757 for b := 0 to High(PainSounds) do
758 e_DeleteSound(PainSounds[b].ID);
759
760 if DieSounds <> nil then
761 for b := 0 to High(DieSounds) do
762 e_DeleteSound(DieSounds[b].ID);
763
764 if Gibs <> nil then
765 for b := 0 to High(Gibs) do
766 begin
767 e_DeleteTexture(Gibs[b].ID);
768 e_DeleteTexture(Gibs[b].MaskID);
769 end;
770 end;
771
772 PlayerModelsArray := nil;
773 end;
774
775 { TPlayerModel }
776
777 procedure TPlayerModel.ChangeAnimation(Animation: Byte; Force: Boolean = False);
778 begin
779 if not Force then if FCurrentAnimation = Animation then Exit;
780
781 FCurrentAnimation := Animation;
782
783 if (FDirection = TDirection.D_LEFT) and
784 (FAnim[TDirection.D_LEFT][FCurrentAnimation] <> nil) and
785 (FMaskAnim[TDirection.D_LEFT][FCurrentAnimation] <> nil) then
786 begin
787 FAnim[TDirection.D_LEFT][FCurrentAnimation].Reset;
788 FMaskAnim[TDirection.D_LEFT][FCurrentAnimation].Reset;
789 end
790 else
791 begin
792 FAnim[TDirection.D_RIGHT][FCurrentAnimation].Reset;
793 FMaskAnim[TDirection.D_RIGHT][FCurrentAnimation].Reset;
794 end;
795 end;
796
797 destructor TPlayerModel.Destroy();
798 var
799 a: Byte;
800 begin
801 for a := A_STAND to A_LAST do
802 begin
803 FAnim[TDirection.D_LEFT][a].Free();
804 FMaskAnim[TDirection.D_LEFT][a].Free();
805 FAnim[TDirection.D_RIGHT][a].Free();
806 FMaskAnim[TDirection.D_RIGHT][a].Free();
807 end;
808
809 inherited;
810 end;
811
812 procedure TPlayerModel.Draw(X, Y: Integer; Alpha: Byte = 0);
813 var
814 Mirror: TMirrorType;
815 pos, act: Byte;
816 p: TDFPoint;
817 begin
818 // Ôëàãè:
819 if Direction = TDirection.D_LEFT then
820 Mirror := TMirrorType.None
821 else
822 Mirror := TMirrorType.Horizontal;
823
824 if (FFlag <> FLAG_NONE) and (FFlagAnim <> nil) and
825 (not (FCurrentAnimation in [A_DIE1, A_DIE2])) then
826 begin
827 p.X := IfThen(Direction = TDirection.D_LEFT,
828 FLAG_BASEPOINT.X,
829 64-FLAG_BASEPOINT.X);
830 p.Y := FLAG_BASEPOINT.Y;
831
832 FFlagAnim.DrawEx(X+IfThen(Direction = TDirection.D_LEFT, FFlagPoint.X-1, 2*FLAG_BASEPOINT.X-FFlagPoint.X+1)-FLAG_BASEPOINT.X,
833 Y+FFlagPoint.Y-FLAG_BASEPOINT.Y+1, Mirror, p,
834 IfThen(FDirection = TDirection.D_RIGHT, FFlagAngle, -FFlagAngle));
835 end;
836
837 // Îðóæèå:
838 if Direction = TDirection.D_RIGHT then
839 Mirror := TMirrorType.None
840 else
841 Mirror := TMirrorType.Horizontal;
842
843 if FDrawWeapon and
844 (not (FCurrentAnimation in [A_DIE1, A_DIE2, A_PAIN])) and
845 (FCurrentWeapon in [WP_FIRST + 1..WP_LAST]) then
846 begin
847 if FCurrentAnimation in [A_SEEUP, A_ATTACKUP] then
848 pos := W_POS_UP
849 else
850 if FCurrentAnimation in [A_SEEDOWN, A_ATTACKDOWN] then
851 pos := W_POS_DOWN
852 else
853 pos := W_POS_NORMAL;
854
855 if (FCurrentAnimation in [A_ATTACK, A_ATTACKUP, A_ATTACKDOWN]) or
856 FFire then
857 act := W_ACT_FIRE
858 else
859 act := W_ACT_NORMAL;
860
861 if Alpha < 201 then
862 e_Draw(WeaponID[FCurrentWeapon][pos][act],
863 X+FWeaponPoints[FCurrentWeapon, FCurrentAnimation, FDirection,
864 FAnim[TDirection.D_RIGHT][FCurrentAnimation].CurrentFrame].X,
865 Y+FWeaponPoints[FCurrentWeapon, FCurrentAnimation, FDirection,
866 FAnim[TDirection.D_RIGHT][FCurrentAnimation].CurrentFrame].Y,
867 0, True, False, Mirror);
868 end;
869
870 // Ìîäåëü:
871 if (FDirection = TDirection.D_LEFT) and
872 (FAnim[TDirection.D_LEFT][FCurrentAnimation] <> nil) then
873 begin
874 FAnim[TDirection.D_LEFT][FCurrentAnimation].Alpha := Alpha;
875 FAnim[TDirection.D_LEFT][FCurrentAnimation].Draw(X, Y, TMirrorType.None);
876 end
877 else
878 begin
879 FAnim[TDirection.D_RIGHT][FCurrentAnimation].Alpha := Alpha;
880 FAnim[TDirection.D_RIGHT][FCurrentAnimation].Draw(X, Y, Mirror);
881 end;
882
883 // Ìàñêà ìîäåëè:
884 e_Colors := FColor;
885
886 if (FDirection = TDirection.D_LEFT) and
887 (FMaskAnim[TDirection.D_LEFT][FCurrentAnimation] <> nil) then
888 begin
889 FMaskAnim[TDirection.D_LEFT][FCurrentAnimation].Alpha := Alpha;
890 FMaskAnim[TDirection.D_LEFT][FCurrentAnimation].Draw(X, Y, TMirrorType.None);
891 end
892 else
893 begin
894 FMaskAnim[TDirection.D_RIGHT][FCurrentAnimation].Alpha := Alpha;
895 FMaskAnim[TDirection.D_RIGHT][FCurrentAnimation].Draw(X, Y, Mirror);
896 end;
897
898 e_Colors.R := 255;
899 e_Colors.G := 255;
900 e_Colors.B := 255;
901 end;
902
903 function TPlayerModel.GetCurrentAnimation: TAnimation;
904 begin
905 if (FDirection = TDirection.D_LEFT) and (FAnim[TDirection.D_LEFT][FCurrentAnimation] <> nil) then
906 Result := FAnim[TDirection.D_LEFT][FCurrentAnimation]
907 else
908 Result := FAnim[TDirection.D_RIGHT][FCurrentAnimation];
909 end;
910
911 function TPlayerModel.GetCurrentAnimationMask: TAnimation;
912 begin
913 if (FDirection = TDirection.D_LEFT) and (FMaskAnim[TDirection.D_LEFT][FCurrentAnimation] <> nil) then
914 Result := FMaskAnim[TDirection.D_LEFT][FCurrentAnimation]
915 else
916 Result := FMaskAnim[TDirection.D_RIGHT][FCurrentAnimation];
917 end;
918
919 function TPlayerModel.PlaySound(SoundType, Level: Byte; X, Y: Integer): Boolean;
920 var
921 TempArray: array of DWORD;
922 a: Integer;
923 begin
924 Result := False;
925 SetLength(TempArray, 0);
926
927 if SoundType = MODELSOUND_PAIN then
928 begin
929 if FPainSounds = nil then Exit;
930
931 for a := 0 to High(FPainSounds) do
932 if FPainSounds[a].Level = Level then
933 begin
934 SetLength(TempArray, Length(TempArray)+1);
935 TempArray[High(TempArray)] := FPainSounds[a].ID;
936 end;
937 end
938 else
939 begin
940 if (Level in [2, 3, 5]) and (FSlopSound > 0) then
941 begin
942 g_Sound_PlayExAt('SOUND_MONSTER_SLOP', X, Y);
943 if FSlopSound = 1 then
944 begin
945 Result := True;
946 Exit;
947 end;
948 end;
949 if FDieSounds = nil then Exit;
950
951 for a := 0 to High(FDieSounds) do
952 if FDieSounds[a].Level = Level then
953 begin
954 SetLength(TempArray, Length(TempArray)+1);
955 TempArray[High(TempArray)] := FDieSounds[a].ID;
956 end;
957 if (TempArray = nil) and (Level = 5) then
958 begin
959 g_Sound_PlayExAt('SOUND_MONSTER_SLOP', X, Y);
960 Result := True;
961 Exit;
962 end;
963 end;
964
965 if TempArray = nil then Exit;
966
967 g_Sound_PlayAt(TempArray[Random(Length(TempArray))], X, Y);
968
969 Result := True;
970 end;
971
972 procedure TPlayerModel.SetColor(Red, Green, Blue: Byte);
973 begin
974 FColor.R := Red;
975 FColor.G := Green;
976 FColor.B := Blue;
977 end;
978
979 procedure TPlayerModel.SetFire(Fire: Boolean);
980 begin
981 FFire := Fire;
982
983 if FFire then FFireCounter := FAnim[TDirection.D_RIGHT, A_ATTACK].Speed*FAnim[TDirection.D_RIGHT, A_ATTACK].TotalFrames
984 else FFireCounter := 0;
985 end;
986
987 procedure TPlayerModel.SetFlag(Flag: Byte);
988 var
989 id: DWORD;
990 begin
991 FFlag := Flag;
992
993 FFlagAnim.Free();
994 FFlagAnim := nil;
995
996 case Flag of
997 FLAG_RED: g_Frames_Get(id, 'FRAMES_FLAG_RED');
998 FLAG_BLUE: g_Frames_Get(id, 'FRAMES_FLAG_BLUE');
999 else Exit;
1000 end;
1001
1002 FFlagAnim := TAnimation.Create(id, True, 8);
1003 end;
1004
1005 procedure TPlayerModel.SetWeapon(Weapon: Byte);
1006 begin
1007 FCurrentWeapon := Weapon;
1008 end;
1009
1010 procedure TPlayerModel.Update();
1011 begin
1012 if (FDirection = TDirection.D_LEFT) and (FAnim[TDirection.D_LEFT][FCurrentAnimation] <> nil) then
1013 FAnim[TDirection.D_LEFT][FCurrentAnimation].Update else FAnim[TDirection.D_RIGHT][FCurrentAnimation].Update;
1014
1015 if (FDirection = TDirection.D_LEFT) and (FMaskAnim[TDirection.D_LEFT][FCurrentAnimation] <> nil) then
1016 FMaskAnim[TDirection.D_LEFT][FCurrentAnimation].Update else FMaskAnim[TDirection.D_RIGHT][FCurrentAnimation].Update;
1017
1018 if FFlagAnim <> nil then FFlagAnim.Update;
1019
1020 if FFireCounter > 0 then Dec(FFireCounter) else FFire := False;
1021 end;
1022
1023 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024