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