DEADSOFTWARE

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