DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob


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