src/game/g_gibs.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 g_gibs;
  17
  18 interface
  19
  20   uses g_phys, g_base;
  21
  22   const
  23     DefaultGibsCount = 32;
  24     DefaultGibsMax = 150;
  25
  26   type
  27     PGib = ^TGib;
  28     TGib = record
  29       alive:    Boolean;
  30       RAngle:   Integer;
  31       Color:    TRGB;
  32       Obj:      TObj;
  33       ModelID: Integer;
  34       GibID: Integer;
  35
  36       procedure getMapBox (out x, y, w, h: Integer); inline;
  37       procedure moveBy (dx, dy: Integer); inline;
  38       procedure positionChanged; inline; //WARNING! call this after entity position was changed, or coldet will not w>
  39     end;
  40
  41   var
  42     gGibsCount: Integer = DefaultGibsCount; // !!! make it private
  43     gGibs: Array of TGib;
  44
  45   procedure g_Gibs_SetMax (Count: Word);
  46   function g_Gibs_GetMax (): Word;
  47
  48   procedure g_Gibs_Create (fX, fY, mid: Integer; fColor: TRGB);
  49   procedure g_Gibs_RemoveAll;
  50   procedure g_Gibs_Update;
  51
  52 implementation
  53
  54   uses
  55     {$IFDEF ENABLE_GFX}
  56       g_gfx,
  57     {$ENDIF}
  58     {$IFDEF ENABLE_RENDER}
  59       r_render,
  60     {$ENDIF}
  61     g_playermodel, g_options, g_game
  62   ;
  63
  64   type
  65     TGibsArray = Array of Integer;
  66
  67   var
  68     CurrentGib: Integer = 0;
  69     MaxGibs: Word = DefaultGibsMax;
  70
  71   procedure TGib.getMapBox (out x, y, w, h: Integer); inline;
  72   begin
  73     x := Obj.X + Obj.Rect.X;
  74     y := Obj.Y + Obj.Rect.Y;
  75     w := Obj.Rect.Width;
  76     h := Obj.Rect.Height;
  77   end;
  78
  79   procedure TGib.moveBy (dx, dy: Integer); inline;
  80   begin
  81     if (dx <> 0) or (dy <> 0) then
  82     begin
  83       Obj.X += dx;
  84       Obj.Y += dy;
  85       positionChanged;
  86     end;
  87   end;
  88
  89   procedure TGib.positionChanged (); inline;
  90   begin
  91   end;
  92
  93   procedure g_Gibs_SetMax (Count: Word);
  94   begin
  95     MaxGibs := Count;
  96     SetLength(gGibs, Count);
  97     if CurrentGib >= Count then
  98       CurrentGib := 0;
  99   end;
 100
 101   function g_Gibs_GetMax (): Word;
 102   begin
 103     Result := MaxGibs;
 104   end;
 105
 106   function g_Gibs_Get (ModelID: Integer; var Gibs: TGibsArray): Boolean;
 107     var i, b: Integer; c: Boolean;
 108   begin
 109     Gibs := nil;
 110     Result := False;
 111     if (PlayerModelsArray = nil) or (gGibsCount = 0) then
 112       Exit;
 113
 114     c := False;
 115     SetLength(Gibs, gGibsCount);
 116     for i := 0 to High(Gibs) do
 117     begin
 118       if c and (PlayerModelsArray[ModelID].GibsCount = 1) then
 119       begin
 120         SetLength(Gibs, i);
 121         Break;
 122       end;
 123
 124       repeat
 125         b := Random(PlayerModelsArray[ModelID].GibsCount);
 126       until not ((PlayerModelsArray[ModelID].GibsOnce = b + 1) and c);
 127
 128       Gibs[i] := b;
 129
 130       c := PlayerModelsArray[ModelID].GibsOnce = b + 1;
 131     end;
 132     Result := True;
 133   end;
 134
 135   procedure g_Gibs_Create (fX, fY, mid: Integer; fColor: TRGB);
 136     var
 137       a: Integer;
 138       GibsArray: TGibsArray;
 139       {$IFDEF ENABLE_GFX}
 140         Blood: TModelBlood;
 141       {$ENDIF}
 142   begin
 143     if mid = -1 then
 144       Exit;
 145     if (gGibs = nil) or (Length(gGibs) = 0) then
 146       Exit;
 147     if not g_Gibs_Get(mid, GibsArray) then
 148       Exit;
 149
 150     {$IFDEF ENABLE_GFX}
 151       Blood := PlayerModelsArray[mid].Blood;
 152     {$ENDIF}
 153
 154     for a := 0 to High(GibsArray) do
 155     begin
 156       with gGibs[CurrentGib] do
 157       begin
 158         ModelID := mid;
 159         GibID := GibsArray[a];
 160         Color := fColor;
 161         alive := True;
 162         g_Obj_Init(@Obj);
 163         {$IFDEF ENABLE_RENDER}
 164           Obj.Rect := r_Render_GetGibRect(ModelID, GibID);
 165         {$ELSE}
 166           Obj.Rect.X := 16;
 167           Obj.Rect.Y := 16;
 168           Obj.Rect.Width := 16;
 169           Obj.Rect.Height := 16;
 170         {$ENDIF}
 171         Obj.X := fX - Obj.Rect.X - (Obj.Rect.Width div 2);
 172         Obj.Y := fY - Obj.Rect.Y - (Obj.Rect.Height div 2);
 173         g_Obj_PushA(@Obj, 25 + Random(10), Random(361));
 174         positionChanged; // this updates spatial accelerators
 175         RAngle := Random(360);
 176         {$IFDEF ENABLE_GFX}
 177           if gBloodCount > 0 then
 178           begin
 179             g_GFX_Blood(
 180               fX,
 181               fY,
 182               16 * gBloodCount + Random(5 * gBloodCount),
 183               -16 + Random(33),
 184               -16 + Random(33),
 185               Random(48),
 186               Random(48),
 187               Blood.R,
 188               Blood.G,
 189               Blood.B,
 190               Blood.Kind
 191            );
 192           end;
 193         {$ENDIF}
 194         if CurrentGib >= High(gGibs) then
 195           CurrentGib := 0
 196         else
 197           Inc(CurrentGib);
 198       end;
 199     end;
 200   end;
 201
 202   procedure g_Gibs_RemoveAll;
 203     var i: Integer;
 204   begin
 205     i := g_Gibs_GetMax();
 206     g_Gibs_SetMax(0);
 207     g_Gibs_SetMax(i);
 208   end;
 209
 210   procedure g_Gibs_Update;
 211     var i: Integer; vel: TPoint2i; mr: Word;
 212   begin
 213     if gGibs = nil then
 214       Exit;
 215     for i := 0 to High(gGibs) do
 216       if gGibs[i].alive then
 217         with gGibs[i] do
 218         begin
 219           Obj.oldX := Obj.X;
 220           Obj.oldY := Obj.Y;
 221
 222           vel := Obj.Vel;
 223           mr := g_Obj_Move(@Obj, True, False, True);
 224           positionChanged(); // this updates spatial accelerators
 225
 226           if WordBool(mr and MOVE_FALLOUT) then
 227           begin
 228             alive := False;
 229             Continue;
 230           end;
 231
 232         // Отлетает от удара о стену/потолок/пол:
 233           if WordBool(mr and MOVE_HITWALL) then
 234             Obj.Vel.X := -(vel.X div 2);
 235           if WordBool(mr and (MOVE_HITCEIL or MOVE_HITLAND)) then
 236             Obj.Vel.Y := -(vel.Y div 2);
 237
 238           if (Obj.Vel.X >= 0) then
 239           begin // Clockwise
 240             RAngle := RAngle + Abs(Obj.Vel.X)*6 + Abs(Obj.Vel.Y);
 241             if RAngle >= 360 then
 242               RAngle := RAngle mod 360;
 243           end else begin // Counter-clockwise
 244             RAngle := RAngle - Abs(Obj.Vel.X)*6 - Abs(Obj.Vel.Y);
 245             if RAngle < 0 then
 246               RAngle := (360 - (Abs(RAngle) mod 360)) mod 360;
 247           end;
 248
 249         // Сопротивление воздуха для куска трупа:
 250           if gTime mod (GAME_TICK*3) = 0 then
 251             Obj.Vel.X := z_dec(Obj.Vel.X, 1);
 252         end;
 253   end;
 254
 255 end.