DEADSOFTWARE

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