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 {$IFDEF USE_MEMPOOL}mempool
,{$ENDIF}
23 MAPDEF
, g_textures
, g_basic
, g_weapons
, e_graphics
, utils
, g_gfx
,
24 ImagingTypes
, Imaging
, ImagingUtility
;
42 A_WALKATTACKDOWN
= 14;
46 A_FISTWALKATTACK
= 18;
50 A_FISTATTACKDOWN
= 22;
53 A_LASTEXT
= A_FISTATTACKDOWN
;
66 FLAG_BASEPOINT
: TDFPoint
= (X
:16; Y
:43);
92 TModelSoundArray
= Array of TModelSound
;
93 TGibsArray
= Array of TGibSprite
;
94 TWeaponPoints
= Array [WP_FIRST
+ 1..WP_LAST
] of
95 Array [A_STAND
..A_LAST
] of
96 Array [TDirection
.D_LEFT
..TDirection
.D_RIGHT
] of Array of TDFPoint
;
97 TModelMatrix
= Array [TDirection
.D_LEFT
..TDirection
.D_RIGHT
] of Array [A_STAND
..A_LAST
] of TAnimation
;
99 TPlayerModel
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
102 FDirection
: TDirection
;
105 FCurrentAnimation
: Byte;
107 FMaskAnim
: TModelMatrix
;
108 FWeaponPoints
: TWeaponPoints
;
109 FPainSounds
: TModelSoundArray
;
110 FDieSounds
: TModelSoundArray
;
112 FCurrentWeapon
: Byte;
113 FDrawWeapon
: Boolean;
115 FFlagPoint
: TDFPoint
;
116 FFlagAngle
: SmallInt;
117 FFlagAnim
: TAnimation
;
122 destructor Destroy(); override;
123 procedure ChangeAnimation(Animation
: Byte; Force
: Boolean = False);
124 function GetCurrentAnimation
: TAnimation
;
125 function GetCurrentAnimationMask
: TAnimation
;
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;
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 property Name
: String read FName
;
141 property Color
: TRGB read FColor write FColor
;
142 property Blood
: TModelBlood read FBlood
;
144 property Anim
: TModelMatrix read FAnim
;
145 property MaskAnim
: TModelMatrix read FMaskAnim
;
146 property CurrentAnimation
: Byte read FCurrentAnimation
;
148 property CurrentWeapon
: Byte read FCurrentWeapon
;
149 property DrawWeapon
: Boolean read FDrawWeapon
;
150 property WeaponPoints
: TWeaponPoints read FWeaponPoints
;
152 property Flag
: Byte read FFlag
;
153 property FlagAnim
: TAnimation read FFlagAnim
;
154 property FlagAngle
: SmallInt read FFlagAngle
;
155 property FlagPoint
: TDFPoint read FFlagPoint
;
158 procedure g_PlayerModel_FreeData();
159 function g_PlayerModel_Load(FileName
: String): Boolean;
160 function g_PlayerModel_GetNames(): SSArray
;
161 function g_PlayerModel_GetInfo(ModelName
: String): TModelInfo
;
162 function g_PlayerModel_GetBlood(ModelName
: String): TModelBlood
;
163 function g_PlayerModel_Get(ModelName
: String): TPlayerModel
;
164 function g_PlayerModel_GetAnim(ModelName
: String; Anim
: Byte; var _Anim
, _Mask
: TAnimation
): Boolean;
165 function g_PlayerModel_GetGibs(ModelName
: String; var Gibs
: TGibsArray
): Boolean;
171 {$INCLUDE ../nogl/noGLuses.inc}
172 g_main
, g_sound
, g_console
, SysUtils
, g_player
, CONFIG
,
173 e_sound
, g_options
, g_map
, Math
, e_log
, wadreader
;
176 TPlayerModelInfo
= record
178 ModelSpeed
: Array [A_STAND
..A_PAIN
] of Byte;
181 WeaponPoints
: TWeaponPoints
;
183 PainSounds
: TModelSoundArray
;
184 DieSounds
: TModelSoundArray
;
190 FLAG_DEFPOINT
: TDFPoint
= (X
:32; Y
:16);
192 WEAPONBASE
: Array [WP_FIRST
+ 1..WP_LAST
] of TDFPoint
=
193 ((X
:8; Y
:4), (X
:8; Y
:8), (X
:16; Y
:16), (X
:16; Y
:24),
194 (X
:16; Y
:16), (X
:24; Y
:24), (X
:16; Y
:16), (X
:24; Y
:24),
195 (X
:16; Y
:16), (X
:8; Y
:8));
197 AnimNames
: Array [A_STAND
..A_LASTEXT
] of String =
198 ('StandAnim','WalkAnim','Die1Anim','Die2Anim','AttackAnim',
199 'SeeUpAnim','SeeDownAnim','AttackUpAnim','AttackDownAnim','PainAnim',
201 'WalkAttackAnim', 'WalkSeeUpAnim', 'WalkSeeDownAnim',
202 'WalkAttackUpAnim', 'WalkAttackDownAnim', 'FistStandAnim', 'FistWalkAnim',
203 'FistAttackAnim', 'FistWalkAttackAnim', 'FistSeeUpAnim', 'FistSeeDownAnim',
204 'FistAttackUpAnim', 'FistAttackDownAnim');
205 WeapNames
: Array [WP_FIRST
+ 1..WP_LAST
] of String =
206 ('csaw', 'hgun', 'sg', 'ssg', 'mgun', 'rkt', 'plz', 'bfg', 'spl', 'flm');
209 PlayerModelsArray
: Array of TPlayerModelInfo
;
211 function GetPoint(var str
: String; var point
: TDFPoint
): Boolean;
221 if Length(str
) < 3 then
224 for a
:= 1 to Length(str
) do
225 if (str
[a
] = ',') or (a
= Length(str
)) then
227 s
:= Copy(str
, 1, a
);
228 if s
[Length(s
)] = ',' then
229 SetLength(s
, Length(s
)-1);
232 if (Sscanf(s
, '%d:%d', [@x
, @y
]) < 2) or
233 (x
< -64) or (x
> 128) or
234 (y
< -64) or (y
> 128) then
246 function GetWeapPoints(str
: String; weapon
: Byte; anim
: Byte; dir
: TDirection
;
247 frames
: Word; backanim
: Boolean; var wpoints
: TWeaponPoints
): Boolean;
256 backanim
:= backanim
and (frames
> 2);
258 for a
:= 1 to frames
do
260 if not GetPoint(str
, wpoints
[weapon
, anim
, dir
, a
-1]) then
263 with wpoints
[weapon
, anim
, dir
, a
-1] do
265 X
:= X
- WEAPONBASE
[weapon
].X
;
266 Y
:= Y
- WEAPONBASE
[weapon
].Y
;
267 if dir
= TDirection
.D_LEFT
then
272 h
:= High(wpoints
[weapon
, anim
, dir
]);
274 for b
:= h
downto frames
do
275 wpoints
[weapon
, anim
, dir
, b
] := wpoints
[weapon
, anim
, dir
, h
-b
+1];
280 procedure ExtAnimFromBaseAnim(MName
: String; AIdx
: Integer);
282 CopyAnim
: array [A_LASTBASE
+1..A_LASTEXT
] of Integer = (
283 A_WALK
, A_WALK
, A_WALK
, A_WALK
, A_WALK
,
284 A_STAND
, A_WALK
, A_ATTACK
, A_WALK
, A_SEEUP
, A_SEEDOWN
,
285 A_ATTACKUP
, A_ATTACKDOWN
290 AName
, OName
: String;
292 // HACK: shitty workaround to duplicate base animations
293 // in place of extended, replace with something better later
295 Assert((AIdx
> A_LASTBASE
) and (AIdx
<= A_LASTEXT
));
296 OIdx
:= CopyAnim
[AIdx
];
298 AName
:= MName
+ '_RIGHTANIM' + IntToStr(AIdx
);
299 OName
:= MName
+ '_RIGHTANIM' + IntToStr(OIdx
);
300 Assert(g_Frames_Dup(AName
, OName
));
301 Assert(g_Frames_Dup(AName
+ '_MASK', OName
+ '_MASK'));
302 AName
:= MName
+ '_LEFTANIM' + IntToStr(AIdx
);
303 OName
:= MName
+ '_LEFTANIM' + IntToStr(OIdx
);
304 if g_Frames_Exists(AName
) then
306 g_Frames_Dup(AName
, OName
);
307 g_Frames_Dup(AName
+ '_MASK', OName
+ '_MASK');
310 with PlayerModelsArray
[High(PlayerModelsArray
)] do
312 for W
:= WP_FIRST
+ 1 to WP_LAST
do
314 for D
:= TDirection
.D_LEFT
to TDirection
.D_RIGHT
do
316 SetLength(WeaponPoints
[W
, AIdx
, D
], Length(WeaponPoints
[W
, OIdx
, D
]));
317 for I
:= 0 to High(WeaponPoints
[W
, AIdx
, D
]) do
318 WeaponPoints
[W
, AIdx
, D
, I
] := WeaponPoints
[W
, OIdx
, D
, I
]
324 function g_PlayerModel_CalcGibSize (pData
: Pointer; dataSize
, x
, y
, w
, h
: Integer): TRectWH
;
325 var i
, j
: Integer; done
: Boolean; img
: TImageData
;
327 function IsVoid (i
, j
: Integer): Boolean;
329 result
:= Byte((PByte(img
.bits
) + (y
+j
)*img
.width
*4 + (x
+i
)*4 + 3)^) = 0
334 assert(LoadImageFromMemory(pData
, dataSize
, img
));
336 (* trace x from right to left *)
337 done
:= false; i
:= 0;
338 while not done
and (i
< w
) do
341 while (j
< h
) and IsVoid(i
, j
) do inc(j
);
342 done
:= (j
< h
) and (IsVoid(i
, j
) = false);
347 (* trace y from up to down *)
348 done
:= false; j
:= 0;
349 while not done
and (j
< h
) do
352 while (i
< w
) and IsVoid(i
, j
) do inc(i
);
353 done
:= (i
< w
) and (IsVoid(i
, j
) = false);
358 (* trace x from right to left *)
359 done
:= false; i
:= w
- 1;
360 while not done
and (i
>= 0) do
363 while (j
< h
) and IsVoid(i
, j
) do inc(j
);
364 done
:= (j
< h
) and (IsVoid(i
, j
) = false);
365 result
.width
:= i
- result
.x
+ 1;
369 (* trace y from down to up *)
370 done
:= false; j
:= h
- 1;
371 while not done
and (j
>= 0) do
374 while (i
< w
) and IsVoid(i
, j
) do inc(i
);
375 done
:= (i
< w
) and (IsVoid(i
, j
) = false);
376 result
.height
:= j
- result
.y
+ 1;
383 function g_PlayerModel_Load(FileName
: string): Boolean;
386 a
, b
, len
, lenpd
, lenpd2
, aa
, bb
, f
: Integer;
389 pData
, pData2
: Pointer;
395 e_WriteLog(Format('Loading player model "%s"...', [FileName
]), TMsgType
.Notify
);
399 WAD
:= TWADFile
.Create
;
400 WAD
.ReadFile(FileName
);
402 if {WAD.GetLastError <> DFWAD_NOERROR} not WAD
.isOpen
then
408 if not WAD
.GetResource('TEXT/MODEL', pData
, len
) then
414 config
:= TConfig
.CreateMem(pData
, len
);
417 s
:= config
.ReadStr('Model', 'name', '');
425 SetLength(PlayerModelsArray
, Length(PlayerModelsArray
)+1);
426 ID
:= High(PlayerModelsArray
);
428 prefix
:= FileName
+':TEXTURES\';
430 with PlayerModelsArray
[ID
].Info
do
433 Author
:= config
.ReadStr('Model', 'author', '');
434 Description
:= config
.ReadStr('Model', 'description', '');
437 with PlayerModelsArray
[ID
] do
439 Blood
.R
:= MAX(0, MIN(255, config
.ReadInt('Blood', 'R', 150)));
440 Blood
.G
:= MAX(0, MIN(255, config
.ReadInt('Blood', 'G', 0)));
441 Blood
.B
:= MAX(0, MIN(255, config
.ReadInt('Blood', 'B', 0)));
442 case config
.ReadStr('Blood', 'Kind', 'NORMAL') of
443 'NORMAL': Blood
.Kind
:= BLOOD_NORMAL
;
444 'SPARKS': Blood
.Kind
:= BLOOD_CSPARKS
;
445 'COMBINE': Blood
.Kind
:= BLOOD_COMBINE
;
447 Blood
.Kind
:= BLOOD_NORMAL
451 for b
:= A_STAND
to A_LAST
do
453 aname
:= s
+'_RIGHTANIM'+IntToStr(b
);
454 //e_LogWritefln('### MODEL FILE: [%s]', [prefix+config.ReadStr(AnimNames[b], 'resource', '')]);
455 if not (g_Frames_CreateWAD(nil, aname
,
456 prefix
+config
.ReadStr(AnimNames
[b
], 'resource', ''),
457 64, 64, config
.ReadInt(AnimNames
[b
], 'frames', 1),
458 config
.ReadBool(AnimNames
[b
], 'backanim', False)) and
459 g_Frames_CreateWAD(nil, aname
+'_MASK',
460 prefix
+config
.ReadStr(AnimNames
[b
], 'mask', ''),
461 64, 64, config
.ReadInt(AnimNames
[b
], 'frames', 1),
462 config
.ReadBool(AnimNames
[b
], 'backanim', False))) then
464 if b
<= A_LASTBASE
then
472 ExtAnimFromBaseAnim(s
, b
);
477 for aa
:= WP_FIRST
+ 1 to WP_LAST
do
478 for bb
:= A_STAND
to A_LAST
do
479 for cc
:= TDirection
.D_LEFT
to TDirection
.D_RIGHT
do
481 f
:= config
.ReadInt(AnimNames
[bb
], 'frames', 1);
482 if config
.ReadBool(AnimNames
[bb
], 'backanim', False) then
483 if f
> 2 then f
:= 2*f
-2;
484 SetLength(PlayerModelsArray
[ID
].WeaponPoints
[aa
, bb
, cc
], f
);
487 if (config
.ReadStr(AnimNames
[b
], 'resource2', '') <> '') and
488 (config
.ReadStr(AnimNames
[b
], 'mask2', '') <> '') then
490 aname
:= s
+'_LEFTANIM'+IntToStr(b
);
491 g_Frames_CreateWAD(nil, aname
,
492 prefix
+config
.ReadStr(AnimNames
[b
], 'resource2', ''),
493 64, 64, config
.ReadInt(AnimNames
[b
], 'frames', 1),
494 config
.ReadBool(AnimNames
[b
], 'backanim', False));
496 g_Frames_CreateWAD(nil, aname
+'_MASK',
497 prefix
+config
.ReadStr(AnimNames
[b
], 'mask2', ''),
498 64, 64, config
.ReadInt(AnimNames
[b
], 'frames', 1),
499 config
.ReadBool(AnimNames
[b
], 'backanim', False));
502 PlayerModelsArray
[ID
].ModelSpeed
[b
] := Max(1, config
.ReadInt(AnimNames
[b
], 'waitcount', 1) div 3);
505 with PlayerModelsArray
[ID
], config
do
507 prefix
:= FileName
+':SOUNDS\';
511 s
:= config
.ReadStr('Sound', 'pain'+IntToStr(a
), '');
514 SetLength(PainSounds
, Length(PainSounds
)+1);
515 g_Sound_CreateWAD(PainSounds
[High(PainSounds
)].ID
, prefix
+s
);
516 PainSounds
[High(PainSounds
)].Level
:= config
.ReadInt('Sound', 'painlevel'+IntToStr(a
), 1);
523 s
:= config
.ReadStr('Sound', 'die'+IntToStr(a
), '');
526 SetLength(DieSounds
, Length(DieSounds
)+1);
527 g_Sound_CreateWAD(DieSounds
[High(DieSounds
)].ID
, prefix
+s
);
528 DieSounds
[High(DieSounds
)].Level
:= config
.ReadInt('Sound', 'dielevel'+IntToStr(a
), 1);
533 SlopSound
:= Min(Max(config
.ReadInt('Sound', 'slop', 0), 0), 2);
535 SetLength(Gibs
, ReadInt('Gibs', 'count', 0));
538 (WAD
.GetResource('TEXTURES/'+config
.ReadStr('Gibs', 'resource', 'GIBS'), pData
, lenpd
)) and
539 (WAD
.GetResource('TEXTURES/'+config
.ReadStr('Gibs', 'mask', 'GIBSMASK'), pData2
, lenpd2
)) then
541 for a
:= 0 to High(Gibs
) do
542 if e_CreateTextureMemEx(pData
, lenpd
, Gibs
[a
].ID
, a
*32, 0, 32, 32) and
543 e_CreateTextureMemEx(pData2
, lenpd2
, Gibs
[a
].MaskID
, a
*32, 0, 32, 32) then
545 //Gibs[a].Rect := e_GetTextureSize2(Gibs[a].ID);
546 Gibs
[a
].Rect
:= g_PlayerModel_CalcGibSize(pData
, lenpd
, a
*32, 0, 32, 32);
548 if Height
> 3 then Height
:= Height
-1-Random(2);
549 Gibs
[a
].OnlyOne
:= config
.ReadInt('Gibs', 'once', -1) = a
+1;
557 for aa
:= WP_FIRST
+ 1 to WP_LAST
do
558 for bb
:= A_STAND
to A_LAST
do
559 if not (bb
in [A_DIE1
, A_DIE2
, A_PAIN
]) then
561 chk
:= GetWeapPoints(config
.ReadStr(AnimNames
[bb
], WeapNames
[aa
]+'_points', ''), aa
, bb
, TDirection
.D_RIGHT
,
562 config
.ReadInt(AnimNames
[bb
], 'frames', 0),
563 config
.ReadBool(AnimNames
[bb
], 'backanim', False),
565 if ok
and (not chk
) and (aa
= WEAPON_FLAMETHROWER
) then
567 // workaround for flamethrower
568 chk
:= GetWeapPoints(config
.ReadStr(AnimNames
[bb
], WeapNames
[WEAPON_PLASMA
]+'_points', ''), aa
, bb
, TDirection
.D_RIGHT
,
569 config
.ReadInt(AnimNames
[bb
], 'frames', 0),
570 config
.ReadBool(AnimNames
[bb
], 'backanim', False),
573 for f
:= 0 to High(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
]) do
578 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].X
, 6);
579 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].Y
, 8);
581 A_WALKATTACK
, A_WALK
:
583 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].X
, 9);
584 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].Y
, 9);
588 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].X
, 5);
589 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].Y
, 8);
591 A_WALKSEEUP
, A_SEEUP
:
593 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].X
, 5);
594 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].Y
, 16);
596 A_WALKSEEDOWN
, A_SEEDOWN
:
598 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].X
, 6);
599 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].Y
, 5);
601 A_WALKATTACKUP
, A_ATTACKUP
:
603 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].X
, 5);
604 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].Y
, 16);
606 A_WALKATTACKDOWN
, A_ATTACKDOWN
:
608 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].X
, 6);
609 Dec(WeaponPoints
[aa
, bb
, TDirection
.D_RIGHT
, f
].Y
, 4);
614 ok
:= ok
and (chk
or (bb
> A_LASTBASE
));
616 if not GetWeapPoints(config
.ReadStr(AnimNames
[bb
], WeapNames
[aa
]+'2_points', ''), aa
, bb
, TDirection
.D_LEFT
,
617 config
.ReadInt(AnimNames
[bb
], 'frames', 0),
618 config
.ReadBool(AnimNames
[bb
], 'backanim', False),
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
;
626 if not ok
then Break
;
628 {if ok then g_Console_Add(Info.Name+' weapon points ok')
629 else g_Console_Add(Info.Name+' weapon points fail');}
630 Info
.HaveWeapon
:= ok
;
632 s
:= config
.ReadStr('Model', 'flag_point', '');
633 if not GetPoint(s
, FlagPoint
) then FlagPoint
:= FLAG_DEFPOINT
;
635 FlagAngle
:= config
.ReadInt('Model', 'flag_angle', FLAG_DEFANGLE
);
644 function g_PlayerModel_Get(ModelName
: String): TPlayerModel
;
652 if PlayerModelsArray
= nil then Exit
;
654 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
.FName
:= Info
.Name
;
662 Result
.FBlood
:= Blood
;
664 for b
:= A_STAND
to A_LAST
do
666 if not (g_Frames_Get(ID
, Info
.Name
+'_RIGHTANIM'+IntToStr(b
)) and
667 g_Frames_Get(ID2
, Info
.Name
+'_RIGHTANIM'+IntToStr(b
)+'_MASK')) then
674 Result
.FAnim
[TDirection
.D_RIGHT
][b
] := TAnimation
.Create(ID
, b
in [A_STAND
, A_WALK
], ModelSpeed
[b
]);
676 Result
.FMaskAnim
[TDirection
.D_RIGHT
][b
] := TAnimation
.Create(ID2
, b
in [A_STAND
, A_WALK
], ModelSpeed
[b
]);
678 if g_Frames_Exists(Info
.Name
+'_LEFTANIM'+IntToStr(b
)) and
679 g_Frames_Exists(Info
.Name
+'_LEFTANIM'+IntToStr(b
)+'_MASK') then
680 if g_Frames_Get(ID
, Info
.Name
+'_LEFTANIM'+IntToStr(b
)) and
681 g_Frames_Get(ID2
, Info
.Name
+'_LEFTANIM'+IntToStr(b
)+'_MASK') then
683 Result
.FAnim
[TDirection
.D_LEFT
][b
] := TAnimation
.Create(ID
, b
in [A_STAND
, A_WALK
], ModelSpeed
[b
]);
685 Result
.FMaskAnim
[TDirection
.D_LEFT
][b
] := TAnimation
.Create(ID2
, b
in [A_STAND
, A_WALK
], ModelSpeed
[b
]);
689 Result
.FPainSounds
:= PainSounds
;
690 Result
.FDieSounds
:= DieSounds
;
691 Result
.FSlopSound
:= SlopSound
;
692 Result
.FDrawWeapon
:= Info
.HaveWeapon
;
693 Result
.FWeaponPoints
:= WeaponPoints
;
695 Result
.FFlagPoint
:= FlagPoint
;
696 Result
.FFlagAngle
:= FlagAngle
;
703 function g_PlayerModel_GetAnim(ModelName
: string; Anim
: Byte; var _Anim
, _Mask
: TAnimation
): Boolean;
711 if PlayerModelsArray
= nil then Exit
;
712 for a
:= 0 to High(PlayerModelsArray
) do
713 if PlayerModelsArray
[a
].Info
.Name
= ModelName
then
714 with PlayerModelsArray
[a
] do
716 if Anim
in [A_STAND
, A_WALK
] then c
:= True else c
:= False;
718 if not g_Frames_Get(ID
, Info
.Name
+'_RIGHTANIM'+IntToStr(Anim
)) then
719 if not g_Frames_Get(ID
, Info
.Name
+'_LEFTANIM'+IntToStr(Anim
)) then Exit
;
721 _Anim
:= TAnimation
.Create(ID
, c
, ModelSpeed
[Anim
]);
722 _Anim
.Speed
:= ModelSpeed
[Anim
];
724 if not g_Frames_Get(ID
, Info
.Name
+'_RIGHTANIM'+IntToStr(Anim
)+'_MASK') then
725 if not g_Frames_Get(ID
, Info
.Name
+'_LEFTANIM'+IntToStr(Anim
)+'_MASK') then Exit
;
727 _Mask
:= TAnimation
.Create(ID
, c
, ModelSpeed
[Anim
]);
728 _Mask
.Speed
:= ModelSpeed
[Anim
];
736 function g_PlayerModel_GetGibs(ModelName
: string; var Gibs
: TGibsArray
): Boolean;
743 if PlayerModelsArray
= nil then Exit
;
744 if gGibsCount
= 0 then Exit
;
748 SetLength(Gibs
, gGibsCount
);
750 for a
:= 0 to High(PlayerModelsArray
) do
751 if PlayerModelsArray
[a
].Info
.Name
= ModelName
then
753 for i
:= 0 to High(Gibs
) do
755 if c
and (Length(PlayerModelsArray
[a
].Gibs
) = 1) then
762 b
:= Random(Length(PlayerModelsArray
[a
].Gibs
));
763 until not (PlayerModelsArray
[a
].Gibs
[b
].OnlyOne
and c
);
765 Gibs
[i
] := PlayerModelsArray
[a
].Gibs
[b
];
767 if Gibs
[i
].OnlyOne
then c
:= True;
775 function g_PlayerModel_GetNames(): SSArray
;
781 if PlayerModelsArray
= nil then Exit
;
783 for i
:= 0 to High(PlayerModelsArray
) do
785 SetLength(Result
, Length(Result
)+1);
786 Result
[High(Result
)] := PlayerModelsArray
[i
].Info
.Name
;
790 function g_PlayerModel_GetInfo(ModelName
: string): TModelInfo
;
794 FillChar(Result
, SizeOf(Result
), 0);
795 if PlayerModelsArray
= nil then Exit
;
797 for a
:= 0 to High(PlayerModelsArray
) do
798 if PlayerModelsArray
[a
].Info
.Name
= ModelName
then
800 Result
:= PlayerModelsArray
[a
].Info
;
805 function g_PlayerModel_GetBlood(ModelName
: string): TModelBlood
;
812 Result
.Kind
:= BLOOD_NORMAL
;
813 if PlayerModelsArray
= nil then Exit
;
815 for a
:= 0 to High(PlayerModelsArray
) do
816 if PlayerModelsArray
[a
].Info
.Name
= ModelName
then
818 Result
:= PlayerModelsArray
[a
].Blood
;
823 procedure g_PlayerModel_FreeData();
828 e_WriteLog('Releasing models...', TMsgType
.Notify
);
830 if PlayerModelsArray
= nil then Exit
;
832 for i
:= 0 to High(PlayerModelsArray
) do
833 with PlayerModelsArray
[i
] do
835 for a
:= A_STAND
to A_LAST
do
837 g_Frames_DeleteByName(Info
.Name
+'_LEFTANIM'+IntToStr(a
));
838 g_Frames_DeleteByName(Info
.Name
+'_LEFTANIM'+IntToStr(a
)+'_MASK');
839 g_Frames_DeleteByName(Info
.Name
+'_RIGHTANIM'+IntToStr(a
));
840 g_Frames_DeleteByName(Info
.Name
+'_RIGHTANIM'+IntToStr(a
)+'_MASK');
843 if PainSounds
<> nil then
844 for b
:= 0 to High(PainSounds
) do
845 e_DeleteSound(PainSounds
[b
].ID
);
847 if DieSounds
<> nil then
848 for b
:= 0 to High(DieSounds
) do
849 e_DeleteSound(DieSounds
[b
].ID
);
852 for b
:= 0 to High(Gibs
) do
854 e_DeleteTexture(Gibs
[b
].ID
);
855 e_DeleteTexture(Gibs
[b
].MaskID
);
859 PlayerModelsArray
:= nil;
864 procedure TPlayerModel
.ChangeAnimation(Animation
: Byte; Force
: Boolean = False);
866 if not Force
then if FCurrentAnimation
= Animation
then Exit
;
868 FCurrentAnimation
:= Animation
;
870 if (FDirection
= TDirection
.D_LEFT
) and
871 (FAnim
[TDirection
.D_LEFT
][FCurrentAnimation
] <> nil) and
872 (FMaskAnim
[TDirection
.D_LEFT
][FCurrentAnimation
] <> nil) then
874 FAnim
[TDirection
.D_LEFT
][FCurrentAnimation
].Reset
;
875 FMaskAnim
[TDirection
.D_LEFT
][FCurrentAnimation
].Reset
;
879 FAnim
[TDirection
.D_RIGHT
][FCurrentAnimation
].Reset
;
880 FMaskAnim
[TDirection
.D_RIGHT
][FCurrentAnimation
].Reset
;
884 destructor TPlayerModel
.Destroy();
888 for a
:= A_STAND
to A_LAST
do
890 FAnim
[TDirection
.D_LEFT
][a
].Free();
891 FMaskAnim
[TDirection
.D_LEFT
][a
].Free();
892 FAnim
[TDirection
.D_RIGHT
][a
].Free();
893 FMaskAnim
[TDirection
.D_RIGHT
][a
].Free();
899 function TPlayerModel
.GetCurrentAnimation
: TAnimation
;
901 if (FDirection
= TDirection
.D_LEFT
) and (FAnim
[TDirection
.D_LEFT
][FCurrentAnimation
] <> nil) then
902 Result
:= FAnim
[TDirection
.D_LEFT
][FCurrentAnimation
]
904 Result
:= FAnim
[TDirection
.D_RIGHT
][FCurrentAnimation
];
907 function TPlayerModel
.GetCurrentAnimationMask
: TAnimation
;
909 if (FDirection
= TDirection
.D_LEFT
) and (FMaskAnim
[TDirection
.D_LEFT
][FCurrentAnimation
] <> nil) then
910 Result
:= FMaskAnim
[TDirection
.D_LEFT
][FCurrentAnimation
]
912 Result
:= FMaskAnim
[TDirection
.D_RIGHT
][FCurrentAnimation
];
915 function TPlayerModel
.PlaySound(SoundType
, Level
: Byte; X
, Y
: Integer): Boolean;
917 TempArray
: array of DWORD
;
921 SetLength(TempArray
, 0);
923 if SoundType
= MODELSOUND_PAIN
then
925 if FPainSounds
= nil then Exit
;
927 for a
:= 0 to High(FPainSounds
) do
928 if FPainSounds
[a
].Level
= Level
then
930 SetLength(TempArray
, Length(TempArray
)+1);
931 TempArray
[High(TempArray
)] := FPainSounds
[a
].ID
;
936 if (Level
in [2, 3, 5]) and (FSlopSound
> 0) then
938 g_Sound_PlayExAt('SOUND_MONSTER_SLOP', X
, Y
);
939 if FSlopSound
= 1 then
945 if FDieSounds
= nil then Exit
;
947 for a
:= 0 to High(FDieSounds
) do
948 if FDieSounds
[a
].Level
= Level
then
950 SetLength(TempArray
, Length(TempArray
)+1);
951 TempArray
[High(TempArray
)] := FDieSounds
[a
].ID
;
953 if (TempArray
= nil) and (Level
= 5) then
955 g_Sound_PlayExAt('SOUND_MONSTER_SLOP', X
, Y
);
961 if TempArray
= nil then Exit
;
963 g_Sound_PlayAt(TempArray
[Random(Length(TempArray
))], X
, Y
);
968 procedure TPlayerModel
.SetColor(Red
, Green
, Blue
: Byte);
975 procedure TPlayerModel
.SetFire(Fire
: Boolean);
979 if FFire
then FFireCounter
:= FAnim
[TDirection
.D_RIGHT
, A_ATTACK
].Speed
*FAnim
[TDirection
.D_RIGHT
, A_ATTACK
].TotalFrames
980 else FFireCounter
:= 0;
983 procedure TPlayerModel
.SetFlag(Flag
: Byte);
993 FLAG_RED
: g_Frames_Get(id
, 'FRAMES_FLAG_RED');
994 FLAG_BLUE
: g_Frames_Get(id
, 'FRAMES_FLAG_BLUE');
998 FFlagAnim
:= TAnimation
.Create(id
, True, 8);
1001 procedure TPlayerModel
.SetWeapon(Weapon
: Byte);
1003 FCurrentWeapon
:= Weapon
;
1006 procedure TPlayerModel
.Update();
1008 if (FDirection
= TDirection
.D_LEFT
) and (FAnim
[TDirection
.D_LEFT
][FCurrentAnimation
] <> nil) then
1009 FAnim
[TDirection
.D_LEFT
][FCurrentAnimation
].Update
else FAnim
[TDirection
.D_RIGHT
][FCurrentAnimation
].Update
;
1011 if (FDirection
= TDirection
.D_LEFT
) and (FMaskAnim
[TDirection
.D_LEFT
][FCurrentAnimation
] <> nil) then
1012 FMaskAnim
[TDirection
.D_LEFT
][FCurrentAnimation
].Update
else FMaskAnim
[TDirection
.D_RIGHT
][FCurrentAnimation
].Update
;
1014 if FFlagAnim
<> nil then FFlagAnim
.Update
;
1016 if FFireCounter
> 0 then Dec(FFireCounter
) else FFire
:= False;