?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
initial commit:
[d2df-sdl.git] / src / game / g_playermodel.pas
blob283113e0dc5e4f4f33bfae98e848a7f0a78f4df0
1 unit g_playermodel;
2
3 interface
4
5 uses
6 g_textures, g_basic, e_graphics, WADEDITOR,
7 WADSTRUCT, g_weapons;
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
169 str := Trim(str);
170 if Length(str) < 3 then
171 Exit;
172
173 for a := 1 to Length(str) do
174 if (str[a] = ',') or (a = Length(str)) then
175 begin
176 s := Copy(str, 1, a);
177 if s[Length(s)] = ',' then
178 SetLength(s, Length(s)-1);
179 Delete(str, 1, a);
180
181 if (Sscanf(s, '%d:%d', [@x, @y]) < 2) or
182 (x < -64) or (x > 128) or
183 (y < -64) or (y > 128) then
184 Exit;
185
186 point.X := x;
187 point.Y := y;
188
189 Break;
190 end;
191
192 Result := True;
193 end;
194
195 function GetWeapPoints(str: String; weapon: Byte; anim: Byte; dir: TDirection;
196 frames: Word; backanim: Boolean; var wpoints: TWeaponPoints): Boolean;
197 var
198 a, b, h: Integer;
199 begin
200 Result := False;
201
202 if frames = 0 then
203 Exit;
204
205 backanim := backanim and (frames > 2);
206
207 for a := 1 to frames do
208 begin
209 if not GetPoint(str, wpoints[weapon, anim, dir, a-1]) then
210 Exit;
211
212 with wpoints[weapon, anim, dir, a-1] do
213 begin
214 X := X - WEAPONBASE[weapon].X;
215 Y := Y - WEAPONBASE[weapon].Y;
216 if dir = D_LEFT then
217 X := -X;
218 end;
219 end;
220
221 h := High(wpoints[weapon, anim, dir]);
222 if backanim then
223 for b := h downto frames do
224 wpoints[weapon, anim, dir, b] := wpoints[weapon, anim, dir, h-b+1];
225
226 Result := True;
227 end;
228
229 function g_PlayerModel_Load(FileName: string): Boolean;
230 var
231 ID: DWORD;
232 a, b, len, aa, bb, f: Integer;
233 cc: TDirection;
234 config: TConfig;
235 pData, pData2: Pointer;
236 WAD: TWADEditor_1;
237 s: string;
238 prefix: string;
239 ok: Boolean;
240 begin
241 e_WriteLog(Format('Loading player model: %s', [ExtractFileName(FileName)]), MSG_NOTIFY);
242
243 Result := False;
244
245 WAD := TWADEditor_1.Create;
246 WAD.ReadFile(FileName);
247
248 if WAD.GetLastError <> DFWAD_NOERROR then
249 begin
250 WAD.Free();
251 Exit;
252 end;
253
254 if not WAD.GetResource('TEXT', 'MODEL', pData, len) then
255 begin
256 WAD.Free();
257 Exit;
258 end;
259
260 config := TConfig.CreateMem(pData, len);
261 FreeMem(pData);
262
263 s := config.ReadStr('Model', 'name', '');
264 if s = '' then
265 begin
266 config.Free();
267 WAD.Free();
268 Exit;
269 end;
270
271 SetLength(PlayerModelsArray, Length(PlayerModelsArray)+1);
272 ID := High(PlayerModelsArray);
273
274 prefix := FileName+':TEXTURES\';
275
276 with PlayerModelsArray[ID].Info do
277 begin
278 Name := s;
279 Author := config.ReadStr('Model', 'author', '');
280 Description := config.ReadStr('Model', 'description', '');
281 end;
282
283 for b := A_STAND to A_PAIN do
284 begin
285 if not (g_Frames_CreateWAD(nil, s+'_RIGHTANIM'+IntToStr(b),
286 prefix+config.ReadStr(AnimNames[b], 'resource', ''),
287 64, 64, config.ReadInt(AnimNames[b], 'frames', 1),
288 config.ReadBool(AnimNames[b], 'backanim', False)) and
289 g_Frames_CreateWAD(nil, s+'_RIGHTANIM'+IntToStr(b)+'_MASK',
290 prefix+config.ReadStr(AnimNames[b], 'mask', ''),
291 64, 64, config.ReadInt(AnimNames[b], 'frames', 1),
292 config.ReadBool(AnimNames[b], 'backanim', False))) then
293 begin
294 config.Free();
295 WAD.Free();
296 Exit;
297 end;
298
299 for aa := WEAPON_SAW to WEAPON_SUPERPULEMET do
300 for bb := A_STAND to A_PAIN do
301 for cc := D_LEFT to D_RIGHT do
302 begin
303 f := config.ReadInt(AnimNames[bb], 'frames', 1);
304 if config.ReadBool(AnimNames[bb], 'backanim', False) then
305 if f > 2 then f := 2*f-2;
306 SetLength(PlayerModelsArray[ID].WeaponPoints[aa, bb, cc], f);
307 end;
308
309 if (config.ReadStr(AnimNames[b], 'resource2', '') <> '') and
310 (config.ReadStr(AnimNames[b], 'mask2', '') <> '') then
311 begin
312 g_Frames_CreateWAD(nil, s+'_LEFTANIM'+IntToStr(b),
313 prefix+config.ReadStr(AnimNames[b], 'resource2', ''),
314 64, 64, config.ReadInt(AnimNames[b], 'frames', 1),
315 config.ReadBool(AnimNames[b], 'backanim', False));
316
317 g_Frames_CreateWAD(nil, s+'_LEFTANIM'+IntToStr(b)+'_MASK',
318 prefix+config.ReadStr(AnimNames[b], 'mask2', ''),
319 64, 64, config.ReadInt(AnimNames[b], 'frames', 1),
320 config.ReadBool(AnimNames[b], 'backanim', False));
321 end;
322
323 PlayerModelsArray[ID].ModelSpeed[b] := Max(1, config.ReadInt(AnimNames[b], 'waitcount', 1) div 3);
324 end;
325
326 with PlayerModelsArray[ID], config do
327 begin
328 prefix := FileName+':SOUNDS\';
329
330 a := 1;
331 repeat
332 s := config.ReadStr('Sound', 'pain'+IntToStr(a), '');
333 if s <> '' then
334 begin
335 SetLength(PainSounds, Length(PainSounds)+1);
336 g_Sound_CreateWAD(PainSounds[High(PainSounds)].ID, prefix+s);
337 PainSounds[High(PainSounds)].Level := config.ReadInt('Sound', 'painlevel'+IntToStr(a), 1);
338 end;
339 a := a+1;
340 until s = '';
341
342 a := 1;
343 repeat
344 s := config.ReadStr('Sound', 'die'+IntToStr(a), '');
345 if s <> '' then
346 begin
347 SetLength(DieSounds, Length(DieSounds)+1);
348 g_Sound_CreateWAD(DieSounds[High(DieSounds)].ID, prefix+s);
349 DieSounds[High(DieSounds)].Level := config.ReadInt('Sound', 'dielevel'+IntToStr(a), 1);
350 end;
351 a := a+1;
352 until s = '';
353
354 SlopSound := Min(Max(config.ReadInt('Sound', 'slop', 0), 0), 2);
355
356 SetLength(Gibs, ReadInt('Gibs', 'count', 0));
357
358 if (Gibs <> nil) and
359 (WAD.GetResource('TEXTURES', config.ReadStr('Gibs', 'resource', 'GIBS'), pData, len)) and
360 (WAD.GetResource('TEXTURES', config.ReadStr('Gibs', 'mask', 'GIBSMASK'), pData2, len)) then
361 begin
362 for a := 0 to High(Gibs) do
363 if e_CreateTextureMemEx(pData, Gibs[a].ID, a*32, 0, 32, 32) and
364 e_CreateTextureMemEx(pData2, Gibs[a].MaskID, a*32, 0, 32, 32) then
365 begin
366 Gibs[a].Rect := e_GetTextureSize2(Gibs[a].ID);
367 with Gibs[a].Rect do
368 if Height > 3 then Height := Height-1-Random(2);
369 Gibs[a].OnlyOne := config.ReadInt('Gibs', 'once', -1) = a+1;
370 end;
371
372 FreeMem(pData);
373 FreeMem(pData2);
374 end;
375
376 ok := True;
377 for aa := WEAPON_SAW to WEAPON_SUPERPULEMET do
378 for bb := A_STAND to A_PAIN do
379 if not (bb in [A_DIE1, A_DIE2, A_PAIN]) then
380 begin
381 ok := ok and GetWeapPoints(config.ReadStr(AnimNames[bb], WeapNames[aa]+'_points', ''), aa, bb, D_RIGHT,
382 config.ReadInt(AnimNames[bb], 'frames', 0),
383 config.ReadBool(AnimNames[bb], 'backanim', False),
384 WeaponPoints);
385
386 if not GetWeapPoints(config.ReadStr(AnimNames[bb], WeapNames[aa]+'2_points', ''), aa, bb, D_LEFT,
387 config.ReadInt(AnimNames[bb], 'frames', 0),
388 config.ReadBool(AnimNames[bb], 'backanim', False),
389 WeaponPoints) then
390 for f := 0 to High(WeaponPoints[aa, bb, D_RIGHT]) do
391 begin
392 WeaponPoints[aa, bb, D_LEFT, f].X := -WeaponPoints[aa, bb, D_RIGHT, f].X;
393 WeaponPoints[aa, bb, D_LEFT, f].Y := WeaponPoints[aa, bb, D_RIGHT, f].Y;
394 end;
395
396 if not ok then Break;
397 end;
398 {if ok then g_Console_Add(Info.Name+' weapon points ok')
399 else g_Console_Add(Info.Name+' weapon points fail');}
400 Info.HaveWeapon := ok;
401
402 s := config.ReadStr('Model', 'flag_point', '');
403 if not GetPoint(s, FlagPoint) then FlagPoint := FLAG_DEFPOINT;
404
405 FlagAngle := config.ReadInt('Model', 'flag_angle', FLAG_DEFANGLE);
406 end;
407
408 config.Free();
409 WAD.Free();
410
411 Result := True;
412 end;
413
414 function g_PlayerModel_Get(ModelName: String): TPlayerModel;
415 var
416 a: Integer;
417 b: Byte;
418 ID, ID2: DWORD;
419 begin
420 Result := nil;
421
422 if PlayerModelsArray = nil then Exit;
423
424 for a := 0 to High(PlayerModelsArray) do
425 if AnsiLowerCase(PlayerModelsArray[a].Info.Name) = AnsiLowerCase(ModelName) then
426 begin
427 Result := TPlayerModel.Create;
428
429 with PlayerModelsArray[a] do
430 begin
431 Result.FName := Info.Name;
432
433 for b := A_STAND to A_PAIN do
434 begin
435 if not (g_Frames_Get(ID, Info.Name+'_RIGHTANIM'+IntToStr(b)) and
436 g_Frames_Get(ID2, Info.Name+'_RIGHTANIM'+IntToStr(b)+'_MASK')) then
437 begin
438 Result.Free();
439 Result := nil;
440 Exit;
441 end;
442
443 Result.FAnim[D_RIGHT][b] := TAnimation.Create(ID, b in [A_STAND, A_WALK], ModelSpeed[b]);
444
445 Result.FMaskAnim[D_RIGHT][b] := TAnimation.Create(ID2, b in [A_STAND, A_WALK], ModelSpeed[b]);
446
447 if g_Frames_Exists(Info.Name+'_LEFTANIM'+IntToStr(b)) and
448 g_Frames_Exists(Info.Name+'_LEFTANIM'+IntToStr(b)+'_MASK') then
449 if g_Frames_Get(ID, Info.Name+'_LEFTANIM'+IntToStr(b)) and
450 g_Frames_Get(ID2, Info.Name+'_LEFTANIM'+IntToStr(b)+'_MASK') then
451 begin
452 Result.FAnim[D_LEFT][b] := TAnimation.Create(ID, b in [A_STAND, A_WALK], ModelSpeed[b]);
453
454 Result.FMaskAnim[D_LEFT][b] := TAnimation.Create(ID2, b in [A_STAND, A_WALK], ModelSpeed[b]);
455 end;
456
457 Result.FPainSounds := PainSounds;
458 Result.FDieSounds := DieSounds;
459 Result.FSlopSound := SlopSound;
460 end;
461
462 Result.FDrawWeapon := Info.HaveWeapon;
463 Result.FWeaponPoints := WeaponPoints;
464
465 Result.FFlagPoint := FlagPoint;
466 Result.FFlagAngle := FlagAngle;
467
468 Break;
469 end;
470 end;
471 end;
472
473 function g_PlayerModel_GetAnim(ModelName: string; Anim: Byte; var _Anim, _Mask: TAnimation): Boolean;
474 var
475 a: Integer;
476 c: Boolean;
477 ID: DWORD;
478 begin
479 Result := False;
480
481 if PlayerModelsArray = nil then Exit;
482 for a := 0 to High(PlayerModelsArray) do
483 if PlayerModelsArray[a].Info.Name = ModelName then
484 with PlayerModelsArray[a] do
485 begin
486 if Anim in [A_STAND, A_WALK] then c := True else c := False;
487
488 if not g_Frames_Get(ID, Info.Name+'_RIGHTANIM'+IntToStr(Anim)) then
489 if not g_Frames_Get(ID, Info.Name+'_LEFTANIM'+IntToStr(Anim)) then Exit;
490
491 _Anim := TAnimation.Create(ID, c, ModelSpeed[Anim]);
492 _Anim.Speed := ModelSpeed[Anim];
493
494 if not g_Frames_Get(ID, Info.Name+'_RIGHTANIM'+IntToStr(Anim)+'_MASK') then
495 if not g_Frames_Get(ID, Info.Name+'_LEFTANIM'+IntToStr(Anim)+'_MASK') then Exit;
496
497 _Mask := TAnimation.Create(ID, c, ModelSpeed[Anim]);
498 _Mask.Speed := ModelSpeed[Anim];
499
500 Break;
501 end;
502
503 Result := True;
504 end;
505
506 function g_PlayerModel_GetGibs(ModelName: string; var Gibs: TGibsArray): Boolean;
507 var
508 a, i, b: Integer;
509 c: Boolean;
510 begin
511 Result := False;
512
513 if PlayerModelsArray = nil then Exit;
514 if gGibsCount = 0 then Exit;
515
516 c := False;
517
518 SetLength(Gibs, gGibsCount);
519
520 for a := 0 to High(PlayerModelsArray) do
521 if PlayerModelsArray[a].Info.Name = ModelName then
522 begin
523 for i := 0 to High(Gibs) do
524 begin
525 if c and (Length(PlayerModelsArray[a].Gibs) = 1) then
526 begin
527 SetLength(Gibs, i);
528 Break;
529 end;
530
531 repeat
532 b := Random(Length(PlayerModelsArray[a].Gibs));
533 until not (PlayerModelsArray[a].Gibs[b].OnlyOne and c);
534
535 Gibs[i] := PlayerModelsArray[a].Gibs[b];
536
537 if Gibs[i].OnlyOne then c := True;
538 end;
539
540 Result := True;
541 Break;
542 end;
543 end;
544
545 function g_PlayerModel_GetNames(): SArray;
546 var
547 i: DWORD;
548 begin
549 Result := nil;
550
551 if PlayerModelsArray = nil then Exit;
552
553 for i := 0 to High(PlayerModelsArray) do
554 begin
555 SetLength(Result, Length(Result)+1);
556 Result[High(Result)] := PlayerModelsArray[i].Info.Name;
557 end;
558 end;
559
560 function g_PlayerModel_GetInfo(ModelName: string): TModelInfo;
561 var
562 a: Integer;
563 begin
564 if PlayerModelsArray = nil then Exit;
565
566 for a := 0 to High(PlayerModelsArray) do
567 if PlayerModelsArray[a].Info.Name = ModelName then
568 begin
569 Result := PlayerModelsArray[a].Info;
570 Break;
571 end;
572 end;
573
574 procedure g_PlayerModel_FreeData();
575 var
576 i: DWORD;
577 a, b, c: Integer;
578 begin
579 for a := WEAPON_SAW to WEAPON_SUPERPULEMET do
580 for b := W_POS_NORMAL to W_POS_DOWN do
581 for c := W_ACT_NORMAL to W_ACT_FIRE do
582 e_DeleteTexture(WeaponID[a][b][c]);
583
584 e_WriteLog('Releasing models...', MSG_NOTIFY);
585
586 if PlayerModelsArray = nil then Exit;
587
588 for i := 0 to High(PlayerModelsArray) do
589 with PlayerModelsArray[i] do
590 begin
591 for a := A_STAND to A_PAIN do
592 begin
593 g_Frames_DeleteByName(Info.Name+'_LEFTANIM'+IntToStr(a));
594 g_Frames_DeleteByName(Info.Name+'_LEFTANIM'+IntToStr(a)+'_MASK');
595 g_Frames_DeleteByName(Info.Name+'_RIGHTANIM'+IntToStr(a));
596 g_Frames_DeleteByName(Info.Name+'_RIGHTANIM'+IntToStr(a)+'_MASK');
597 end;
598
599 if PainSounds <> nil then
600 for b := 0 to High(PainSounds) do
601 e_DeleteSound(PainSounds[b].ID);
602
603 if DieSounds <> nil then
604 for b := 0 to High(DieSounds) do
605 e_DeleteSound(DieSounds[b].ID);
606
607 if Gibs <> nil then
608 for b := 0 to High(Gibs) do
609 begin
610 e_DeleteTexture(Gibs[b].ID);
611 e_DeleteTexture(Gibs[b].MaskID);
612 end;
613 end;
614
615 PlayerModelsArray := nil;
616 end;
617
618 { TPlayerModel }
619
620 procedure TPlayerModel.ChangeAnimation(Animation: Byte; Force: Boolean = False);
621 begin
622 if not Force then if FCurrentAnimation = Animation then Exit;
623
624 FCurrentAnimation := Animation;
625
626 if (FDirection = D_LEFT) and
627 (FAnim[D_LEFT][FCurrentAnimation] <> nil) and
628 (FMaskAnim[D_LEFT][FCurrentAnimation] <> nil) then
629 begin
630 FAnim[D_LEFT][FCurrentAnimation].Reset;
631 FMaskAnim[D_LEFT][FCurrentAnimation].Reset;
632 end
633 else
634 begin
635 FAnim[D_RIGHT][FCurrentAnimation].Reset;
636 FMaskAnim[D_RIGHT][FCurrentAnimation].Reset;
637 end;
638 end;
639
640 destructor TPlayerModel.Destroy();
641 var
642 a: Byte;
643 begin
644 for a := A_STAND to A_PAIN do
645 begin
646 FAnim[D_LEFT][a].Free();
647 FMaskAnim[D_LEFT][a].Free();
648 FAnim[D_RIGHT][a].Free();
649 FMaskAnim[D_RIGHT][a].Free();
650 end;
651
652 inherited;
653 end;
654
655 procedure TPlayerModel.Draw(X, Y: Integer; Alpha: Byte = 0);
656 var
657 Mirror: TMirrorType;
658 pos, act: Byte;
659 p: TPoint;
660 begin
661 // Ôëàãè:
662 if Direction = D_LEFT then
663 Mirror := M_NONE
664 else
665 Mirror := M_HORIZONTAL;
666
667 if (FFlag <> FLAG_NONE) and (FFlagAnim <> nil) and
668 (not (FCurrentAnimation in [A_DIE1, A_DIE2])) then
669 begin
670 p.X := IfThen(Direction = D_LEFT,
671 FLAG_BASEPOINT.X,
672 64-FLAG_BASEPOINT.X);
673 p.Y := FLAG_BASEPOINT.Y;
674
675 FFlagAnim.DrawEx(X+IfThen(Direction = D_LEFT, FFlagPoint.X-1, 2*FLAG_BASEPOINT.X-FFlagPoint.X+1)-FLAG_BASEPOINT.X,
676 Y+FFlagPoint.Y-FLAG_BASEPOINT.Y+1, Mirror, p,
677 IfThen(FDirection = D_RIGHT, FFlagAngle, -FFlagAngle));
678 end;
679
680 // Îðóæèå:
681 if Direction = D_RIGHT then
682 Mirror := M_NONE
683 else
684 Mirror := M_HORIZONTAL;
685
686 if FDrawWeapon and
687 (not (FCurrentAnimation in [A_DIE1, A_DIE2, A_PAIN])) and
688 (FCurrentWeapon in [WEAPON_SAW..WEAPON_SUPERPULEMET]) then
689 begin
690 if FCurrentAnimation in [A_SEEUP, A_ATTACKUP] then
691 pos := W_POS_UP
692 else
693 if FCurrentAnimation in [A_SEEDOWN, A_ATTACKDOWN] then
694 pos := W_POS_DOWN
695 else
696 pos := W_POS_NORMAL;
697
698 if (FCurrentAnimation in [A_ATTACK, A_ATTACKUP, A_ATTACKDOWN]) or
699 FFire then
700 act := W_ACT_FIRE
701 else
702 act := W_ACT_NORMAL;
703
704 if Alpha < 201 then
705 e_Draw(WeaponID[FCurrentWeapon][pos][act],
706 X+FWeaponPoints[FCurrentWeapon, FCurrentAnimation, FDirection,
707 FAnim[D_RIGHT][FCurrentAnimation].CurrentFrame].X,
708 Y+FWeaponPoints[FCurrentWeapon, FCurrentAnimation, FDirection,
709 FAnim[D_RIGHT][FCurrentAnimation].CurrentFrame].Y,
710 0, True, False, Mirror);
711 end;
712
713 // Ìîäåëü:
714 if (FDirection = D_LEFT) and
715 (FAnim[D_LEFT][FCurrentAnimation] <> nil) then
716 begin
717 FAnim[D_LEFT][FCurrentAnimation].Alpha := Alpha;
718 FAnim[D_LEFT][FCurrentAnimation].Draw(X, Y, M_NONE);
719 end
720 else
721 begin
722 FAnim[D_RIGHT][FCurrentAnimation].Alpha := Alpha;
723 FAnim[D_RIGHT][FCurrentAnimation].Draw(X, Y, Mirror);
724 end;
725
726 // Ìàñêà ìîäåëè:
727 e_Colors := FColor;
728
729 if (FDirection = D_LEFT) and
730 (FMaskAnim[D_LEFT][FCurrentAnimation] <> nil) then
731 begin
732 FMaskAnim[D_LEFT][FCurrentAnimation].Alpha := Alpha;
733 FMaskAnim[D_LEFT][FCurrentAnimation].Draw(X, Y, M_NONE);
734 end
735 else
736 begin
737 FMaskAnim[D_RIGHT][FCurrentAnimation].Alpha := Alpha;
738 FMaskAnim[D_RIGHT][FCurrentAnimation].Draw(X, Y, Mirror);
739 end;
740
741 e_Colors.R := 255;
742 e_Colors.G := 255;
743 e_Colors.B := 255;
744 end;
745
746 function TPlayerModel.GetCurrentAnimation: TAnimation;
747 begin
748 if (FDirection = D_LEFT) and (FAnim[D_LEFT][FCurrentAnimation] <> nil) then
749 Result := FAnim[D_LEFT][FCurrentAnimation]
750 else
751 Result := FAnim[D_RIGHT][FCurrentAnimation];
752 end;
753
754 function TPlayerModel.GetCurrentAnimationMask: TAnimation;
755 begin
756 if (FDirection = D_LEFT) and (FMaskAnim[D_LEFT][FCurrentAnimation] <> nil) then
757 Result := FMaskAnim[D_LEFT][FCurrentAnimation]
758 else
759 Result := FMaskAnim[D_RIGHT][FCurrentAnimation];
760 end;
761
762 function TPlayerModel.PlaySound(SoundType, Level: Byte; X, Y: Integer): Boolean;
763 var
764 TempArray: array of DWORD;
765 a: Integer;
766 begin
767 Result := False;
768 SetLength(TempArray, 0);
769
770 if SoundType = MODELSOUND_PAIN then
771 begin
772 if FPainSounds = nil then Exit;
773
774 for a := 0 to High(FPainSounds) do
775 if FPainSounds[a].Level = Level then
776 begin
777 SetLength(TempArray, Length(TempArray)+1);
778 TempArray[High(TempArray)] := FPainSounds[a].ID;
779 end;
780 end
781 else
782 begin
783 if (Level in [2, 3]) and (FSlopSound > 0) then
784 begin
785 g_Sound_PlayExAt('SOUND_MONSTER_SLOP', X, Y);
786 if FSlopSound = 1 then
787 begin
788 Result := True;
789 Exit;
790 end;
791 end;
792 if FDieSounds = nil then Exit;
793
794 for a := 0 to High(FDieSounds) do
795 if FDieSounds[a].Level = Level then
796 begin
797 SetLength(TempArray, Length(TempArray)+1);
798 TempArray[High(TempArray)] := FDieSounds[a].ID;
799 end;
800 end;
801
802 if TempArray = nil then Exit;
803
804 g_Sound_PlayAt(TempArray[Random(Length(TempArray))], X, Y);
805
806 Result := True;
807 end;
808
809 procedure TPlayerModel.SetColor(Red, Green, Blue: Byte);
810 begin
811 FColor.R := Red;
812 FColor.G := Green;
813 FColor.B := Blue;
814 end;
815
816 procedure TPlayerModel.SetFire(Fire: Boolean);
817 begin
818 FFire := Fire;
819
820 if FFire then FFireCounter := FAnim[D_RIGHT, A_ATTACK].Speed*FAnim[D_RIGHT, A_ATTACK].TotalFrames
821 else FFireCounter := 0;
822 end;
823
824 procedure TPlayerModel.SetFlag(Flag: Byte);
825 var
826 id: DWORD;
827 begin
828 FFlag := Flag;
829
830 FFlagAnim.Free();
831 FFlagAnim := nil;
832
833 case Flag of
834 FLAG_RED: g_Frames_Get(id, 'FRAMES_FLAG_RED');
835 FLAG_BLUE: g_Frames_Get(id, 'FRAMES_FLAG_BLUE');
836 else Exit;
837 end;
838
839 FFlagAnim := TAnimation.Create(id, True, 8);
840 end;
841
842 procedure TPlayerModel.SetWeapon(Weapon: Byte);
843 begin
844 FCurrentWeapon := Weapon;
845 end;
846
847 procedure TPlayerModel.Update();
848 begin
849 if (FDirection = D_LEFT) and (FAnim[D_LEFT][FCurrentAnimation] <> nil) then
850 FAnim[D_LEFT][FCurrentAnimation].Update else FAnim[D_RIGHT][FCurrentAnimation].Update;
851
852 if (FDirection = D_LEFT) and (FMaskAnim[D_LEFT][FCurrentAnimation] <> nil) then
853 FMaskAnim[D_LEFT][FCurrentAnimation].Update else FMaskAnim[D_RIGHT][FCurrentAnimation].Update;
854
855 if FFlagAnim <> nil then FFlagAnim.Update;
856
857 if FFireCounter > 0 then Dec(FFireCounter) else FFire := False;
858 end;
859
860 end.
a port of Doom2D Forever to FPC/SDL