DEADSOFTWARE

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