DEADSOFTWARE

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