DEADSOFTWARE

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