DEADSOFTWARE

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