src/game/opengl/r_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, version 3 of the License ONLY.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14  *)
  15 {$INCLUDE ../../shared/a_modes.inc}
  16 unit r_playermodel;
  17
  18 interface
  19
  20   uses g_playermodel, g_base; // TPlayerModel, TRectWH
  21
  22   procedure r_PlayerModel_Initialize;
  23   procedure r_PlayerModel_Finalize;
  24   procedure r_PlayerModel_Load;
  25   procedure r_PlayerModel_Free;
  26   procedure r_PlayerModel_Update;
  27   procedure r_PlayerModel_Draw (pm: TPlayerModel; X, Y: Integer; Alpha: Byte = 0);
  28
  29   {$IFDEF ENABLE_GIBS}
  30     procedure r_PlayerModel_DrawGibs;
  31     function r_PlayerModel_GetGibRect (m, id: Integer): TRectWH;
  32   {$ENDIF}
  33
  34 implementation
  35
  36   uses
  37     {$IFDEF ENABLE_GIBS}
  38       g_gibs,
  39     {$ENDIF}
  40     SysUtils, Classes, Math,
  41     MAPDEF, utils, e_log, wadreader,
  42     ImagingTypes, Imaging, ImagingUtility,
  43     r_graphics, g_options, r_animations, r_textures,
  44     g_basic, g_map, g_weapons, g_textures, g_player, g_phys, g_game
  45   ;
  46
  47   const
  48     WeapNames: Array [WP_FIRST + 1..WP_LAST] of String = ('csaw', 'hgun', 'sg', 'ssg', 'mgun', 'rkt', 'plz', 'bfg', 'spl', 'flm');
  49
  50   type
  51     TDirIdx = TDirection.D_LEFT..TDirection.D_RIGHT;
  52     TAnimIdx = A_STAND..A_LAST;
  53
  54   var
  55     WeaponID: Array [WP_FIRST + 1..WP_LAST, W_POS_NORMAL..W_POS_DOWN, W_ACT_NORMAL..W_ACT_FIRE] of DWORD;
  56     Models: Array of record
  57       Frames: Array [TDirIdx, TAnimIdx] of record
  58         base: DWORD;
  59         mask: DWORD;
  60       end;
  61       {$IFDEF ENABLE_GIBS}
  62         Gibs: Array of record
  63           base: DWORD;
  64           mask: DWORD;
  65           rect: TRectWH;
  66         end;
  67       {$ENDIF}
  68     end;
  69     RedFlagFrames: DWORD;
  70     BlueFlagFrames: DWORD;
  71     FlagAnimState: TAnimationState;
  72
  73 {$IFDEF ENABLE_GIBS}
  74   function r_PlayerModel_GetGibRect (m, id: Integer): TRectWH;
  75   begin
  76     Result := Models[m].Gibs[id].rect
  77   end;
  78 {$ENDIF}
  79
  80   procedure r_PlayerModel_Initialize;
  81   begin
  82     FlagAnimState := TAnimationState.Create(True, 8, 5);
  83   end;
  84
  85   procedure r_PlayerModel_Finalize;
  86   begin
  87     FlagAnimState.Free;
  88     FlagAnimState := nil;
  89   end;
  90
  91   procedure ExtAnimFromBaseAnim(MName: String; AIdx: Integer);
  92     const
  93       CopyAnim: array [A_LASTBASE+1..A_LASTEXT] of Integer = (
  94         A_WALK, A_WALK, A_WALK, A_WALK, A_WALK,
  95         A_STAND, A_WALK, A_ATTACK, A_WALK, A_SEEUP, A_SEEDOWN,
  96         A_ATTACKUP, A_ATTACKDOWN
  97       );
  98     var
  99       OIdx: Integer;
 100       AName, OName: String;
 101   begin
 102     // HACK: shitty workaround to duplicate base animations
 103     //       in place of extended, replace with something better later
 104
 105     Assert((AIdx > A_LASTBASE) and (AIdx <= A_LASTEXT));
 106     OIdx := CopyAnim[AIdx];
 107
 108     AName := MName + '_RIGHTANIM' + IntToStr(AIdx);
 109     OName := MName + '_RIGHTANIM' + IntToStr(OIdx);
 110     Assert(g_Frames_Dup(AName, OName));
 111     Assert(g_Frames_Dup(AName + '_MASK', OName + '_MASK'));
 112     AName := MName + '_LEFTANIM' + IntToStr(AIdx);
 113     OName := MName + '_LEFTANIM' + IntToStr(OIdx);
 114     if g_Frames_Exists(AName) then
 115     begin
 116       g_Frames_Dup(AName, OName);
 117       g_Frames_Dup(AName + '_MASK', OName + '_MASK');
 118     end;
 119   end;
 120
 121   procedure r_PlayerModel_LoadResource (resource: AnsiString; var pData: Pointer; var len: Integer);
 122     var WAD: TWADFile;
 123   begin
 124     pData := nil;
 125     len := 0;
 126     WAD := TWADFile.Create;
 127     WAD.ReadFile(g_ExtractWadName(resource));
 128     WAD.GetResource(g_ExtractFilePathName(resource), pData, len);
 129     WAD.Free;
 130   end;
 131
 132   function g_PlayerModel_CalcGibSize (pData: Pointer; dataSize, x, y, w, h: Integer): TRectWH;
 133     var i, j: Integer; done: Boolean; img: TImageData;
 134
 135     function IsVoid (i, j: Integer): Boolean;
 136     begin
 137       result := Byte((PByte(img.bits) + (y+j)*img.width*4 + (x+i)*4 + 3)^) = 0
 138     end;
 139
 140   begin
 141     InitImage(img);
 142     assert(LoadImageFromMemory(pData, dataSize, img));
 143
 144     (* trace x from right to left *)
 145     done := false; i := 0;
 146     while not done and (i < w) do
 147     begin
 148       j := 0;
 149       while (j < h) and IsVoid(i, j) do inc(j);
 150       done := (j < h) and (IsVoid(i, j) = false);
 151       result.x := i;
 152       inc(i);
 153     end;
 154
 155     (* trace y from up to down *)
 156     done := false; j := 0;
 157     while not done and (j < h) do
 158     begin
 159       i := 0;
 160       while (i < w) and IsVoid(i, j) do inc(i);
 161       done := (i < w) and (IsVoid(i, j) = false);
 162       result.y := j;
 163       inc(j);
 164     end;
 165
 166     (* trace x from right to left *)
 167     done := false; i := w - 1;
 168     while not done and (i >= 0) do
 169     begin
 170       j := 0;
 171       while (j < h) and IsVoid(i, j) do inc(j);
 172       done := (j < h) and (IsVoid(i, j) = false);
 173       result.width := i - result.x + 1;
 174       dec(i);
 175     end;
 176
 177     (* trace y from down to up *)
 178     done := false; j := h - 1;
 179     while not done and (j >= 0) do
 180     begin
 181       i := 0;
 182       while (i < w) and IsVoid(i, j) do inc(i);
 183       done := (i < w) and (IsVoid(i, j) = false);
 184       result.height := j - result.y + 1;
 185       dec(j);
 186     end;
 187
 188     FreeImage(img);
 189   end;
 190
 191   procedure r_PlayerModel_Load;
 192     {$IFDEF ENABLE_GIBS}
 193       var base, mask: Pointer; baseLen, maskLen: Integer;
 194     {$ENDIF}
 195     var ID1, ID2: DWORD; i, a, b: Integer; prefix, aname: String;
 196   begin
 197     g_Frames_CreateWAD(@RedFlagFrames, 'FRAMES_FLAG_RED', GameWAD + ':TEXTURES\FLAGRED', 64, 64, 5, False);
 198     g_Frames_CreateWAD(@BlueFlagFrames, 'FRAMES_FLAG_BLUE', GameWAD + ':TEXTURES\FLAGBLUE', 64, 64, 5, False);
 199     for a := WP_FIRST + 1 to WP_LAST do
 200     begin
 201       g_Texture_CreateWAD(WeaponID[a][W_POS_NORMAL][W_ACT_NORMAL], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a]));
 202       g_Texture_CreateWAD(WeaponID[a][W_POS_NORMAL][W_ACT_FIRE], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_FIRE');
 203       g_Texture_CreateWAD(WeaponID[a][W_POS_UP][W_ACT_NORMAL], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_UP');
 204       g_Texture_CreateWAD(WeaponID[a][W_POS_UP][W_ACT_FIRE], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_UP_FIRE');
 205       g_Texture_CreateWAD(WeaponID[a][W_POS_DOWN][W_ACT_NORMAL], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_DN');
 206       g_Texture_CreateWAD(WeaponID[a][W_POS_DOWN][W_ACT_FIRE], GameWAD+':WEAPONS\'+UpperCase(WeapNames[a])+'_DN_FIRE');
 207     end;
 208     Models := nil;
 209     if PlayerModelsArray <> nil then
 210     begin
 211       SetLength(Models, Length(PlayerModelsArray));
 212       for i := 0 to High(PlayerModelsArray) do
 213       begin
 214         prefix := PlayerModelsArray[i].FileName + ':TEXTURES\';
 215         for b := A_STAND to A_LAST do
 216         begin
 217           aname := PlayerModelsArray[i].Name + '_RIGHTANIM' + IntToStr(b);
 218           with PlayerModelsArray[i].Anim[TDirection.D_RIGHT, b] do
 219           begin
 220             if not (g_Frames_CreateWAD(@ID1, aname, prefix + Resource, 64, 64, Frames, Back) and
 221                     g_Frames_CreateWAD(@ID2, aname + '_MASK', prefix + Mask, 64, 64, Frames, Back)) then
 222             begin
 223               if b > A_LASTBASE then
 224               begin
 225                 ExtAnimFromBaseAnim(PlayerModelsArray[i].Name, b);
 226                 continue
 227               end
 228             end;
 229             Models[i].Frames[TDirection.D_RIGHT, b].base := ID1;
 230             Models[i].Frames[TDirection.D_RIGHT, b].mask := ID2;
 231           end;
 232           with PlayerModelsArray[i].Anim[TDirection.D_LEFT, b] do
 233           begin
 234             if (Resource <> '') and (Mask <> '') then
 235             begin
 236               aname := PlayerModelsArray[i].Name + '_LEFTANIM' + IntToStr(b);
 237               g_Frames_CreateWAD(@ID1, aname, prefix + Resource, 64, 64, Frames, Back);
 238               g_Frames_CreateWAD(@ID2, aname + '_MASK', prefix + Mask, 64, 64, Frames, Back);
 239               Models[i].Frames[TDirection.D_LEFT, b].base := ID1;
 240               Models[i].Frames[TDirection.D_LEFT, b].mask := ID2;
 241             end
 242           end
 243         end;
 244         {$IFDEF ENABLE_GIBS}
 245           SetLength(Models[i].Gibs, PlayerModelsArray[i].GibsCount);
 246           if PlayerModelsArray[i].GibsCount > 0 then
 247           begin
 248             r_PlayerModel_LoadResource(prefix + PlayerModelsArray[i].GibsResource, base, baseLen);
 249             r_PlayerModel_LoadResource(prefix + PlayerModelsArray[i].GibsMask, mask, maskLen);
 250             if (base <> nil) and (mask <> nil) then
 251             begin
 252               for a := 0 to PlayerModelsArray[i].GibsCount - 1 do
 253               begin
 254                 if e_CreateTextureMemEx(base, baseLen, Models[i].Gibs[a].base, a * 32, 0, 32, 32) and
 255                    e_CreateTextureMemEx(mask, maskLen, Models[i].Gibs[a].mask, a * 32, 0, 32, 32) then
 256                 begin
 257                   Models[i].Gibs[a].rect := g_PlayerModel_CalcGibSize(base, baseLen, a * 32, 0, 32, 32);
 258                   with Models[i].Gibs[a].Rect do
 259                     if Height > 3 then
 260                       Height := Height - 1 - Random(2); // ???
 261                 end
 262               end
 263             end;
 264             FreeMem(mask);
 265             FreeMem(base);
 266           end
 267         {$ENDIF}
 268       end
 269     end
 270   end;
 271
 272   procedure r_PlayerModel_Free;
 273     var i, a, b, c: Integer;
 274   begin
 275     e_DeleteTexture(RedFlagFrames);
 276     e_DeleteTexture(BlueFlagFrames);
 277     if PlayerModelsArray = nil then Exit;
 278     for i := 0 to High(PlayerModelsArray) do
 279     begin
 280       with PlayerModelsArray[i] do
 281       begin
 282         for a := A_STAND to A_LAST do
 283         begin
 284           g_Frames_DeleteByName(Name + '_LEFTANIM' + IntToStr(a));
 285           g_Frames_DeleteByName(Name + '_LEFTANIM' + IntToStr(a) + '_MASK');
 286           g_Frames_DeleteByName(Name + '_RIGHTANIM' + IntToStr(a));
 287           g_Frames_DeleteByName(Name + '_RIGHTANIM' + IntToStr(a) + '_MASK');
 288         end;
 289       end
 290       // !!! delete gibs textures here
 291     end;
 292     for a := WP_FIRST + 1 to WP_LAST do
 293       for b := W_POS_NORMAL to W_POS_DOWN do
 294         for c := W_ACT_NORMAL to W_ACT_FIRE do
 295           e_DeleteTexture(WeaponID[a][b][c])
 296   end;
 297
 298   procedure r_PlayerModel_Update;
 299   begin
 300     FlagAnimState.Update
 301   end;
 302
 303 procedure r_PlayerModel_Draw (pm: TPlayerModel; X, Y: Integer; Alpha: Byte = 0);
 304 var
 305   Mirror: TMirrorType;
 306   pos, act: Byte;
 307   fp, p: TDFPoint;
 308   FramesID: DWORD;
 309   fa: Integer;
 310 begin
 311 // Флаги:
 312   if pm.Direction = TDirection.D_LEFT then
 313     Mirror := TMirrorType.None
 314   else
 315     Mirror := TMirrorType.Horizontal;
 316
 317   FramesID := 0;
 318   case pm.Flag of
 319     FLAG_RED: FramesID := RedFlagFrames;
 320     FLAG_BLUE: FramesID := BlueFlagFrames;
 321   end;
 322   if (FramesID <> 0) and (not (pm.CurrentAnimation in [A_DIE1, A_DIE2])) then
 323   begin
 324     fp := PlayerModelsArray[pm.id].FlagPoint;
 325     fa := PlayerModelsArray[pm.id].FlagAngle;
 326     p.X := IfThen(pm.Direction = TDirection.D_LEFT, FLAG_BASEPOINT.X, 64 - FLAG_BASEPOINT.X);
 327     p.Y := FLAG_BASEPOINT.Y;
 328     r_AnimationState_DrawEx(
 329       FramesID,
 330       FlagAnimState,
 331       X + IfThen(pm.Direction = TDirection.D_LEFT, fp.X - 1, 2 * FLAG_BASEPOINT.X - fp.X + 1) - FLAG_BASEPOINT.X,
 332       Y + fp.Y - FLAG_BASEPOINT.Y + 1,
 333       0,
 334       Mirror,
 335       False,
 336       p,
 337       IfThen(pm.Direction = TDirection.D_RIGHT, fa, -fa)
 338     );
 339   end;
 340
 341 // Оружие:
 342   if pm.Direction = TDirection.D_RIGHT then
 343     Mirror := TMirrorType.None
 344   else
 345     Mirror := TMirrorType.Horizontal;
 346
 347   if PlayerModelsArray[pm.id].HaveWeapon and (not (pm.CurrentAnimation in [A_DIE1, A_DIE2, A_PAIN])) and  (pm.CurrentWeapon in [WP_FIRST + 1..WP_LAST]) then
 348   begin
 349     if pm.CurrentAnimation in [A_SEEUP, A_ATTACKUP] then
 350       pos := W_POS_UP
 351     else
 352       if pm.CurrentAnimation in [A_SEEDOWN, A_ATTACKDOWN] then
 353         pos := W_POS_DOWN
 354       else
 355         pos := W_POS_NORMAL;
 356
 357     if (pm.CurrentAnimation in [A_ATTACK, A_ATTACKUP, A_ATTACKDOWN]) or pm.GetFire() then
 358       act := W_ACT_FIRE
 359     else
 360       act := W_ACT_NORMAL;
 361
 362     if Alpha < 201 then
 363       e_Draw(
 364         WeaponID[pm.CurrentWeapon][pos][act],
 365         X + PlayerModelsArray[pm.id].WeaponPoints[pm.CurrentWeapon, pm.CurrentAnimation, pm.Direction, pm.AnimState.CurrentFrame].X,
 366         Y + PlayerModelsArray[pm.id].WeaponPoints[pm.CurrentWeapon, pm.CurrentAnimation, pm.Direction, pm.AnimState.CurrentFrame].Y,
 367         0,
 368         True,
 369         False,
 370         Mirror
 371       );
 372   end;
 373
 374 // Модель:
 375   if (pm.Direction = TDirection.D_LEFT) and (Models[pm.id].Frames[TDirection.D_LEFT, pm.CurrentAnimation].base <> 0) then
 376   begin
 377     FramesID := Models[pm.id].Frames[TDirection.D_LEFT, pm.CurrentAnimation].base;
 378     r_AnimationState_Draw(FramesID, pm.AnimState, X, Y, Alpha, TMirrorType.None, False);
 379   end
 380   else
 381   begin
 382     FramesID := Models[pm.id].Frames[TDirection.D_RIGHT, pm.CurrentAnimation].base;
 383     r_AnimationState_Draw(FramesID, pm.AnimState, X, Y, Alpha, Mirror, False);
 384   end;
 385
 386 // Маска модели:
 387   e_Colors := pm.Color;
 388
 389   if (pm.Direction = TDirection.D_LEFT) and (Models[pm.id].Frames[TDirection.D_LEFT, pm.CurrentAnimation].mask <> 0) then
 390   begin
 391     FramesID := Models[pm.id].Frames[TDirection.D_LEFT, pm.CurrentAnimation].mask;
 392     r_AnimationState_Draw(FramesID, pm.AnimState, X, Y, Alpha, TMirrorType.None, False);
 393   end
 394   else
 395   begin
 396     FramesID := Models[pm.id].Frames[TDirection.D_RIGHT, pm.CurrentAnimation].mask;
 397     r_AnimationState_Draw(FramesID, pm.AnimState, X, Y, Alpha, Mirror, False);
 398   end;
 399
 400   e_Colors.R := 255;
 401   e_Colors.G := 255;
 402   e_Colors.B := 255;
 403 end;
 404
 405 {$IFDEF ENABLE_GIBS}
 406   procedure r_PlayerModel_DrawGibs;
 407     var i, fX, fY, m, id: Integer; a: TDFPoint; pobj: ^TObj;
 408   begin
 409     if gGibs <> nil then
 410     begin
 411       for i := 0 to High(gGibs) do
 412       begin
 413         if gGibs[i].alive then
 414         begin
 415           pobj := @gGibs[i].Obj;
 416           if not g_Obj_Collide(sX, sY, sWidth, sHeight, pobj) then
 417             Continue;
 418           pobj.lerp(gLerpFactor, fX, fY);
 419           a.X := pobj.Rect.X + (pobj.Rect.Width div 2);
 420           a.y := pobj.Rect.Y + (pobj.Rect.Height div 2);
 421           m := gGibs[i].ModelID;
 422           id := gGibs[i].GibID;
 423           e_DrawAdv(Models[m].Gibs[id].base, fX, fY, 0, True, False, gGibs[i].RAngle, @a, TMirrorType.None);
 424           e_Colors := gGibs[i].Color;
 425           e_DrawAdv(Models[m].Gibs[id].mask, fX, fY, 0, True, False, gGibs[i].RAngle, @a, TMirrorType.None);
 426           e_Colors.R := 255;
 427           e_Colors.G := 255;
 428           e_Colors.B := 255;
 429         end
 430       end
 431     end
 432   end;
 433 {$ENDIF}
 434
 435 end.