DEADSOFTWARE

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