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/>.
16 {$INCLUDE ../shared/a_modes.inc}
23 MAPDEF
, BinEditor
, g_textures
, xdynrec
;
26 TAddTextureArray
= Array of
32 TPanel
= Class (TObject
)
41 False: (Tex
: Cardinal);
42 True: (AnTex
: TAnimation
);
46 function getx1 (): Integer; inline;
47 function gety1 (): Integer; inline;
48 function getvisvalid (): Boolean; inline;
51 FCurTexture
: Integer; // Íîìåð òåêóùåé òåêñòóðû
55 FWidth
, FHeight
: Word;
57 FSaveIt
: Boolean; // Ñîõðàíÿòü ïðè SaveState?
63 arrIdx
: Integer; // index in one of internal arrays; sorry
64 tag
: Integer; // used in coldets and such; sorry
65 proxyId
: Integer; // proxy id in map grid (DO NOT USE!)
67 constructor Create(PanelRec
: TDynRecord
;
68 AddTextures
: TAddTextureArray
;
70 var Textures
: TLevelTextureArray
);
71 destructor Destroy(); override;
74 procedure DrawShadowVolume(lightX
: Integer; lightY
: Integer; radius
: Integer);
76 procedure SetFrame(Frame
: Integer; Count
: Byte);
77 procedure NextTexture(AnimLoop
: Byte = 0);
78 procedure SetTexture(ID
: Integer; AnimLoop
: Byte = 0);
79 function GetTextureID(): Cardinal;
80 function GetTextureCount(): Integer;
82 procedure SaveState(var Mem
: TBinMemoryWriter
);
83 procedure LoadState(var Mem
: TBinMemoryReader
);
86 property visvalid
: Boolean read getvisvalid
; // panel is "visvalid" when it's width and height are positive
89 property x0
: Integer read FX
;
90 property y0
: Integer read FY
;
91 property x1
: Integer read getx1
; // inclusive!
92 property y1
: Integer read gety1
; // inclusive!
93 property x
: Integer read FX write FX
;
94 property y
: Integer read FY write FY
;
95 property width
: Word read FWidth write FWidth
;
96 property height
: Word read FHeight write FHeight
;
97 property panelType
: Word read FPanelType write FPanelType
;
98 property saveIt
: Boolean read FSaveIt write FSaveIt
; // Ñîõðàíÿòü ïðè SaveState?
99 property enabled
: Boolean read FEnabled write FEnabled
; // Ñîõðàíÿòü ïðè SaveState?
100 property door
: Boolean read FDoor write FDoor
; // Ñîõðàíÿòü ïðè SaveState?
101 property moved
: Boolean read FMoved write FMoved
; // Ñîõðàíÿòü ïðè SaveState?
102 property liftType
: Byte read FLiftType write FLiftType
; // Ñîõðàíÿòü ïðè SaveState?
103 property lastAnimLoop
: Byte read FLastAnimLoop write FLastAnimLoop
; // Ñîõðàíÿòü ïðè SaveState?
106 TPanelArray
= Array of TPanel
;
111 SysUtils
, g_basic
, g_map
, g_game
, e_graphics
,
112 g_console
, g_language
, e_log
, GL
;
115 PANEL_SIGNATURE
= $4C4E4150; // 'PANL'
119 constructor TPanel
.Create(PanelRec
: TDynRecord
;
120 AddTextures
: TAddTextureArray
;
122 var Textures
: TLevelTextureArray
);
128 Width
:= PanelRec
.Width
;
129 Height
:= PanelRec
.Height
;
138 PanelType
:= PanelRec
.PanelType
;
176 if ByteBool(PanelRec
.Flags
and PANEL_FLAG_HIDE
) then
178 SetLength(FTextureIDs
, 0);
182 // Ïàíåëè, íå èñïîëüçóþùèå òåêñòóðû:
183 if ByteBool(PanelType
and
188 PANEL_BLOCKMON
)) then
190 SetLength(FTextureIDs
, 0);
195 // Åñëè ýòî æèäêîñòü áåç òåêñòóðû - ñïåöòåêñòóðó:
196 if WordBool(PanelType
and (PANEL_WATER
or PANEL_ACID1
or PANEL_ACID2
)) and
197 (not ByteBool(PanelRec
.Flags
and PANEL_FLAG_WATERTEXTURES
)) then
199 SetLength(FTextureIDs
, 1);
200 FTextureIDs
[0].Anim
:= False;
202 case PanelRec
.PanelType
of
204 FTextureIDs
[0].Tex
:= LongWord(TEXTURE_SPECIAL_WATER
);
206 FTextureIDs
[0].Tex
:= LongWord(TEXTURE_SPECIAL_ACID1
);
208 FTextureIDs
[0].Tex
:= LongWord(TEXTURE_SPECIAL_ACID2
);
215 SetLength(FTextureIDs
, Length(AddTextures
));
220 if CurTex
>= Length(FTextureIDs
) then
221 FCurTexture
:= Length(FTextureIDs
) - 1
223 FCurTexture
:= CurTex
;
225 for i
:= 0 to Length(FTextureIDs
)-1 do
227 FTextureIDs
[i
].Anim
:= AddTextures
[i
].Anim
;
228 if FTextureIDs
[i
].Anim
then
229 begin // Àíèìèðîâàííàÿ òåêñòóðà
230 FTextureIDs
[i
].AnTex
:=
231 TAnimation
.Create(Textures
[AddTextures
[i
].Texture
].FramesID
,
232 True, Textures
[AddTextures
[i
].Texture
].Speed
);
233 FTextureIDs
[i
].AnTex
.Blending
:= ByteBool(PanelRec
.Flags
and PANEL_FLAG_BLENDING
);
234 FTextureIDs
[i
].AnTex
.Alpha
:= PanelRec
.Alpha
;
238 begin // Îáû÷íàÿ òåêñòóðà
239 FTextureIDs
[i
].Tex
:= Textures
[AddTextures
[i
].Texture
].TextureID
;
243 // Òåêñòóð íåñêîëüêî - íóæíî ñîõðàíÿòü òåêóùóþ:
244 if Length(FTextureIDs
) > 1 then
247 // Åñëè íå ñïåöòåêñòóðà, òî çàäàåì ðàçìåðû:
248 if PanelRec
.TextureNum
> High(Textures
) then
250 e_WriteLog(Format('WTF?! PanelRec.TextureNum is out of limits! (%d : %d)', [PanelRec
.TextureNum
, High(Textures
)]), MSG_FATALERROR
);
254 FBlending
:= ByteBool(0);
256 else if not g_Map_IsSpecialTexture(Textures
[PanelRec
.TextureNum
].TextureName
) then
258 FTextureWidth
:= Textures
[PanelRec
.TextureNum
].Width
;
259 FTextureHeight
:= Textures
[PanelRec
.TextureNum
].Height
;
260 FAlpha
:= PanelRec
.Alpha
;
261 FBlending
:= ByteBool(PanelRec
.Flags
and PANEL_FLAG_BLENDING
);
265 destructor TPanel
.Destroy();
269 for i
:= 0 to High(FTextureIDs
) do
270 if FTextureIDs
[i
].Anim
then
271 FTextureIDs
[i
].AnTex
.Free();
272 SetLength(FTextureIDs
, 0);
277 function TPanel
.getx1 (): Integer; inline; begin result
:= X
+Width
-1; end;
278 function TPanel
.gety1 (): Integer; inline; begin result
:= Y
+Height
-1; end;
279 function TPanel
.getvisvalid (): Boolean; inline; begin result
:= (Width
> 0) and (Height
> 0); end;
281 procedure TPanel
.Draw();
287 if {Enabled and} (FCurTexture
>= 0) and
288 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) and
289 (g_dbg_scale_05
or g_Collide(X
, Y
, Width
, Height
, sX
, sY
, sWidth
, sHeight
)) then
291 if FTextureIDs
[FCurTexture
].Anim
then
292 begin // Àíèìèðîâàííàÿ òåêñòóðà
293 if FTextureIDs
[FCurTexture
].AnTex
= nil then
296 for xx
:= 0 to (Width
div FTextureWidth
)-1 do
297 for yy
:= 0 to (Height
div FTextureHeight
)-1 do
298 FTextureIDs
[FCurTexture
].AnTex
.Draw(
299 X
+ xx
*FTextureWidth
,
300 Y
+ yy
*FTextureHeight
, M_NONE
);
303 begin // Îáû÷íàÿ òåêñòóðà
304 case FTextureIDs
[FCurTexture
].Tex
of
305 LongWord(TEXTURE_SPECIAL_WATER
):
306 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
307 0, 0, 255, 0, B_FILTER
);
308 LongWord(TEXTURE_SPECIAL_ACID1
):
309 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
310 0, 128, 0, 0, B_FILTER
);
311 LongWord(TEXTURE_SPECIAL_ACID2
):
312 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
313 128, 0, 0, 0, B_FILTER
);
314 LongWord(TEXTURE_NONE
):
315 if g_Texture_Get('NOTEXTURE', NoTextureID
) then
317 e_GetTextureSize(NoTextureID
, @NW
, @NH
);
318 e_DrawFill(NoTextureID
, X
, Y
, Width
div NW
, Height
div NH
,
322 xx
:= X
+ (Width
div 2);
323 yy
:= Y
+ (Height
div 2);
324 e_DrawFillQuad(X
, Y
, xx
, yy
,
326 e_DrawFillQuad(xx
, Y
, X
+Width
-1, yy
,
328 e_DrawFillQuad(X
, yy
, xx
, Y
+Height
-1,
330 e_DrawFillQuad(xx
, yy
, X
+Width
-1, Y
+Height
-1,
335 e_DrawFill(FTextureIDs
[FCurTexture
].Tex
, X
, Y
,
336 Width
div FTextureWidth
,
337 Height
div FTextureHeight
,
338 FAlpha
, True, FBlending
);
344 procedure TPanel
.DrawShadowVolume(lightX
: Integer; lightY
: Integer; radius
: Integer);
345 procedure extrude (x
: Integer; y
: Integer);
347 glVertex2i(x
+(x
-lightX
)*500, y
+(y
-lightY
)*500);
348 //e_WriteLog(Format(' : (%d,%d)', [x+(x-lightX)*300, y+(y-lightY)*300]), MSG_WARNING);
351 procedure drawLine (x0
: Integer; y0
: Integer; x1
: Integer; y1
: Integer);
353 // does this side facing the light?
354 if ((x1
-x0
)*(lightY
-y0
)-(lightX
-x0
)*(y1
-y0
) >= 0) then exit
;
355 //e_WriteLog(Format('lightpan: (%d,%d)-(%d,%d)', [x0, y0, x1, y1]), MSG_WARNING);
356 // this edge is facing the light, extrude and draw it
364 if radius
< 4 then exit
;
365 if Enabled
and (FCurTexture
>= 0) and (Width
> 0) and (Height
> 0) and (FAlpha
< 255) and g_Collide(X
, Y
, Width
, Height
, sX
, sY
, sWidth
, sHeight
) then
367 if not FTextureIDs
[FCurTexture
].Anim
then
369 case FTextureIDs
[FCurTexture
].Tex
of
370 LongWord(TEXTURE_SPECIAL_WATER
): exit
;
371 LongWord(TEXTURE_SPECIAL_ACID1
): exit
;
372 LongWord(TEXTURE_SPECIAL_ACID2
): exit
;
373 LongWord(TEXTURE_NONE
): exit
;
376 if (X
+Width
< lightX
-radius
) then exit
;
377 if (Y
+Height
< lightY
-radius
) then exit
;
378 if (X
> lightX
+radius
) then exit
;
379 if (Y
> lightY
+radius
) then exit
;
380 //e_DrawFill(FTextureIDs[FCurTexture].Tex, X, Y, Width div FTextureWidth, Height div FTextureHeight, FAlpha, True, FBlending);
383 drawLine(x
, y
, x
+width
, y
); // top
384 drawLine(x
+width
, y
, x
+width
, y
+height
); // right
385 drawLine(x
+width
, y
+height
, x
, y
+height
); // bottom
386 drawLine(x
, y
+height
, x
, y
); // left
391 procedure TPanel
.Update();
393 if Enabled
and (FCurTexture
>= 0) and
394 (FTextureIDs
[FCurTexture
].Anim
) and
395 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
396 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
398 FTextureIDs
[FCurTexture
].AnTex
.Update();
399 FCurFrame
:= FTextureIDs
[FCurTexture
].AnTex
.CurrentFrame
;
400 FCurFrameCount
:= FTextureIDs
[FCurTexture
].AnTex
.CurrentCounter
;
404 procedure TPanel
.SetFrame(Frame
: Integer; Count
: Byte);
406 function ClampInt(X
, A
, B
: Integer): Integer;
409 if X
< A
then Result
:= A
else if X
> B
then Result
:= B
;
413 if Enabled
and (FCurTexture
>= 0) and
414 (FTextureIDs
[FCurTexture
].Anim
) and
415 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
416 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
418 FCurFrame
:= ClampInt(Frame
, 0, FTextureIDs
[FCurTexture
].AnTex
.TotalFrames
);
419 FCurFrameCount
:= Count
;
420 FTextureIDs
[FCurTexture
].AnTex
.CurrentFrame
:= FCurFrame
;
421 FTextureIDs
[FCurTexture
].AnTex
.CurrentCounter
:= FCurFrameCount
;
425 procedure TPanel
.NextTexture(AnimLoop
: Byte = 0);
427 Assert(FCurTexture
>= -1, 'FCurTexture < -1');
430 if Length(FTextureIDs
) = 0 then
433 // Òîëüêî îäíà òåêñòóðà:
434 if Length(FTextureIDs
) = 1 then
436 if FCurTexture
= 0 then
442 // Áîëüøå îäíîé òåêñòóðû:
446 // Ñëåäóþùåé íåò - âîçâðàò ê íà÷àëó:
447 if FCurTexture
>= Length(FTextureIDs
) then
451 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
452 if (FCurTexture
>= 0) and FTextureIDs
[FCurTexture
].Anim
then
454 if (FTextureIDs
[FCurTexture
].AnTex
= nil) then
456 g_FatalError(_lc
[I_GAME_ERROR_SWITCH_TEXTURE
]);
461 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= True
464 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= False;
466 FTextureIDs
[FCurTexture
].AnTex
.Reset();
469 LastAnimLoop
:= AnimLoop
;
472 procedure TPanel
.SetTexture(ID
: Integer; AnimLoop
: Byte = 0);
475 if Length(FTextureIDs
) = 0 then
478 // Òîëüêî îäíà òåêñòóðà:
479 if Length(FTextureIDs
) = 1 then
481 if (ID
= 0) or (ID
= -1) then
485 // Áîëüøå îäíîé òåêñòóðû:
487 if (ID
>= -1) and (ID
<= High(FTextureIDs
)) then
491 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
492 if (FCurTexture
>= 0) and FTextureIDs
[FCurTexture
].Anim
then
494 if (FTextureIDs
[FCurTexture
].AnTex
= nil) then
496 g_FatalError(_lc
[I_GAME_ERROR_SWITCH_TEXTURE
]);
501 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= True
504 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= False;
506 FTextureIDs
[FCurTexture
].AnTex
.Reset();
509 LastAnimLoop
:= AnimLoop
;
512 function TPanel
.GetTextureID(): DWORD
;
514 Result
:= LongWord(TEXTURE_NONE
);
516 if (FCurTexture
>= 0) then
518 if FTextureIDs
[FCurTexture
].Anim
then
519 Result
:= FTextureIDs
[FCurTexture
].AnTex
.FramesID
521 Result
:= FTextureIDs
[FCurTexture
].Tex
;
525 function TPanel
.GetTextureCount(): Integer;
527 Result
:= Length(FTextureIDs
);
528 if Enabled
and (FCurTexture
>= 0) then
529 if (FTextureIDs
[FCurTexture
].Anim
) and
530 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
531 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
532 Result
:= Result
+ 100;
535 procedure TPanel
.SaveState(Var Mem
: TBinMemoryWriter
);
540 if (not SaveIt
) or (Mem
= nil) then
544 sig
:= PANEL_SIGNATURE
; // 'PANL'
546 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
547 Mem
.WriteBoolean(FEnabled
);
548 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
549 Mem
.WriteByte(FLiftType
);
550 // Íîìåð òåêóùåé òåêñòóðû:
551 Mem
.WriteInt(FCurTexture
);
555 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
556 if (FCurTexture
>= 0) and (FTextureIDs
[FCurTexture
].Anim
) then
558 Assert(FTextureIDs
[FCurTexture
].AnTex
<> nil,
559 'TPanel.SaveState: No animation object');
564 Mem
.WriteBoolean(anim
);
565 // Åñëè äà - ñîõðàíÿåì àíèìàöèþ:
567 FTextureIDs
[FCurTexture
].AnTex
.SaveState(Mem
);
570 procedure TPanel
.LoadState(var Mem
: TBinMemoryReader
);
575 if (not SaveIt
) or (Mem
= nil) then
580 if sig
<> PANEL_SIGNATURE
then // 'PANL'
582 raise EBinSizeError
.Create('TPanel.LoadState: Wrong Panel Signature');
584 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
585 Mem
.ReadBoolean(FEnabled
);
586 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
587 Mem
.ReadByte(FLiftType
);
588 // Íîìåð òåêóùåé òåêñòóðû:
589 Mem
.ReadInt(FCurTexture
);
593 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
594 Mem
.ReadBoolean(anim
);
595 // Åñëè äà - çàãðóæàåì àíèìàöèþ:
598 Assert((FCurTexture
>= 0) and
599 (FTextureIDs
[FCurTexture
].Anim
) and
600 (FTextureIDs
[FCurTexture
].AnTex
<> nil),
601 'TPanel.LoadState: No animation object');
602 FTextureIDs
[FCurTexture
].AnTex
.LoadState(Mem
);