src/game/g_corpses.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_corpses;
  17
  18 interface
  19
  20   uses Classes, g_phys, g_player, g_playermodel, g_base;
  21
  22   const
  23     CORPSE_STATE_REMOVEME = 0;
  24     CORPSE_STATE_NORMAL   = 1;
  25     CORPSE_STATE_MESS     = 2;
  26
  27     PLAYER_CORPSERECT: TRectWH = (X:15; Y:48; Width:34; Height:16);
  28
  29     DefaultCorpsesMax = 20;
  30
  31   type
  32     TCorpse = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
  33     private
  34       FMess:          Boolean;
  35       FState:         Byte;
  36       FDamage:        Byte;
  37       FObj:           TObj;
  38       FPlayerUID:     Word;
  39       FModel:   TPlayerModel;
  40
  41     public
  42       constructor Create(X, Y: Integer; ModelName: String; aMess: Boolean);
  43       destructor  Destroy(); override;
  44       procedure   Damage(Value: Word; SpawnerUID: Word; vx, vy: Integer);
  45       procedure   Update();
  46       procedure   SaveState (st: TStream);
  47       procedure   LoadState (st: TStream);
  48
  49       procedure getMapBox (out x, y, w, h: Integer); inline;
  50       procedure moveBy (dx, dy: Integer); inline;
  51
  52       procedure positionChanged ();  inline; //WARNING! call this after entity position was changed, or coldet will not work right!
  53
  54       function ObjPtr (): PObj; inline;
  55
  56       property Obj: TObj read FObj; // copies object
  57       property State: Byte read FState;
  58       property Mess: Boolean read FMess;
  59       property Model: TPlayerModel read FModel;
  60       property PlayerUID: Word read FPlayerUID;
  61     end;
  62
  63   var
  64     gCorpses: Array of TCorpse;
  65
  66   procedure g_Corpses_SetMax (Count: Word);
  67   function g_Corpses_GetMax (): Word;
  68
  69   function g_Corpses_Create (Player: TPlayer): Integer;
  70   procedure g_Corpses_RemoveAll;
  71   procedure g_Corpses_Update;
  72
  73   {$IFNDEF HEADLESS}
  74     function g_Corpses_GetCameraObj (Player: TPlayer): TObj;
  75   {$ENDIF}
  76
  77 implementation
  78
  79   uses
  80     {$IFDEF ENABLE_GFX}
  81       g_gfx,
  82     {$ENDIF}
  83     {$IFDEF ENABLE_GIBS}
  84       g_gibs,
  85     {$ENDIF}
  86     Math,
  87     utils, g_saveload, xstreams,
  88     g_game, g_textures, g_map
  89   ;
  90
  91   var
  92     MaxCorpses: Word = DefaultCorpsesMax;
  93
  94   constructor TCorpse.Create (X, Y: Integer; ModelName: String; aMess: Boolean);
  95   begin
  96     g_Obj_Init(@FObj);
  97     FObj.X := X;
  98     FObj.Y := Y;
  99     FObj.Rect := PLAYER_CORPSERECT;
 100     FMess := aMess;
 101     FModel := g_PlayerModel_Get(ModelName);
 102     if FMess then
 103     begin
 104       FState := CORPSE_STATE_MESS;
 105       FModel.ChangeAnimation(A_DIE2);
 106     end
 107     else
 108     begin
 109       FState := CORPSE_STATE_NORMAL;
 110       FModel.ChangeAnimation(A_DIE1);
 111     end;
 112   end;
 113
 114   destructor TCorpse.Destroy;
 115   begin
 116     FModel.Free;
 117     inherited;
 118   end;
 119
 120   function TCorpse.ObjPtr (): PObj; inline;
 121   begin
 122     Result := @FObj;
 123   end;
 124
 125   procedure TCorpse.positionChanged; inline;
 126   begin
 127   end;
 128
 129   procedure TCorpse.moveBy (dx, dy: Integer); inline;
 130   begin
 131     if (dx <> 0) or (dy <> 0) then
 132     begin
 133       FObj.X += dx;
 134       FObj.Y += dy;
 135       positionChanged;
 136     end;
 137   end;
 138
 139   procedure TCorpse.getMapBox (out x, y, w, h: Integer); inline;
 140   begin
 141     x := FObj.X+PLAYER_CORPSERECT.X;
 142     y := FObj.Y+PLAYER_CORPSERECT.Y;
 143     w := PLAYER_CORPSERECT.Width;
 144     h := PLAYER_CORPSERECT.Height;
 145   end;
 146
 147   procedure TCorpse.Damage (Value: Word; SpawnerUID: Word; vx, vy: Integer);
 148     {$IFDEF ENABLE_GFX}
 149       var Blood: TModelBlood;
 150     {$ENDIF}
 151   begin
 152     if FState = CORPSE_STATE_REMOVEME then
 153       Exit;
 154     FDamage := FDamage + Value;
 155
 156 {$IFDEF ENABLE_GIBS}
 157     if FDamage > 150 then
 158     begin
 159       if FModel <> nil then
 160       begin
 161         FState := CORPSE_STATE_REMOVEME;
 162         g_Gibs_Create(
 163           FObj.X + FObj.Rect.X + (FObj.Rect.Width div 2),
 164           FObj.Y + FObj.Rect.Y + (FObj.Rect.Height div 2),
 165           FModel.id,
 166           FModel.Color
 167         );
 168         // Звук мяса от трупа:
 169         FModel.PlaySound(MODELSOUND_DIE, 5, FObj.X, FObj.Y);
 170         // Зловещий смех:
 171         if (gBodyKillEvent <> -1) and gDelayedEvents[gBodyKillEvent].Pending then
 172           gDelayedEvents[gBodyKillEvent].Pending := False;
 173         gBodyKillEvent := g_Game_DelayEvent(DE_BODYKILL, 1050, SpawnerUID);
 174         FModel.Free;
 175         FModel := nil;
 176       end
 177     end
 178     else
 179 {$ENDIF}
 180     begin
 181       FObj.Vel.X := FObj.Vel.X + vx;
 182       FObj.Vel.Y := FObj.Vel.Y + vy;
 183       {$IFDEF ENABLE_GFX}
 184         Blood := FModel.GetBlood();
 185         g_GFX_Blood(FObj.X+PLAYER_CORPSERECT.X+(PLAYER_CORPSERECT.Width div 2),
 186                     FObj.Y+PLAYER_CORPSERECT.Y+(PLAYER_CORPSERECT.Height div 2),
 187                     Value, vx, vy, 16, (PLAYER_CORPSERECT.Height*2) div 3,
 188                     Blood.R, Blood.G, Blood.B, Blood.Kind);
 189       {$ENDIF}
 190     end;
 191   end;
 192
 193   procedure TCorpse.Update;
 194     var st: Word;
 195   begin
 196     if FState = CORPSE_STATE_REMOVEME then
 197       Exit;
 198
 199     FObj.oldX := FObj.X;
 200     FObj.oldY := FObj.Y;
 201     if gTime mod (GAME_TICK*2) <> 0 then
 202     begin
 203       g_Obj_Move(@FObj, True, True, True);
 204       positionChanged(); // this updates spatial accelerators
 205       Exit;
 206     end;
 207
 208     // Сопротивление воздуха для трупа:
 209     FObj.Vel.X := z_dec(FObj.Vel.X, 1);
 210
 211     st := g_Obj_Move(@FObj, True, True, True);
 212     positionChanged; // this updates spatial accelerators
 213
 214     if WordBool(st and MOVE_FALLOUT) then
 215       FState := CORPSE_STATE_REMOVEME
 216     else if FModel <> nil then
 217       FModel.Update;
 218   end;
 219
 220   procedure TCorpse.SaveState (st: TStream);
 221     var anim: Boolean;
 222   begin
 223     assert(st <> nil);
 224
 225     // Сигнатура трупа
 226     utils.writeSign(st, 'CORP');
 227     utils.writeInt(st, Byte(0));
 228     // Состояние
 229     utils.writeInt(st, Byte(FState));
 230     // Накопленный урон
 231     utils.writeInt(st, Byte(FDamage));
 232     // Цвет
 233     utils.writeInt(st, Byte(FModel.Color.R));
 234     utils.writeInt(st, Byte(FModel.Color.G));
 235     utils.writeInt(st, Byte(FModel.Color.B));
 236     // Объект трупа
 237     Obj_SaveState(st, @FObj);
 238     utils.writeInt(st, Word(FPlayerUID));
 239     // animation
 240     anim := (FModel <> nil);
 241     utils.writeBool(st, anim);
 242     if anim then FModel.AnimState.SaveState(st, 0, False);
 243     // animation for mask (same as animation, compat with older saves)
 244     anim := (FModel <> nil);
 245     utils.writeBool(st, anim);
 246     if anim then FModel.AnimState.SaveState(st, 0, False);
 247   end;
 248
 249   procedure TCorpse.LoadState (st: TStream);
 250     var anim, blending: Boolean; r, g, b, alpha: Byte; stub: TAnimationState;
 251   begin
 252     assert(st <> nil);
 253
 254     // Сигнатура трупа
 255     if not utils.checkSign(st, 'CORP') then raise XStreamError.Create('invalid corpse signature');
 256     if (utils.readByte(st) <> 0) then raise XStreamError.Create('invalid corpse version');
 257     // Состояние
 258     FState := utils.readByte(st);
 259     // Накопленный урон
 260     FDamage := utils.readByte(st);
 261     // Цвет
 262     r := utils.readByte(st);
 263     g := utils.readByte(st);
 264     b := utils.readByte(st);
 265     FModel.SetColor(r, g, b);
 266     // Объект трупа
 267     Obj_LoadState(@FObj, st);
 268     FPlayerUID := utils.readWord(st);
 269     // animation
 270     stub := TAnimationState.Create(False, 0, 0);
 271     anim := utils.readBool(st);
 272     if anim then
 273     begin
 274       stub.LoadState(st, alpha, blending);
 275       FModel.AnimState.CurrentFrame := Min(stub.CurrentFrame, FModel.AnimState.Length);
 276     end
 277     else
 278     begin
 279       FModel.Free;
 280       FModel := nil
 281     end;
 282     // animation for mask (same as animation, compat with older saves)
 283     anim := utils.readBool(st);
 284     if anim then stub.LoadState(st, alpha, blending);
 285     stub.Free;
 286   end;
 287
 288   procedure g_Corpses_SetMax (Count: Word);
 289   begin
 290     MaxCorpses := Count;
 291     SetLength(gCorpses, Count);
 292   end;
 293
 294   function g_Corpses_GetMax (): Word;
 295   begin
 296     Result := MaxCorpses;
 297   end;
 298
 299   function  g_Corpses_Create (Player: TPlayer): Integer;
 300     var i: Integer; find_id: DWORD; ok: Boolean;
 301   begin
 302     Result := -1;
 303     if Player.alive then
 304       Exit;
 305     // Разрываем связь с прежним трупом:
 306     i := Player.FCorpse;
 307     if (i >= 0) and (i < Length(gCorpses)) then
 308     begin
 309       if (gCorpses[i] <> nil) and (gCorpses[i].FPlayerUID = Player.UID) then
 310         gCorpses[i].FPlayerUID := 0;
 311     end;
 312
 313     if Player.Obj.Y >= gMapInfo.Height+128 then
 314       Exit;
 315
 316 {$IFDEF ENABLE_GIBS}
 317     if (Player.Health < -50) and (gGibsCount > 0) then
 318     begin
 319       g_Gibs_Create(Player.Obj.X + PLAYER_RECT_CX, Player.Obj.Y + PLAYER_RECT_CY, Player.Model.id, Player.Model.Color);
 320     end
 321     else
 322 {$ENDIF}
 323     begin
 324       if (gCorpses = nil) or (Length(gCorpses) = 0) then
 325         Exit;
 326       ok := False;
 327       for find_id := 0 to High(gCorpses) do
 328         if gCorpses[find_id] = nil then
 329         begin
 330           ok := True;
 331           Break;
 332         end;
 333       if not ok then
 334         find_id := Random(Length(gCorpses));
 335       gCorpses[find_id] := TCorpse.Create(Player.Obj.X, Player.Obj.Y, Player.Model.GetName(), Player.Health < -20);
 336       gCorpses[find_id].FModel.Color := Player.Model.Color;
 337       gCorpses[find_id].FObj.Vel := Player.Obj.Vel;
 338       gCorpses[find_id].FObj.Accel := Player.Obj.Accel;
 339       gCorpses[find_id].FPlayerUID := Player.UID;
 340       Result := find_id;
 341     end
 342   end;
 343
 344   procedure g_Corpses_Update;
 345     var i: Integer;
 346   begin
 347     if gCorpses <> nil then
 348     begin
 349       for i := 0 to High(gCorpses) do
 350       begin
 351         if gCorpses[i] <> nil then
 352         begin
 353           if gCorpses[i].State = CORPSE_STATE_REMOVEME then
 354           begin
 355             gCorpses[i].Free();
 356             gCorpses[i] := nil;
 357           end
 358           else
 359             gCorpses[i].Update();
 360         end;
 361       end;
 362     end;
 363   end;
 364
 365   procedure g_Corpses_RemoveAll;
 366     var i: Integer;
 367   begin
 368     if gCorpses <> nil then
 369       for i := 0 to High(gCorpses) do
 370         gCorpses[i].Free();
 371     gCorpses := nil;
 372     SetLength(gCorpses, MaxCorpses);
 373   end;
 374
 375 {$IFNDEF HEADLESS}
 376   function g_Corpses_GetCameraObj (Player: TPlayer): TObj;
 377   begin
 378     {$IFDEF ENABLE_CORPSES}
 379       if (not Player.Alive) and (not Player.Spectator) and
 380          (Player.Corpse >= 0) and (Player.Corpse < Length(gCorpses)) and
 381          (gCorpses[Player.Corpse] <> nil) and (gCorpses[Player.Corpse].PlayerUID = Player.UID) then
 382       begin
 383         gCorpses[Player.Corpse].FObj.slopeUpLeft := Player.Obj.slopeUpLeft;
 384         Result := gCorpses[Player.Corpse].Obj;
 385       end
 386       else
 387       begin
 388         Result := Player.Obj;
 389       end;
 390     {$ELSE}
 391       Result := Player.Obj;
 392     {$ENDIF}
 393   end;
 394 {$ENDIF}
 395
 396 end.