1 (* Copyright (C) Doom 2D: Forever Developers
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.
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.
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/>.
15 {$INCLUDE ../shared/a_modes.inc}
20 uses Classes
, g_phys
, g_player
, g_playermodel
, g_base
;
23 CORPSE_STATE_REMOVEME
= 0;
24 CORPSE_STATE_NORMAL
= 1;
25 CORPSE_STATE_MESS
= 2;
27 PLAYER_CORPSERECT
: TRectWH
= (X
:15; Y
:48; Width
:34; Height
:16);
29 DefaultCorpsesMax
= 20;
32 TCorpse
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
42 constructor Create(X
, Y
: Integer; ModelName
: String; aMess
: Boolean);
43 destructor Destroy(); override;
44 procedure Damage(Value
: Word; SpawnerUID
: Word; vx
, vy
: Integer);
46 procedure SaveState (st
: TStream
);
47 procedure LoadState (st
: TStream
);
49 procedure getMapBox (out x
, y
, w
, h
: Integer); inline;
50 procedure moveBy (dx
, dy
: Integer); inline;
52 procedure positionChanged (); inline; //WARNING! call this after entity position was changed, or coldet will not work right!
54 function ObjPtr (): PObj
; inline;
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
;
64 gCorpses
: Array of TCorpse
;
66 procedure g_Corpses_SetMax (Count
: Word);
67 function g_Corpses_GetMax (): Word;
69 function g_Corpses_Create (Player
: TPlayer
): Integer;
70 procedure g_Corpses_RemoveAll
;
71 procedure g_Corpses_Update
;
73 {$IFDEF ENABLE_RENDER}
74 function g_Corpses_GetCameraObj (Player
: TPlayer
): TObj
;
87 utils
, g_saveload
, xstreams
,
88 g_game
, g_textures
, g_map
92 MaxCorpses
: Word = DefaultCorpsesMax
;
94 constructor TCorpse
.Create (X
, Y
: Integer; ModelName
: String; aMess
: Boolean);
99 FObj
.Rect
:= PLAYER_CORPSERECT
;
101 FModel
:= g_PlayerModel_Get(ModelName
);
104 FState
:= CORPSE_STATE_MESS
;
105 FModel
.ChangeAnimation(A_DIE2
);
109 FState
:= CORPSE_STATE_NORMAL
;
110 FModel
.ChangeAnimation(A_DIE1
);
114 destructor TCorpse
.Destroy
;
120 function TCorpse
.ObjPtr (): PObj
; inline;
125 procedure TCorpse
.positionChanged
; inline;
129 procedure TCorpse
.moveBy (dx
, dy
: Integer); inline;
131 if (dx
<> 0) or (dy
<> 0) then
139 procedure TCorpse
.getMapBox (out x
, y
, w
, h
: Integer); inline;
141 x
:= FObj
.X
+PLAYER_CORPSERECT
.X
;
142 y
:= FObj
.Y
+PLAYER_CORPSERECT
.Y
;
143 w
:= PLAYER_CORPSERECT
.Width
;
144 h
:= PLAYER_CORPSERECT
.Height
;
147 procedure TCorpse
.Damage (Value
: Word; SpawnerUID
: Word; vx
, vy
: Integer);
149 var Blood
: TModelBlood
;
152 if FState
= CORPSE_STATE_REMOVEME
then
154 FDamage
:= FDamage
+ Value
;
157 if FDamage
> 150 then
159 if FModel
<> nil then
161 FState
:= CORPSE_STATE_REMOVEME
;
163 FObj
.X
+ FObj
.Rect
.X
+ (FObj
.Rect
.Width
div 2),
164 FObj
.Y
+ FObj
.Rect
.Y
+ (FObj
.Rect
.Height
div 2),
168 // Звук мяса от трупа:
169 FModel
.PlaySound(MODELSOUND_DIE
, 5, FObj
.X
, FObj
.Y
);
171 if (gBodyKillEvent
<> -1) and gDelayedEvents
[gBodyKillEvent
].Pending
then
172 gDelayedEvents
[gBodyKillEvent
].Pending
:= False;
173 gBodyKillEvent
:= g_Game_DelayEvent(DE_BODYKILL
, 1050, SpawnerUID
);
181 FObj
.Vel
.X
:= FObj
.Vel
.X
+ vx
;
182 FObj
.Vel
.Y
:= FObj
.Vel
.Y
+ vy
;
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
);
193 procedure TCorpse
.Update
;
196 if FState
= CORPSE_STATE_REMOVEME
then
201 if gTime
mod (GAME_TICK
*2) <> 0 then
203 g_Obj_Move(@FObj
, True, True, True);
204 positionChanged(); // this updates spatial accelerators
208 // Сопротивление воздуха для трупа:
209 FObj
.Vel
.X
:= z_dec(FObj
.Vel
.X
, 1);
211 st
:= g_Obj_Move(@FObj
, True, True, True);
212 positionChanged
; // this updates spatial accelerators
214 if WordBool(st
and MOVE_FALLOUT
) then
215 FState
:= CORPSE_STATE_REMOVEME
216 else if FModel
<> nil then
220 procedure TCorpse
.SaveState (st
: TStream
);
226 utils
.writeSign(st
, 'CORP');
227 utils
.writeInt(st
, Byte(0));
229 utils
.writeInt(st
, Byte(FState
));
231 utils
.writeInt(st
, Byte(FDamage
));
233 utils
.writeInt(st
, Byte(FModel
.Color
.R
));
234 utils
.writeInt(st
, Byte(FModel
.Color
.G
));
235 utils
.writeInt(st
, Byte(FModel
.Color
.B
));
237 Obj_SaveState(st
, @FObj
);
238 utils
.writeInt(st
, Word(FPlayerUID
));
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);
249 procedure TCorpse
.LoadState (st
: TStream
);
250 var anim
, blending
: Boolean; r
, g
, b
, alpha
: Byte; stub
: TAnimState
;
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');
258 FState
:= utils
.readByte(st
);
260 FDamage
:= utils
.readByte(st
);
262 r
:= utils
.readByte(st
);
263 g
:= utils
.readByte(st
);
264 b
:= utils
.readByte(st
);
265 FModel
.SetColor(r
, g
, b
);
267 Obj_LoadState(@FObj
, st
);
268 FPlayerUID
:= utils
.readWord(st
);
270 stub
:= TAnimState
.Create(False, 0, 0);
271 anim
:= utils
.readBool(st
);
274 stub
.LoadState(st
, alpha
, blending
);
275 FModel
.AnimState
.CurrentFrame
:= Min(stub
.CurrentFrame
, FModel
.AnimState
.Length
);
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
);
287 procedure g_Corpses_SetMax (Count
: Word);
290 SetLength(gCorpses
, Count
);
293 function g_Corpses_GetMax (): Word;
295 Result
:= MaxCorpses
;
298 function g_Corpses_Create (Player
: TPlayer
): Integer;
299 var i
: Integer; find_id
: DWORD
; ok
: Boolean;
304 // Разрываем связь с прежним трупом:
306 if (i
>= 0) and (i
< Length(gCorpses
)) then
308 if (gCorpses
[i
] <> nil) and (gCorpses
[i
].FPlayerUID
= Player
.UID
) then
309 gCorpses
[i
].FPlayerUID
:= 0;
312 if Player
.Obj
.Y
>= gMapInfo
.Height
+128 then
316 if (Player
.Health
< -50) and (gGibsCount
> 0) then
318 g_Gibs_Create(Player
.Obj
.X
+ PLAYER_RECT_CX
, Player
.Obj
.Y
+ PLAYER_RECT_CY
, Player
.Model
.id
, Player
.Model
.Color
);
323 if (gCorpses
= nil) or (Length(gCorpses
) = 0) then
326 for find_id
:= 0 to High(gCorpses
) do
327 if gCorpses
[find_id
] = nil then
333 find_id
:= Random(Length(gCorpses
));
334 gCorpses
[find_id
] := TCorpse
.Create(Player
.Obj
.X
, Player
.Obj
.Y
, Player
.Model
.GetName(), Player
.Health
< -20);
335 gCorpses
[find_id
].FModel
.Color
:= Player
.Model
.Color
;
336 gCorpses
[find_id
].FObj
.Vel
:= Player
.Obj
.Vel
;
337 gCorpses
[find_id
].FObj
.Accel
:= Player
.Obj
.Accel
;
338 gCorpses
[find_id
].FPlayerUID
:= Player
.UID
;
343 procedure g_Corpses_Update
;
346 if gCorpses
<> nil then
348 for i
:= 0 to High(gCorpses
) do
350 if gCorpses
[i
] <> nil then
352 if gCorpses
[i
].State
= CORPSE_STATE_REMOVEME
then
358 gCorpses
[i
].Update();
364 procedure g_Corpses_RemoveAll
;
367 if gCorpses
<> nil then
368 for i
:= 0 to High(gCorpses
) do
371 SetLength(gCorpses
, MaxCorpses
);
374 {$IFDEF ENABLE_RENDER}
375 function g_Corpses_GetCameraObj (Player
: TPlayer
): TObj
;
377 {$IFDEF ENABLE_CORPSES}
378 if (not Player
.Alive
) and (not Player
.Spectator
) and
379 (Player
.Corpse
>= 0) and (Player
.Corpse
< Length(gCorpses
)) and
380 (gCorpses
[Player
.Corpse
] <> nil) and (gCorpses
[Player
.Corpse
].PlayerUID
= Player
.UID
) then
382 gCorpses
[Player
.Corpse
].FObj
.slopeUpLeft
:= Player
.Obj
.slopeUpLeft
;
383 Result
:= gCorpses
[Player
.Corpse
].Obj
;
387 Result
:= Player
.Obj
;
390 Result
:= Player
.Obj
;