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