DEADSOFTWARE

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