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, either version 3 of the License, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
22 MAPSTRUCT
, BinEditor
, g_textures
;
25 TAddTextureArray
= Array of
31 TPanel
= Class (TObject
)
40 False: (Tex
: Cardinal);
41 True: (AnTex
: TAnimation
);
45 FCurTexture
: Integer; // Íîìåð òåêóùåé òåêñòóðû
51 SaveIt
: Boolean; // Ñîõðàíÿòü ïðè SaveState?
58 constructor Create(PanelRec
: TPanelRec_1
;
59 AddTextures
: TAddTextureArray
;
61 var Textures
: TLevelTextureArray
);
62 destructor Destroy(); override;
66 procedure SetFrame(Frame
: Integer; Count
: Byte);
67 procedure NextTexture(AnimLoop
: Byte = 0);
68 procedure SetTexture(ID
: Integer; AnimLoop
: Byte = 0);
69 function GetTextureID(): Cardinal;
70 function GetTextureCount(): Integer;
72 procedure SaveState(var Mem
: TBinMemoryWriter
);
73 procedure LoadState(var Mem
: TBinMemoryReader
);
76 TPanelArray
= Array of TPanel
;
81 SysUtils
, g_basic
, g_map
, MAPDEF
, g_game
, e_graphics
,
82 g_console
, g_language
, e_log
;
85 PANEL_SIGNATURE
= $4C4E4150; // 'PANL'
89 constructor TPanel
.Create(PanelRec
: TPanelRec_1
;
90 AddTextures
: TAddTextureArray
;
92 var Textures
: TLevelTextureArray
);
98 Width
:= PanelRec
.Width
;
99 Height
:= PanelRec
.Height
;
108 PanelType
:= PanelRec
.PanelType
;
146 if ByteBool(PanelRec
.Flags
and PANEL_FLAG_HIDE
) then
148 SetLength(FTextureIDs
, 0);
152 // Ïàíåëè, íå èñïîëüçóþùèå òåêñòóðû:
153 if ByteBool(PanelType
and
158 PANEL_BLOCKMON
)) then
160 SetLength(FTextureIDs
, 0);
165 // Åñëè ýòî æèäêîñòü áåç òåêñòóðû - ñïåöòåêñòóðó:
166 if WordBool(PanelType
and (PANEL_WATER
or PANEL_ACID1
or PANEL_ACID2
)) and
167 (not ByteBool(PanelRec
.Flags
and PANEL_FLAG_WATERTEXTURES
)) then
169 SetLength(FTextureIDs
, 1);
170 FTextureIDs
[0].Anim
:= False;
172 case PanelRec
.PanelType
of
174 FTextureIDs
[0].Tex
:= TEXTURE_SPECIAL_WATER
;
176 FTextureIDs
[0].Tex
:= TEXTURE_SPECIAL_ACID1
;
178 FTextureIDs
[0].Tex
:= TEXTURE_SPECIAL_ACID2
;
185 SetLength(FTextureIDs
, Length(AddTextures
));
190 if CurTex
>= Length(FTextureIDs
) then
191 FCurTexture
:= Length(FTextureIDs
) - 1
193 FCurTexture
:= CurTex
;
195 for i
:= 0 to Length(FTextureIDs
)-1 do
197 FTextureIDs
[i
].Anim
:= AddTextures
[i
].Anim
;
198 if FTextureIDs
[i
].Anim
then
199 begin // Àíèìèðîâàííàÿ òåêñòóðà
200 FTextureIDs
[i
].AnTex
:=
201 TAnimation
.Create(Textures
[AddTextures
[i
].Texture
].FramesID
,
202 True, Textures
[AddTextures
[i
].Texture
].Speed
);
203 FTextureIDs
[i
].AnTex
.Blending
:= ByteBool(PanelRec
.Flags
and PANEL_FLAG_BLENDING
);
204 FTextureIDs
[i
].AnTex
.Alpha
:= PanelRec
.Alpha
;
208 begin // Îáû÷íàÿ òåêñòóðà
209 FTextureIDs
[i
].Tex
:= Textures
[AddTextures
[i
].Texture
].TextureID
;
213 // Òåêñòóð íåñêîëüêî - íóæíî ñîõðàíÿòü òåêóùóþ:
214 if Length(FTextureIDs
) > 1 then
217 // Åñëè íå ñïåöòåêñòóðà, òî çàäàåì ðàçìåðû:
218 if PanelRec
.TextureNum
> High(Textures
) then
220 e_WriteLog(Format('WTF?! PanelRec.TextureNum is out of limits! (%d : %d)', [PanelRec
.TextureNum
, High(Textures
)]), MSG_FATALERROR
);
224 FBlending
:= ByteBool(0);
226 else if not g_Map_IsSpecialTexture(Textures
[PanelRec
.TextureNum
].TextureName
) then
228 FTextureWidth
:= Textures
[PanelRec
.TextureNum
].Width
;
229 FTextureHeight
:= Textures
[PanelRec
.TextureNum
].Height
;
230 FAlpha
:= PanelRec
.Alpha
;
231 FBlending
:= ByteBool(PanelRec
.Flags
and PANEL_FLAG_BLENDING
);
235 destructor TPanel
.Destroy();
239 for i
:= 0 to High(FTextureIDs
) do
240 if FTextureIDs
[i
].Anim
then
241 FTextureIDs
[i
].AnTex
.Free();
242 SetLength(FTextureIDs
, 0);
247 procedure TPanel
.Draw();
253 if Enabled
and (FCurTexture
>= 0) and
254 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) and
255 g_Collide(X
, Y
, Width
, Height
,
256 sX
, sY
, sWidth
, sHeight
) then
258 if FTextureIDs
[FCurTexture
].Anim
then
259 begin // Àíèìèðîâàííàÿ òåêñòóðà
260 if FTextureIDs
[FCurTexture
].AnTex
= nil then
263 for xx
:= 0 to (Width
div FTextureWidth
)-1 do
264 for yy
:= 0 to (Height
div FTextureHeight
)-1 do
265 FTextureIDs
[FCurTexture
].AnTex
.Draw(
266 X
+ xx
*FTextureWidth
,
267 Y
+ yy
*FTextureHeight
, M_NONE
);
270 begin // Îáû÷íàÿ òåêñòóðà
271 case FTextureIDs
[FCurTexture
].Tex
of
272 TEXTURE_SPECIAL_WATER
:
273 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
274 0, 0, 255, 0, B_FILTER
);
275 TEXTURE_SPECIAL_ACID1
:
276 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
277 0, 128, 0, 0, B_FILTER
);
278 TEXTURE_SPECIAL_ACID2
:
279 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
280 128, 0, 0, 0, B_FILTER
);
282 if g_Texture_Get('NOTEXTURE', NoTextureID
) then
284 e_GetTextureSize(NoTextureID
, @NW
, @NH
);
285 e_DrawFill(NoTextureID
, X
, Y
, Width
div NW
, Height
div NH
,
289 xx
:= X
+ (Width
div 2);
290 yy
:= Y
+ (Height
div 2);
291 e_DrawFillQuad(X
, Y
, xx
, yy
,
293 e_DrawFillQuad(xx
, Y
, X
+Width
-1, yy
,
295 e_DrawFillQuad(X
, yy
, xx
, Y
+Height
-1,
297 e_DrawFillQuad(xx
, yy
, X
+Width
-1, Y
+Height
-1,
302 e_DrawFill(FTextureIDs
[FCurTexture
].Tex
, X
, Y
,
303 Width
div FTextureWidth
,
304 Height
div FTextureHeight
,
305 FAlpha
, True, FBlending
);
311 procedure TPanel
.Update();
313 if Enabled
and (FCurTexture
>= 0) and
314 (FTextureIDs
[FCurTexture
].Anim
) and
315 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
316 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
318 FTextureIDs
[FCurTexture
].AnTex
.Update();
319 FCurFrame
:= FTextureIDs
[FCurTexture
].AnTex
.CurrentFrame
;
320 FCurFrameCount
:= FTextureIDs
[FCurTexture
].AnTex
.CurrentCounter
;
324 procedure TPanel
.SetFrame(Frame
: Integer; Count
: Byte);
326 function ClampInt(X
, A
, B
: Integer): Integer;
329 if X
< A
then Result
:= A
else if X
> B
then Result
:= B
;
333 if Enabled
and (FCurTexture
>= 0) and
334 (FTextureIDs
[FCurTexture
].Anim
) and
335 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
336 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
338 FCurFrame
:= ClampInt(Frame
, 0, FTextureIDs
[FCurTexture
].AnTex
.TotalFrames
);
339 FCurFrameCount
:= Count
;
340 FTextureIDs
[FCurTexture
].AnTex
.CurrentFrame
:= FCurFrame
;
341 FTextureIDs
[FCurTexture
].AnTex
.CurrentCounter
:= FCurFrameCount
;
345 procedure TPanel
.NextTexture(AnimLoop
: Byte = 0);
347 Assert(FCurTexture
>= -1, 'FCurTexture < -1');
350 if Length(FTextureIDs
) = 0 then
353 // Òîëüêî îäíà òåêñòóðà:
354 if Length(FTextureIDs
) = 1 then
356 if FCurTexture
= 0 then
362 // Áîëüøå îäíîé òåêñòóðû:
366 // Ñëåäóþùåé íåò - âîçâðàò ê íà÷àëó:
367 if FCurTexture
>= Length(FTextureIDs
) then
371 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
372 if (FCurTexture
>= 0) and FTextureIDs
[FCurTexture
].Anim
then
374 if (FTextureIDs
[FCurTexture
].AnTex
= nil) then
376 g_FatalError(_lc
[I_GAME_ERROR_SWITCH_TEXTURE
]);
381 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= True
384 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= False;
386 FTextureIDs
[FCurTexture
].AnTex
.Reset();
389 LastAnimLoop
:= AnimLoop
;
392 procedure TPanel
.SetTexture(ID
: Integer; AnimLoop
: Byte = 0);
395 if Length(FTextureIDs
) = 0 then
398 // Òîëüêî îäíà òåêñòóðà:
399 if Length(FTextureIDs
) = 1 then
401 if (ID
= 0) or (ID
= -1) then
405 // Áîëüøå îäíîé òåêñòóðû:
407 if (ID
>= -1) and (ID
<= High(FTextureIDs
)) then
411 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
412 if (FCurTexture
>= 0) and FTextureIDs
[FCurTexture
].Anim
then
414 if (FTextureIDs
[FCurTexture
].AnTex
= nil) then
416 g_FatalError(_lc
[I_GAME_ERROR_SWITCH_TEXTURE
]);
421 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= True
424 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= False;
426 FTextureIDs
[FCurTexture
].AnTex
.Reset();
429 LastAnimLoop
:= AnimLoop
;
432 function TPanel
.GetTextureID(): DWORD
;
434 Result
:= TEXTURE_NONE
;
436 if (FCurTexture
>= 0) then
438 if FTextureIDs
[FCurTexture
].Anim
then
439 Result
:= FTextureIDs
[FCurTexture
].AnTex
.FramesID
441 Result
:= FTextureIDs
[FCurTexture
].Tex
;
445 function TPanel
.GetTextureCount(): Integer;
447 Result
:= Length(FTextureIDs
);
448 if Enabled
and (FCurTexture
>= 0) then
449 if (FTextureIDs
[FCurTexture
].Anim
) and
450 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
451 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
452 Result
:= Result
+ 100;
455 procedure TPanel
.SaveState(Var Mem
: TBinMemoryWriter
);
460 if (not SaveIt
) or (Mem
= nil) then
464 sig
:= PANEL_SIGNATURE
; // 'PANL'
466 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
467 Mem
.WriteBoolean(Enabled
);
468 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
469 Mem
.WriteByte(LiftType
);
470 // Íîìåð òåêóùåé òåêñòóðû:
471 Mem
.WriteInt(FCurTexture
);
475 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
476 if (FCurTexture
>= 0) and (FTextureIDs
[FCurTexture
].Anim
) then
478 Assert(FTextureIDs
[FCurTexture
].AnTex
<> nil,
479 'TPanel.SaveState: No animation object');
484 Mem
.WriteBoolean(anim
);
485 // Åñëè äà - ñîõðàíÿåì àíèìàöèþ:
487 FTextureIDs
[FCurTexture
].AnTex
.SaveState(Mem
);
490 procedure TPanel
.LoadState(var Mem
: TBinMemoryReader
);
495 if (not SaveIt
) or (Mem
= nil) then
500 if sig
<> PANEL_SIGNATURE
then // 'PANL'
502 raise EBinSizeError
.Create('TPanel.LoadState: Wrong Panel Signature');
504 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
505 Mem
.ReadBoolean(Enabled
);
506 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
507 Mem
.ReadByte(LiftType
);
508 // Íîìåð òåêóùåé òåêñòóðû:
509 Mem
.ReadInt(FCurTexture
);
513 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
514 Mem
.ReadBoolean(anim
);
515 // Åñëè äà - çàãðóæàåì àíèìàöèþ:
518 Assert((FCurTexture
>= 0) and
519 (FTextureIDs
[FCurTexture
].Anim
) and
520 (FTextureIDs
[FCurTexture
].AnTex
<> nil),
521 'TPanel.LoadState: No animation object');
522 FTextureIDs
[FCurTexture
].AnTex
.LoadState(Mem
);