DEADSOFTWARE

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