7 MAPSTRUCT
, BinEditor
, g_textures
;
10 TAddTextureArray
= Array of
16 TPanel
= Class (TObject
)
25 False: (Tex
: Cardinal);
26 True: (AnTex
: TAnimation
);
30 FCurTexture
: Integer; // Íîìåð òåêóùåé òåêñòóðû
36 SaveIt
: Boolean; // Ñîõðàíÿòü ïðè SaveState?
42 constructor Create(PanelRec
: TPanelRec_1
;
43 AddTextures
: TAddTextureArray
;
45 var Textures
: TLevelTextureArray
);
46 destructor Destroy(); override;
50 procedure SetFrame(Frame
: Integer; Count
: Byte);
51 procedure NextTexture(AnimLoop
: Byte = 0);
52 procedure SetTexture(ID
: Integer; AnimLoop
: Byte = 0);
53 function GetTextureID(): Cardinal;
54 function GetTextureCount(): Integer;
56 procedure SaveState(var Mem
: TBinMemoryWriter
);
57 procedure LoadState(var Mem
: TBinMemoryReader
);
60 TPanelArray
= Array of TPanel
;
65 SysUtils
, g_basic
, g_map
, MAPDEF
, g_game
, e_graphics
,
66 g_console
, g_language
, e_log
;
69 PANEL_SIGNATURE
= $4C4E4150; // 'PANL'
73 constructor TPanel
.Create(PanelRec
: TPanelRec_1
;
74 AddTextures
: TAddTextureArray
;
76 var Textures
: TLevelTextureArray
);
82 Width
:= PanelRec
.Width
;
83 Height
:= PanelRec
.Height
;
91 PanelType
:= PanelRec
.PanelType
;
129 if ByteBool(PanelRec
.Flags
and PANEL_FLAG_HIDE
) then
131 SetLength(FTextureIDs
, 0);
135 // Ïàíåëè, íå èñïîëüçóþùèå òåêñòóðû:
136 if ByteBool(PanelType
and
141 PANEL_BLOCKMON
)) then
143 SetLength(FTextureIDs
, 0);
148 // Åñëè ýòî æèäêîñòü áåç òåêñòóðû - ñïåöòåêñòóðó:
149 if WordBool(PanelType
and (PANEL_WATER
or PANEL_ACID1
or PANEL_ACID2
)) and
150 (not ByteBool(PanelRec
.Flags
and PANEL_FLAG_WATERTEXTURES
)) then
152 SetLength(FTextureIDs
, 1);
153 FTextureIDs
[0].Anim
:= False;
155 case PanelRec
.PanelType
of
157 FTextureIDs
[0].Tex
:= TEXTURE_SPECIAL_WATER
;
159 FTextureIDs
[0].Tex
:= TEXTURE_SPECIAL_ACID1
;
161 FTextureIDs
[0].Tex
:= TEXTURE_SPECIAL_ACID2
;
168 SetLength(FTextureIDs
, Length(AddTextures
));
173 if CurTex
>= Length(FTextureIDs
) then
174 FCurTexture
:= Length(FTextureIDs
) - 1
176 FCurTexture
:= CurTex
;
178 for i
:= 0 to Length(FTextureIDs
)-1 do
180 FTextureIDs
[i
].Anim
:= AddTextures
[i
].Anim
;
181 if FTextureIDs
[i
].Anim
then
182 begin // Àíèìèðîâàííàÿ òåêñòóðà
183 FTextureIDs
[i
].AnTex
:=
184 TAnimation
.Create(Textures
[AddTextures
[i
].Texture
].FramesID
,
185 True, Textures
[AddTextures
[i
].Texture
].Speed
);
186 FTextureIDs
[i
].AnTex
.Blending
:= ByteBool(PanelRec
.Flags
and PANEL_FLAG_BLENDING
);
187 FTextureIDs
[i
].AnTex
.Alpha
:= PanelRec
.Alpha
;
191 begin // Îáû÷íàÿ òåêñòóðà
192 FTextureIDs
[i
].Tex
:= Textures
[AddTextures
[i
].Texture
].TextureID
;
196 // Òåêñòóð íåñêîëüêî - íóæíî ñîõðàíÿòü òåêóùóþ:
197 if Length(FTextureIDs
) > 1 then
200 // Åñëè íå ñïåöòåêñòóðà, òî çàäàåì ðàçìåðû:
201 if PanelRec
.TextureNum
> High(Textures
) then
203 e_WriteLog(Format('WTF?! PanelRec.TextureNum is out of limits! (%d : %d)', [PanelRec
.TextureNum
, High(Textures
)]), MSG_FATALERROR
);
207 FBlending
:= ByteBool(0);
209 else if not g_Map_IsSpecialTexture(Textures
[PanelRec
.TextureNum
].TextureName
) then
211 FTextureWidth
:= Textures
[PanelRec
.TextureNum
].Width
;
212 FTextureHeight
:= Textures
[PanelRec
.TextureNum
].Height
;
213 FAlpha
:= PanelRec
.Alpha
;
214 FBlending
:= ByteBool(PanelRec
.Flags
and PANEL_FLAG_BLENDING
);
218 destructor TPanel
.Destroy();
222 for i
:= 0 to High(FTextureIDs
) do
223 if FTextureIDs
[i
].Anim
then
224 FTextureIDs
[i
].AnTex
.Free();
225 SetLength(FTextureIDs
, 0);
230 procedure TPanel
.Draw();
236 if Enabled
and (FCurTexture
>= 0) and
237 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) and
238 g_Collide(X
, Y
, Width
, Height
,
239 sX
, sY
, sWidth
, sHeight
) then
241 if FTextureIDs
[FCurTexture
].Anim
then
242 begin // Àíèìèðîâàííàÿ òåêñòóðà
243 if FTextureIDs
[FCurTexture
].AnTex
= nil then
246 for xx
:= 0 to (Width
div FTextureWidth
)-1 do
247 for yy
:= 0 to (Height
div FTextureHeight
)-1 do
248 FTextureIDs
[FCurTexture
].AnTex
.Draw(
249 X
+ xx
*FTextureWidth
,
250 Y
+ yy
*FTextureHeight
, M_NONE
);
253 begin // Îáû÷íàÿ òåêñòóðà
254 case FTextureIDs
[FCurTexture
].Tex
of
255 TEXTURE_SPECIAL_WATER
:
256 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
257 0, 0, 255, 0, B_FILTER
);
258 TEXTURE_SPECIAL_ACID1
:
259 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
260 0, 128, 0, 0, B_FILTER
);
261 TEXTURE_SPECIAL_ACID2
:
262 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
263 128, 0, 0, 0, B_FILTER
);
265 if g_Texture_Get('NOTEXTURE', NoTextureID
) then
267 e_GetTextureSize(NoTextureID
, @NW
, @NH
);
268 e_DrawFill(NoTextureID
, X
, Y
, Width
div NW
, Height
div NH
,
272 xx
:= X
+ (Width
div 2);
273 yy
:= Y
+ (Height
div 2);
274 e_DrawFillQuad(X
, Y
, xx
, yy
,
276 e_DrawFillQuad(xx
, Y
, X
+Width
-1, yy
,
278 e_DrawFillQuad(X
, yy
, xx
, Y
+Height
-1,
280 e_DrawFillQuad(xx
, yy
, X
+Width
-1, Y
+Height
-1,
285 e_DrawFill(FTextureIDs
[FCurTexture
].Tex
, X
, Y
,
286 Width
div FTextureWidth
,
287 Height
div FTextureHeight
,
288 FAlpha
, True, FBlending
);
294 procedure TPanel
.Update();
296 if Enabled
and (FCurTexture
>= 0) and
297 (FTextureIDs
[FCurTexture
].Anim
) and
298 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
299 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
301 FTextureIDs
[FCurTexture
].AnTex
.Update();
302 FCurFrame
:= FTextureIDs
[FCurTexture
].AnTex
.CurrentFrame
;
303 FCurFrameCount
:= FTextureIDs
[FCurTexture
].AnTex
.CurrentCounter
;
307 procedure TPanel
.SetFrame(Frame
: Integer; Count
: Byte);
309 function ClampInt(X
, A
, B
: Integer): Integer;
312 if X
< A
then Result
:= A
else if X
> B
then Result
:= B
;
316 if Enabled
and (FCurTexture
>= 0) and
317 (FTextureIDs
[FCurTexture
].Anim
) and
318 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
319 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
321 FCurFrame
:= ClampInt(Frame
, 0, FTextureIDs
[FCurTexture
].AnTex
.TotalFrames
);
322 FCurFrameCount
:= Count
;
323 FTextureIDs
[FCurTexture
].AnTex
.CurrentFrame
:= FCurFrame
;
324 FTextureIDs
[FCurTexture
].AnTex
.CurrentCounter
:= FCurFrameCount
;
328 procedure TPanel
.NextTexture(AnimLoop
: Byte = 0);
330 Assert(FCurTexture
>= -1, 'FCurTexture < -1');
333 if Length(FTextureIDs
) = 0 then
336 // Òîëüêî îäíà òåêñòóðà:
337 if Length(FTextureIDs
) = 1 then
339 if FCurTexture
= 0 then
345 // Áîëüøå îäíîé òåêñòóðû:
349 // Ñëåäóþùåé íåò - âîçâðàò ê íà÷àëó:
350 if FCurTexture
>= Length(FTextureIDs
) then
354 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
355 if (FCurTexture
>= 0) and FTextureIDs
[FCurTexture
].Anim
then
357 if (FTextureIDs
[FCurTexture
].AnTex
= nil) then
359 g_FatalError(_lc
[I_GAME_ERROR_SWITCH_TEXTURE
]);
364 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= True
367 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= False;
369 FTextureIDs
[FCurTexture
].AnTex
.Reset();
372 LastAnimLoop
:= AnimLoop
;
375 procedure TPanel
.SetTexture(ID
: Integer; AnimLoop
: Byte = 0);
378 if Length(FTextureIDs
) = 0 then
381 // Òîëüêî îäíà òåêñòóðà:
382 if Length(FTextureIDs
) = 1 then
384 if (ID
= 0) or (ID
= -1) then
388 // Áîëüøå îäíîé òåêñòóðû:
390 if (ID
>= -1) and (ID
<= High(FTextureIDs
)) then
394 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
395 if (FCurTexture
>= 0) and FTextureIDs
[FCurTexture
].Anim
then
397 if (FTextureIDs
[FCurTexture
].AnTex
= nil) then
399 g_FatalError(_lc
[I_GAME_ERROR_SWITCH_TEXTURE
]);
404 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= True
407 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= False;
409 FTextureIDs
[FCurTexture
].AnTex
.Reset();
412 LastAnimLoop
:= AnimLoop
;
415 function TPanel
.GetTextureID(): DWORD
;
417 Result
:= TEXTURE_NONE
;
419 if (FCurTexture
>= 0) then
421 if FTextureIDs
[FCurTexture
].Anim
then
422 Result
:= FTextureIDs
[FCurTexture
].AnTex
.FramesID
424 Result
:= FTextureIDs
[FCurTexture
].Tex
;
428 function TPanel
.GetTextureCount(): Integer;
430 Result
:= Length(FTextureIDs
);
431 if Enabled
and (FCurTexture
>= 0) then
432 if (FTextureIDs
[FCurTexture
].Anim
) and
433 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
434 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
435 Result
:= Result
+ 100;
438 procedure TPanel
.SaveState(Var Mem
: TBinMemoryWriter
);
443 if (not SaveIt
) or (Mem
= nil) then
447 sig
:= PANEL_SIGNATURE
; // 'PANL'
449 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
450 Mem
.WriteBoolean(Enabled
);
451 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
452 Mem
.WriteByte(LiftType
);
453 // Íîìåð òåêóùåé òåêñòóðû:
454 Mem
.WriteInt(FCurTexture
);
455 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
456 if (FCurTexture
>= 0) and (FTextureIDs
[FCurTexture
].Anim
) then
458 Assert(FTextureIDs
[FCurTexture
].AnTex
<> nil,
459 'TPanel.SaveState: No animation object');
464 Mem
.WriteBoolean(anim
);
465 // Åñëè äà - ñîõðàíÿåì àíèìàöèþ:
467 FTextureIDs
[FCurTexture
].AnTex
.SaveState(Mem
);
470 procedure TPanel
.LoadState(var Mem
: TBinMemoryReader
);
475 if (not SaveIt
) or (Mem
= nil) then
480 if sig
<> PANEL_SIGNATURE
then // 'PANL'
482 raise EBinSizeError
.Create('TPanel.LoadState: Wrong Panel Signature');
484 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
485 Mem
.ReadBoolean(Enabled
);
486 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
487 Mem
.ReadByte(LiftType
);
488 // Íîìåð òåêóùåé òåêñòóðû:
489 Mem
.ReadInt(FCurTexture
);
490 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
491 Mem
.ReadBoolean(anim
);
492 // Åñëè äà - çàãðóæàåì àíèìàöèþ:
495 Assert((FCurTexture
>= 0) and
496 (FTextureIDs
[FCurTexture
].Anim
) and
497 (FTextureIDs
[FCurTexture
].AnTex
<> nil),
498 'TPanel.LoadState: No animation object');
499 FTextureIDs
[FCurTexture
].AnTex
.LoadState(Mem
);