ab996040406168f29ced2f9c131f576d080b86fd
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}
22 MAPSTRUCT
, BinEditor
, g_textures
;
25 TAddTextureArray
= Array of
31 TPanel
= Class (TObject
)
40 False: (Tex
: Cardinal);
41 True: (AnTex
: TAnimation
);
45 function getx1 (): Integer; inline;
46 function gety1 (): Integer; inline;
47 function getvisvalid (): Boolean; inline;
50 FCurTexture
: Integer; // Íîìåð òåêóùåé òåêñòóðû
56 SaveIt
: Boolean; // Ñîõðàíÿòü ïðè SaveState?
62 ArrIdx
: Integer; // index in one of internal arrays; sorry
63 tag
: Integer; // used in coldets and such; sorry
65 constructor Create(PanelRec
: TPanelRec_1
;
66 AddTextures
: TAddTextureArray
;
68 var Textures
: TLevelTextureArray
);
69 destructor Destroy(); override;
72 procedure DrawShadowVolume(lightX
: Integer; lightY
: Integer; radius
: Integer);
74 procedure SetFrame(Frame
: Integer; Count
: Byte);
75 procedure NextTexture(AnimLoop
: Byte = 0);
76 procedure SetTexture(ID
: Integer; AnimLoop
: Byte = 0);
77 function GetTextureID(): Cardinal;
78 function GetTextureCount(): Integer;
80 procedure SaveState(var Mem
: TBinMemoryWriter
);
81 procedure LoadState(var Mem
: TBinMemoryReader
);
83 property x0
: Integer read X
;
84 property y0
: Integer read Y
;
85 property x1
: Integer read getx1
; // inclusive!
86 property y1
: Integer read gety1
; // inclusive!
87 property visvalid
: Boolean read getvisvalid
; // panel is "visvalid" when it's width and height are positive
91 TPanelArray
= Array of TPanel
;
96 SysUtils
, g_basic
, g_map
, MAPDEF
, g_game
, e_graphics
,
97 g_console
, g_language
, e_log
, GL
;
100 PANEL_SIGNATURE
= $4C4E4150; // 'PANL'
104 constructor TPanel
.Create(PanelRec
: TPanelRec_1
;
105 AddTextures
: TAddTextureArray
;
107 var Textures
: TLevelTextureArray
);
113 Width
:= PanelRec
.Width
;
114 Height
:= PanelRec
.Height
;
123 PanelType
:= PanelRec
.PanelType
;
161 if ByteBool(PanelRec
.Flags
and PANEL_FLAG_HIDE
) then
163 SetLength(FTextureIDs
, 0);
167 // Ïàíåëè, íå èñïîëüçóþùèå òåêñòóðû:
168 if ByteBool(PanelType
and
173 PANEL_BLOCKMON
)) then
175 SetLength(FTextureIDs
, 0);
180 // Åñëè ýòî æèäêîñòü áåç òåêñòóðû - ñïåöòåêñòóðó:
181 if WordBool(PanelType
and (PANEL_WATER
or PANEL_ACID1
or PANEL_ACID2
)) and
182 (not ByteBool(PanelRec
.Flags
and PANEL_FLAG_WATERTEXTURES
)) then
184 SetLength(FTextureIDs
, 1);
185 FTextureIDs
[0].Anim
:= False;
187 case PanelRec
.PanelType
of
189 FTextureIDs
[0].Tex
:= TEXTURE_SPECIAL_WATER
;
191 FTextureIDs
[0].Tex
:= TEXTURE_SPECIAL_ACID1
;
193 FTextureIDs
[0].Tex
:= TEXTURE_SPECIAL_ACID2
;
200 SetLength(FTextureIDs
, Length(AddTextures
));
205 if CurTex
>= Length(FTextureIDs
) then
206 FCurTexture
:= Length(FTextureIDs
) - 1
208 FCurTexture
:= CurTex
;
210 for i
:= 0 to Length(FTextureIDs
)-1 do
212 FTextureIDs
[i
].Anim
:= AddTextures
[i
].Anim
;
213 if FTextureIDs
[i
].Anim
then
214 begin // Àíèìèðîâàííàÿ òåêñòóðà
215 FTextureIDs
[i
].AnTex
:=
216 TAnimation
.Create(Textures
[AddTextures
[i
].Texture
].FramesID
,
217 True, Textures
[AddTextures
[i
].Texture
].Speed
);
218 FTextureIDs
[i
].AnTex
.Blending
:= ByteBool(PanelRec
.Flags
and PANEL_FLAG_BLENDING
);
219 FTextureIDs
[i
].AnTex
.Alpha
:= PanelRec
.Alpha
;
223 begin // Îáû÷íàÿ òåêñòóðà
224 FTextureIDs
[i
].Tex
:= Textures
[AddTextures
[i
].Texture
].TextureID
;
228 // Òåêñòóð íåñêîëüêî - íóæíî ñîõðàíÿòü òåêóùóþ:
229 if Length(FTextureIDs
) > 1 then
232 // Åñëè íå ñïåöòåêñòóðà, òî çàäàåì ðàçìåðû:
233 if PanelRec
.TextureNum
> High(Textures
) then
235 e_WriteLog(Format('WTF?! PanelRec.TextureNum is out of limits! (%d : %d)', [PanelRec
.TextureNum
, High(Textures
)]), MSG_FATALERROR
);
239 FBlending
:= ByteBool(0);
241 else if not g_Map_IsSpecialTexture(Textures
[PanelRec
.TextureNum
].TextureName
) then
243 FTextureWidth
:= Textures
[PanelRec
.TextureNum
].Width
;
244 FTextureHeight
:= Textures
[PanelRec
.TextureNum
].Height
;
245 FAlpha
:= PanelRec
.Alpha
;
246 FBlending
:= ByteBool(PanelRec
.Flags
and PANEL_FLAG_BLENDING
);
250 destructor TPanel
.Destroy();
254 for i
:= 0 to High(FTextureIDs
) do
255 if FTextureIDs
[i
].Anim
then
256 FTextureIDs
[i
].AnTex
.Free();
257 SetLength(FTextureIDs
, 0);
262 function TPanel
.getx1 (): Integer; inline; begin result
:= X
+Width
-1; end;
263 function TPanel
.gety1 (): Integer; inline; begin result
:= Y
+Height
-1; end;
264 function TPanel
.getvisvalid (): Boolean; inline; begin result
:= (Width
> 0) and (Height
> 0); end;
266 procedure TPanel
.Draw();
272 if Enabled
and (FCurTexture
>= 0) and
273 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) and
274 g_Collide(X
, Y
, Width
, Height
,
275 sX
, sY
, sWidth
, sHeight
) then
277 if FTextureIDs
[FCurTexture
].Anim
then
278 begin // Àíèìèðîâàííàÿ òåêñòóðà
279 if FTextureIDs
[FCurTexture
].AnTex
= nil then
282 for xx
:= 0 to (Width
div FTextureWidth
)-1 do
283 for yy
:= 0 to (Height
div FTextureHeight
)-1 do
284 FTextureIDs
[FCurTexture
].AnTex
.Draw(
285 X
+ xx
*FTextureWidth
,
286 Y
+ yy
*FTextureHeight
, M_NONE
);
289 begin // Îáû÷íàÿ òåêñòóðà
290 case FTextureIDs
[FCurTexture
].Tex
of
291 TEXTURE_SPECIAL_WATER
:
292 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
293 0, 0, 255, 0, B_FILTER
);
294 TEXTURE_SPECIAL_ACID1
:
295 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
296 0, 128, 0, 0, B_FILTER
);
297 TEXTURE_SPECIAL_ACID2
:
298 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
299 128, 0, 0, 0, B_FILTER
);
301 if g_Texture_Get('NOTEXTURE', NoTextureID
) then
303 e_GetTextureSize(NoTextureID
, @NW
, @NH
);
304 e_DrawFill(NoTextureID
, X
, Y
, Width
div NW
, Height
div NH
,
308 xx
:= X
+ (Width
div 2);
309 yy
:= Y
+ (Height
div 2);
310 e_DrawFillQuad(X
, Y
, xx
, yy
,
312 e_DrawFillQuad(xx
, Y
, X
+Width
-1, yy
,
314 e_DrawFillQuad(X
, yy
, xx
, Y
+Height
-1,
316 e_DrawFillQuad(xx
, yy
, X
+Width
-1, Y
+Height
-1,
321 e_DrawFill(FTextureIDs
[FCurTexture
].Tex
, X
, Y
,
322 Width
div FTextureWidth
,
323 Height
div FTextureHeight
,
324 FAlpha
, True, FBlending
);
330 procedure TPanel
.DrawShadowVolume(lightX
: Integer; lightY
: Integer; radius
: Integer);
331 procedure extrude (x
: Integer; y
: Integer);
333 glVertex2i(x
+(x
-lightX
)*500, y
+(y
-lightY
)*500);
334 //e_WriteLog(Format(' : (%d,%d)', [x+(x-lightX)*300, y+(y-lightY)*300]), MSG_WARNING);
337 procedure drawLine (x0
: Integer; y0
: Integer; x1
: Integer; y1
: Integer);
339 // does this side facing the light?
340 if ((x1
-x0
)*(lightY
-y0
)-(lightX
-x0
)*(y1
-y0
) >= 0) then exit
;
341 //e_WriteLog(Format('lightpan: (%d,%d)-(%d,%d)', [x0, y0, x1, y1]), MSG_WARNING);
342 // this edge is facing the light, extrude and draw it
350 if radius
< 4 then exit
;
351 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
353 if not FTextureIDs
[FCurTexture
].Anim
then
355 case FTextureIDs
[FCurTexture
].Tex
of
356 TEXTURE_SPECIAL_WATER
: exit
;
357 TEXTURE_SPECIAL_ACID1
: exit
;
358 TEXTURE_SPECIAL_ACID2
: exit
;
362 if (X
+Width
< lightX
-radius
) then exit
;
363 if (Y
+Height
< lightY
-radius
) then exit
;
364 if (X
> lightX
+radius
) then exit
;
365 if (Y
> lightY
+radius
) then exit
;
366 //e_DrawFill(FTextureIDs[FCurTexture].Tex, X, Y, Width div FTextureWidth, Height div FTextureHeight, FAlpha, True, FBlending);
369 drawLine(x
, y
, x
+width
, y
); // top
370 drawLine(x
+width
, y
, x
+width
, y
+height
); // right
371 drawLine(x
+width
, y
+height
, x
, y
+height
); // bottom
372 drawLine(x
, y
+height
, x
, y
); // left
377 procedure TPanel
.Update();
379 if Enabled
and (FCurTexture
>= 0) and
380 (FTextureIDs
[FCurTexture
].Anim
) and
381 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
382 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
384 FTextureIDs
[FCurTexture
].AnTex
.Update();
385 FCurFrame
:= FTextureIDs
[FCurTexture
].AnTex
.CurrentFrame
;
386 FCurFrameCount
:= FTextureIDs
[FCurTexture
].AnTex
.CurrentCounter
;
390 procedure TPanel
.SetFrame(Frame
: Integer; Count
: Byte);
392 function ClampInt(X
, A
, B
: Integer): Integer;
395 if X
< A
then Result
:= A
else if X
> B
then Result
:= B
;
399 if Enabled
and (FCurTexture
>= 0) and
400 (FTextureIDs
[FCurTexture
].Anim
) and
401 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
402 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
404 FCurFrame
:= ClampInt(Frame
, 0, FTextureIDs
[FCurTexture
].AnTex
.TotalFrames
);
405 FCurFrameCount
:= Count
;
406 FTextureIDs
[FCurTexture
].AnTex
.CurrentFrame
:= FCurFrame
;
407 FTextureIDs
[FCurTexture
].AnTex
.CurrentCounter
:= FCurFrameCount
;
411 procedure TPanel
.NextTexture(AnimLoop
: Byte = 0);
413 Assert(FCurTexture
>= -1, 'FCurTexture < -1');
416 if Length(FTextureIDs
) = 0 then
419 // Òîëüêî îäíà òåêñòóðà:
420 if Length(FTextureIDs
) = 1 then
422 if FCurTexture
= 0 then
428 // Áîëüøå îäíîé òåêñòóðû:
432 // Ñëåäóþùåé íåò - âîçâðàò ê íà÷àëó:
433 if FCurTexture
>= Length(FTextureIDs
) then
437 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
438 if (FCurTexture
>= 0) and FTextureIDs
[FCurTexture
].Anim
then
440 if (FTextureIDs
[FCurTexture
].AnTex
= nil) then
442 g_FatalError(_lc
[I_GAME_ERROR_SWITCH_TEXTURE
]);
447 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= True
450 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= False;
452 FTextureIDs
[FCurTexture
].AnTex
.Reset();
455 LastAnimLoop
:= AnimLoop
;
458 procedure TPanel
.SetTexture(ID
: Integer; AnimLoop
: Byte = 0);
461 if Length(FTextureIDs
) = 0 then
464 // Òîëüêî îäíà òåêñòóðà:
465 if Length(FTextureIDs
) = 1 then
467 if (ID
= 0) or (ID
= -1) then
471 // Áîëüøå îäíîé òåêñòóðû:
473 if (ID
>= -1) and (ID
<= High(FTextureIDs
)) then
477 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
478 if (FCurTexture
>= 0) and FTextureIDs
[FCurTexture
].Anim
then
480 if (FTextureIDs
[FCurTexture
].AnTex
= nil) then
482 g_FatalError(_lc
[I_GAME_ERROR_SWITCH_TEXTURE
]);
487 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= True
490 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= False;
492 FTextureIDs
[FCurTexture
].AnTex
.Reset();
495 LastAnimLoop
:= AnimLoop
;
498 function TPanel
.GetTextureID(): DWORD
;
500 Result
:= TEXTURE_NONE
;
502 if (FCurTexture
>= 0) then
504 if FTextureIDs
[FCurTexture
].Anim
then
505 Result
:= FTextureIDs
[FCurTexture
].AnTex
.FramesID
507 Result
:= FTextureIDs
[FCurTexture
].Tex
;
511 function TPanel
.GetTextureCount(): Integer;
513 Result
:= Length(FTextureIDs
);
514 if Enabled
and (FCurTexture
>= 0) then
515 if (FTextureIDs
[FCurTexture
].Anim
) and
516 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
517 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
518 Result
:= Result
+ 100;
521 procedure TPanel
.SaveState(Var Mem
: TBinMemoryWriter
);
526 if (not SaveIt
) or (Mem
= nil) then
530 sig
:= PANEL_SIGNATURE
; // 'PANL'
532 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
533 Mem
.WriteBoolean(Enabled
);
534 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
535 Mem
.WriteByte(LiftType
);
536 // Íîìåð òåêóùåé òåêñòóðû:
537 Mem
.WriteInt(FCurTexture
);
541 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
542 if (FCurTexture
>= 0) and (FTextureIDs
[FCurTexture
].Anim
) then
544 Assert(FTextureIDs
[FCurTexture
].AnTex
<> nil,
545 'TPanel.SaveState: No animation object');
550 Mem
.WriteBoolean(anim
);
551 // Åñëè äà - ñîõðàíÿåì àíèìàöèþ:
553 FTextureIDs
[FCurTexture
].AnTex
.SaveState(Mem
);
556 procedure TPanel
.LoadState(var Mem
: TBinMemoryReader
);
561 if (not SaveIt
) or (Mem
= nil) then
566 if sig
<> PANEL_SIGNATURE
then // 'PANL'
568 raise EBinSizeError
.Create('TPanel.LoadState: Wrong Panel Signature');
570 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
571 Mem
.ReadBoolean(Enabled
);
572 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
573 Mem
.ReadByte(LiftType
);
574 // Íîìåð òåêóùåé òåêñòóðû:
575 Mem
.ReadInt(FCurTexture
);
579 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
580 Mem
.ReadBoolean(anim
);
581 // Åñëè äà - çàãðóæàåì àíèìàöèþ:
584 Assert((FCurTexture
>= 0) and
585 (FTextureIDs
[FCurTexture
].Anim
) and
586 (FTextureIDs
[FCurTexture
].AnTex
<> nil),
587 'TPanel.LoadState: No animation object');
588 FTextureIDs
[FCurTexture
].AnTex
.LoadState(Mem
);