DEADSOFTWARE

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