DEADSOFTWARE

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