1 (* Copyright (C) Doom 2D: Forever Developers
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.
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.
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/>.
15 {$INCLUDE ../shared/a_modes.inc}
22 MAPDEF
, g_textures
, g_base
, g_basic
, g_weapons
, r_graphics
, utils
, g_gfx
,
23 ImagingTypes
, Imaging
, ImagingUtility
;
41 A_WALKATTACKDOWN
= 14;
45 A_FISTWALKATTACK
= 18;
49 A_FISTATTACKDOWN
= 22;
52 A_LASTEXT
= A_FISTATTACKDOWN
;
65 FLAG_BASEPOINT
: TDFPoint
= (X
:16; Y
:43);
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
102 TModelSoundArray
= Array of TModelSound
;
103 TGibsArray
= Array of TGibSprite
;
105 TPlayerModel
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
107 FDirection
: TDirection
;
109 FCurrentAnimation
: Byte;
110 FAnimState
: TAnimationState
;
111 FPainSounds
: TModelSoundArray
;
112 FDieSounds
: TModelSoundArray
;
114 FCurrentWeapon
: Byte;
116 FFlagPoint
: TDFPoint
;
117 FFlagAngle
: SmallInt;
118 FFlagAnim
: TAnimation
; // !!! TAnimationState
124 destructor Destroy(); override;
125 procedure ChangeAnimation(Animation
: Byte; Force
: Boolean = False);
126 procedure SetColor(Red
, Green
, Blue
: Byte);
127 procedure SetWeapon(Weapon
: Byte);
128 procedure SetFlag(Flag
: Byte);
129 procedure SetFire(Fire
: Boolean);
130 function PlaySound(SoundType
, Level
: Byte; X
, Y
: Integer): Boolean;
133 function GetBlood (): TModelBlood
;
134 function GetName (): String;
137 property Fire
: Boolean read FFire
;
138 property Direction
: TDirection read FDirection write FDirection
;
139 property Animation
: Byte read FCurrentAnimation
;
140 property Weapon
: Byte read FCurrentWeapon
;
143 property Color
: TRGB read FColor write FColor
;
145 property AnimState
: TAnimationState read FAnimState
;
146 property CurrentAnimation
: Byte read FCurrentAnimation
;
148 property CurrentWeapon
: Byte read FCurrentWeapon
;
150 property Flag
: Byte read FFlag
;
151 property FlagAnim
: TAnimation read FFlagAnim
;
152 property FlagAngle
: SmallInt read FFlagAngle
;
153 property FlagPoint
: TDFPoint read FFlagPoint
;
155 property ID
: Integer read FID
;
158 procedure g_PlayerModel_LoadAll
;
159 procedure g_PlayerModel_FreeData();
160 function g_PlayerModel_Load(FileName
: String): Boolean;
161 function g_PlayerModel_GetNames(): SSArray
;
162 function g_PlayerModel_GetInfo(ModelName
: String): TModelInfo
;
163 function g_PlayerModel_GetBlood(ModelName
: String): TModelBlood
;
164 function g_PlayerModel_Get(ModelName
: String): TPlayerModel
;
165 function g_PlayerModel_GetAnim(ModelName
: String; AnimTyp
: Byte; var _Anim
, _Mask
: TAnimation
): Boolean;
166 function g_PlayerModel_GetGibs(ModelName
: String; var Gibs
: TGibsArray
): Boolean;
168 (* --- private data --- *)
171 TPlayerModelInfo
= record
173 ModelSpeed
: Array [A_STAND
..A_PAIN
] of Byte;
176 WeaponPoints
: TWeaponPoints
;
177 Gibs
: TGibsArray
; // !!! move to render
178 PainSounds
: TModelSoundArray
;
179 DieSounds
: TModelSoundArray
;
182 // =======================
184 Anim
: TModelTextures
;
192 PlayerModelsArray
: Array of TPlayerModelInfo
;
197 g_sound
, g_console
, SysUtils
, g_player
, CONFIG
, r_textures
, r_animations
,
198 e_sound
, g_options
, g_map
, Math
, e_log
, wadreader
;
201 FLAG_DEFPOINT
: TDFPoint
= (X
:32; Y
:16);
203 WEAPONBASE
: Array [WP_FIRST
+ 1..WP_LAST
] of TDFPoint
=
204 ((X
:8; Y
:4), (X
:8; Y
:8), (X
:16; Y
:16), (X
:16; Y
:24),
205 (X
:16; Y
:16), (X
:24; Y
:24), (X
:16; Y
:16), (X
:24; Y
:24),
206 (X
:16; Y
:16), (X
:8; Y
:8));
208 AnimNames
: Array [A_STAND
..A_LASTEXT
] of String =
209 ('StandAnim','WalkAnim','Die1Anim','Die2Anim','AttackAnim',
210 'SeeUpAnim','SeeDownAnim','AttackUpAnim','AttackDownAnim','PainAnim',
212 'WalkAttackAnim', 'WalkSeeUpAnim', 'WalkSeeDownAnim',
213 'WalkAttackUpAnim', 'WalkAttackDownAnim', 'FistStandAnim', 'FistWalkAnim',
214 'FistAttackAnim', 'FistWalkAttackAnim', 'FistSeeUpAnim', 'FistSeeDownAnim',
215 'FistAttackUpAnim', 'FistAttackDownAnim');
216 WeapNames
: Array [WP_FIRST
+ 1..WP_LAST
] of String =
217 ('csaw', 'hgun', 'sg', 'ssg', 'mgun', 'rkt', 'plz', 'bfg', 'spl', 'flm');
219 function GetPoint(var str
: String; var point
: TDFPoint
): Boolean;
229 if Length(str
) < 3 then
232 for a
:= 1 to Length(str
) do
233 if (str
[a
] = ',') or (a
= Length(str
)) then
235 s
:= Copy(str
, 1, a
);
236 if s
[Length(s
)] = ',' then
237 SetLength(s
, Length(s
)-1);
240 if (Sscanf(s
, '%d:%d', [@x
, @y
]) < 2) or
241 (x
< -64) or (x
> 128) or
242 (y
< -64) or (y
> 128) then
254 function GetWeapPoints(str
: String; weapon
: Byte; anim
: Byte; dir
: TDirection
;
255 frames
: Word; backanim
: Boolean; var wpoints
: TWeaponPoints
): Boolean;
264 backanim
:= backanim
and (frames
> 2);
266 for a
:= 1 to frames
do
268 if not GetPoint(str
, wpoints
[weapon
, anim
, dir
, a
-1]) then
271 with wpoints
[weapon
, anim
, dir
, a
-1] do
273 X
:= X
- WEAPONBASE
[weapon
].X
;
274 Y
:= Y
- WEAPONBASE
[weapon
].Y
;
275 if dir
= TDirection
.D_LEFT
then
280 h
:= High(wpoints
[weapon
, anim
, dir
]);
282 for b
:= h
downto frames
do
283 wpoints
[weapon
, anim
, dir
, b
] := wpoints
[weapon
, anim
, dir
, h
-b
+1];
288 procedure g_PlayerMode_ExtendPoints (id
: Integer; AIdx
: Integer);
290 CopyAnim
: array [A_LASTBASE
+1..A_LASTEXT
] of Integer = (
291 A_WALK
, A_WALK
, A_WALK
, A_WALK
, A_WALK
,
292 A_STAND
, A_WALK
, A_ATTACK
, A_WALK
, A_SEEUP
, A_SEEDOWN
,
293 A_ATTACKUP
, A_ATTACKDOWN
295 var W
, I
, OIdx
: Integer; D
: TDirection
;
297 OIdx
:= CopyAnim
[AIdx
];
298 with PlayerModelsArray
[id
] do
300 for W
:= WP_FIRST
+ 1 to WP_LAST
do
302 for D
:= TDirection
.D_LEFT
to TDirection
.D_RIGHT
do
304 SetLength(WeaponPoints
[W
, AIdx
, D
], Length(WeaponPoints
[W
, OIdx
, D
]));
305 for I
:= 0 to High(WeaponPoints
[W
, AIdx
, D
]) do
306 WeaponPoints
[W
, AIdx
, D
, I
] := WeaponPoints
[W
, OIdx
, D
, I
]
312 function g_PlayerModel_CalcGibSize (pData
: Pointer; dataSize
, x
, y
, w
, h
: Integer): TRectWH
;
313 var i
, j
: Integer; done
: Boolean; img
: TImageData
;
315 function IsVoid (i
, j
: Integer): Boolean;
317 result
:= Byte((PByte(img
.bits
) + (y
+j
)*img
.width
*4 + (x
+i
)*4 + 3)^) = 0
322 assert(LoadImageFromMemory(pData
, dataSize
, img
));
324 (* trace x from right to left *)
325 done
:= false; i
:= 0;
326 while not done
and (i
< w
) do
329 while (j
< h
) and IsVoid(i
, j
) do inc(j
);
330 done
:= (j
< h
) and (IsVoid(i
, j
) = false);
335 (* trace y from up to down *)
336 done
:= false; j
:= 0;
337 while not done
and (j
< h
) do
340 while (i
< w
) and IsVoid(i
, j
) do inc(i
);
341 done
:= (i
< w
) and (IsVoid(i
, j
) = false);
346 (* trace x from right to left *)
347 done
:= false; i
:= w
- 1;
348 while not done
and (i
>= 0) do
351 while (j
< h
) and IsVoid(i
, j
) do inc(j
);
352 done
:= (j
< h
) and (IsVoid(i
, j
) = false);
353 result
.width
:= i
- result
.x
+ 1;
357 (* trace y from down to up *)
358 done
:= false; j
:= h
- 1;
359 while not done
and (j
>= 0) do
362 while (i
< w
) and IsVoid(i
, j
) do inc(i
);
363 done
:= (i
< w
) and (IsVoid(i
, j
) = false);
364 result
.height
:= j
- result
.y
+ 1;
371 function g_PlayerModel_Load(FileName
: string): Boolean;
374 a
, b
, len
, lenpd
, lenpd2
, aa
, bb
, f
: Integer;
377 pData
, pData2
: Pointer;
381 ok
, chk
, chk2
: Boolean;
383 e_WriteLog(Format('Loading player model "%s"...', [FileName
]), TMsgType
.Notify
);
387 WAD
:= TWADFile
.Create
;
388 WAD
.ReadFile(FileName
);
390 if {WAD.GetLastError <> DFWAD_NOERROR} not WAD
.isOpen
then
396 if not WAD
.GetResource('TEXT/MODEL', pData
, len
) then
402 config
:= TConfig
.CreateMem(pData
, len
);
405 s
:= config
.ReadStr('Model', 'name', '');
413 SetLength(PlayerModelsArray
, Length(PlayerModelsArray
)+1);
414 ID
:= High(PlayerModelsArray
);
416 prefix
:= FileName
+':TEXTURES\';
418 with PlayerModelsArray
[ID
].Info
do
421 Author
:= config
.ReadStr('Model', 'author', '');
422 Description
:= config
.ReadStr('Model', 'description', '');
425 PlayerModelsArray
[ID
].FileName
:= FileName
;
426 with PlayerModelsArray
[ID
] do
428 Blood
.R
:= MAX(0, MIN(255, config
.ReadInt('Blood', 'R', 150)));
429 Blood
.G
:= MAX(0, MIN(255, config
.ReadInt('Blood', 'G', 0)));
430 Blood
.B
:= MAX(0, MIN(255, config
.ReadInt('Blood', 'B', 0)));
431 case config
.ReadStr('Blood', 'Kind', 'NORMAL') of
432 'NORMAL': Blood
.Kind
:= BLOOD_NORMAL
;
433 'SPARKS': Blood
.Kind
:= BLOOD_CSPARKS
;
434 'COMBINE': Blood
.Kind
:= BLOOD_COMBINE
;
436 Blood
.Kind
:= BLOOD_NORMAL
440 for b
:= A_STAND
to A_LAST
do
442 with PlayerModelsArray
[ID
].Anim
[TDirection
.D_RIGHT
, b
] do
444 Resource
:= config
.ReadStr(AnimNames
[b
], 'resource', '');
445 Mask
:= config
.ReadStr(AnimNames
[b
], 'mask', '');
446 Frames
:= config
.ReadInt(AnimNames
[b
], 'frames', 1);
447 Back
:= config
.ReadBool(AnimNames
[b
], 'backanim', False);
448 if (Resource
= '') or (Mask
= '') then
450 if b
<= A_LASTBASE
then
458 g_PlayerMode_ExtendPoints(ID
, b
);
464 for aa
:= WP_FIRST
+ 1 to WP_LAST
do
465 for bb
:= A_STAND
to A_LAST
do
466 for cc
:= TDirection
.D_LEFT
to TDirection
.D_RIGHT
do
468 f
:= PlayerModelsArray
[ID
].Anim
[cc
, bb
].Frames
;
469 if PlayerModelsArray
[ID
].Anim
[cc
, bb
].Back
and (f
> 2) then
471 SetLength(PlayerModelsArray
[ID
].WeaponPoints
[aa
, bb
, cc
], f
);
474 with PlayerModelsArray
[ID
].Anim
[TDirection
.D_LEFT
, b
] do
476 Frames
:= PlayerModelsArray
[ID
].Anim
[TDirection
.D_RIGHT
, b
].Frames
;
477 Back
:= PlayerModelsArray
[ID
].Anim
[TDirection
.D_RIGHT
, b
].Back
;
480 PlayerModelsArray
[ID
].ModelSpeed
[b
] := Max(1, config
.ReadInt(AnimNames
[b
], 'waitcount', 1) div 3);
483 with PlayerModelsArray
[ID
], config
do
485 prefix
:= FileName
+':SOUNDS\';
489 s
:= config
.ReadStr('Sound', 'pain'+IntToStr(a
), '');
492 SetLength(PainSounds
, Length(PainSounds
)+1);
493 g_Sound_CreateWAD(PainSounds
[High(PainSounds
)].ID
, prefix
+s
);
494 PainSounds
[High(PainSounds
)].Level
:= config
.ReadInt('Sound', 'painlevel'+IntToStr(a
), 1);
501 s
:= config
.ReadStr('Sound', 'die'+IntToStr(a
), '');
504 SetLength(DieSounds
, Length(DieSounds
)+1);
505 g_Sound_CreateWAD(DieSounds
[High(DieSounds
)].ID
, prefix
+s
);
506 DieSounds
[High(DieSounds
)].Level
:= config
.ReadInt('Sound', 'dielevel'+IntToStr(a
), 1);
511 SlopSound
:= Min(Max(config
.ReadInt('Sound', 'slop', 0), 0), 2);
513 GibsCount
:= config
.ReadInt('Gibs', 'count', 0);
514 GibsResource
:= config
.ReadStr('Gibs', 'resource', 'GIBS');
515 GibsMask
:= config
.ReadStr('Gibs', 'mask', 'GIBSMASK');
516 GibsOnce
:= config
.ReadInt('Gibs', 'once', -1);
518 SetLength(Gibs
, GibsCount
); // !!! remove load
520 (WAD
.GetResource('TEXTURES/' + GibsResource
, pData
, lenpd
)) and
521 (WAD
.GetResource('TEXTURES/' + GibsMask
, pData2
, lenpd2
)) then
523 for a
:= 0 to High(Gibs
) do
524 if e_CreateTextureMemEx(pData
, lenpd
, Gibs
[a
].ID
, a
*32, 0, 32, 32) and
525 e_CreateTextureMemEx(pData2
, lenpd2
, Gibs
[a
].MaskID
, a
*32, 0, 32, 32) then
527 //Gibs[a].Rect := e_GetTextureSize2(Gibs[a].ID);
528 Gibs
[a
].Rect
:= g_PlayerModel_CalcGibSize(pData
, lenpd
, a
*32, 0, 32, 32);
530 if Height
> 3 then Height
:= Height
-1-Random(2);
531 Gibs
[a
].OnlyOne
:= GibsOnce
= a
+ 1;
539 for aa
:= WP_FIRST
+ 1 to WP_LAST
do
540 for bb
:= A_STAND
to A_LAST
do
541 if not (bb
in [A_DIE1
, A_DIE2
, A_PAIN
]) then
543 chk
:= GetWeapPoints(
544 config
.ReadStr(AnimNames
[bb
], WeapNames
[aa
] + '_points', ''),
548 Anim
[TDirection
.D_RIGHT
, bb
].Frames
,
549 Anim
[TDirection
.D_RIGHT
, bb
].Back
,
552 if ok
and (not chk
) and (aa
= WEAPON_FLAMETHROWER
) then
554 // workaround for flamethrower
555 chk
:= GetWeapPoints(
556 config
.ReadStr(AnimNames
[bb
], WeapNames
[WEAPON_PLASMA
] + '_points', ''),
560 Anim
[TDirection
.D_RIGHT
, bb
].Frames
,
561 Anim
[TDirection
.D_RIGHT
, bb
].Back
,
565 for f
:= 0 to High(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
]) do
570 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].X
, 6);
571 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].Y
, 8);
573 A_WALKATTACK
, A_WALK
:
575 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].X
, 9);
576 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].Y
, 9);
580 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].X
, 5);
581 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].Y
, 8);
583 A_WALKSEEUP
, A_SEEUP
:
585 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].X
, 5);
586 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].Y
, 16);
588 A_WALKSEEDOWN
, A_SEEDOWN
:
590 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].X
, 6);
591 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].Y
, 5);
593 A_WALKATTACKUP
, A_ATTACKUP
:
595 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].X
, 5);
596 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].Y
, 16);
598 A_WALKATTACKDOWN
, A_ATTACKDOWN
:
600 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].X
, 6);
601 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].Y
, 4);
607 ok
:= ok
and (chk
or (bb
> A_LASTBASE
));
609 chk2
:= GetWeapPoints(
610 config
.ReadStr(AnimNames
[bb
], WeapNames
[aa
] + '2_points', ''),
614 Anim
[TDirection
.D_LEFT
, bb
].Frames
,
615 Anim
[TDirection
.D_LEFT
, bb
].Back
,
620 for f
:= 0 to High(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
]) do
622 WeaponPoints
[aa
, bb
, TDirection
.D_LEFT
, f
].X
:= -WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].X
;
623 WeaponPoints
[aa
, bb
, TDirection
.D_LEFT
, f
].Y
:= WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].Y
;
627 if not ok
then Break
;
629 {if ok then g_Console_Add(Info.Name+' weapon points ok')
630 else g_Console_Add(Info.Name+' weapon points fail');}
631 Info
.HaveWeapon
:= ok
;
633 s
:= config
.ReadStr('Model', 'flag_point', '');
634 if not GetPoint(s
, FlagPoint
) then
635 FlagPoint
:= FLAG_DEFPOINT
;
637 FlagAngle
:= config
.ReadInt('Model', 'flag_angle', FLAG_DEFANGLE
);
646 function g_PlayerModel_Get(ModelName
: String): TPlayerModel
;
651 if PlayerModelsArray
= nil then Exit
;
653 for a
:= 0 to High(PlayerModelsArray
) do
655 if AnsiLowerCase(PlayerModelsArray
[a
].Info
.Name
) = AnsiLowerCase(ModelName
) then
657 Result
:= TPlayerModel
.Create
;
659 with PlayerModelsArray
[a
] do
661 Result
.FPainSounds
:= PainSounds
;
662 Result
.FDieSounds
:= DieSounds
;
663 Result
.FSlopSound
:= SlopSound
;
665 Result
.FFlagPoint
:= FlagPoint
;
666 Result
.FFlagAngle
:= FlagAngle
;
669 Result
.ChangeAnimation(A_STAND
, True);
677 function g_PlayerModel_GetAnim(ModelName
: string; AnimTyp
: Byte; var _Anim
, _Mask
: TAnimation
): Boolean;
685 if PlayerModelsArray
= nil then Exit
;
686 for a
:= 0 to High(PlayerModelsArray
) do
687 if PlayerModelsArray
[a
].Info
.Name
= ModelName
then
688 with PlayerModelsArray
[a
] do
690 if AnimTyp
in [A_STAND
, A_WALK
] then c
:= True else c
:= False;
692 if not g_Frames_Get(ID
, Info
.Name
+'_RIGHTANIM'+IntToStr(AnimTyp
)) then
693 if not g_Frames_Get(ID
, Info
.Name
+'_LEFTANIM'+IntToStr(AnimTyp
)) then Exit
;
695 _Anim
:= TAnimation
.Create(ID
, c
, ModelSpeed
[AnimTyp
]);
696 _Anim
.Speed
:= ModelSpeed
[AnimTyp
];
698 if not g_Frames_Get(ID
, Info
.Name
+'_RIGHTANIM'+IntToStr(AnimTyp
)+'_MASK') then
699 if not g_Frames_Get(ID
, Info
.Name
+'_LEFTANIM'+IntToStr(AnimTyp
)+'_MASK') then Exit
;
701 _Mask
:= TAnimation
.Create(ID
, c
, ModelSpeed
[AnimTyp
]);
702 _Mask
.Speed
:= ModelSpeed
[AnimTyp
];
710 function g_PlayerModel_GetGibs(ModelName
: string; var Gibs
: TGibsArray
): Boolean;
717 if PlayerModelsArray
= nil then Exit
;
718 if gGibsCount
= 0 then Exit
;
722 SetLength(Gibs
, gGibsCount
);
724 for a
:= 0 to High(PlayerModelsArray
) do
725 if PlayerModelsArray
[a
].Info
.Name
= ModelName
then
727 for i
:= 0 to High(Gibs
) do
729 if c
and (Length(PlayerModelsArray
[a
].Gibs
) = 1) then
736 b
:= Random(Length(PlayerModelsArray
[a
].Gibs
));
737 until not (PlayerModelsArray
[a
].Gibs
[b
].OnlyOne
and c
);
739 Gibs
[i
] := PlayerModelsArray
[a
].Gibs
[b
];
741 if Gibs
[i
].OnlyOne
then c
:= True;
749 function g_PlayerModel_GetNames(): SSArray
;
755 if PlayerModelsArray
= nil then Exit
;
757 for i
:= 0 to High(PlayerModelsArray
) do
759 SetLength(Result
, Length(Result
)+1);
760 Result
[High(Result
)] := PlayerModelsArray
[i
].Info
.Name
;
764 function g_PlayerModel_GetInfo(ModelName
: string): TModelInfo
;
768 FillChar(Result
, SizeOf(Result
), 0);
769 if PlayerModelsArray
= nil then Exit
;
771 for a
:= 0 to High(PlayerModelsArray
) do
772 if PlayerModelsArray
[a
].Info
.Name
= ModelName
then
774 Result
:= PlayerModelsArray
[a
].Info
;
779 function g_PlayerModel_GetBlood(ModelName
: string): TModelBlood
;
786 Result
.Kind
:= BLOOD_NORMAL
;
787 if PlayerModelsArray
= nil then Exit
;
789 for a
:= 0 to High(PlayerModelsArray
) do
790 if PlayerModelsArray
[a
].Info
.Name
= ModelName
then
792 Result
:= PlayerModelsArray
[a
].Blood
;
797 procedure g_PlayerModel_FreeData();
800 e_WriteLog('Releasing models...', TMsgType
.Notify
);
802 if PlayerModelsArray
= nil then Exit
;
804 for i
:= 0 to High(PlayerModelsArray
) do
806 with PlayerModelsArray
[i
] do
808 if PainSounds
<> nil then
809 for b
:= 0 to High(PainSounds
) do
810 e_DeleteSound(PainSounds
[b
].ID
);
811 if DieSounds
<> nil then
812 for b
:= 0 to High(DieSounds
) do
813 e_DeleteSound(DieSounds
[b
].ID
);
816 PlayerModelsArray
:= nil;
821 procedure TPlayerModel
.ChangeAnimation (Animation
: Byte; Force
: Boolean = False);
822 var once
: Boolean; speed
, count
: Integer;
825 if FCurrentAnimation
= Animation
then
827 FCurrentAnimation
:= Animation
;
828 once
:= FCurrentAnimation
in [A_STAND
, A_WALK
];
829 speed
:= PlayerModelsArray
[FID
].ModelSpeed
[FCurrentAnimation
];
830 count
:= PlayerModelsArray
[FID
].Anim
[FDirection
, FCurrentAnimation
].Frames
;
831 FAnimState
:= TAnimationState
.Create(once
, speed
, count
);
834 destructor TPlayerModel
.Destroy();
840 function TPlayerModel
.PlaySound(SoundType
, Level
: Byte; X
, Y
: Integer): Boolean;
842 TempArray
: array of DWORD
;
846 SetLength(TempArray
, 0);
848 if SoundType
= MODELSOUND_PAIN
then
850 if FPainSounds
= nil then Exit
;
852 for a
:= 0 to High(FPainSounds
) do
853 if FPainSounds
[a
].Level
= Level
then
855 SetLength(TempArray
, Length(TempArray
)+1);
856 TempArray
[High(TempArray
)] := FPainSounds
[a
].ID
;
861 if (Level
in [2, 3, 5]) and (FSlopSound
> 0) then
863 g_Sound_PlayExAt('SOUND_MONSTER_SLOP', X
, Y
);
864 if FSlopSound
= 1 then
870 if FDieSounds
= nil then Exit
;
872 for a
:= 0 to High(FDieSounds
) do
873 if FDieSounds
[a
].Level
= Level
then
875 SetLength(TempArray
, Length(TempArray
)+1);
876 TempArray
[High(TempArray
)] := FDieSounds
[a
].ID
;
878 if (TempArray
= nil) and (Level
= 5) then
880 g_Sound_PlayExAt('SOUND_MONSTER_SLOP', X
, Y
);
886 if TempArray
= nil then Exit
;
888 g_Sound_PlayAt(TempArray
[Random(Length(TempArray
))], X
, Y
);
893 procedure TPlayerModel
.SetColor(Red
, Green
, Blue
: Byte);
900 procedure TPlayerModel
.SetFire(Fire
: Boolean);
904 FFireCounter
:= PlayerModelsArray
[FID
].ModelSpeed
[A_ATTACK
] * PlayerModelsArray
[FID
].Anim
[TDirection
.D_RIGHT
, A_ATTACK
].Frames
909 procedure TPlayerModel
.SetFlag(Flag
: Byte);
919 FLAG_RED
: g_Frames_Get(tid
, 'FRAMES_FLAG_RED');
920 FLAG_BLUE
: g_Frames_Get(tid
, 'FRAMES_FLAG_BLUE');
924 FFlagAnim
:= TAnimation
.Create(tid
, True, 8);
927 procedure TPlayerModel
.SetWeapon(Weapon
: Byte);
929 FCurrentWeapon
:= Weapon
;
932 function TPlayerModel
.GetBlood (): TModelBlood
;
934 Result
:= PlayerModelsArray
[FID
].Blood
937 function TPlayerModel
.GetName (): String;
939 Result
:= PlayerModelsArray
[FID
].Info
.Name
942 procedure TPlayerModel
.Update
;
944 if FAnimState
<> nil then
946 if FFlagAnim
<> nil then
948 if FFireCounter
> 0 then
954 procedure g_PlayerModel_LoadAll
;
957 knownFiles
: array of AnsiString = nil;
962 // load models from all possible wad types, in all known directories
963 // this does a loosy job (linear search, ooph!), but meh
964 for wext
in wadExtensions
do
966 for f
:= High(ModelDirs
) downto Low(ModelDirs
) do
968 if (FindFirst(ModelDirs
[f
]+DirectorySeparator
+'*'+wext
, faAnyFile
, SR
) = 0) then
972 for s
in knownFiles
do
974 if (strEquCI1251(forceFilenameExt(SR
.Name
, ''), forceFilenameExt(ExtractFileName(s
), ''))) then
982 SetLength(knownFiles
, length(knownFiles
)+1);
983 knownFiles
[High(knownFiles
)] := ModelDirs
[f
]+DirectorySeparator
+SR
.Name
;
985 until (FindNext(SR
) <> 0);
990 if (length(knownFiles
) = 0) then
991 raise Exception
.Create('no player models found!');
992 if (length(knownFiles
) = 1) then
993 e_LogWriteln('1 player model found.', TMsgType
.Notify
)
995 e_LogWritefln('%d player models found.', [Integer(length(knownFiles
))], TMsgType
.Notify
);
996 for s
in knownFiles
do
997 if not g_PlayerModel_Load(s
) then
998 e_LogWritefln('Error loading model "%s"', [s
], TMsgType
.Warning
);