DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
turned on "SCOPEDENUMS" fpc option
[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, either version 3 of the License, or
6 * (at your option) any later version.
7 *
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
12 *
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 *)
16 {$INCLUDE ../shared/a_modes.inc}
17 {$M+}
18 unit g_playermodel;
19
20 interface
21
22 uses
23 mempool,
24 MAPDEF, g_textures, g_basic, g_weapons, e_graphics, wadreader;
25
26 const
27 A_STAND = 0;
28 A_WALK = 1;
29 A_DIE1 = 2;
30 A_DIE2 = 3;
31 A_ATTACK = 4;
32 A_SEEUP = 5;
33 A_SEEDOWN = 6;
34 A_ATTACKUP = 7;
35 A_ATTACKDOWN = 8;
36 A_PAIN = 9;
37 // EXTENDED
38 A_WALKATTACK = 10;
39 A_WALKSEEUP = 11;
40 A_WALKSEEDOWN = 12;
41 A_WALKATTACKUP = 13;
42 A_WALKATTACKDOWN = 14;
43 A_FISTSTAND = 15;
44 A_FISTWALK = 16;
45 A_FISTATTACK = 17;
46 A_FISTWALKATTACK = 18;
47 A_FISTSEEUP = 19;
48 A_FISTSEEDOWN = 20;
49 A_FISTATTACKUP = 21;
50 A_FISTATTACKDOWN = 22;
51
52 A_LASTBASE = A_PAIN;
53 A_LASTEXT = A_FISTATTACKDOWN;
54 A_LAST = A_LASTEXT;
55
56 MODELSOUND_PAIN = 0;
57 MODELSOUND_DIE = 1;
58
59 type
60 TModelInfo = record
61 Name: String;
62 Author: String;
63 Description: String;
64 HaveWeapon: Boolean;
65 end;
66
67 TModelSound = record
68 ID: DWORD;
69 Level: Byte;
70 end;
71
72 TGibSprite = record
73 ID: DWORD;
74 MaskID: DWORD;
75 Rect: TRectWH;
76 OnlyOne: Boolean;
77 end;
78
79 TModelSoundArray = Array of TModelSound;
80 TGibsArray = Array of TGibSprite;
81 TWeaponPoints = Array [WP_FIRST + 1..WP_LAST] of
82 Array [A_STAND..A_LAST] of
83 Array [TDirection.D_LEFT..TDirection.D_RIGHT] of Array of TDFPoint;
84
85 TPlayerModel = class(TPoolObject)
86 private
87 FName: String;
88 FDirection: TDirection;
89 FColor: TRGB;
90 FCurrentAnimation: Byte;
91 FAnim: Array [TDirection.D_LEFT..TDirection.D_RIGHT] of Array [A_STAND..A_LAST] of TAnimation;
92 FMaskAnim: Array [TDirection.D_LEFT..TDirection.D_RIGHT] of Array [A_STAND..A_LAST] of TAnimation;
93 FWeaponPoints: TWeaponPoints;
94 FPainSounds: TModelSoundArray;
95 FDieSounds: TModelSoundArray;
96 FSlopSound: Byte;
97 FCurrentWeapon: Byte;
98 FDrawWeapon: Boolean;
99 FFlag: Byte;
100 FFlagPoint: TDFPoint;
101 FFlagAngle: SmallInt;
102 FFlagAnim: TAnimation;
103 FFire: Boolean;
104 FFireCounter: Byte;
105
106 public
107 destructor Destroy(); override;
108 procedure ChangeAnimation(Animation: Byte; Force: Boolean = False);
109 function GetCurrentAnimation: TAnimation;
110 function GetCurrentAnimationMask: TAnimation;
111 procedure SetColor(Red, Green, Blue: Byte);
112 procedure SetWeapon(Weapon: Byte);
113 procedure SetFlag(Flag: Byte);
114 procedure SetFire(Fire: Boolean);
115 function PlaySound(SoundType, Level: Byte; X, Y: Integer): Boolean;
116 procedure Update();
117 procedure Draw(X, Y: Integer; Alpha: Byte = 0);
118
119 published
120 property Fire: Boolean read FFire;
121 property Direction: TDirection read FDirection write FDirection;
122 property Animation: Byte read FCurrentAnimation;
123 property Weapon: Byte read FCurrentWeapon;
124 property Name: String read FName;
125
126 public
127 property Color: TRGB read FColor write FColor;
128 end;
129
130 procedure g_PlayerModel_LoadData();
131 procedure g_PlayerModel_FreeData();
132 function g_PlayerModel_Load(FileName: String): Boolean;
133 function g_PlayerModel_GetNames(): SArray;
134 function g_PlayerModel_GetInfo(ModelName: String): TModelInfo;
135 function g_PlayerModel_Get(ModelName: String): TPlayerModel;
136 function g_PlayerModel_GetAnim(ModelName: String; Anim: Byte; var _Anim, _Mask: TAnimation): Boolean;
137 function g_PlayerModel_GetGibs(ModelName: String; var Gibs: TGibsArray): Boolean;
138
139 implementation
140
141 uses
142 g_main, g_sound, g_console, SysUtils, g_player, CONFIG,
143 GL, GLExt, e_sound, g_options, g_map, Math, e_log;
144
145 type
146 TPlayerModelInfo = record
147 Info: TModelInfo;
148 ModelSpeed: Array [A_STAND..A_PAIN] of Byte;
149 FlagPoint: TDFPoint;
150 FlagAngle: SmallInt;
151 WeaponPoints: TWeaponPoints;
152 Gibs: TGibsArray;
153 PainSounds: TModelSoundArray;
154 DieSounds: TModelSoundArray;
155 SlopSound: Byte;
156 end;
157
158 const
159 W_POS_NORMAL = 0;
160 W_POS_UP = 1;
161 W_POS_DOWN = 2;
162
163 W_ACT_NORMAL = 0;
164 W_ACT_FIRE = 1;
165
166 FLAG_BASEPOINT: TDFPoint = (X:16; Y:43);
167 FLAG_DEFPOINT: TDFPoint = (X:32; Y:16);
168 FLAG_DEFANGLE = -20;
169 WEAPONBASE: Array [WP_FIRST + 1..WP_LAST] of TDFPoint =
170 ((X:8; Y:4), (X:8; Y:8), (X:16; Y:16), (X:16; Y:24),
171 (X:16; Y:16), (X:24; Y:24), (X:16; Y:16), (X:24; Y:24),
172 (X:16; Y:16), (X:8; Y:8));
173
174 AnimNames: Array [A_STAND..A_LASTEXT] of String =
175 ('StandAnim','WalkAnim','Die1Anim','Die2Anim','AttackAnim',
176 'SeeUpAnim','SeeDownAnim','AttackUpAnim','AttackDownAnim','PainAnim',
177 // EXTENDED
178 'WalkAttackAnim', 'WalkSeeUpAnim', 'WalkSeeDownAnim',
179 'WalkAttackUpAnim', 'WalkAttackDownAnim', 'FistStandAnim', 'FistWalkAnim',
180 'FistAttackAnim', 'FistWalkAttackAnim', 'FistSeeUpAnim', 'FistSeeDownAnim',
181 'FistAttackUpAnim', 'FistAttackDownAnim');
182 WeapNames: Array [WP_FIRST + 1..WP_LAST] of String =
183 ('csaw', 'hgun', 'sg', 'ssg', 'mgun', 'rkt', 'plz', 'bfg', 'spl', 'flm');
184
185 var
186 WeaponID: Array [WP_FIRST + 1..WP_LAST] of
187 Array [W_POS_NORMAL..W_POS_DOWN] of
188 Array [W_ACT_NORMAL..W_ACT_FIRE] of DWORD;
189 PlayerModelsArray: Array of TPlayerModelInfo;
190
191 procedure g_PlayerModel_LoadData();
192 var
193 a: Integer;
194 begin
195 for a := WP_FIRST + 1 to WP_LAST do
196 begin
197 g_Texture_CreateWAD(WeaponID[a][W_POS_NORMAL][W_ACT_NORMAL], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a]));
198 g_Texture_CreateWAD(WeaponID[a][W_POS_NORMAL][W_ACT_FIRE], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_FIRE');
199 g_Texture_CreateWAD(WeaponID[a][W_POS_UP][W_ACT_NORMAL], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_UP');
200 g_Texture_CreateWAD(WeaponID[a][W_POS_UP][W_ACT_FIRE], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_UP_FIRE');
201 g_Texture_CreateWAD(WeaponID[a][W_POS_DOWN][W_ACT_NORMAL], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_DN');
202 g_Texture_CreateWAD(WeaponID[a][W_POS_DOWN][W_ACT_FIRE], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_DN_FIRE');
203 end;
204 end;
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 ExtAnimFromBaseAnim(MName: String; 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
283 OIdx, W, I: Integer;
284 D: TDirection;
285 AName, OName: String;
286 begin
287 // HACK: shitty workaround to duplicate base animations
288 // in place of extended, replace with something better later
289
290 Assert((AIdx > A_LASTBASE) and (AIdx <= A_LASTEXT));
291 OIdx := CopyAnim[AIdx];
292
293 AName := MName + '_RIGHTANIM' + IntToStr(AIdx);
294 OName := MName + '_RIGHTANIM' + IntToStr(OIdx);
295 Assert(g_Frames_Dup(AName, OName));
296 Assert(g_Frames_Dup(AName + '_MASK', OName + '_MASK'));
297 AName := MName + '_LEFTANIM' + IntToStr(AIdx);
298 OName := MName + '_LEFTANIM' + IntToStr(OIdx);
299 if g_Frames_Exists(AName) then
300 begin
301 g_Frames_Dup(AName, OName);
302 g_Frames_Dup(AName + '_MASK', OName + '_MASK');
303 end;
304
305 with PlayerModelsArray[High(PlayerModelsArray)] do
306 begin
307 for W := WP_FIRST + 1 to WP_LAST do
308 begin
309 for D := TDirection.D_LEFT to TDirection.D_RIGHT do
310 begin
311 SetLength(WeaponPoints[W, AIdx, D], Length(WeaponPoints[W, OIdx, D]));
312 for I := 0 to High(WeaponPoints[W, AIdx, D]) do
313 WeaponPoints[W, AIdx, D, I] := WeaponPoints[W, OIdx, D, I]
314 end;
315 end;
316 end;
317 end;
318
319 function g_PlayerModel_Load(FileName: string): Boolean;
320 var
321 ID: DWORD;
322 a, b, len, lenpd, lenpd2, aa, bb, f: Integer;
323 cc: TDirection;
324 config: TConfig;
325 pData, pData2: Pointer;
326 WAD: TWADFile;
327 s, aname: string;
328 prefix: string;
329 ok, chk: Boolean;
330 begin
331 e_WriteLog(Format('Loading player model: %s', [ExtractFileName(FileName)]), TMsgType.Notify);
332
333 Result := False;
334
335 WAD := TWADFile.Create;
336 WAD.ReadFile(FileName);
337
338 if {WAD.GetLastError <> DFWAD_NOERROR} not WAD.isOpen then
339 begin
340 WAD.Free();
341 Exit;
342 end;
343
344 if not WAD.GetResource('TEXT/MODEL', pData, len) then
345 begin
346 WAD.Free();
347 Exit;
348 end;
349
350 config := TConfig.CreateMem(pData, len);
351 FreeMem(pData);
352
353 s := config.ReadStr('Model', 'name', '');
354 if s = '' then
355 begin
356 config.Free();
357 WAD.Free();
358 Exit;
359 end;
360
361 SetLength(PlayerModelsArray, Length(PlayerModelsArray)+1);
362 ID := High(PlayerModelsArray);
363
364 prefix := FileName+':TEXTURES\';
365
366 with PlayerModelsArray[ID].Info do
367 begin
368 Name := s;
369 Author := config.ReadStr('Model', 'author', '');
370 Description := config.ReadStr('Model', 'description', '');
371 end;
372
373 for b := A_STAND to A_LAST do
374 begin
375 aname := s+'_RIGHTANIM'+IntToStr(b);
376 //e_LogWritefln('### MODEL FILE: [%s]', [prefix+config.ReadStr(AnimNames[b], 'resource', '')]);
377 if not (g_Frames_CreateWAD(nil, aname,
378 prefix+config.ReadStr(AnimNames[b], 'resource', ''),
379 64, 64, config.ReadInt(AnimNames[b], 'frames', 1),
380 config.ReadBool(AnimNames[b], 'backanim', False)) and
381 g_Frames_CreateWAD(nil, aname+'_MASK',
382 prefix+config.ReadStr(AnimNames[b], 'mask', ''),
383 64, 64, config.ReadInt(AnimNames[b], 'frames', 1),
384 config.ReadBool(AnimNames[b], 'backanim', False))) then
385 begin
386 if b <= A_LASTBASE then
387 begin
388 config.Free();
389 WAD.Free();
390 Exit;
391 end
392 else
393 begin
394 ExtAnimFromBaseAnim(s, b);
395 continue;
396 end;
397 end;
398
399 for aa := WP_FIRST + 1 to WP_LAST do
400 for bb := A_STAND to A_LAST do
401 for cc := TDirection.D_LEFT to TDirection.D_RIGHT do
402 begin
403 f := config.ReadInt(AnimNames[bb], 'frames', 1);
404 if config.ReadBool(AnimNames[bb], 'backanim', False) then
405 if f > 2 then f := 2*f-2;
406 SetLength(PlayerModelsArray[ID].WeaponPoints[aa, bb, cc], f);
407 end;
408
409 if (config.ReadStr(AnimNames[b], 'resource2', '') <> '') and
410 (config.ReadStr(AnimNames[b], 'mask2', '') <> '') then
411 begin
412 aname := s+'_LEFTANIM'+IntToStr(b);
413 g_Frames_CreateWAD(nil, aname,
414 prefix+config.ReadStr(AnimNames[b], 'resource2', ''),
415 64, 64, config.ReadInt(AnimNames[b], 'frames', 1),
416 config.ReadBool(AnimNames[b], 'backanim', False));
417
418 g_Frames_CreateWAD(nil, aname+'_MASK',
419 prefix+config.ReadStr(AnimNames[b], 'mask2', ''),
420 64, 64, config.ReadInt(AnimNames[b], 'frames', 1),
421 config.ReadBool(AnimNames[b], 'backanim', False));
422 end;
423
424 PlayerModelsArray[ID].ModelSpeed[b] := Max(1, config.ReadInt(AnimNames[b], 'waitcount', 1) div 3);
425 end;
426
427 with PlayerModelsArray[ID], config do
428 begin
429 prefix := FileName+':SOUNDS\';
430
431 a := 1;
432 repeat
433 s := config.ReadStr('Sound', 'pain'+IntToStr(a), '');
434 if s <> '' then
435 begin
436 SetLength(PainSounds, Length(PainSounds)+1);
437 g_Sound_CreateWAD(PainSounds[High(PainSounds)].ID, prefix+s);
438 PainSounds[High(PainSounds)].Level := config.ReadInt('Sound', 'painlevel'+IntToStr(a), 1);
439 end;
440 a := a+1;
441 until s = '';
442
443 a := 1;
444 repeat
445 s := config.ReadStr('Sound', 'die'+IntToStr(a), '');
446 if s <> '' then
447 begin
448 SetLength(DieSounds, Length(DieSounds)+1);
449 g_Sound_CreateWAD(DieSounds[High(DieSounds)].ID, prefix+s);
450 DieSounds[High(DieSounds)].Level := config.ReadInt('Sound', 'dielevel'+IntToStr(a), 1);
451 end;
452 a := a+1;
453 until s = '';
454
455 SlopSound := Min(Max(config.ReadInt('Sound', 'slop', 0), 0), 2);
456
457 SetLength(Gibs, ReadInt('Gibs', 'count', 0));
458
459 if (Gibs <> nil) and
460 (WAD.GetResource('TEXTURES/'+config.ReadStr('Gibs', 'resource', 'GIBS'), pData, lenpd)) and
461 (WAD.GetResource('TEXTURES/'+config.ReadStr('Gibs', 'mask', 'GIBSMASK'), pData2, lenpd2)) then
462 begin
463 for a := 0 to High(Gibs) do
464 if e_CreateTextureMemEx(pData, lenpd, Gibs[a].ID, a*32, 0, 32, 32) and
465 e_CreateTextureMemEx(pData2, lenpd2, Gibs[a].MaskID, a*32, 0, 32, 32) then
466 begin
467 Gibs[a].Rect := e_GetTextureSize2(Gibs[a].ID);
468 with Gibs[a].Rect do
469 if Height > 3 then Height := Height-1-Random(2);
470 Gibs[a].OnlyOne := config.ReadInt('Gibs', 'once', -1) = a+1;
471 end;
472
473 FreeMem(pData);
474 FreeMem(pData2);
475 end;
476
477 ok := True;
478 for aa := WP_FIRST + 1 to WP_LAST do
479 for bb := A_STAND to A_LAST do
480 if not (bb in [A_DIE1, A_DIE2, A_PAIN]) then
481 begin
482 chk := GetWeapPoints(config.ReadStr(AnimNames[bb], WeapNames[aa]+'_points', ''), aa, bb, TDirection.D_RIGHT,
483 config.ReadInt(AnimNames[bb], 'frames', 0),
484 config.ReadBool(AnimNames[bb], 'backanim', False),
485 WeaponPoints);
486 if ok and (not chk) and (aa = WEAPON_FLAMETHROWER) then
487 begin
488 // workaround for flamethrower
489 chk := GetWeapPoints(config.ReadStr(AnimNames[bb], WeapNames[WEAPON_PLASMA]+'_points', ''), aa, bb, TDirection.D_RIGHT,
490 config.ReadInt(AnimNames[bb], 'frames', 0),
491 config.ReadBool(AnimNames[bb], 'backanim', False),
492 WeaponPoints);
493 if chk then
494 for f := 0 to High(WeaponPoints[aa, bb, TDirection.D_RIGHT]) do
495 begin
496 case bb of
497 A_STAND, A_PAIN:
498 begin
499 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 6);
500 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 8);
501 end;
502 A_WALKATTACK, A_WALK:
503 begin
504 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 9);
505 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 9);
506 end;
507 A_ATTACK:
508 begin
509 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 5);
510 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 8);
511 end;
512 A_WALKSEEUP, A_SEEUP:
513 begin
514 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 5);
515 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 16);
516 end;
517 A_WALKSEEDOWN, A_SEEDOWN:
518 begin
519 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 6);
520 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 5);
521 end;
522 A_WALKATTACKUP, A_ATTACKUP:
523 begin
524 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 5);
525 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 16);
526 end;
527 A_WALKATTACKDOWN, A_ATTACKDOWN:
528 begin
529 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X, 6);
530 Dec(WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y, 4);
531 end;
532 end;
533 end;
534 end;
535 ok := ok and (chk or (bb > A_LASTBASE));
536
537 if not GetWeapPoints(config.ReadStr(AnimNames[bb], WeapNames[aa]+'2_points', ''), aa, bb, TDirection.D_LEFT,
538 config.ReadInt(AnimNames[bb], 'frames', 0),
539 config.ReadBool(AnimNames[bb], 'backanim', False),
540 WeaponPoints) then
541 for f := 0 to High(WeaponPoints[aa, bb, TDirection.D_RIGHT]) do
542 begin
543 WeaponPoints[aa, bb, TDirection.D_LEFT, f].X := -WeaponPoints[aa, bb, TDirection.D_RIGHT, f].X;
544 WeaponPoints[aa, bb, TDirection.D_LEFT, f].Y := WeaponPoints[aa, bb, TDirection.D_RIGHT, f].Y;
545 end;
546
547 if not ok then Break;
548 end;
549 {if ok then g_Console_Add(Info.Name+' weapon points ok')
550 else g_Console_Add(Info.Name+' weapon points fail');}
551 Info.HaveWeapon := ok;
552
553 s := config.ReadStr('Model', 'flag_point', '');
554 if not GetPoint(s, FlagPoint) then FlagPoint := FLAG_DEFPOINT;
555
556 FlagAngle := config.ReadInt('Model', 'flag_angle', FLAG_DEFANGLE);
557 end;
558
559 config.Free();
560 WAD.Free();
561
562 Result := True;
563 end;
564
565 function g_PlayerModel_Get(ModelName: String): TPlayerModel;
566 var
567 a: Integer;
568 b: Byte;
569 ID, ID2: DWORD;
570 begin
571 Result := nil;
572
573 if PlayerModelsArray = nil then Exit;
574
575 for a := 0 to High(PlayerModelsArray) do
576 if AnsiLowerCase(PlayerModelsArray[a].Info.Name) = AnsiLowerCase(ModelName) then
577 begin
578 Result := TPlayerModel.Create;
579
580 with PlayerModelsArray[a] do
581 begin
582 Result.FName := Info.Name;
583
584 for b := A_STAND to A_LAST do
585 begin
586 if not (g_Frames_Get(ID, Info.Name+'_RIGHTANIM'+IntToStr(b)) and
587 g_Frames_Get(ID2, Info.Name+'_RIGHTANIM'+IntToStr(b)+'_MASK')) then
588 begin
589 Result.Free();
590 Result := nil;
591 Exit;
592 end;
593
594 Result.FAnim[TDirection.D_RIGHT][b] := TAnimation.Create(ID, b in [A_STAND, A_WALK], ModelSpeed[b]);
595
596 Result.FMaskAnim[TDirection.D_RIGHT][b] := TAnimation.Create(ID2, b in [A_STAND, A_WALK], ModelSpeed[b]);
597
598 if g_Frames_Exists(Info.Name+'_LEFTANIM'+IntToStr(b)) and
599 g_Frames_Exists(Info.Name+'_LEFTANIM'+IntToStr(b)+'_MASK') then
600 if g_Frames_Get(ID, Info.Name+'_LEFTANIM'+IntToStr(b)) and
601 g_Frames_Get(ID2, Info.Name+'_LEFTANIM'+IntToStr(b)+'_MASK') then
602 begin
603 Result.FAnim[TDirection.D_LEFT][b] := TAnimation.Create(ID, b in [A_STAND, A_WALK], ModelSpeed[b]);
604
605 Result.FMaskAnim[TDirection.D_LEFT][b] := TAnimation.Create(ID2, b in [A_STAND, A_WALK], ModelSpeed[b]);
606 end;
607 end;
608
609 Result.FPainSounds := PainSounds;
610 Result.FDieSounds := DieSounds;
611 Result.FSlopSound := SlopSound;
612 Result.FDrawWeapon := Info.HaveWeapon;
613 Result.FWeaponPoints := WeaponPoints;
614
615 Result.FFlagPoint := FlagPoint;
616 Result.FFlagAngle := FlagAngle;
617
618 Break;
619 end;
620 end;
621 end;
622
623 function g_PlayerModel_GetAnim(ModelName: string; Anim: Byte; var _Anim, _Mask: TAnimation): Boolean;
624 var
625 a: Integer;
626 c: Boolean;
627 ID: DWORD;
628 begin
629 Result := False;
630
631 if PlayerModelsArray = nil then Exit;
632 for a := 0 to High(PlayerModelsArray) do
633 if PlayerModelsArray[a].Info.Name = ModelName then
634 with PlayerModelsArray[a] do
635 begin
636 if Anim in [A_STAND, A_WALK] then c := True else c := False;
637
638 if not g_Frames_Get(ID, Info.Name+'_RIGHTANIM'+IntToStr(Anim)) then
639 if not g_Frames_Get(ID, Info.Name+'_LEFTANIM'+IntToStr(Anim)) then Exit;
640
641 _Anim := TAnimation.Create(ID, c, ModelSpeed[Anim]);
642 _Anim.Speed := ModelSpeed[Anim];
643
644 if not g_Frames_Get(ID, Info.Name+'_RIGHTANIM'+IntToStr(Anim)+'_MASK') then
645 if not g_Frames_Get(ID, Info.Name+'_LEFTANIM'+IntToStr(Anim)+'_MASK') then Exit;
646
647 _Mask := TAnimation.Create(ID, c, ModelSpeed[Anim]);
648 _Mask.Speed := ModelSpeed[Anim];
649
650 Break;
651 end;
652
653 Result := True;
654 end;
655
656 function g_PlayerModel_GetGibs(ModelName: string; var Gibs: TGibsArray): Boolean;
657 var
658 a, i, b: Integer;
659 c: Boolean;
660 begin
661 Result := False;
662
663 if PlayerModelsArray = nil then Exit;
664 if gGibsCount = 0 then Exit;
665
666 c := False;
667
668 SetLength(Gibs, gGibsCount);
669
670 for a := 0 to High(PlayerModelsArray) do
671 if PlayerModelsArray[a].Info.Name = ModelName then
672 begin
673 for i := 0 to High(Gibs) do
674 begin
675 if c and (Length(PlayerModelsArray[a].Gibs) = 1) then
676 begin
677 SetLength(Gibs, i);
678 Break;
679 end;
680
681 repeat
682 b := Random(Length(PlayerModelsArray[a].Gibs));
683 until not (PlayerModelsArray[a].Gibs[b].OnlyOne and c);
684
685 Gibs[i] := PlayerModelsArray[a].Gibs[b];
686
687 if Gibs[i].OnlyOne then c := True;
688 end;
689
690 Result := True;
691 Break;
692 end;
693 end;
694
695 function g_PlayerModel_GetNames(): SArray;
696 var
697 i: DWORD;
698 begin
699 Result := nil;
700
701 if PlayerModelsArray = nil then Exit;
702
703 for i := 0 to High(PlayerModelsArray) do
704 begin
705 SetLength(Result, Length(Result)+1);
706 Result[High(Result)] := PlayerModelsArray[i].Info.Name;
707 end;
708 end;
709
710 function g_PlayerModel_GetInfo(ModelName: string): TModelInfo;
711 var
712 a: Integer;
713 begin
714 FillChar(Result, SizeOf(Result), 0);
715 if PlayerModelsArray = nil then Exit;
716
717 for a := 0 to High(PlayerModelsArray) do
718 if PlayerModelsArray[a].Info.Name = ModelName then
719 begin
720 Result := PlayerModelsArray[a].Info;
721 Break;
722 end;
723 end;
724
725 procedure g_PlayerModel_FreeData();
726 var
727 i: DWORD;
728 a, b, c: Integer;
729 begin
730 for a := WP_FIRST + 1 to WP_LAST do
731 for b := W_POS_NORMAL to W_POS_DOWN do
732 for c := W_ACT_NORMAL to W_ACT_FIRE do
733 e_DeleteTexture(WeaponID[a][b][c]);
734
735 e_WriteLog('Releasing models...', TMsgType.Notify);
736
737 if PlayerModelsArray = nil then Exit;
738
739 for i := 0 to High(PlayerModelsArray) do
740 with PlayerModelsArray[i] do
741 begin
742 for a := A_STAND to A_LAST do
743 begin
744 g_Frames_DeleteByName(Info.Name+'_LEFTANIM'+IntToStr(a));
745 g_Frames_DeleteByName(Info.Name+'_LEFTANIM'+IntToStr(a)+'_MASK');
746 g_Frames_DeleteByName(Info.Name+'_RIGHTANIM'+IntToStr(a));
747 g_Frames_DeleteByName(Info.Name+'_RIGHTANIM'+IntToStr(a)+'_MASK');
748 end;
749
750 if PainSounds <> nil then
751 for b := 0 to High(PainSounds) do
752 e_DeleteSound(PainSounds[b].ID);
753
754 if DieSounds <> nil then
755 for b := 0 to High(DieSounds) do
756 e_DeleteSound(DieSounds[b].ID);
757
758 if Gibs <> nil then
759 for b := 0 to High(Gibs) do
760 begin
761 e_DeleteTexture(Gibs[b].ID);
762 e_DeleteTexture(Gibs[b].MaskID);
763 end;
764 end;
765
766 PlayerModelsArray := nil;
767 end;
768
769 { TPlayerModel }
770
771 procedure TPlayerModel.ChangeAnimation(Animation: Byte; Force: Boolean = False);
772 begin
773 if not Force then if FCurrentAnimation = Animation then Exit;
774
775 FCurrentAnimation := Animation;
776
777 if (FDirection = TDirection.D_LEFT) and
778 (FAnim[TDirection.D_LEFT][FCurrentAnimation] <> nil) and
779 (FMaskAnim[TDirection.D_LEFT][FCurrentAnimation] <> nil) then
780 begin
781 FAnim[TDirection.D_LEFT][FCurrentAnimation].Reset;
782 FMaskAnim[TDirection.D_LEFT][FCurrentAnimation].Reset;
783 end
784 else
785 begin
786 FAnim[TDirection.D_RIGHT][FCurrentAnimation].Reset;
787 FMaskAnim[TDirection.D_RIGHT][FCurrentAnimation].Reset;
788 end;
789 end;
790
791 destructor TPlayerModel.Destroy();
792 var
793 a: Byte;
794 begin
795 for a := A_STAND to A_LAST do
796 begin
797 FAnim[TDirection.D_LEFT][a].Free();
798 FMaskAnim[TDirection.D_LEFT][a].Free();
799 FAnim[TDirection.D_RIGHT][a].Free();
800 FMaskAnim[TDirection.D_RIGHT][a].Free();
801 end;
802
803 inherited;
804 end;
805
806 procedure TPlayerModel.Draw(X, Y: Integer; Alpha: Byte = 0);
807 var
808 Mirror: TMirrorType;
809 pos, act: Byte;
810 p: TDFPoint;
811 begin
812 // Ôëàãè:
813 if Direction = TDirection.D_LEFT then
814 Mirror := TMirrorType.None
815 else
816 Mirror := TMirrorType.Horizontal;
817
818 if (FFlag <> FLAG_NONE) and (FFlagAnim <> nil) and
819 (not (FCurrentAnimation in [A_DIE1, A_DIE2])) then
820 begin
821 p.X := IfThen(Direction = TDirection.D_LEFT,
822 FLAG_BASEPOINT.X,
823 64-FLAG_BASEPOINT.X);
824 p.Y := FLAG_BASEPOINT.Y;
825
826 FFlagAnim.DrawEx(X+IfThen(Direction = TDirection.D_LEFT, FFlagPoint.X-1, 2*FLAG_BASEPOINT.X-FFlagPoint.X+1)-FLAG_BASEPOINT.X,
827 Y+FFlagPoint.Y-FLAG_BASEPOINT.Y+1, Mirror, p,
828 IfThen(FDirection = TDirection.D_RIGHT, FFlagAngle, -FFlagAngle));
829 end;
830
831 // Îðóæèå:
832 if Direction = TDirection.D_RIGHT then
833 Mirror := TMirrorType.None
834 else
835 Mirror := TMirrorType.Horizontal;
836
837 if FDrawWeapon and
838 (not (FCurrentAnimation in [A_DIE1, A_DIE2, A_PAIN])) and
839 (FCurrentWeapon in [WP_FIRST + 1..WP_LAST]) then
840 begin
841 if FCurrentAnimation in [A_SEEUP, A_ATTACKUP] then
842 pos := W_POS_UP
843 else
844 if FCurrentAnimation in [A_SEEDOWN, A_ATTACKDOWN] then
845 pos := W_POS_DOWN
846 else
847 pos := W_POS_NORMAL;
848
849 if (FCurrentAnimation in [A_ATTACK, A_ATTACKUP, A_ATTACKDOWN]) or
850 FFire then
851 act := W_ACT_FIRE
852 else
853 act := W_ACT_NORMAL;
854
855 if Alpha < 201 then
856 e_Draw(WeaponID[FCurrentWeapon][pos][act],
857 X+FWeaponPoints[FCurrentWeapon, FCurrentAnimation, FDirection,
858 FAnim[TDirection.D_RIGHT][FCurrentAnimation].CurrentFrame].X,
859 Y+FWeaponPoints[FCurrentWeapon, FCurrentAnimation, FDirection,
860 FAnim[TDirection.D_RIGHT][FCurrentAnimation].CurrentFrame].Y,
861 0, True, False, Mirror);
862 end;
863
864 // Ìîäåëü:
865 if (FDirection = TDirection.D_LEFT) and
866 (FAnim[TDirection.D_LEFT][FCurrentAnimation] <> nil) then
867 begin
868 FAnim[TDirection.D_LEFT][FCurrentAnimation].Alpha := Alpha;
869 FAnim[TDirection.D_LEFT][FCurrentAnimation].Draw(X, Y, TMirrorType.None);
870 end
871 else
872 begin
873 FAnim[TDirection.D_RIGHT][FCurrentAnimation].Alpha := Alpha;
874 FAnim[TDirection.D_RIGHT][FCurrentAnimation].Draw(X, Y, Mirror);
875 end;
876
877 // Ìàñêà ìîäåëè:
878 e_Colors := FColor;
879
880 if (FDirection = TDirection.D_LEFT) and
881 (FMaskAnim[TDirection.D_LEFT][FCurrentAnimation] <> nil) then
882 begin
883 FMaskAnim[TDirection.D_LEFT][FCurrentAnimation].Alpha := Alpha;
884 FMaskAnim[TDirection.D_LEFT][FCurrentAnimation].Draw(X, Y, TMirrorType.None);
885 end
886 else
887 begin
888 FMaskAnim[TDirection.D_RIGHT][FCurrentAnimation].Alpha := Alpha;
889 FMaskAnim[TDirection.D_RIGHT][FCurrentAnimation].Draw(X, Y, Mirror);
890 end;
891
892 e_Colors.R := 255;
893 e_Colors.G := 255;
894 e_Colors.B := 255;
895 end;
896
897 function TPlayerModel.GetCurrentAnimation: TAnimation;
898 begin
899 if (FDirection = TDirection.D_LEFT) and (FAnim[TDirection.D_LEFT][FCurrentAnimation] <> nil) then
900 Result := FAnim[TDirection.D_LEFT][FCurrentAnimation]
901 else
902 Result := FAnim[TDirection.D_RIGHT][FCurrentAnimation];
903 end;
904
905 function TPlayerModel.GetCurrentAnimationMask: TAnimation;
906 begin
907 if (FDirection = TDirection.D_LEFT) and (FMaskAnim[TDirection.D_LEFT][FCurrentAnimation] <> nil) then
908 Result := FMaskAnim[TDirection.D_LEFT][FCurrentAnimation]
909 else
910 Result := FMaskAnim[TDirection.D_RIGHT][FCurrentAnimation];
911 end;
912
913 function TPlayerModel.PlaySound(SoundType, Level: Byte; X, Y: Integer): Boolean;
914 var
915 TempArray: array of DWORD;
916 a: Integer;
917 begin
918 Result := False;
919 SetLength(TempArray, 0);
920
921 if SoundType = MODELSOUND_PAIN then
922 begin
923 if FPainSounds = nil then Exit;
924
925 for a := 0 to High(FPainSounds) do
926 if FPainSounds[a].Level = Level then
927 begin
928 SetLength(TempArray, Length(TempArray)+1);
929 TempArray[High(TempArray)] := FPainSounds[a].ID;
930 end;
931 end
932 else
933 begin
934 if (Level in [2, 3, 5]) and (FSlopSound > 0) then
935 begin
936 g_Sound_PlayExAt('SOUND_MONSTER_SLOP', X, Y);
937 if FSlopSound = 1 then
938 begin
939 Result := True;
940 Exit;
941 end;
942 end;
943 if FDieSounds = nil then Exit;
944
945 for a := 0 to High(FDieSounds) do
946 if FDieSounds[a].Level = Level then
947 begin
948 SetLength(TempArray, Length(TempArray)+1);
949 TempArray[High(TempArray)] := FDieSounds[a].ID;
950 end;
951 if (TempArray = nil) and (Level = 5) then
952 begin
953 g_Sound_PlayExAt('SOUND_MONSTER_SLOP', X, Y);
954 Result := True;
955 Exit;
956 end;
957 end;
958
959 if TempArray = nil then Exit;
960
961 g_Sound_PlayAt(TempArray[Random(Length(TempArray))], X, Y);
962
963 Result := True;
964 end;
965
966 procedure TPlayerModel.SetColor(Red, Green, Blue: Byte);
967 begin
968 FColor.R := Red;
969 FColor.G := Green;
970 FColor.B := Blue;
971 end;
972
973 procedure TPlayerModel.SetFire(Fire: Boolean);
974 begin
975 FFire := Fire;
976
977 if FFire then FFireCounter := FAnim[TDirection.D_RIGHT, A_ATTACK].Speed*FAnim[TDirection.D_RIGHT, A_ATTACK].TotalFrames
978 else FFireCounter := 0;
979 end;
980
981 procedure TPlayerModel.SetFlag(Flag: Byte);
982 var
983 id: DWORD;
984 begin
985 FFlag := Flag;
986
987 FFlagAnim.Free();
988 FFlagAnim := nil;
989
990 case Flag of
991 FLAG_RED: g_Frames_Get(id, 'FRAMES_FLAG_RED');
992 FLAG_BLUE: g_Frames_Get(id, 'FRAMES_FLAG_BLUE');
993 else Exit;
994 end;
995
996 FFlagAnim := TAnimation.Create(id, True, 8);
997 end;
998
999 procedure TPlayerModel.SetWeapon(Weapon: Byte);
1000 begin
1001 FCurrentWeapon := Weapon;
1002 end;
1003
1004 procedure TPlayerModel.Update();
1005 begin
1006 if (FDirection = TDirection.D_LEFT) and (FAnim[TDirection.D_LEFT][FCurrentAnimation] <> nil) then
1007 FAnim[TDirection.D_LEFT][FCurrentAnimation].Update else FAnim[TDirection.D_RIGHT][FCurrentAnimation].Update;
1008
1009 if (FDirection = TDirection.D_LEFT) and (FMaskAnim[TDirection.D_LEFT][FCurrentAnimation] <> nil) then
1010 FMaskAnim[TDirection.D_LEFT][FCurrentAnimation].Update else FMaskAnim[TDirection.D_RIGHT][FCurrentAnimation].Update;
1011
1012 if FFlagAnim <> nil then FFlagAnim.Update;
1013
1014 if FFireCounter > 0 then Dec(FFireCounter) else FFire := False;
1015 end;
1016
1017 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024