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