DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
render: use TPlayerModel for corpse drawing
[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
22 MAPDEF, g_textures, g_base, g_basic, g_weapons, r_graphics, utils, g_gfx,
23 ImagingTypes, Imaging, ImagingUtility;
24
25 const
26 A_STAND = 0;
27 A_WALK = 1;
28 A_DIE1 = 2;
29 A_DIE2 = 3;
30 A_ATTACK = 4;
31 A_SEEUP = 5;
32 A_SEEDOWN = 6;
33 A_ATTACKUP = 7;
34 A_ATTACKDOWN = 8;
35 A_PAIN = 9;
36 // EXTENDED
37 A_WALKATTACK = 10;
38 A_WALKSEEUP = 11;
39 A_WALKSEEDOWN = 12;
40 A_WALKATTACKUP = 13;
41 A_WALKATTACKDOWN = 14;
42 A_FISTSTAND = 15;
43 A_FISTWALK = 16;
44 A_FISTATTACK = 17;
45 A_FISTWALKATTACK = 18;
46 A_FISTSEEUP = 19;
47 A_FISTSEEDOWN = 20;
48 A_FISTATTACKUP = 21;
49 A_FISTATTACKDOWN = 22;
50
51 A_LASTBASE = A_PAIN;
52 A_LASTEXT = A_FISTATTACKDOWN;
53 A_LAST = A_LASTEXT;
54
55 MODELSOUND_PAIN = 0;
56 MODELSOUND_DIE = 1;
57
58 W_POS_NORMAL = 0;
59 W_POS_UP = 1;
60 W_POS_DOWN = 2;
61
62 W_ACT_NORMAL = 0;
63 W_ACT_FIRE = 1;
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 TAnimationState;
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 TModelBlood = record
80 R, G, B, Kind: Byte;
81 end;
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 function GetBlood (): TModelBlood;
115 function GetName (): String;
116
117 published
118 property Direction: TDirection read FDirection write FDirection;
119 property Animation: Byte read FCurrentAnimation;
120 property Weapon: Byte read FCurrentWeapon;
121
122 public
123 property Color: TRGB read FColor write FColor;
124 property AnimState: TAnimationState read FAnimState;
125 property CurrentAnimation: Byte read FCurrentAnimation;
126 property CurrentWeapon: Byte read FCurrentWeapon;
127 property Flag: Byte read FFlag;
128 property ID: Integer read FID;
129 end;
130
131 procedure g_PlayerModel_LoadAll;
132 procedure g_PlayerModel_FreeData();
133 function g_PlayerModel_Load(FileName: String): Boolean;
134 function g_PlayerModel_GetNames(): SSArray;
135 function g_PlayerModel_GetBlood(ModelName: String): TModelBlood;
136 function g_PlayerModel_Get(ModelName: String): TPlayerModel;
137 function g_PlayerModel_GetGibs (ModelID: Integer; var Gibs: TGibsArray): Boolean;
138 function g_PlayerModel_GetIndex (ModelName: String): Integer;
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, r_textures, r_animations,
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 function g_PlayerModel_CalcGibSize (pData: Pointer; dataSize, x, y, w, h: Integer): TRectWH;
301 var i, j: Integer; done: Boolean; img: TImageData;
302
303 function IsVoid (i, j: Integer): Boolean;
304 begin
305 result := Byte((PByte(img.bits) + (y+j)*img.width*4 + (x+i)*4 + 3)^) = 0
306 end;
307
308 begin
309 InitImage(img);
310 assert(LoadImageFromMemory(pData, dataSize, img));
311
312 (* trace x from right to left *)
313 done := false; i := 0;
314 while not done and (i < w) do
315 begin
316 j := 0;
317 while (j < h) and IsVoid(i, j) do inc(j);
318 done := (j < h) and (IsVoid(i, j) = false);
319 result.x := i;
320 inc(i);
321 end;
322
323 (* trace y from up to down *)
324 done := false; j := 0;
325 while not done and (j < h) do
326 begin
327 i := 0;
328 while (i < w) and IsVoid(i, j) do inc(i);
329 done := (i < w) and (IsVoid(i, j) = false);
330 result.y := j;
331 inc(j);
332 end;
333
334 (* trace x from right to left *)
335 done := false; i := w - 1;
336 while not done and (i >= 0) do
337 begin
338 j := 0;
339 while (j < h) and IsVoid(i, j) do inc(j);
340 done := (j < h) and (IsVoid(i, j) = false);
341 result.width := i - result.x + 1;
342 dec(i);
343 end;
344
345 (* trace y from down to up *)
346 done := false; j := h - 1;
347 while not done and (j >= 0) do
348 begin
349 i := 0;
350 while (i < w) and IsVoid(i, j) do inc(i);
351 done := (i < w) and (IsVoid(i, j) = false);
352 result.height := j - result.y + 1;
353 dec(j);
354 end;
355
356 FreeImage(img);
357 end;
358
359 function g_PlayerModel_Load(FileName: string): Boolean;
360 var
361 ID: DWORD;
362 a, b, len, aa, bb, f: Integer;
363 cc: TDirection;
364 config: TConfig;
365 pData: Pointer;
366 WAD: TWADFile;
367 s: string;
368 prefix: string;
369 ok, chk, chk2: Boolean;
370 begin
371 e_WriteLog(Format('Loading player model "%s"...', [FileName]), TMsgType.Notify);
372
373 Result := False;
374
375 WAD := TWADFile.Create;
376 WAD.ReadFile(FileName);
377
378 if {WAD.GetLastError <> DFWAD_NOERROR} not WAD.isOpen then
379 begin
380 WAD.Free();
381 Exit;
382 end;
383
384 if not WAD.GetResource('TEXT/MODEL', pData, len) then
385 begin
386 WAD.Free();
387 Exit;
388 end;
389
390 config := TConfig.CreateMem(pData, len);
391 FreeMem(pData);
392
393 s := config.ReadStr('Model', 'name', '');
394 if s = '' then
395 begin
396 config.Free();
397 WAD.Free();
398 Exit;
399 end;
400
401 SetLength(PlayerModelsArray, Length(PlayerModelsArray)+1);
402 ID := High(PlayerModelsArray);
403
404 prefix := FileName+':TEXTURES\';
405
406 PlayerModelsArray[ID].Name := s;
407 PlayerModelsArray[ID].Author := config.ReadStr('Model', 'author', '');
408 PlayerModelsArray[ID].Description := config.ReadStr('Model', 'description', '');
409 PlayerModelsArray[ID].FileName := FileName;
410 with PlayerModelsArray[ID] do
411 begin
412 Blood.R := MAX(0, MIN(255, config.ReadInt('Blood', 'R', 150)));
413 Blood.G := MAX(0, MIN(255, config.ReadInt('Blood', 'G', 0)));
414 Blood.B := MAX(0, MIN(255, config.ReadInt('Blood', 'B', 0)));
415 case config.ReadStr('Blood', 'Kind', 'NORMAL') of
416 'NORMAL': Blood.Kind := BLOOD_NORMAL;
417 'SPARKS': Blood.Kind := BLOOD_CSPARKS;
418 'COMBINE': Blood.Kind := BLOOD_COMBINE;
419 else
420 Blood.Kind := BLOOD_NORMAL
421 end
422 end;
423
424 for b := A_STAND to A_LAST do
425 begin
426 with PlayerModelsArray[ID].Anim[TDirection.D_RIGHT, b] do
427 begin
428 Resource := config.ReadStr(AnimNames[b], 'resource', '');
429 Mask := config.ReadStr(AnimNames[b], 'mask', '');
430 Frames := config.ReadInt(AnimNames[b], 'frames', 1);
431 Back := config.ReadBool(AnimNames[b], 'backanim', False);
432 if (Resource = '') or (Mask = '') then
433 begin
434 if b <= A_LASTBASE then
435 begin
436 config.Free();
437 WAD.Free();
438 Exit
439 end
440 else
441 begin
442 g_PlayerMode_ExtendPoints(ID, b);
443 continue
444 end
445 end;
446 end;
447
448 for aa := WP_FIRST + 1 to WP_LAST do
449 for bb := A_STAND to A_LAST do
450 for cc := TDirection.D_LEFT to TDirection.D_RIGHT do
451 begin
452 f := PlayerModelsArray[ID].Anim[cc, bb].Frames;
453 if PlayerModelsArray[ID].Anim[cc, bb].Back and (f > 2) then
454 f := 2 * f - 2;
455 SetLength(PlayerModelsArray[ID].WeaponPoints[aa, bb, cc], f);
456 end;
457
458 with PlayerModelsArray[ID].Anim[TDirection.D_LEFT, b] do
459 begin
460 Frames := PlayerModelsArray[ID].Anim[TDirection.D_RIGHT, b].Frames;
461 Back := PlayerModelsArray[ID].Anim[TDirection.D_RIGHT, b].Back;
462 end;
463
464 PlayerModelsArray[ID].ModelSpeed[b] := Max(1, config.ReadInt(AnimNames[b], 'waitcount', 1) div 3);
465 end;
466
467 with PlayerModelsArray[ID], config do
468 begin
469 prefix := FileName+':SOUNDS\';
470
471 a := 1;
472 repeat
473 s := config.ReadStr('Sound', 'pain'+IntToStr(a), '');
474 if s <> '' then
475 begin
476 SetLength(PainSounds, Length(PainSounds)+1);
477 g_Sound_CreateWAD(PainSounds[High(PainSounds)].ID, prefix+s);
478 PainSounds[High(PainSounds)].Level := config.ReadInt('Sound', 'painlevel'+IntToStr(a), 1);
479 end;
480 a := a+1;
481 until s = '';
482
483 a := 1;
484 repeat
485 s := config.ReadStr('Sound', 'die'+IntToStr(a), '');
486 if s <> '' then
487 begin
488 SetLength(DieSounds, Length(DieSounds)+1);
489 g_Sound_CreateWAD(DieSounds[High(DieSounds)].ID, prefix+s);
490 DieSounds[High(DieSounds)].Level := config.ReadInt('Sound', 'dielevel'+IntToStr(a), 1);
491 end;
492 a := a+1;
493 until s = '';
494
495 SlopSound := Min(Max(config.ReadInt('Sound', 'slop', 0), 0), 2);
496
497 GibsCount := config.ReadInt('Gibs', 'count', 0);
498 GibsResource := config.ReadStr('Gibs', 'resource', 'GIBS');
499 GibsMask := config.ReadStr('Gibs', 'mask', 'GIBSMASK');
500 GibsOnce := config.ReadInt('Gibs', 'once', -1);
501
502 ok := True;
503 for aa := WP_FIRST + 1 to WP_LAST do
504 for bb := A_STAND to A_LAST do
505 if not (bb in [A_DIE1, A_DIE2, A_PAIN]) then
506 begin
507 chk := GetWeapPoints(
508 config.ReadStr(AnimNames[bb], WeapNames[aa] + '_points', ''),
509 aa,
510 bb,
511 TDirection.D_RIGHT,
512 Anim[TDirection.D_RIGHT, bb].Frames,
513 Anim[TDirection.D_RIGHT, bb].Back,
514 WeaponPoints
515 );
516 if ok and (not chk) and (aa = WEAPON_FLAMETHROWER) then
517 begin
518 // workaround for flamethrower
519 chk := GetWeapPoints(
520 config.ReadStr(AnimNames[bb], WeapNames[WEAPON_PLASMA] + '_points', ''),
521 aa,
522 bb,
523 TDirection.D_RIGHT,
524 Anim[TDirection.D_RIGHT, bb].Frames,
525 Anim[TDirection.D_RIGHT, bb].Back,
526 WeaponPoints
527 );
528 if chk then
529 for f := 0 to High(WeaponPoints[aa, bb, TDirection.D_RIGHT]) do
530 begin
531 case bb of
532 A_STAND, A_PAIN:
533 begin
534 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 6);
535 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 8);
536 end;
537 A_WALKATTACK, A_WALK:
538 begin
539 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 9);
540 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 9);
541 end;
542 A_ATTACK:
543 begin
544 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 5);
545 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 8);
546 end;
547 A_WALKSEEUP, A_SEEUP:
548 begin
549 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 5);
550 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 16);
551 end;
552 A_WALKSEEDOWN, A_SEEDOWN:
553 begin
554 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 6);
555 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 5);
556 end;
557 A_WALKATTACKUP, A_ATTACKUP:
558 begin
559 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 5);
560 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 16);
561 end;
562 A_WALKATTACKDOWN, A_ATTACKDOWN:
563 begin
564 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 6);
565 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 4);
566 end;
567 end;
568 end;
569 end;
570
571 ok := ok and (chk or (bb > A_LASTBASE));
572
573 chk2 := GetWeapPoints(
574 config.ReadStr(AnimNames[bb], WeapNames[aa] + '2_points', ''),
575 aa,
576 bb,
577 TDirection.D_LEFT,
578 Anim[TDirection.D_LEFT, bb].Frames,
579 Anim[TDirection.D_LEFT, bb].Back,
580 WeaponPoints
581 );
582 if not chk2 then
583 begin
584 for f := 0 to High(WeaponPoints[aa, bb, TDirection.D_RIGHT]) do
585 begin
586 WeaponPoints[aa, bb, TDirection.D_LEFT, f].X := -WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X;
587 WeaponPoints[aa, bb, TDirection.D_LEFT, f].Y := WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y;
588 end;
589 end;
590
591 if not ok then Break;
592 end;
593 {if ok then g_Console_Add(Info.Name+' weapon points ok')
594 else g_Console_Add(Info.Name+' weapon points fail');}
595 PlayerModelsArray[ID].HaveWeapon := ok;
596
597 s := config.ReadStr('Model', 'flag_point', '');
598 if not GetPoint(s, FlagPoint) then
599 FlagPoint := FLAG_DEFPOINT;
600
601 FlagAngle := config.ReadInt('Model', 'flag_angle', FLAG_DEFANGLE);
602 end;
603
604 config.Free();
605 WAD.Free();
606
607 Result := True;
608 end;
609
610 function g_PlayerModel_Get (ModelName: String): TPlayerModel;
611 var a: Integer;
612 begin
613 Result := nil;
614
615 if PlayerModelsArray = nil then Exit;
616
617 for a := 0 to High(PlayerModelsArray) do
618 begin
619 if AnsiLowerCase(PlayerModelsArray[a].Name) = AnsiLowerCase(ModelName) then
620 begin
621 Result := TPlayerModel.Create;
622
623 with PlayerModelsArray[a] do
624 begin
625 Result.FID := a;
626 Result.ChangeAnimation(A_STAND, True);
627 Break;
628 end;
629 end;
630 end;
631 end;
632
633 function g_PlayerModel_GetGibs (ModelID: Integer; var Gibs: TGibsArray): Boolean;
634 var i, b: Integer; c: Boolean;
635 begin
636 Gibs := nil;
637 Result := False;
638 if (PlayerModelsArray = nil) or (gGibsCount = 0) then
639 Exit;
640
641 c := False;
642 SetLength(Gibs, gGibsCount);
643 for i := 0 to High(Gibs) do
644 begin
645 if c and (PlayerModelsArray[ModelID].GibsCount = 1) then
646 begin
647 SetLength(Gibs, i);
648 Break;
649 end;
650
651 repeat
652 b := Random(PlayerModelsArray[ModelID].GibsCount);
653 until not ((PlayerModelsArray[ModelID].GibsOnce = b + 1) and c);
654
655 Gibs[i] := b;
656
657 c := PlayerModelsArray[ModelID].GibsOnce = b + 1;
658 end;
659 Result := True;
660 end;
661
662 function g_PlayerModel_GetNames(): SSArray;
663 var
664 i: DWORD;
665 begin
666 Result := nil;
667
668 if PlayerModelsArray = nil then Exit;
669
670 for i := 0 to High(PlayerModelsArray) do
671 begin
672 SetLength(Result, Length(Result)+1);
673 Result[High(Result)] := PlayerModelsArray[i].Name;
674 end;
675 end;
676
677 function g_PlayerModel_GetBlood(ModelName: string): TModelBlood;
678 var
679 a: Integer;
680 begin
681 Result.R := 150;
682 Result.G := 0;
683 Result.B := 0;
684 Result.Kind := BLOOD_NORMAL;
685 if PlayerModelsArray = nil then Exit;
686
687 for a := 0 to High(PlayerModelsArray) do
688 if PlayerModelsArray[a].Name = ModelName then
689 begin
690 Result := PlayerModelsArray[a].Blood;
691 Break;
692 end;
693 end;
694
695 procedure g_PlayerModel_FreeData();
696 var i, b: Integer;
697 begin
698 e_WriteLog('Releasing models...', TMsgType.Notify);
699
700 if PlayerModelsArray = nil then Exit;
701
702 for i := 0 to High(PlayerModelsArray) do
703 begin
704 with PlayerModelsArray[i] do
705 begin
706 if PainSounds <> nil then
707 for b := 0 to High(PainSounds) do
708 e_DeleteSound(PainSounds[b].ID);
709 if DieSounds <> nil then
710 for b := 0 to High(DieSounds) do
711 e_DeleteSound(DieSounds[b].ID);
712 end;
713 end;
714 PlayerModelsArray := nil;
715 end;
716
717 { TPlayerModel }
718
719 procedure TPlayerModel.ChangeAnimation (Animation: Byte; Force: Boolean = False);
720 var once: Boolean; speed, count: Integer;
721 begin
722 if not Force then
723 if FCurrentAnimation = Animation then
724 Exit;
725 FCurrentAnimation := Animation;
726 once := FCurrentAnimation in [A_STAND, A_WALK];
727 speed := PlayerModelsArray[FID].ModelSpeed[FCurrentAnimation];
728 count := PlayerModelsArray[FID].Anim[FDirection, FCurrentAnimation].Frames;
729 FAnimState := TAnimationState.Create(once, speed, count);
730 end;
731
732 destructor TPlayerModel.Destroy();
733 begin
734 FAnimState.Free;
735 inherited;
736 end;
737
738 function TPlayerModel.PlaySound(SoundType, Level: Byte; X, Y: Integer): Boolean;
739 var
740 TempArray: array of DWORD;
741 a: Integer;
742 begin
743 Result := False;
744 SetLength(TempArray, 0);
745
746 if SoundType = MODELSOUND_PAIN then
747 begin
748 if PlayerModelsArray[FID].PainSounds = nil then Exit;
749
750 for a := 0 to High(PlayerModelsArray[FID].PainSounds) do
751 if PlayerModelsArray[FID].PainSounds[a].Level = Level then
752 begin
753 SetLength(TempArray, Length(TempArray) + 1);
754 TempArray[High(TempArray)] := PlayerModelsArray[FID].PainSounds[a].ID;
755 end;
756 end
757 else
758 begin
759 if (Level in [2, 3, 5]) and (PlayerModelsArray[FID].SlopSound > 0) then
760 begin
761 g_Sound_PlayExAt('SOUND_MONSTER_SLOP', X, Y);
762 if PlayerModelsArray[FID].SlopSound = 1 then
763 begin
764 Result := True;
765 Exit;
766 end;
767 end;
768 if PlayerModelsArray[FID].DieSounds = nil then Exit;
769
770 for a := 0 to High(PlayerModelsArray[FID].DieSounds) do
771 if PlayerModelsArray[FID].DieSounds[a].Level = Level then
772 begin
773 SetLength(TempArray, Length(TempArray) + 1);
774 TempArray[High(TempArray)] := PlayerModelsArray[FID].DieSounds[a].ID;
775 end;
776 if (TempArray = nil) and (Level = 5) then
777 begin
778 g_Sound_PlayExAt('SOUND_MONSTER_SLOP', X, Y);
779 Result := True;
780 Exit;
781 end;
782 end;
783
784 if TempArray = nil then Exit;
785
786 g_Sound_PlayAt(TempArray[Random(Length(TempArray))], X, Y);
787
788 Result := True;
789 end;
790
791 procedure TPlayerModel.SetColor(Red, Green, Blue: Byte);
792 begin
793 FColor.R := Red;
794 FColor.G := Green;
795 FColor.B := Blue;
796 end;
797
798 procedure TPlayerModel.SetFire (Fire: Boolean);
799 begin
800 if Fire then
801 FFireCounter := PlayerModelsArray[FID].ModelSpeed[A_ATTACK] * PlayerModelsArray[FID].Anim[TDirection.D_RIGHT, A_ATTACK].Frames
802 else
803 FFireCounter := 0
804 end;
805
806 function TPlayerModel.GetFire (): Boolean;
807 begin
808 Result := FFireCounter > 0
809 end;
810
811 procedure TPlayerModel.SetFlag (Flag: Byte);
812 begin
813 FFlag := Flag
814 end;
815
816 procedure TPlayerModel.SetWeapon (Weapon: Byte);
817 begin
818 FCurrentWeapon := Weapon
819 end;
820
821 function TPlayerModel.GetBlood (): TModelBlood;
822 begin
823 Result := PlayerModelsArray[FID].Blood
824 end;
825
826 function TPlayerModel.GetName (): String;
827 begin
828 Result := PlayerModelsArray[FID].Name
829 end;
830
831 procedure TPlayerModel.Update;
832 begin
833 if FAnimState <> nil then
834 FAnimState.Update;
835 if FFireCounter > 0 then
836 Dec(FFireCounter)
837 end;
838
839 procedure g_PlayerModel_LoadAll;
840 var
841 SR: TSearchRec;
842 knownFiles: array of AnsiString = nil;
843 found: Boolean;
844 wext, s: AnsiString;
845 f: Integer;
846 begin
847 // load models from all possible wad types, in all known directories
848 // this does a loosy job (linear search, ooph!), but meh
849 for wext in wadExtensions do
850 begin
851 for f := High(ModelDirs) downto Low(ModelDirs) do
852 begin
853 if (FindFirst(ModelDirs[f]+DirectorySeparator+'*'+wext, faAnyFile, SR) = 0) then
854 begin
855 repeat
856 found := false;
857 for s in knownFiles do
858 begin
859 if (strEquCI1251(forceFilenameExt(SR.Name, ''), forceFilenameExt(ExtractFileName(s), ''))) then
860 begin
861 found := true;
862 break;
863 end;
864 end;
865 if not found then
866 begin
867 SetLength(knownFiles, length(knownFiles)+1);
868 knownFiles[High(knownFiles)] := ModelDirs[f]+DirectorySeparator+SR.Name;
869 end;
870 until (FindNext(SR) <> 0);
871 end;
872 FindClose(SR);
873 end;
874 end;
875 if (length(knownFiles) = 0) then
876 raise Exception.Create('no player models found!');
877 if (length(knownFiles) = 1) then
878 e_LogWriteln('1 player model found.', TMsgType.Notify)
879 else
880 e_LogWritefln('%d player models found.', [Integer(length(knownFiles))], TMsgType.Notify);
881 for s in knownFiles do
882 if not g_PlayerModel_Load(s) then
883 e_LogWritefln('Error loading model "%s"', [s], TMsgType.Warning);
884 end;
885
886 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024