DEADSOFTWARE

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