DEADSOFTWARE

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


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