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 g_playermodel
, g_base
; // TPlayerModel, TRectWH
22 procedure r_PlayerModel_Initialize
;
23 procedure r_PlayerModel_Finalize
;
24 procedure r_PlayerModel_Load
;
25 procedure r_PlayerModel_Free
;
26 procedure r_PlayerModel_Update
;
27 procedure r_PlayerModel_Draw (pm
: TPlayerModel
; X
, Y
: Integer; Alpha
: Byte = 0);
28 procedure r_PlayerModel_DrawGibs
;
30 function r_PlayerModel_GetGibRect (m
, id
: Integer): TRectWH
;
35 SysUtils
, Classes
, Math
,
36 MAPDEF
, utils
, e_log
, wadreader
,
37 ImagingTypes
, Imaging
, ImagingUtility
,
38 r_graphics
, g_options
, r_animations
, r_textures
,
39 g_basic
, g_map
, g_weapons
, g_textures
, g_player
, g_phys
, g_game
43 WeapNames
: Array [WP_FIRST
+ 1..WP_LAST
] of String = ('csaw', 'hgun', 'sg', 'ssg', 'mgun', 'rkt', 'plz', 'bfg', 'spl', 'flm');
46 TDirIdx
= TDirection
.D_LEFT
..TDirection
.D_RIGHT
;
47 TAnimIdx
= A_STAND
..A_LAST
;
50 WeaponID
: Array [WP_FIRST
+ 1..WP_LAST
, W_POS_NORMAL
..W_POS_DOWN
, W_ACT_NORMAL
..W_ACT_FIRE
] of DWORD
;
51 Models
: Array of record
52 Frames
: Array [TDirIdx
, TAnimIdx
] of record
63 BlueFlagFrames
: DWORD
;
64 FlagAnimState
: TAnimationState
;
66 function r_PlayerModel_GetGibRect (m
, id
: Integer): TRectWH
;
68 Result
:= Models
[m
].Gibs
[id
].rect
71 procedure r_PlayerModel_Initialize
;
73 FlagAnimState
:= TAnimationState
.Create(True, 8, 5);
76 procedure r_PlayerModel_Finalize
;
82 procedure ExtAnimFromBaseAnim(MName
: String; AIdx
: Integer);
84 CopyAnim
: array [A_LASTBASE
+1..A_LASTEXT
] of Integer = (
85 A_WALK
, A_WALK
, A_WALK
, A_WALK
, A_WALK
,
86 A_STAND
, A_WALK
, A_ATTACK
, A_WALK
, A_SEEUP
, A_SEEDOWN
,
87 A_ATTACKUP
, A_ATTACKDOWN
93 // HACK: shitty workaround to duplicate base animations
94 // in place of extended, replace with something better later
96 Assert((AIdx
> A_LASTBASE
) and (AIdx
<= A_LASTEXT
));
97 OIdx
:= CopyAnim
[AIdx
];
99 AName
:= MName
+ '_RIGHTANIM' + IntToStr(AIdx
);
100 OName
:= MName
+ '_RIGHTANIM' + IntToStr(OIdx
);
101 Assert(g_Frames_Dup(AName
, OName
));
102 Assert(g_Frames_Dup(AName
+ '_MASK', OName
+ '_MASK'));
103 AName
:= MName
+ '_LEFTANIM' + IntToStr(AIdx
);
104 OName
:= MName
+ '_LEFTANIM' + IntToStr(OIdx
);
105 if g_Frames_Exists(AName
) then
107 g_Frames_Dup(AName
, OName
);
108 g_Frames_Dup(AName
+ '_MASK', OName
+ '_MASK');
112 procedure r_PlayerModel_LoadResource (resource
: AnsiString; var pData
: Pointer; var len
: Integer);
117 WAD
:= TWADFile
.Create
;
118 WAD
.ReadFile(g_ExtractWadName(resource
));
119 WAD
.GetResource(g_ExtractFilePathName(resource
), pData
, len
);
123 function g_PlayerModel_CalcGibSize (pData
: Pointer; dataSize
, x
, y
, w
, h
: Integer): TRectWH
;
124 var i
, j
: Integer; done
: Boolean; img
: TImageData
;
126 function IsVoid (i
, j
: Integer): Boolean;
128 result
:= Byte((PByte(img
.bits
) + (y
+j
)*img
.width
*4 + (x
+i
)*4 + 3)^) = 0
133 assert(LoadImageFromMemory(pData
, dataSize
, img
));
135 (* trace x from right to left *)
136 done
:= false; i
:= 0;
137 while not done
and (i
< w
) do
140 while (j
< h
) and IsVoid(i
, j
) do inc(j
);
141 done
:= (j
< h
) and (IsVoid(i
, j
) = false);
146 (* trace y from up to down *)
147 done
:= false; j
:= 0;
148 while not done
and (j
< h
) do
151 while (i
< w
) and IsVoid(i
, j
) do inc(i
);
152 done
:= (i
< w
) and (IsVoid(i
, j
) = false);
157 (* trace x from right to left *)
158 done
:= false; i
:= w
- 1;
159 while not done
and (i
>= 0) do
162 while (j
< h
) and IsVoid(i
, j
) do inc(j
);
163 done
:= (j
< h
) and (IsVoid(i
, j
) = false);
164 result
.width
:= i
- result
.x
+ 1;
168 (* trace y from down to up *)
169 done
:= false; j
:= h
- 1;
170 while not done
and (j
>= 0) do
173 while (i
< w
) and IsVoid(i
, j
) do inc(i
);
174 done
:= (i
< w
) and (IsVoid(i
, j
) = false);
175 result
.height
:= j
- result
.y
+ 1;
182 procedure r_PlayerModel_Load
;
186 prefix
, aname
: String;
188 baseLen
, maskLen
: Integer;
190 g_Frames_CreateWAD(@RedFlagFrames
, 'FRAMES_FLAG_RED', GameWAD
+ ':TEXTURES\FLAGRED', 64, 64, 5, False);
191 g_Frames_CreateWAD(@BlueFlagFrames
, 'FRAMES_FLAG_BLUE', GameWAD
+ ':TEXTURES\FLAGBLUE', 64, 64, 5, False);
192 for a
:= WP_FIRST
+ 1 to WP_LAST
do
194 g_Texture_CreateWAD(WeaponID
[a
][W_POS_NORMAL
][W_ACT_NORMAL
], GameWAD
+':WEAPONS\'+UpperCase(WeapNames
[a
]));
195 g_Texture_CreateWAD(WeaponID
[a
][W_POS_NORMAL
][W_ACT_FIRE
], GameWAD
+':WEAPONS\'+UpperCase(WeapNames
[a
])+'_FIRE');
196 g_Texture_CreateWAD(WeaponID
[a
][W_POS_UP
][W_ACT_NORMAL
], GameWAD
+':WEAPONS\'+UpperCase(WeapNames
[a
])+'_UP');
197 g_Texture_CreateWAD(WeaponID
[a
][W_POS_UP
][W_ACT_FIRE
], GameWAD
+':WEAPONS\'+UpperCase(WeapNames
[a
])+'_UP_FIRE');
198 g_Texture_CreateWAD(WeaponID
[a
][W_POS_DOWN
][W_ACT_NORMAL
], GameWAD
+':WEAPONS\'+UpperCase(WeapNames
[a
])+'_DN');
199 g_Texture_CreateWAD(WeaponID
[a
][W_POS_DOWN
][W_ACT_FIRE
], GameWAD
+':WEAPONS\'+UpperCase(WeapNames
[a
])+'_DN_FIRE');
202 if PlayerModelsArray
<> nil then
204 SetLength(Models
, Length(PlayerModelsArray
));
205 for i
:= 0 to High(PlayerModelsArray
) do
207 prefix
:= PlayerModelsArray
[i
].FileName
+ ':TEXTURES\';
208 for b
:= A_STAND
to A_LAST
do
210 aname
:= PlayerModelsArray
[i
].Name
+ '_RIGHTANIM' + IntToStr(b
);
211 with PlayerModelsArray
[i
].Anim
[TDirection
.D_RIGHT
, b
] do
213 if not (g_Frames_CreateWAD(@ID1
, aname
, prefix
+ Resource
, 64, 64, Frames
, Back
) and
214 g_Frames_CreateWAD(@ID2
, aname
+ '_MASK', prefix
+ Mask
, 64, 64, Frames
, Back
)) then
216 if b
> A_LASTBASE
then
218 ExtAnimFromBaseAnim(PlayerModelsArray
[i
].Name
, b
);
222 Models
[i
].Frames
[TDirection
.D_RIGHT
, b
].base
:= ID1
;
223 Models
[i
].Frames
[TDirection
.D_RIGHT
, b
].mask
:= ID2
;
225 with PlayerModelsArray
[i
].Anim
[TDirection
.D_LEFT
, b
] do
227 if (Resource
<> '') and (Mask
<> '') then
229 aname
:= PlayerModelsArray
[i
].Name
+ '_LEFTANIM' + IntToStr(b
);
230 g_Frames_CreateWAD(@ID1
, aname
, prefix
+ Resource
, 64, 64, Frames
, Back
);
231 g_Frames_CreateWAD(@ID2
, aname
+ '_MASK', prefix
+ Mask
, 64, 64, Frames
, Back
);
232 Models
[i
].Frames
[TDirection
.D_LEFT
, b
].base
:= ID1
;
233 Models
[i
].Frames
[TDirection
.D_LEFT
, b
].mask
:= ID2
;
237 SetLength(Models
[i
].Gibs
, PlayerModelsArray
[i
].GibsCount
);
238 if PlayerModelsArray
[i
].GibsCount
> 0 then
240 r_PlayerModel_LoadResource(prefix
+ PlayerModelsArray
[i
].GibsResource
, base
, baseLen
);
241 r_PlayerModel_LoadResource(prefix
+ PlayerModelsArray
[i
].GibsMask
, mask
, maskLen
);
242 if (base
<> nil) and (mask
<> nil) then
244 for a
:= 0 to PlayerModelsArray
[i
].GibsCount
- 1 do
246 if e_CreateTextureMemEx(base
, baseLen
, Models
[i
].Gibs
[a
].base
, a
* 32, 0, 32, 32) and
247 e_CreateTextureMemEx(mask
, maskLen
, Models
[i
].Gibs
[a
].mask
, a
* 32, 0, 32, 32) then
249 Models
[i
].Gibs
[a
].rect
:= g_PlayerModel_CalcGibSize(base
, baseLen
, a
* 32, 0, 32, 32);
250 with Models
[i
].Gibs
[a
].Rect
do
252 Height
:= Height
- 1 - Random(2); // ???
263 procedure r_PlayerModel_Free
;
264 var i
, a
, b
, c
: Integer;
266 e_DeleteTexture(RedFlagFrames
);
267 e_DeleteTexture(BlueFlagFrames
);
268 if PlayerModelsArray
= nil then Exit
;
269 for i
:= 0 to High(PlayerModelsArray
) do
271 with PlayerModelsArray
[i
] do
273 for a
:= A_STAND
to A_LAST
do
275 g_Frames_DeleteByName(Name
+ '_LEFTANIM' + IntToStr(a
));
276 g_Frames_DeleteByName(Name
+ '_LEFTANIM' + IntToStr(a
) + '_MASK');
277 g_Frames_DeleteByName(Name
+ '_RIGHTANIM' + IntToStr(a
));
278 g_Frames_DeleteByName(Name
+ '_RIGHTANIM' + IntToStr(a
) + '_MASK');
281 // !!! delete gibs textures here
283 for a
:= WP_FIRST
+ 1 to WP_LAST
do
284 for b
:= W_POS_NORMAL
to W_POS_DOWN
do
285 for c
:= W_ACT_NORMAL
to W_ACT_FIRE
do
286 e_DeleteTexture(WeaponID
[a
][b
][c
])
289 procedure r_PlayerModel_Update
;
294 procedure r_PlayerModel_Draw (pm
: TPlayerModel
; X
, Y
: Integer; Alpha
: Byte = 0);
303 if pm
.Direction
= TDirection
.D_LEFT
then
304 Mirror
:= TMirrorType
.None
306 Mirror
:= TMirrorType
.Horizontal
;
310 FLAG_RED
: FramesID
:= RedFlagFrames
;
311 FLAG_BLUE
: FramesID
:= BlueFlagFrames
;
313 if (FramesID
<> 0) and (not (pm
.CurrentAnimation
in [A_DIE1
, A_DIE2
])) then
315 fp
:= PlayerModelsArray
[pm
.id
].FlagPoint
;
316 fa
:= PlayerModelsArray
[pm
.id
].FlagAngle
;
317 p
.X
:= IfThen(pm
.Direction
= TDirection
.D_LEFT
, FLAG_BASEPOINT
.X
, 64 - FLAG_BASEPOINT
.X
);
318 p
.Y
:= FLAG_BASEPOINT
.Y
;
319 r_AnimationState_DrawEx(
322 X
+ IfThen(pm
.Direction
= TDirection
.D_LEFT
, fp
.X
- 1, 2 * FLAG_BASEPOINT
.X
- fp
.X
+ 1) - FLAG_BASEPOINT
.X
,
323 Y
+ fp
.Y
- FLAG_BASEPOINT
.Y
+ 1,
328 IfThen(pm
.Direction
= TDirection
.D_RIGHT
, fa
, -fa
)
333 if pm
.Direction
= TDirection
.D_RIGHT
then
334 Mirror
:= TMirrorType
.None
336 Mirror
:= TMirrorType
.Horizontal
;
338 if PlayerModelsArray
[pm
.id
].HaveWeapon
and (not (pm
.CurrentAnimation
in [A_DIE1
, A_DIE2
, A_PAIN
])) and (pm
.CurrentWeapon
in [WP_FIRST
+ 1..WP_LAST
]) then
340 if pm
.CurrentAnimation
in [A_SEEUP
, A_ATTACKUP
] then
343 if pm
.CurrentAnimation
in [A_SEEDOWN
, A_ATTACKDOWN
] then
348 if (pm
.CurrentAnimation
in [A_ATTACK
, A_ATTACKUP
, A_ATTACKDOWN
]) or pm
.GetFire() then
355 WeaponID
[pm
.CurrentWeapon
][pos
][act
],
356 X
+ PlayerModelsArray
[pm
.id
].WeaponPoints
[pm
.CurrentWeapon
, pm
.CurrentAnimation
, pm
.Direction
, pm
.AnimState
.CurrentFrame
].X
,
357 Y
+ PlayerModelsArray
[pm
.id
].WeaponPoints
[pm
.CurrentWeapon
, pm
.CurrentAnimation
, pm
.Direction
, pm
.AnimState
.CurrentFrame
].Y
,
366 if (pm
.Direction
= TDirection
.D_LEFT
) and (Models
[pm
.id
].Frames
[TDirection
.D_LEFT
, pm
.CurrentAnimation
].base
<> 0) then
368 FramesID
:= Models
[pm
.id
].Frames
[TDirection
.D_LEFT
, pm
.CurrentAnimation
].base
;
369 r_AnimationState_Draw(FramesID
, pm
.AnimState
, X
, Y
, Alpha
, TMirrorType
.None
, False);
373 FramesID
:= Models
[pm
.id
].Frames
[TDirection
.D_RIGHT
, pm
.CurrentAnimation
].base
;
374 r_AnimationState_Draw(FramesID
, pm
.AnimState
, X
, Y
, Alpha
, Mirror
, False);
378 e_Colors
:= pm
.Color
;
380 if (pm
.Direction
= TDirection
.D_LEFT
) and (Models
[pm
.id
].Frames
[TDirection
.D_LEFT
, pm
.CurrentAnimation
].mask
<> 0) then
382 FramesID
:= Models
[pm
.id
].Frames
[TDirection
.D_LEFT
, pm
.CurrentAnimation
].mask
;
383 r_AnimationState_Draw(FramesID
, pm
.AnimState
, X
, Y
, Alpha
, TMirrorType
.None
, False);
387 FramesID
:= Models
[pm
.id
].Frames
[TDirection
.D_RIGHT
, pm
.CurrentAnimation
].mask
;
388 r_AnimationState_Draw(FramesID
, pm
.AnimState
, X
, Y
, Alpha
, Mirror
, False);
396 procedure r_PlayerModel_DrawGibs
;
397 var i
, fX
, fY
, m
, id
: Integer; a
: TDFPoint
; pobj
: ^TObj
;
401 for i
:= 0 to High(gGibs
) do
403 if gGibs
[i
].alive
then
405 pobj
:= @gGibs
[i
].Obj
;
406 if not g_Obj_Collide(sX
, sY
, sWidth
, sHeight
, pobj
) then
408 pobj
.lerp(gLerpFactor
, fX
, fY
);
409 a
.X
:= pobj
.Rect
.X
+ (pobj
.Rect
.Width
div 2);
410 a
.y
:= pobj
.Rect
.Y
+ (pobj
.Rect
.Height
div 2);
411 m
:= gGibs
[i
].ModelID
;
412 id
:= gGibs
[i
].GibID
;
413 e_DrawAdv(Models
[m
].Gibs
[id
].base
, fX
, fY
, 0, True, False, gGibs
[i
].RAngle
, @a
, TMirrorType
.None
);
414 e_Colors
:= gGibs
[i
].Color
;
415 e_DrawAdv(Models
[m
].Gibs
[id
].mask
, fX
, fY
, 0, True, False, gGibs
[i
].RAngle
, @a
, TMirrorType
.None
);