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
)
36 mGUID
: Integer; // will be assigned in "g_map.pas"
44 False: (Tex
: Cardinal);
45 True: (AnTex
: TAnimation
);
48 mMovingSpeed
: TDFPoint
;
49 mMovingStart
: TDFPoint
;
51 mMovingActive
: Boolean;
54 function getx1 (): Integer; inline;
55 function gety1 (): Integer; inline;
56 function getvisvalid (): Boolean; inline;
58 function getMovingSpeedX (): Integer; inline;
59 procedure setMovingSpeedX (v
: Integer); inline;
60 function getMovingSpeedY (): Integer; inline;
61 procedure setMovingSpeedY (v
: Integer); inline;
63 function getMovingStartX (): Integer; inline;
64 procedure setMovingStartX (v
: Integer); inline;
65 function getMovingStartY (): Integer; inline;
66 procedure setMovingStartY (v
: Integer); inline;
68 function getMovingEndX (): Integer; inline;
69 procedure setMovingEndX (v
: Integer); inline;
70 function getMovingEndY (): Integer; inline;
71 procedure setMovingEndY (v
: Integer); inline;
74 FCurTexture
: Integer; // Íîìåð òåêóùåé òåêñòóðû
78 FWidth
, FHeight
: Word;
80 FSaveIt
: Boolean; // Ñîõðàíÿòü ïðè SaveState?
86 // sorry, there fields are public to allow setting 'em in g_map; this should be fixed later
87 // for now, PLEASE, don't modify 'em, or all hell will break loose
88 arrIdx
: Integer; // index in one of internal arrays; sorry
89 tag
: Integer; // used in coldets and such; sorry; see g_map.GridTagXXX
90 proxyId
: Integer; // proxy id in map grid (DO NOT USE!)
91 mapId
: AnsiString; // taken directly from map file; dunno why it is here
93 constructor Create(PanelRec
: TDynRecord
;
94 AddTextures
: TAddTextureArray
;
96 var Textures
: TLevelTextureArray
; aguid
: Integer);
97 destructor Destroy(); override;
100 procedure DrawShadowVolume(lightX
: Integer; lightY
: Integer; radius
: Integer);
102 procedure SetFrame(Frame
: Integer; Count
: Byte);
103 procedure NextTexture(AnimLoop
: Byte = 0);
104 procedure SetTexture(ID
: Integer; AnimLoop
: Byte = 0);
105 function GetTextureID(): Cardinal;
106 function GetTextureCount(): Integer;
108 procedure SaveState(var Mem
: TBinMemoryWriter
);
109 procedure LoadState(var Mem
: TBinMemoryReader
);
111 procedure positionChanged (); inline;
113 function getIsGBack (): Boolean; inline; // gRenderBackgrounds
114 function getIsGStep (): Boolean; inline; // gSteps
115 function getIsGWall (): Boolean; inline; // gWalls
116 function getIsGAcid1 (): Boolean; inline; // gAcid1
117 function getIsGAcid2 (): Boolean; inline; // gAcid2
118 function getIsGWater (): Boolean; inline; // gWater
119 function getIsGFore (): Boolean; inline; // gRenderForegrounds
120 function getIsGLift (): Boolean; inline; // gLifts
121 function getIsGBlockMon (): Boolean; inline; // gBlockMon
124 property visvalid
: Boolean read getvisvalid
; // panel is "visvalid" when it's width and height are positive
127 property guid
: Integer read mGUID
; // will be assigned in "g_map.pas"
128 property x0
: Integer read FX
;
129 property y0
: Integer read FY
;
130 property x1
: Integer read getx1
; // inclusive!
131 property y1
: Integer read gety1
; // inclusive!
132 property x
: Integer read FX write FX
;
133 property y
: Integer read FY write FY
;
134 property width
: Word read FWidth write FWidth
;
135 property height
: Word read FHeight write FHeight
;
136 property panelType
: Word read FPanelType write FPanelType
;
137 property saveIt
: Boolean read FSaveIt write FSaveIt
; // Ñîõðàíÿòü ïðè SaveState?
138 property enabled
: Boolean read FEnabled write FEnabled
; // Ñîõðàíÿòü ïðè SaveState?
139 property door
: Boolean read FDoor write FDoor
; // Ñîõðàíÿòü ïðè SaveState?
140 property moved
: Boolean read FMoved write FMoved
; // Ñîõðàíÿòü ïðè SaveState?
141 property liftType
: Byte read FLiftType write FLiftType
; // Ñîõðàíÿòü ïðè SaveState?
142 property lastAnimLoop
: Byte read FLastAnimLoop write FLastAnimLoop
; // Ñîõðàíÿòü ïðè SaveState?
144 property movingSpeedX
: Integer read getMovingSpeedX write setMovingSpeedX
;
145 property movingSpeedY
: Integer read getMovingSpeedY write setMovingSpeedY
;
146 property movingStartX
: Integer read getMovingStartX write setMovingStartX
;
147 property movingStartY
: Integer read getMovingStartY write setMovingStartY
;
148 property movingEndX
: Integer read getMovingEndX write setMovingEndX
;
149 property movingEndY
: Integer read getMovingEndY write setMovingEndY
;
150 property movingActive
: Boolean read mMovingActive write mMovingActive
;
152 property isGBack
: Boolean read getIsGBack
;
153 property isGStep
: Boolean read getIsGStep
;
154 property isGWall
: Boolean read getIsGWall
;
155 property isGAcid1
: Boolean read getIsGAcid1
;
156 property isGAcid2
: Boolean read getIsGAcid2
;
157 property isGWater
: Boolean read getIsGWater
;
158 property isGFore
: Boolean read getIsGFore
;
159 property isGLift
: Boolean read getIsGLift
;
160 property isGBlockMon
: Boolean read getIsGBlockMon
;
163 property movingSpeed
: TDFPoint read mMovingSpeed write mMovingSpeed
;
164 property movingStart
: TDFPoint read mMovingStart write mMovingStart
;
165 property movingEnd
: TDFPoint read mMovingEnd write mMovingEnd
;
168 TPanelArray
= Array of TPanel
;
171 g_dbgpan_mplat_active
: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}true{$ENDIF};
172 g_dbgpan_mplat_step
: Boolean = false; // one step, and stop
178 SysUtils
, g_basic
, g_map
, g_game
, g_gfx
, e_graphics
, g_weapons
,
179 g_console
, g_language
, g_monsters
, g_player
, e_log
, GL
;
182 PANEL_SIGNATURE
= $4C4E4150; // 'PANL'
186 constructor TPanel
.Create(PanelRec
: TDynRecord
;
187 AddTextures
: TAddTextureArray
;
189 var Textures
: TLevelTextureArray
; aguid
: Integer);
195 Width
:= PanelRec
.Width
;
196 Height
:= PanelRec
.Height
;
204 mapId
:= PanelRec
.id
;
207 mMovingSpeed
:= PanelRec
.moveSpeed
;
208 mMovingStart
:= PanelRec
.moveStart
;
209 mMovingEnd
:= PanelRec
.moveEnd
;
210 mMovingActive
:= PanelRec
['move_active'].varvalue
;
213 PanelType
:= PanelRec
.PanelType
;
251 if ByteBool(PanelRec
.Flags
and PANEL_FLAG_HIDE
) then
253 SetLength(FTextureIDs
, 0);
257 // Ïàíåëè, íå èñïîëüçóþùèå òåêñòóðû:
258 if ByteBool(PanelType
and
263 PANEL_BLOCKMON
)) then
265 SetLength(FTextureIDs
, 0);
270 // Åñëè ýòî æèäêîñòü áåç òåêñòóðû - ñïåöòåêñòóðó:
271 if WordBool(PanelType
and (PANEL_WATER
or PANEL_ACID1
or PANEL_ACID2
)) and
272 (not ByteBool(PanelRec
.Flags
and PANEL_FLAG_WATERTEXTURES
)) then
274 SetLength(FTextureIDs
, 1);
275 FTextureIDs
[0].Anim
:= False;
277 case PanelRec
.PanelType
of
279 FTextureIDs
[0].Tex
:= LongWord(TEXTURE_SPECIAL_WATER
);
281 FTextureIDs
[0].Tex
:= LongWord(TEXTURE_SPECIAL_ACID1
);
283 FTextureIDs
[0].Tex
:= LongWord(TEXTURE_SPECIAL_ACID2
);
290 SetLength(FTextureIDs
, Length(AddTextures
));
295 if CurTex
>= Length(FTextureIDs
) then
296 FCurTexture
:= Length(FTextureIDs
) - 1
298 FCurTexture
:= CurTex
;
300 for i
:= 0 to Length(FTextureIDs
)-1 do
302 FTextureIDs
[i
].Anim
:= AddTextures
[i
].Anim
;
303 if FTextureIDs
[i
].Anim
then
304 begin // Àíèìèðîâàííàÿ òåêñòóðà
305 FTextureIDs
[i
].AnTex
:=
306 TAnimation
.Create(Textures
[AddTextures
[i
].Texture
].FramesID
,
307 True, Textures
[AddTextures
[i
].Texture
].Speed
);
308 FTextureIDs
[i
].AnTex
.Blending
:= ByteBool(PanelRec
.Flags
and PANEL_FLAG_BLENDING
);
309 FTextureIDs
[i
].AnTex
.Alpha
:= PanelRec
.Alpha
;
313 begin // Îáû÷íàÿ òåêñòóðà
314 FTextureIDs
[i
].Tex
:= Textures
[AddTextures
[i
].Texture
].TextureID
;
318 // Òåêñòóð íåñêîëüêî - íóæíî ñîõðàíÿòü òåêóùóþ:
319 if Length(FTextureIDs
) > 1 then
322 // Åñëè íå ñïåöòåêñòóðà, òî çàäàåì ðàçìåðû:
323 if PanelRec
.TextureNum
> High(Textures
) then
325 e_WriteLog(Format('WTF?! PanelRec.TextureNum is out of limits! (%d : %d)', [PanelRec
.TextureNum
, High(Textures
)]), MSG_FATALERROR
);
329 FBlending
:= ByteBool(0);
331 else if not g_Map_IsSpecialTexture(Textures
[PanelRec
.TextureNum
].TextureName
) then
333 FTextureWidth
:= Textures
[PanelRec
.TextureNum
].Width
;
334 FTextureHeight
:= Textures
[PanelRec
.TextureNum
].Height
;
335 FAlpha
:= PanelRec
.Alpha
;
336 FBlending
:= ByteBool(PanelRec
.Flags
and PANEL_FLAG_BLENDING
);
340 destructor TPanel
.Destroy();
344 for i
:= 0 to High(FTextureIDs
) do
345 if FTextureIDs
[i
].Anim
then
346 FTextureIDs
[i
].AnTex
.Free();
347 SetLength(FTextureIDs
, 0);
352 function TPanel
.getx1 (): Integer; inline; begin result
:= X
+Width
-1; end;
353 function TPanel
.gety1 (): Integer; inline; begin result
:= Y
+Height
-1; end;
354 function TPanel
.getvisvalid (): Boolean; inline; begin result
:= (Width
> 0) and (Height
> 0); end;
356 function TPanel
.getMovingSpeedX (): Integer; inline; begin result
:= mMovingSpeed
.X
; end;
357 procedure TPanel
.setMovingSpeedX (v
: Integer); inline; begin mMovingSpeed
.X
:= v
; end;
358 function TPanel
.getMovingSpeedY (): Integer; inline; begin result
:= mMovingSpeed
.Y
; end;
359 procedure TPanel
.setMovingSpeedY (v
: Integer); inline; begin mMovingSpeed
.Y
:= v
; end;
361 function TPanel
.getMovingStartX (): Integer; inline; begin result
:= mMovingStart
.X
; end;
362 procedure TPanel
.setMovingStartX (v
: Integer); inline; begin mMovingStart
.X
:= v
; end;
363 function TPanel
.getMovingStartY (): Integer; inline; begin result
:= mMovingStart
.Y
; end;
364 procedure TPanel
.setMovingStartY (v
: Integer); inline; begin mMovingStart
.Y
:= v
; end;
366 function TPanel
.getMovingEndX (): Integer; inline; begin result
:= mMovingEnd
.X
; end;
367 procedure TPanel
.setMovingEndX (v
: Integer); inline; begin mMovingEnd
.X
:= v
; end;
368 function TPanel
.getMovingEndY (): Integer; inline; begin result
:= mMovingEnd
.Y
; end;
369 procedure TPanel
.setMovingEndY (v
: Integer); inline; begin mMovingEnd
.Y
:= v
; end;
371 function TPanel
.getIsGBack (): Boolean; inline; begin result
:= ((tag
and GridTagBack
) <> 0); end;
372 function TPanel
.getIsGStep (): Boolean; inline; begin result
:= ((tag
and GridTagStep
) <> 0); end;
373 function TPanel
.getIsGWall (): Boolean; inline; begin result
:= ((tag
and (GridTagWall
or GridTagDoor
)) <> 0); end;
374 function TPanel
.getIsGAcid1 (): Boolean; inline; begin result
:= ((tag
and GridTagAcid1
) <> 0); end;
375 function TPanel
.getIsGAcid2 (): Boolean; inline; begin result
:= ((tag
and GridTagAcid2
) <> 0); end;
376 function TPanel
.getIsGWater (): Boolean; inline; begin result
:= ((tag
and GridTagWater
) <> 0); end;
377 function TPanel
.getIsGFore (): Boolean; inline; begin result
:= ((tag
and GridTagFore
) <> 0); end;
378 function TPanel
.getIsGLift (): Boolean; inline; begin result
:= ((tag
and GridTagLift
) <> 0); end;
379 function TPanel
.getIsGBlockMon (): Boolean; inline; begin result
:= ((tag
and GridTagBlockMon
) <> 0); end;
381 procedure TPanel
.Draw();
387 if {Enabled and} (FCurTexture
>= 0) and
388 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) and
389 ((g_dbg_scale
<> 1.0) or g_Collide(X
, Y
, Width
, Height
, sX
, sY
, sWidth
, sHeight
)) then
391 if FTextureIDs
[FCurTexture
].Anim
then
392 begin // Àíèìèðîâàííàÿ òåêñòóðà
393 if FTextureIDs
[FCurTexture
].AnTex
= nil then
396 for xx
:= 0 to (Width
div FTextureWidth
)-1 do
397 for yy
:= 0 to (Height
div FTextureHeight
)-1 do
398 FTextureIDs
[FCurTexture
].AnTex
.Draw(
399 X
+ xx
*FTextureWidth
,
400 Y
+ yy
*FTextureHeight
, M_NONE
);
403 begin // Îáû÷íàÿ òåêñòóðà
404 case FTextureIDs
[FCurTexture
].Tex
of
405 LongWord(TEXTURE_SPECIAL_WATER
):
406 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
407 0, 0, 255, 0, B_FILTER
);
408 LongWord(TEXTURE_SPECIAL_ACID1
):
409 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
410 0, 128, 0, 0, B_FILTER
);
411 LongWord(TEXTURE_SPECIAL_ACID2
):
412 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
413 128, 0, 0, 0, B_FILTER
);
414 LongWord(TEXTURE_NONE
):
415 if g_Texture_Get('NOTEXTURE', NoTextureID
) then
417 e_GetTextureSize(NoTextureID
, @NW
, @NH
);
418 e_DrawFill(NoTextureID
, X
, Y
, Width
div NW
, Height
div NH
,
422 xx
:= X
+ (Width
div 2);
423 yy
:= Y
+ (Height
div 2);
424 e_DrawFillQuad(X
, Y
, xx
, yy
,
426 e_DrawFillQuad(xx
, Y
, X
+Width
-1, yy
,
428 e_DrawFillQuad(X
, yy
, xx
, Y
+Height
-1,
430 e_DrawFillQuad(xx
, yy
, X
+Width
-1, Y
+Height
-1,
435 e_DrawFill(FTextureIDs
[FCurTexture
].Tex
, X
, Y
,
436 Width
div FTextureWidth
,
437 Height
div FTextureHeight
,
438 FAlpha
, True, FBlending
);
444 procedure TPanel
.DrawShadowVolume(lightX
: Integer; lightY
: Integer; radius
: Integer);
445 procedure extrude (x
: Integer; y
: Integer);
447 glVertex2i(x
+(x
-lightX
)*500, y
+(y
-lightY
)*500);
448 //e_WriteLog(Format(' : (%d,%d)', [x+(x-lightX)*300, y+(y-lightY)*300]), MSG_WARNING);
451 procedure drawLine (x0
: Integer; y0
: Integer; x1
: Integer; y1
: Integer);
453 // does this side facing the light?
454 if ((x1
-x0
)*(lightY
-y0
)-(lightX
-x0
)*(y1
-y0
) >= 0) then exit
;
455 //e_WriteLog(Format('lightpan: (%d,%d)-(%d,%d)', [x0, y0, x1, y1]), MSG_WARNING);
456 // this edge is facing the light, extrude and draw it
464 if radius
< 4 then exit
;
465 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
467 if not FTextureIDs
[FCurTexture
].Anim
then
469 case FTextureIDs
[FCurTexture
].Tex
of
470 LongWord(TEXTURE_SPECIAL_WATER
): exit
;
471 LongWord(TEXTURE_SPECIAL_ACID1
): exit
;
472 LongWord(TEXTURE_SPECIAL_ACID2
): exit
;
473 LongWord(TEXTURE_NONE
): exit
;
476 if (X
+Width
< lightX
-radius
) then exit
;
477 if (Y
+Height
< lightY
-radius
) then exit
;
478 if (X
> lightX
+radius
) then exit
;
479 if (Y
> lightY
+radius
) then exit
;
480 //e_DrawFill(FTextureIDs[FCurTexture].Tex, X, Y, Width div FTextureWidth, Height div FTextureHeight, FAlpha, True, FBlending);
483 drawLine(x
, y
, x
+width
, y
); // top
484 drawLine(x
+width
, y
, x
+width
, y
+height
); // right
485 drawLine(x
+width
, y
+height
, x
, y
+height
); // bottom
486 drawLine(x
, y
+height
, x
, y
); // left
492 procedure TPanel
.positionChanged (); inline;
494 px
, py
, pw
, ph
: Integer;
496 if (proxyId
>= 0) then
498 mapGrid
.getBodyDims(proxyId
, px
, py
, pw
, ph
);
499 if (px
<> x
) or (py
<> y
) or (pw
<> Width
) or (ph
<> Height
) then
502 e_LogWritefln('panel moved: arridx=%s; guid=%s; proxyid=%s; old:(%s,%s)-(%sx%s); new:(%s,%s)-(%sx%s)',
503 [arrIdx, mGUID, proxyId, px, py, pw, ph, x, y, width, height]);
505 g_Mark(px
, py
, pw
, ph
, MARK_WALL
, false);
506 if (pw
<> Width
) or (ph
<> Height
) then mapGrid
.moveResizeBody(proxyId
, X
, Y
, Width
, Height
)
507 else mapGrid
.moveBody(proxyId
, X
, Y
);
508 g_Mark(X
, Y
, Width
, Height
, MARK_WALL
);
515 monMoveList
: array of TMonster
= nil;
516 monMoveListUsed
: Integer = 0;
518 procedure TPanel
.Update();
522 function doPush (px
, py
, pw
, ph
: Integer; out dx
, dy
: Integer): Boolean;
524 result
:= g_Collide(px
, py
, pw
, ph
, nx
, ny
, Width
, Height
);
528 if (mMovingSpeed
.X
< 0) then dx
:= nx
-(px
+pw
)
529 else if (mMovingSpeed
.X
> 0) then dx
:= (nx
+Width
)-px
531 if (mMovingSpeed
.Y
< 0) then dy
:= ny
-(py
+ph
)
532 else if (mMovingSpeed
.Y
> 0) then dy
:= (ny
+Height
)-py
542 function monMove (mon
: TMonster
): Boolean;
544 result
:= false; // don't stop
545 //mon.GameX := mon.GameX+mMovingSpeed.X;
546 //mon.GameY := mon.GameY+mMovingSpeed.Y;
547 mon
.setPosition(mon
.GameX
+mMovingSpeed
.X
, mon
.GameY
+mMovingSpeed
.Y
, false); // we can't call `positionChanged()` in grid callback
548 if (monMoveListUsed
>= Length(monMoveList
)) then SetLength(monMoveList
, monMoveListUsed
+64);
549 monMoveList
[monMoveListUsed
] := mon
;
550 Inc(monMoveListUsed
);
553 function monPush (mon
: TMonster
): Boolean;
555 px
, py
, pw
, ph
, dx
, dy
: Integer;
557 result
:= false; // don't stop
558 mon
.getMapBox(px
, py
, pw
, ph
);
559 if doPush(px
, py
, pw
, ph
, dx
, dy
) then
561 //mon.GameX := mon.GameX+dx;
562 //mon.GameY := mon.GameY+dy;
563 mon
.setPosition(mon
.GameX
+dx
, mon
.GameY
+dy
, false); // we can't call `positionChanged()` in grid callback
564 if (monMoveListUsed
>= Length(monMoveList
)) then SetLength(monMoveList
, monMoveListUsed
+64);
565 monMoveList
[monMoveListUsed
] := mon
;
566 Inc(monMoveListUsed
);
570 procedure plrMove (plr
: TPlayer
);
572 px
, py
, pw
, ph
, dx
, dy
: Integer;
574 // dead players leaves separate body entities, so don't move 'em
575 if (plr
= nil) or not plr
.alive
then exit
;
576 plr
.getMapBox(px
, py
, pw
, ph
);
580 if doPush(px
, py
, pw
, ph
, dx
, dy
) then
582 plr
.GameX
:= plr
.GameX
+dx
;
583 plr
.GameY
:= plr
.GameY
+dy
;
584 plr
.positionChanged();
585 // check if we're squashed
588 plr
.getMapBox(px
, py
, pw
, ph
);
589 if g_Map_CollidePanel(px
, py
, pw
, ph
, (PANEL_WALL
or PANEL_OPENDOOR
or PANEL_CLOSEDOOR
)) then
591 plr
.Damage(15000, 0, 0, 0, HIT_TRAP
);
597 if (px
+pw
<= X
) then exit
;
598 if (px
>= X
+Width
) then exit
;
599 plr
.GameX
:= plr
.GameX
+mMovingSpeed
.X
;
600 plr
.GameY
:= plr
.GameY
+mMovingSpeed
.Y
;
601 plr
.positionChanged();
604 procedure gibMove (gib
: PGib
);
606 px
, py
, pw
, ph
, dx
, dy
: Integer;
608 if (gib
= nil) or not gib
.alive
then exit
;
609 gib
.getMapBox(px
, py
, pw
, ph
);
611 writeln('gib: p=(', px, ',', py, '); obj=(', gib.Obj.X, ',', gib.Obj.Y, ')');
618 if doPush(px
, py
, pw
, ph
, dx
, dy
) then
622 gib
.positionChanged();
626 if (px
+pw
<= X
) then exit
;
627 if (px
>= X
+Width
) then exit
;
628 gib
.Obj
.X
+= mMovingSpeed
.X
;
629 gib
.Obj
.Y
+= mMovingSpeed
.Y
;
630 gib
.positionChanged();
633 procedure corpseMove (cor
: TCorpse
);
635 px
, py
, pw
, ph
, dx
, dy
: Integer;
637 if (cor
= nil) then exit
;
638 cor
.getMapBox(px
, py
, pw
, ph
);
642 if doPush(px
, py
, pw
, ph
, dx
, dy
) then
644 cor
.moveBy(dx
, dy
); // will call `positionChanged()` for us
648 if (px
+pw
<= X
) then exit
;
649 if (px
>= X
+Width
) then exit
;
650 cor
.moveBy(mMovingSpeed
.X
, mMovingSpeed
.Y
); // will call `positionChanged()` for us
656 px
, py
, pw
, ph
: Integer;
658 if Enabled
and (FCurTexture
>= 0) and
659 (FTextureIDs
[FCurTexture
].Anim
) and
660 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
661 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
663 FTextureIDs
[FCurTexture
].AnTex
.Update();
664 FCurFrame
:= FTextureIDs
[FCurTexture
].AnTex
.CurrentFrame
;
665 FCurFrameCount
:= FTextureIDs
[FCurTexture
].AnTex
.CurrentCounter
;
668 if mMovingActive
and (not mMovingSpeed
.isZero
) and g_dbgpan_mplat_active
then
670 monMoveListUsed
:= 0;
671 nx
:= X
+mMovingSpeed
.X
;
672 ny
:= Y
+mMovingSpeed
.Y
;
673 // move monsters on lifts
674 g_Mons_ForEachAt(X
, Y
-1, Width
, 1, monMove
);
680 g_Mons_ForEachAt(nx
, ny
, Width
, Height
, monPush
);
681 // move and push players
682 for f
:= 0 to High(gPlayers
) do plrMove(gPlayers
[f
]);
683 // move and push gibs
684 for f
:= 0 to High(gGibs
) do gibMove(@gGibs
[f
]);
685 // move and push corpses
686 for f
:= 0 to High(gCorpses
) do corpseMove(gCorpses
[f
]);
687 // reverse moving direction, if necessary
688 if (mMovingSpeed
.X
< 0) and (nx
<= mMovingStart
.X
) then mMovingSpeed
.X
:= -mMovingSpeed
.X
689 else if (mMovingSpeed
.X
> 0) and (nx
>= mMovingEnd
.X
) then mMovingSpeed
.X
:= -mMovingSpeed
.X
;
690 if (mMovingSpeed
.Y
< 0) and (ny
<= mMovingStart
.Y
) then mMovingSpeed
.Y
:= -mMovingSpeed
.Y
691 else if (mMovingSpeed
.Y
> 0) and (ny
>= mMovingEnd
.Y
) then mMovingSpeed
.Y
:= -mMovingSpeed
.Y
;
692 // notify moved monsters about their movement
693 for f
:= 0 to monMoveListUsed
-1 do
695 monMoveList
[f
].positionChanged();
697 for f
:= 0 to monMoveListUsed
-1 do
699 mon
:= monMoveList
[f
];
700 // check if it is squashed
703 mon
.getMapBox(px
, py
, pw
, ph
);
704 if g_Map_CollidePanel(px
, py
, pw
, ph
, (PANEL_WALL
or PANEL_OPENDOOR
or PANEL_CLOSEDOOR
)) then
706 mon
.Damage(15000, 0, 0, 0, HIT_TRAP
);
713 procedure TPanel
.SetFrame(Frame
: Integer; Count
: Byte);
715 function ClampInt(X
, A
, B
: Integer): Integer;
718 if X
< A
then Result
:= A
else if X
> B
then Result
:= B
;
722 if Enabled
and (FCurTexture
>= 0) and
723 (FTextureIDs
[FCurTexture
].Anim
) and
724 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
725 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
727 FCurFrame
:= ClampInt(Frame
, 0, FTextureIDs
[FCurTexture
].AnTex
.TotalFrames
);
728 FCurFrameCount
:= Count
;
729 FTextureIDs
[FCurTexture
].AnTex
.CurrentFrame
:= FCurFrame
;
730 FTextureIDs
[FCurTexture
].AnTex
.CurrentCounter
:= FCurFrameCount
;
734 procedure TPanel
.NextTexture(AnimLoop
: Byte = 0);
736 Assert(FCurTexture
>= -1, 'FCurTexture < -1');
739 if Length(FTextureIDs
) = 0 then
742 // Òîëüêî îäíà òåêñòóðà:
743 if Length(FTextureIDs
) = 1 then
745 if FCurTexture
= 0 then
751 // Áîëüøå îäíîé òåêñòóðû:
755 // Ñëåäóþùåé íåò - âîçâðàò ê íà÷àëó:
756 if FCurTexture
>= Length(FTextureIDs
) then
760 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
761 if (FCurTexture
>= 0) and FTextureIDs
[FCurTexture
].Anim
then
763 if (FTextureIDs
[FCurTexture
].AnTex
= nil) then
765 g_FatalError(_lc
[I_GAME_ERROR_SWITCH_TEXTURE
]);
770 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= True
773 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= False;
775 FTextureIDs
[FCurTexture
].AnTex
.Reset();
778 LastAnimLoop
:= AnimLoop
;
781 procedure TPanel
.SetTexture(ID
: Integer; AnimLoop
: Byte = 0);
784 if Length(FTextureIDs
) = 0 then
787 // Òîëüêî îäíà òåêñòóðà:
788 if Length(FTextureIDs
) = 1 then
790 if (ID
= 0) or (ID
= -1) then
794 // Áîëüøå îäíîé òåêñòóðû:
796 if (ID
>= -1) and (ID
<= High(FTextureIDs
)) then
800 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
801 if (FCurTexture
>= 0) and FTextureIDs
[FCurTexture
].Anim
then
803 if (FTextureIDs
[FCurTexture
].AnTex
= nil) then
805 g_FatalError(_lc
[I_GAME_ERROR_SWITCH_TEXTURE
]);
810 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= True
813 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= False;
815 FTextureIDs
[FCurTexture
].AnTex
.Reset();
818 LastAnimLoop
:= AnimLoop
;
821 function TPanel
.GetTextureID(): DWORD
;
823 Result
:= LongWord(TEXTURE_NONE
);
825 if (FCurTexture
>= 0) then
827 if FTextureIDs
[FCurTexture
].Anim
then
828 Result
:= FTextureIDs
[FCurTexture
].AnTex
.FramesID
830 Result
:= FTextureIDs
[FCurTexture
].Tex
;
834 function TPanel
.GetTextureCount(): Integer;
836 Result
:= Length(FTextureIDs
);
837 if Enabled
and (FCurTexture
>= 0) then
838 if (FTextureIDs
[FCurTexture
].Anim
) and
839 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
840 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
841 Result
:= Result
+ 100;
844 procedure TPanel
.SaveState(Var Mem
: TBinMemoryWriter
);
849 if (Mem
= nil) then exit
;
850 //if not SaveIt then exit;
853 sig
:= PANEL_SIGNATURE
; // 'PANL'
855 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
856 Mem
.WriteBoolean(FEnabled
);
857 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
858 Mem
.WriteByte(FLiftType
);
859 // Íîìåð òåêóùåé òåêñòóðû:
860 Mem
.WriteInt(FCurTexture
);
864 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
865 if (FCurTexture
>= 0) and (FTextureIDs
[FCurTexture
].Anim
) then
867 Assert(FTextureIDs
[FCurTexture
].AnTex
<> nil,
868 'TPanel.SaveState: No animation object');
873 Mem
.WriteBoolean(anim
);
874 // Åñëè äà - ñîõðàíÿåì àíèìàöèþ:
876 FTextureIDs
[FCurTexture
].AnTex
.SaveState(Mem
);
877 // moving platform state
878 Mem
.WriteInt(mMovingSpeed
.X
);
879 Mem
.WriteInt(mMovingSpeed
.Y
);
880 Mem
.WriteInt(mMovingStart
.X
);
881 Mem
.WriteInt(mMovingStart
.Y
);
882 Mem
.WriteInt(mMovingEnd
.X
);
883 Mem
.WriteInt(mMovingEnd
.Y
);
884 Mem
.WriteBoolean(mMovingActive
);
887 procedure TPanel
.LoadState(var Mem
: TBinMemoryReader
);
893 if (Mem
= nil) then exit
;
894 //if not SaveIt then exit;
898 if sig
<> PANEL_SIGNATURE
then // 'PANL'
900 raise EBinSizeError
.Create('TPanel.LoadState: Wrong Panel Signature');
902 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
903 Mem
.ReadBoolean(FEnabled
);
904 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
905 Mem
.ReadByte(FLiftType
);
906 // Íîìåð òåêóùåé òåêñòóðû:
907 Mem
.ReadInt(FCurTexture
);
913 //e_LogWritefln('panel %s(%s): old=(%s,%s); new=(%s,%s); delta=(%s,%s)', [arrIdx, proxyId, ox, oy, FX, FY, FX-ox, FY-oy]);
914 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
915 Mem
.ReadBoolean(anim
);
916 // Åñëè äà - çàãðóæàåì àíèìàöèþ:
919 Assert((FCurTexture
>= 0) and
920 (FTextureIDs
[FCurTexture
].Anim
) and
921 (FTextureIDs
[FCurTexture
].AnTex
<> nil),
922 'TPanel.LoadState: No animation object');
923 FTextureIDs
[FCurTexture
].AnTex
.LoadState(Mem
);
925 // moving platform state
926 Mem
.ReadInt(mMovingSpeed
.X
);
927 Mem
.ReadInt(mMovingSpeed
.Y
);
928 Mem
.ReadInt(mMovingStart
.X
);
929 Mem
.ReadInt(mMovingStart
.Y
);
930 Mem
.ReadInt(mMovingEnd
.X
);
931 Mem
.ReadInt(mMovingEnd
.Y
);
932 Mem
.ReadBoolean(mMovingActive
);
935 //mapGrid.proxyEnabled[proxyId] := FEnabled; // done in g_map.pas