DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Refactor: Constants for first and last weapon
[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 {$MODE DELPHI}
17 unit g_playermodel;
18
19 interface
20
21 uses
22 g_textures, g_basic, g_weapons, e_graphics, wadreader;
23
24 const
25 A_STAND = 0;
26 A_WALK = 1;
27 A_DIE1 = 2;
28 A_DIE2 = 3;
29 A_ATTACK = 4;
30 A_SEEUP = 5;
31 A_SEEDOWN = 6;
32 A_ATTACKUP = 7;
33 A_ATTACKDOWN = 8;
34 A_PAIN = 9;
35
36 MODELSOUND_PAIN = 0;
37 MODELSOUND_DIE = 1;
38
39 type
40 TModelInfo = record
41 Name: String;
42 Author: String;
43 Description: String;
44 HaveWeapon: Boolean;
45 end;
46
47 TModelSound = record
48 ID: DWORD;
49 Level: Byte;
50 end;
51
52 TGibSprite = record
53 ID: DWORD;
54 MaskID: DWORD;
55 Rect: TRectWH;
56 OnlyOne: Boolean;
57 end;
58
59 TModelSoundArray = Array of TModelSound;
60 TGibsArray = Array of TGibSprite;
61 TWeaponPoints = Array [WP_FIRST + 1..WP_LAST] of
62 Array [A_STAND..A_PAIN] of
63 Array [D_LEFT..D_RIGHT] of Array of TPoint;
64
65 TPlayerModel = class (TObject)
66 private
67 FName: String;
68 FDirection: TDirection;
69 FColor: TRGB;
70 FCurrentAnimation: Byte;
71 FAnim: Array [D_LEFT..D_RIGHT] of Array [A_STAND..A_PAIN] of TAnimation;
72 FMaskAnim: Array [D_LEFT..D_RIGHT] of Array [A_STAND..A_PAIN] of TAnimation;
73 FWeaponPoints: TWeaponPoints;
74 FPainSounds: TModelSoundArray;
75 FDieSounds: TModelSoundArray;
76 FSlopSound: Byte;
77 FCurrentWeapon: Byte;
78 FDrawWeapon: Boolean;
79 FFlag: Byte;
80 FFlagPoint: TPoint;
81 FFlagAngle: SmallInt;
82 FFlagAnim: TAnimation;
83 FFire: Boolean;
84 FFireCounter: Byte;
85
86 public
87 destructor Destroy(); override;
88 procedure ChangeAnimation(Animation: Byte; Force: Boolean = False);
89 function GetCurrentAnimation: TAnimation;
90 function GetCurrentAnimationMask: TAnimation;
91 procedure SetColor(Red, Green, Blue: Byte);
92 procedure SetWeapon(Weapon: Byte);
93 procedure SetFlag(Flag: Byte);
94 procedure SetFire(Fire: Boolean);
95 function PlaySound(SoundType, Level: Byte; X, Y: Integer): Boolean;
96 procedure Update();
97 procedure Draw(X, Y: Integer; Alpha: Byte = 0);
98
99 property Fire: Boolean read FFire;
100 property Direction: TDirection read FDirection write FDirection;
101 property Animation: Byte read FCurrentAnimation;
102 property Weapon: Byte read FCurrentWeapon;
103 property Name: String read FName;
104 property Color: TRGB read FColor write FColor;
105 end;
106
107 procedure g_PlayerModel_LoadData();
108 procedure g_PlayerModel_FreeData();
109 function g_PlayerModel_Load(FileName: String): Boolean;
110 function g_PlayerModel_GetNames(): SArray;
111 function g_PlayerModel_GetInfo(ModelName: String): TModelInfo;
112 function g_PlayerModel_Get(ModelName: String): TPlayerModel;
113 function g_PlayerModel_GetAnim(ModelName: String; Anim: Byte; var _Anim, _Mask: TAnimation): Boolean;
114 function g_PlayerModel_GetGibs(ModelName: String; var Gibs: TGibsArray): Boolean;
115
116 implementation
117
118 uses
119 g_main, g_sound, g_console, SysUtils, g_player, CONFIG,
120 GL, GLExt, e_sound, g_options, g_map, Math, e_log;
121
122 type
123 TPlayerModelInfo = record
124 Info: TModelInfo;
125 ModelSpeed: Array [A_STAND..A_PAIN] of Byte;
126 FlagPoint: TPoint;
127 FlagAngle: SmallInt;
128 WeaponPoints: TWeaponPoints;
129 Gibs: TGibsArray;
130 PainSounds: TModelSoundArray;
131 DieSounds: TModelSoundArray;
132 SlopSound: Byte;
133 end;
134
135 const
136 W_POS_NORMAL = 0;
137 W_POS_UP = 1;
138 W_POS_DOWN = 2;
139
140 W_ACT_NORMAL = 0;
141 W_ACT_FIRE = 1;
142
143 FLAG_BASEPOINT: TPoint = (X:16; Y:43);
144 FLAG_DEFPOINT: TPoint = (X:32; Y:16);
145 FLAG_DEFANGLE = -20;
146 WEAPONBASE: Array [WP_FIRST + 1..WP_LAST] of TPoint =
147 ((X:8; Y:4), (X:8; Y:8), (X:16; Y:16), (X:16; Y:24),
148 (X:16; Y:16), (X:24; Y:24), (X:16; Y:16), (X:24; Y:24), (X:16; Y:16));
149
150 AnimNames: Array [A_STAND..A_PAIN] of String =
151 ('StandAnim','WalkAnim','Die1Anim','Die2Anim','AttackAnim',
152 'SeeUpAnim','SeeDownAnim','AttackUpAnim','AttackDownAnim','PainAnim');
153 WeapNames: Array [WP_FIRST + 1..WP_LAST] of String =
154 ('csaw', 'hgun', 'sg', 'ssg', 'mgun', 'rkt', 'plz', 'bfg', 'spl');
155
156 var
157 WeaponID: Array [WP_FIRST + 1..WP_LAST] of
158 Array [W_POS_NORMAL..W_POS_DOWN] of
159 Array [W_ACT_NORMAL..W_ACT_FIRE] of DWORD;
160 PlayerModelsArray: Array of TPlayerModelInfo;
161
162 procedure g_PlayerModel_LoadData();
163 var
164 a: Integer;
165 begin
166 for a := WP_FIRST + 1 to WP_LAST do
167 begin
168 g_Texture_CreateWAD(WeaponID[a][W_POS_NORMAL][W_ACT_NORMAL], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a]));
169 g_Texture_CreateWAD(WeaponID[a][W_POS_NORMAL][W_ACT_FIRE], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_FIRE');
170 g_Texture_CreateWAD(WeaponID[a][W_POS_UP][W_ACT_NORMAL], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_UP');
171 g_Texture_CreateWAD(WeaponID[a][W_POS_UP][W_ACT_FIRE], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_UP_FIRE');
172 g_Texture_CreateWAD(WeaponID[a][W_POS_DOWN][W_ACT_NORMAL], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_DN');
173 g_Texture_CreateWAD(WeaponID[a][W_POS_DOWN][W_ACT_FIRE], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_DN_FIRE');
174 end;
175 end;
176
177 function GetPoint(var str: String; var point: TPoint): Boolean;
178 var
179 a, x, y: Integer;
180 s: String;
181 begin
182 Result := False;
183 x := 0;
184 y := 0;
185
186 str := Trim(str);
187 if Length(str) < 3 then
188 Exit;
189
190 for a := 1 to Length(str) do
191 if (str[a] = ',') or (a = Length(str)) then
192 begin
193 s := Copy(str, 1, a);
194 if s[Length(s)] = ',' then
195 SetLength(s, Length(s)-1);
196 Delete(str, 1, a);
197
198 if (Sscanf(s, '%d:%d', [@x, @y]) < 2) or
199 (x < -64) or (x > 128) or
200 (y < -64) or (y > 128) then
201 Exit;
202
203 point.X := x;
204 point.Y := y;
205
206 Break;
207 end;
208
209 Result := True;
210 end;
211
212 function GetWeapPoints(str: String; weapon: Byte; anim: Byte; dir: TDirection;
213 frames: Word; backanim: Boolean; var wpoints: TWeaponPoints): Boolean;
214 var
215 a, b, h: Integer;
216 begin
217 Result := False;
218
219 if frames = 0 then
220 Exit;
221
222 backanim := backanim and (frames > 2);
223
224 for a := 1 to frames do
225 begin
226 if not GetPoint(str, wpoints[weapon, anim, dir, a-1]) then
227 Exit;
228
229 with wpoints[weapon, anim, dir, a-1] do
230 begin
231 X := X - WEAPONBASE[weapon].X;
232 Y := Y - WEAPONBASE[weapon].Y;
233 if dir = D_LEFT then
234 X := -X;
235 end;
236 end;
237
238 h := High(wpoints[weapon, anim, dir]);
239 if backanim then
240 for b := h downto frames do
241 wpoints[weapon, anim, dir, b] := wpoints[weapon, anim, dir, h-b+1];
242
243 Result := True;
244 end;
245
246 function g_PlayerModel_Load(FileName: string): Boolean;
247 var
248 ID: DWORD;
249 a, b, len, lenpd, lenpd2, aa, bb, f: Integer;
250 cc: TDirection;
251 config: TConfig;
252 pData, pData2: Pointer;
253 WAD: TWADFile;
254 s: string;
255 prefix: string;
256 ok: Boolean;
257 begin
258 e_WriteLog(Format('Loading player model: %s', [ExtractFileName(FileName)]), MSG_NOTIFY);
259
260 Result := False;
261
262 WAD := TWADFile.Create;
263 WAD.ReadFile(FileName);
264
265 if {WAD.GetLastError <> DFWAD_NOERROR} not WAD.isOpen then
266 begin
267 WAD.Free();
268 Exit;
269 end;
270
271 if not WAD.GetResource('TEXT/MODEL', pData, len) then
272 begin
273 WAD.Free();
274 Exit;
275 end;
276
277 config := TConfig.CreateMem(pData, len);
278 FreeMem(pData);
279
280 s := config.ReadStr('Model', 'name', '');
281 if s = '' then
282 begin
283 config.Free();
284 WAD.Free();
285 Exit;
286 end;
287
288 SetLength(PlayerModelsArray, Length(PlayerModelsArray)+1);
289 ID := High(PlayerModelsArray);
290
291 prefix := FileName+':TEXTURES\';
292
293 with PlayerModelsArray[ID].Info do
294 begin
295 Name := s;
296 Author := config.ReadStr('Model', 'author', '');
297 Description := config.ReadStr('Model', 'description', '');
298 end;
299
300 for b := A_STAND to A_PAIN do
301 begin
302 if not (g_Frames_CreateWAD(nil, s+'_RIGHTANIM'+IntToStr(b),
303 prefix+config.ReadStr(AnimNames[b], 'resource', ''),
304 64, 64, config.ReadInt(AnimNames[b], 'frames', 1),
305 config.ReadBool(AnimNames[b], 'backanim', False)) and
306 g_Frames_CreateWAD(nil, s+'_RIGHTANIM'+IntToStr(b)+'_MASK',
307 prefix+config.ReadStr(AnimNames[b], 'mask', ''),
308 64, 64, config.ReadInt(AnimNames[b], 'frames', 1),
309 config.ReadBool(AnimNames[b], 'backanim', False))) then
310 begin
311 config.Free();
312 WAD.Free();
313 Exit;
314 end;
315
316 for aa := WP_FIRST + 1 to WP_LAST do
317 for bb := A_STAND to A_PAIN do
318 for cc := D_LEFT to D_RIGHT do
319 begin
320 f := config.ReadInt(AnimNames[bb], 'frames', 1);
321 if config.ReadBool(AnimNames[bb], 'backanim', False) then
322 if f > 2 then f := 2*f-2;
323 SetLength(PlayerModelsArray[ID].WeaponPoints[aa, bb, cc], f);
324 end;
325
326 if (config.ReadStr(AnimNames[b], 'resource2', '') <> '') and
327 (config.ReadStr(AnimNames[b], 'mask2', '') <> '') then
328 begin
329 g_Frames_CreateWAD(nil, s+'_LEFTANIM'+IntToStr(b),
330 prefix+config.ReadStr(AnimNames[b], 'resource2', ''),
331 64, 64, config.ReadInt(AnimNames[b], 'frames', 1),
332 config.ReadBool(AnimNames[b], 'backanim', False));
333
334 g_Frames_CreateWAD(nil, s+'_LEFTANIM'+IntToStr(b)+'_MASK',
335 prefix+config.ReadStr(AnimNames[b], 'mask2', ''),
336 64, 64, config.ReadInt(AnimNames[b], 'frames', 1),
337 config.ReadBool(AnimNames[b], 'backanim', False));
338 end;
339
340 PlayerModelsArray[ID].ModelSpeed[b] := Max(1, config.ReadInt(AnimNames[b], 'waitcount', 1) div 3);
341 end;
342
343 with PlayerModelsArray[ID], config do
344 begin
345 prefix := FileName+':SOUNDS\';
346
347 a := 1;
348 repeat
349 s := config.ReadStr('Sound', 'pain'+IntToStr(a), '');
350 if s <> '' then
351 begin
352 SetLength(PainSounds, Length(PainSounds)+1);
353 g_Sound_CreateWAD(PainSounds[High(PainSounds)].ID, prefix+s);
354 PainSounds[High(PainSounds)].Level := config.ReadInt('Sound', 'painlevel'+IntToStr(a), 1);
355 end;
356 a := a+1;
357 until s = '';
358
359 a := 1;
360 repeat
361 s := config.ReadStr('Sound', 'die'+IntToStr(a), '');
362 if s <> '' then
363 begin
364 SetLength(DieSounds, Length(DieSounds)+1);
365 g_Sound_CreateWAD(DieSounds[High(DieSounds)].ID, prefix+s);
366 DieSounds[High(DieSounds)].Level := config.ReadInt('Sound', 'dielevel'+IntToStr(a), 1);
367 end;
368 a := a+1;
369 until s = '';
370
371 SlopSound := Min(Max(config.ReadInt('Sound', 'slop', 0), 0), 2);
372
373 SetLength(Gibs, ReadInt('Gibs', 'count', 0));
374
375 if (Gibs <> nil) and
376 (WAD.GetResource('TEXTURES/'+config.ReadStr('Gibs', 'resource', 'GIBS'), pData, lenpd)) and
377 (WAD.GetResource('TEXTURES/'+config.ReadStr('Gibs', 'mask', 'GIBSMASK'), pData2, lenpd2)) then
378 begin
379 for a := 0 to High(Gibs) do
380 if e_CreateTextureMemEx(pData, lenpd, Gibs[a].ID, a*32, 0, 32, 32) and
381 e_CreateTextureMemEx(pData2, lenpd2, Gibs[a].MaskID, a*32, 0, 32, 32) then
382 begin
383 Gibs[a].Rect := e_GetTextureSize2(Gibs[a].ID);
384 with Gibs[a].Rect do
385 if Height > 3 then Height := Height-1-Random(2);
386 Gibs[a].OnlyOne := config.ReadInt('Gibs', 'once', -1) = a+1;
387 end;
388
389 FreeMem(pData);
390 FreeMem(pData2);
391 end;
392
393 ok := True;
394 for aa := WP_FIRST + 1 to WP_LAST do
395 for bb := A_STAND to A_PAIN do
396 if not (bb in [A_DIE1, A_DIE2, A_PAIN]) then
397 begin
398 ok := ok and GetWeapPoints(config.ReadStr(AnimNames[bb], WeapNames[aa]+'_points', ''), aa, bb, D_RIGHT,
399 config.ReadInt(AnimNames[bb], 'frames', 0),
400 config.ReadBool(AnimNames[bb], 'backanim', False),
401 WeaponPoints);
402
403 if not GetWeapPoints(config.ReadStr(AnimNames[bb], WeapNames[aa]+'2_points', ''), aa, bb, D_LEFT,
404 config.ReadInt(AnimNames[bb], 'frames', 0),
405 config.ReadBool(AnimNames[bb], 'backanim', False),
406 WeaponPoints) then
407 for f := 0 to High(WeaponPoints[aa, bb, D_RIGHT]) do
408 begin
409 WeaponPoints[aa, bb, D_LEFT, f].X := -WeaponPoints[aa, bb, D_RIGHT, f].X;
410 WeaponPoints[aa, bb, D_LEFT, f].Y := WeaponPoints[aa, bb, D_RIGHT, f].Y;
411 end;
412
413 if not ok then Break;
414 end;
415 {if ok then g_Console_Add(Info.Name+' weapon points ok')
416 else g_Console_Add(Info.Name+' weapon points fail');}
417 Info.HaveWeapon := ok;
418
419 s := config.ReadStr('Model', 'flag_point', '');
420 if not GetPoint(s, FlagPoint) then FlagPoint := FLAG_DEFPOINT;
421
422 FlagAngle := config.ReadInt('Model', 'flag_angle', FLAG_DEFANGLE);
423 end;
424
425 config.Free();
426 WAD.Free();
427
428 Result := True;
429 end;
430
431 function g_PlayerModel_Get(ModelName: String): TPlayerModel;
432 var
433 a: Integer;
434 b: Byte;
435 ID, ID2: DWORD;
436 begin
437 Result := nil;
438
439 if PlayerModelsArray = nil then Exit;
440
441 for a := 0 to High(PlayerModelsArray) do
442 if AnsiLowerCase(PlayerModelsArray[a].Info.Name) = AnsiLowerCase(ModelName) then
443 begin
444 Result := TPlayerModel.Create;
445
446 with PlayerModelsArray[a] do
447 begin
448 Result.FName := Info.Name;
449
450 for b := A_STAND to A_PAIN do
451 begin
452 if not (g_Frames_Get(ID, Info.Name+'_RIGHTANIM'+IntToStr(b)) and
453 g_Frames_Get(ID2, Info.Name+'_RIGHTANIM'+IntToStr(b)+'_MASK')) then
454 begin
455 Result.Free();
456 Result := nil;
457 Exit;
458 end;
459
460 Result.FAnim[D_RIGHT][b] := TAnimation.Create(ID, b in [A_STAND, A_WALK], ModelSpeed[b]);
461
462 Result.FMaskAnim[D_RIGHT][b] := TAnimation.Create(ID2, b in [A_STAND, A_WALK], ModelSpeed[b]);
463
464 if g_Frames_Exists(Info.Name+'_LEFTANIM'+IntToStr(b)) and
465 g_Frames_Exists(Info.Name+'_LEFTANIM'+IntToStr(b)+'_MASK') then
466 if g_Frames_Get(ID, Info.Name+'_LEFTANIM'+IntToStr(b)) and
467 g_Frames_Get(ID2, Info.Name+'_LEFTANIM'+IntToStr(b)+'_MASK') then
468 begin
469 Result.FAnim[D_LEFT][b] := TAnimation.Create(ID, b in [A_STAND, A_WALK], ModelSpeed[b]);
470
471 Result.FMaskAnim[D_LEFT][b] := TAnimation.Create(ID2, b in [A_STAND, A_WALK], ModelSpeed[b]);
472 end;
473
474 Result.FPainSounds := PainSounds;
475 Result.FDieSounds := DieSounds;
476 Result.FSlopSound := SlopSound;
477 end;
478
479 Result.FDrawWeapon := Info.HaveWeapon;
480 Result.FWeaponPoints := WeaponPoints;
481
482 Result.FFlagPoint := FlagPoint;
483 Result.FFlagAngle := FlagAngle;
484
485 Break;
486 end;
487 end;
488 end;
489
490 function g_PlayerModel_GetAnim(ModelName: string; Anim: Byte; var _Anim, _Mask: TAnimation): Boolean;
491 var
492 a: Integer;
493 c: Boolean;
494 ID: DWORD;
495 begin
496 Result := False;
497
498 if PlayerModelsArray = nil then Exit;
499 for a := 0 to High(PlayerModelsArray) do
500 if PlayerModelsArray[a].Info.Name = ModelName then
501 with PlayerModelsArray[a] do
502 begin
503 if Anim in [A_STAND, A_WALK] then c := True else c := False;
504
505 if not g_Frames_Get(ID, Info.Name+'_RIGHTANIM'+IntToStr(Anim)) then
506 if not g_Frames_Get(ID, Info.Name+'_LEFTANIM'+IntToStr(Anim)) then Exit;
507
508 _Anim := TAnimation.Create(ID, c, ModelSpeed[Anim]);
509 _Anim.Speed := ModelSpeed[Anim];
510
511 if not g_Frames_Get(ID, Info.Name+'_RIGHTANIM'+IntToStr(Anim)+'_MASK') then
512 if not g_Frames_Get(ID, Info.Name+'_LEFTANIM'+IntToStr(Anim)+'_MASK') then Exit;
513
514 _Mask := TAnimation.Create(ID, c, ModelSpeed[Anim]);
515 _Mask.Speed := ModelSpeed[Anim];
516
517 Break;
518 end;
519
520 Result := True;
521 end;
522
523 function g_PlayerModel_GetGibs(ModelName: string; var Gibs: TGibsArray): Boolean;
524 var
525 a, i, b: Integer;
526 c: Boolean;
527 begin
528 Result := False;
529
530 if PlayerModelsArray = nil then Exit;
531 if gGibsCount = 0 then Exit;
532
533 c := False;
534
535 SetLength(Gibs, gGibsCount);
536
537 for a := 0 to High(PlayerModelsArray) do
538 if PlayerModelsArray[a].Info.Name = ModelName then
539 begin
540 for i := 0 to High(Gibs) do
541 begin
542 if c and (Length(PlayerModelsArray[a].Gibs) = 1) then
543 begin
544 SetLength(Gibs, i);
545 Break;
546 end;
547
548 repeat
549 b := Random(Length(PlayerModelsArray[a].Gibs));
550 until not (PlayerModelsArray[a].Gibs[b].OnlyOne and c);
551
552 Gibs[i] := PlayerModelsArray[a].Gibs[b];
553
554 if Gibs[i].OnlyOne then c := True;
555 end;
556
557 Result := True;
558 Break;
559 end;
560 end;
561
562 function g_PlayerModel_GetNames(): SArray;
563 var
564 i: DWORD;
565 begin
566 Result := nil;
567
568 if PlayerModelsArray = nil then Exit;
569
570 for i := 0 to High(PlayerModelsArray) do
571 begin
572 SetLength(Result, Length(Result)+1);
573 Result[High(Result)] := PlayerModelsArray[i].Info.Name;
574 end;
575 end;
576
577 function g_PlayerModel_GetInfo(ModelName: string): TModelInfo;
578 var
579 a: Integer;
580 begin
581 FillChar(Result, SizeOf(Result), 0);
582 if PlayerModelsArray = nil then Exit;
583
584 for a := 0 to High(PlayerModelsArray) do
585 if PlayerModelsArray[a].Info.Name = ModelName then
586 begin
587 Result := PlayerModelsArray[a].Info;
588 Break;
589 end;
590 end;
591
592 procedure g_PlayerModel_FreeData();
593 var
594 i: DWORD;
595 a, b, c: Integer;
596 begin
597 for a := WP_FIRST + 1 to WP_LAST do
598 for b := W_POS_NORMAL to W_POS_DOWN do
599 for c := W_ACT_NORMAL to W_ACT_FIRE do
600 e_DeleteTexture(WeaponID[a][b][c]);
601
602 e_WriteLog('Releasing models...', MSG_NOTIFY);
603
604 if PlayerModelsArray = nil then Exit;
605
606 for i := 0 to High(PlayerModelsArray) do
607 with PlayerModelsArray[i] do
608 begin
609 for a := A_STAND to A_PAIN do
610 begin
611 g_Frames_DeleteByName(Info.Name+'_LEFTANIM'+IntToStr(a));
612 g_Frames_DeleteByName(Info.Name+'_LEFTANIM'+IntToStr(a)+'_MASK');
613 g_Frames_DeleteByName(Info.Name+'_RIGHTANIM'+IntToStr(a));
614 g_Frames_DeleteByName(Info.Name+'_RIGHTANIM'+IntToStr(a)+'_MASK');
615 end;
616
617 if PainSounds <> nil then
618 for b := 0 to High(PainSounds) do
619 e_DeleteSound(PainSounds[b].ID);
620
621 if DieSounds <> nil then
622 for b := 0 to High(DieSounds) do
623 e_DeleteSound(DieSounds[b].ID);
624
625 if Gibs <> nil then
626 for b := 0 to High(Gibs) do
627 begin
628 e_DeleteTexture(Gibs[b].ID);
629 e_DeleteTexture(Gibs[b].MaskID);
630 end;
631 end;
632
633 PlayerModelsArray := nil;
634 end;
635
636 { TPlayerModel }
637
638 procedure TPlayerModel.ChangeAnimation(Animation: Byte; Force: Boolean = False);
639 begin
640 if not Force then if FCurrentAnimation = Animation then Exit;
641
642 FCurrentAnimation := Animation;
643
644 if (FDirection = D_LEFT) and
645 (FAnim[D_LEFT][FCurrentAnimation] <> nil) and
646 (FMaskAnim[D_LEFT][FCurrentAnimation] <> nil) then
647 begin
648 FAnim[D_LEFT][FCurrentAnimation].Reset;
649 FMaskAnim[D_LEFT][FCurrentAnimation].Reset;
650 end
651 else
652 begin
653 FAnim[D_RIGHT][FCurrentAnimation].Reset;
654 FMaskAnim[D_RIGHT][FCurrentAnimation].Reset;
655 end;
656 end;
657
658 destructor TPlayerModel.Destroy();
659 var
660 a: Byte;
661 begin
662 for a := A_STAND to A_PAIN do
663 begin
664 FAnim[D_LEFT][a].Free();
665 FMaskAnim[D_LEFT][a].Free();
666 FAnim[D_RIGHT][a].Free();
667 FMaskAnim[D_RIGHT][a].Free();
668 end;
669
670 inherited;
671 end;
672
673 procedure TPlayerModel.Draw(X, Y: Integer; Alpha: Byte = 0);
674 var
675 Mirror: TMirrorType;
676 pos, act: Byte;
677 p: TPoint;
678 begin
679 // Ôëàãè:
680 if Direction = D_LEFT then
681 Mirror := M_NONE
682 else
683 Mirror := M_HORIZONTAL;
684
685 if (FFlag <> FLAG_NONE) and (FFlagAnim <> nil) and
686 (not (FCurrentAnimation in [A_DIE1, A_DIE2])) then
687 begin
688 p.X := IfThen(Direction = D_LEFT,
689 FLAG_BASEPOINT.X,
690 64-FLAG_BASEPOINT.X);
691 p.Y := FLAG_BASEPOINT.Y;
692
693 FFlagAnim.DrawEx(X+IfThen(Direction = D_LEFT, FFlagPoint.X-1, 2*FLAG_BASEPOINT.X-FFlagPoint.X+1)-FLAG_BASEPOINT.X,
694 Y+FFlagPoint.Y-FLAG_BASEPOINT.Y+1, Mirror, p,
695 IfThen(FDirection = D_RIGHT, FFlagAngle, -FFlagAngle));
696 end;
697
698 // Îðóæèå:
699 if Direction = D_RIGHT then
700 Mirror := M_NONE
701 else
702 Mirror := M_HORIZONTAL;
703
704 if FDrawWeapon and
705 (not (FCurrentAnimation in [A_DIE1, A_DIE2, A_PAIN])) and
706 (FCurrentWeapon in [WP_FIRST + 1..WP_LAST]) then
707 begin
708 if FCurrentAnimation in [A_SEEUP, A_ATTACKUP] then
709 pos := W_POS_UP
710 else
711 if FCurrentAnimation in [A_SEEDOWN, A_ATTACKDOWN] then
712 pos := W_POS_DOWN
713 else
714 pos := W_POS_NORMAL;
715
716 if (FCurrentAnimation in [A_ATTACK, A_ATTACKUP, A_ATTACKDOWN]) or
717 FFire then
718 act := W_ACT_FIRE
719 else
720 act := W_ACT_NORMAL;
721
722 if Alpha < 201 then
723 e_Draw(WeaponID[FCurrentWeapon][pos][act],
724 X+FWeaponPoints[FCurrentWeapon, FCurrentAnimation, FDirection,
725 FAnim[D_RIGHT][FCurrentAnimation].CurrentFrame].X,
726 Y+FWeaponPoints[FCurrentWeapon, FCurrentAnimation, FDirection,
727 FAnim[D_RIGHT][FCurrentAnimation].CurrentFrame].Y,
728 0, True, False, Mirror);
729 end;
730
731 // Ìîäåëü:
732 if (FDirection = D_LEFT) and
733 (FAnim[D_LEFT][FCurrentAnimation] <> nil) then
734 begin
735 FAnim[D_LEFT][FCurrentAnimation].Alpha := Alpha;
736 FAnim[D_LEFT][FCurrentAnimation].Draw(X, Y, M_NONE);
737 end
738 else
739 begin
740 FAnim[D_RIGHT][FCurrentAnimation].Alpha := Alpha;
741 FAnim[D_RIGHT][FCurrentAnimation].Draw(X, Y, Mirror);
742 end;
743
744 // Ìàñêà ìîäåëè:
745 e_Colors := FColor;
746
747 if (FDirection = D_LEFT) and
748 (FMaskAnim[D_LEFT][FCurrentAnimation] <> nil) then
749 begin
750 FMaskAnim[D_LEFT][FCurrentAnimation].Alpha := Alpha;
751 FMaskAnim[D_LEFT][FCurrentAnimation].Draw(X, Y, M_NONE);
752 end
753 else
754 begin
755 FMaskAnim[D_RIGHT][FCurrentAnimation].Alpha := Alpha;
756 FMaskAnim[D_RIGHT][FCurrentAnimation].Draw(X, Y, Mirror);
757 end;
758
759 e_Colors.R := 255;
760 e_Colors.G := 255;
761 e_Colors.B := 255;
762 end;
763
764 function TPlayerModel.GetCurrentAnimation: TAnimation;
765 begin
766 if (FDirection = D_LEFT) and (FAnim[D_LEFT][FCurrentAnimation] <> nil) then
767 Result := FAnim[D_LEFT][FCurrentAnimation]
768 else
769 Result := FAnim[D_RIGHT][FCurrentAnimation];
770 end;
771
772 function TPlayerModel.GetCurrentAnimationMask: TAnimation;
773 begin
774 if (FDirection = D_LEFT) and (FMaskAnim[D_LEFT][FCurrentAnimation] <> nil) then
775 Result := FMaskAnim[D_LEFT][FCurrentAnimation]
776 else
777 Result := FMaskAnim[D_RIGHT][FCurrentAnimation];
778 end;
779
780 function TPlayerModel.PlaySound(SoundType, Level: Byte; X, Y: Integer): Boolean;
781 var
782 TempArray: array of DWORD;
783 a: Integer;
784 begin
785 Result := False;
786 SetLength(TempArray, 0);
787
788 if SoundType = MODELSOUND_PAIN then
789 begin
790 if FPainSounds = nil then Exit;
791
792 for a := 0 to High(FPainSounds) do
793 if FPainSounds[a].Level = Level then
794 begin
795 SetLength(TempArray, Length(TempArray)+1);
796 TempArray[High(TempArray)] := FPainSounds[a].ID;
797 end;
798 end
799 else
800 begin
801 if (Level in [2, 3, 5]) and (FSlopSound > 0) then
802 begin
803 g_Sound_PlayExAt('SOUND_MONSTER_SLOP', X, Y);
804 if FSlopSound = 1 then
805 begin
806 Result := True;
807 Exit;
808 end;
809 end;
810 if FDieSounds = nil then Exit;
811
812 for a := 0 to High(FDieSounds) do
813 if FDieSounds[a].Level = Level then
814 begin
815 SetLength(TempArray, Length(TempArray)+1);
816 TempArray[High(TempArray)] := FDieSounds[a].ID;
817 end;
818 if (TempArray = nil) and (Level = 5) then
819 begin
820 g_Sound_PlayExAt('SOUND_MONSTER_SLOP', X, Y);
821 Result := True;
822 Exit;
823 end;
824 end;
825
826 if TempArray = nil then Exit;
827
828 g_Sound_PlayAt(TempArray[Random(Length(TempArray))], X, Y);
829
830 Result := True;
831 end;
832
833 procedure TPlayerModel.SetColor(Red, Green, Blue: Byte);
834 begin
835 FColor.R := Red;
836 FColor.G := Green;
837 FColor.B := Blue;
838 end;
839
840 procedure TPlayerModel.SetFire(Fire: Boolean);
841 begin
842 FFire := Fire;
843
844 if FFire then FFireCounter := FAnim[D_RIGHT, A_ATTACK].Speed*FAnim[D_RIGHT, A_ATTACK].TotalFrames
845 else FFireCounter := 0;
846 end;
847
848 procedure TPlayerModel.SetFlag(Flag: Byte);
849 var
850 id: DWORD;
851 begin
852 FFlag := Flag;
853
854 FFlagAnim.Free();
855 FFlagAnim := nil;
856
857 case Flag of
858 FLAG_RED: g_Frames_Get(id, 'FRAMES_FLAG_RED');
859 FLAG_BLUE: g_Frames_Get(id, 'FRAMES_FLAG_BLUE');
860 else Exit;
861 end;
862
863 FFlagAnim := TAnimation.Create(id, True, 8);
864 end;
865
866 procedure TPlayerModel.SetWeapon(Weapon: Byte);
867 begin
868 FCurrentWeapon := Weapon;
869 end;
870
871 procedure TPlayerModel.Update();
872 begin
873 if (FDirection = D_LEFT) and (FAnim[D_LEFT][FCurrentAnimation] <> nil) then
874 FAnim[D_LEFT][FCurrentAnimation].Update else FAnim[D_RIGHT][FCurrentAnimation].Update;
875
876 if (FDirection = D_LEFT) and (FMaskAnim[D_LEFT][FCurrentAnimation] <> nil) then
877 FMaskAnim[D_LEFT][FCurrentAnimation].Update else FMaskAnim[D_RIGHT][FCurrentAnimation].Update;
878
879 if FFlagAnim <> nil then FFlagAnim.Update;
880
881 if FFireCounter > 0 then Dec(FFireCounter) else FFire := False;
882 end;
883
884 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024