DEADSOFTWARE

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