DEADSOFTWARE

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


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