DEADSOFTWARE

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