DEADSOFTWARE

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


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