DEADSOFTWARE

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