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, version 3 of the License ONLY.
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 {$INCLUDE ../shared/a_modes.inc}
23 MAPDEF
, g_textures
, xdynrec
;
26 TAddTextureArray
= Array of
33 TPanel
= Class (TObject
)
37 mGUID
: Integer; // will be assigned in "g_map.pas"
45 False: (Tex
: Cardinal);
46 True: (AnTex
: TAnimation
);
49 mMovingSpeed
: TDFPoint
;
50 mMovingStart
: TDFPoint
;
52 mMovingActive
: Boolean;
55 mOldMovingActive
: Boolean;
61 mEndSizeTrig
: Integer;
63 mNeedSend
: Boolean; // for network
66 function getx1 (): Integer; inline;
67 function gety1 (): Integer; inline;
68 function getvisvalid (): Boolean; inline;
70 function getMovingSpeedX (): Integer; inline;
71 procedure setMovingSpeedX (v
: Integer); inline;
72 function getMovingSpeedY (): Integer; inline;
73 procedure setMovingSpeedY (v
: Integer); inline;
75 function getMovingStartX (): Integer; inline;
76 procedure setMovingStartX (v
: Integer); inline;
77 function getMovingStartY (): Integer; inline;
78 procedure setMovingStartY (v
: Integer); inline;
80 function getMovingEndX (): Integer; inline;
81 procedure setMovingEndX (v
: Integer); inline;
82 function getMovingEndY (): Integer; inline;
83 procedure setMovingEndY (v
: Integer); inline;
85 function getSizeSpeedX (): Integer; inline;
86 procedure setSizeSpeedX (v
: Integer); inline;
87 function getSizeSpeedY (): Integer; inline;
88 procedure setSizeSpeedY (v
: Integer); inline;
90 function getSizeEndX (): Integer; inline;
91 procedure setSizeEndX (v
: Integer); inline;
92 function getSizeEndY (): Integer; inline;
93 procedure setSizeEndY (v
: Integer); inline;
96 FCurTexture
: Integer; // Íîìåð òåêóùåé òåêñòóðû
100 FOldX
, FOldY
: Integer;
101 FWidth
, FHeight
: Word;
108 // sorry, there fields are public to allow setting 'em in g_map; this should be fixed later
109 // for now, PLEASE, don't modify 'em, or all hell will break loose
110 arrIdx
: Integer; // index in one of internal arrays; sorry
111 tag
: Integer; // used in coldets and such; sorry; see g_map.GridTagXXX
112 proxyId
: Integer; // proxy id in map grid (DO NOT USE!)
113 mapId
: AnsiString; // taken directly from map file; dunno why it is here
114 hasTexTrigger
: Boolean; // HACK: true when there's a trigger than can change my texture
116 constructor Create(PanelRec
: TDynRecord
;
117 AddTextures
: TAddTextureArray
;
119 var Textures
: TLevelTextureArray
; aguid
: Integer);
120 destructor Destroy(); override;
122 procedure Draw (hasAmbient
: Boolean; constref ambColor
: TDFColor
);
123 procedure DrawShadowVolume(lightX
: Integer; lightY
: Integer; radius
: Integer);
125 procedure SetFrame(Frame
: Integer; Count
: Byte);
126 procedure NextTexture(AnimLoop
: Byte = 0);
127 procedure SetTexture(ID
: Integer; AnimLoop
: Byte = 0);
128 function GetTextureID(): Cardinal;
129 function GetTextureCount(): Integer;
130 function CanChangeTexture(): Boolean;
132 procedure SaveState (st
: TStream
);
133 procedure LoadState (st
: TStream
);
135 procedure positionChanged (); inline;
137 function getIsGBack (): Boolean; inline; // gRenderBackgrounds
138 function getIsGStep (): Boolean; inline; // gSteps
139 function getIsGWall (): Boolean; inline; // gWalls
140 function getIsGAcid1 (): Boolean; inline; // gAcid1
141 function getIsGAcid2 (): Boolean; inline; // gAcid2
142 function getIsGWater (): Boolean; inline; // gWater
143 function getIsGFore (): Boolean; inline; // gRenderForegrounds
144 function getIsGLift (): Boolean; inline; // gLifts
145 function getIsGBlockMon (): Boolean; inline; // gBlockMon
148 function gncNeedSend (): Boolean; inline;
149 procedure setDirty (); inline; // why `dirty`? 'cause i may introduce property `needSend` later
151 procedure lerp (t
: Single; out tX
, tY
, tW
, tH
: Integer);
154 property visvalid
: Boolean read getvisvalid
; // panel is "visvalid" when it's width and height are positive
157 property guid
: Integer read mGUID
; // will be assigned in "g_map.pas"
158 property x0
: Integer read FX
;
159 property y0
: Integer read FY
;
160 property x1
: Integer read getx1
; // inclusive!
161 property y1
: Integer read gety1
; // inclusive!
162 property x
: Integer read FX write FX
;
163 property y
: Integer read FY write FY
;
164 property width
: Word read FWidth write FWidth
;
165 property height
: Word read FHeight write FHeight
;
166 property panelType
: Word read FPanelType write FPanelType
;
167 property enabled
: Boolean read FEnabled write FEnabled
;
168 property door
: Boolean read FDoor write FDoor
;
169 property liftType
: Byte read FLiftType write FLiftType
;
170 property lastAnimLoop
: Byte read FLastAnimLoop write FLastAnimLoop
;
172 property movingSpeedX
: Integer read getMovingSpeedX write setMovingSpeedX
;
173 property movingSpeedY
: Integer read getMovingSpeedY write setMovingSpeedY
;
174 property movingStartX
: Integer read getMovingStartX write setMovingStartX
;
175 property movingStartY
: Integer read getMovingStartY write setMovingStartY
;
176 property movingEndX
: Integer read getMovingEndX write setMovingEndX
;
177 property movingEndY
: Integer read getMovingEndY write setMovingEndY
;
178 property movingActive
: Boolean read mMovingActive write mMovingActive
;
179 property moveOnce
: Boolean read mMoveOnce write mMoveOnce
;
181 property sizeSpeedX
: Integer read getSizeSpeedX write setSizeSpeedX
;
182 property sizeSpeedY
: Integer read getSizeSpeedY write setSizeSpeedY
;
183 property sizeEndX
: Integer read getSizeEndX write setSizeEndX
;
184 property sizeEndY
: Integer read getSizeEndY write setSizeEndY
;
186 property isGBack
: Boolean read getIsGBack
;
187 property isGStep
: Boolean read getIsGStep
;
188 property isGWall
: Boolean read getIsGWall
;
189 property isGAcid1
: Boolean read getIsGAcid1
;
190 property isGAcid2
: Boolean read getIsGAcid2
;
191 property isGWater
: Boolean read getIsGWater
;
192 property isGFore
: Boolean read getIsGFore
;
193 property isGLift
: Boolean read getIsGLift
;
194 property isGBlockMon
: Boolean read getIsGBlockMon
;
197 property movingSpeed
: TDFPoint read mMovingSpeed write mMovingSpeed
;
198 property movingStart
: TDFPoint read mMovingStart write mMovingStart
;
199 property movingEnd
: TDFPoint read mMovingEnd write mMovingEnd
;
201 property sizeSpeed
: TDFSize read mSizeSpeed write mSizeSpeed
;
202 property sizeEnd
: TDFSize read mSizeEnd write mSizeEnd
;
204 property endPosTrigId
: Integer read mEndPosTrig write mEndPosTrig
;
205 property endSizeTrigId
: Integer read mEndSizeTrig write mEndSizeTrig
;
208 TPanelArray
= Array of TPanel
;
217 g_dbgpan_mplat_active
: Boolean = {$IF DEFINED(D2F_DEBUG)}true{$ELSE}true{$ENDIF};
218 g_dbgpan_mplat_step
: Boolean = false; // one step, and stop
224 {$INCLUDE ../nogl/noGLuses.inc}
225 e_texture
, g_basic
, g_map
, g_game
, g_gfx
, e_graphics
, g_weapons
, g_triggers
, g_items
,
226 g_console
, g_language
, g_monsters
, g_player
, g_grid
, e_log
, geom
, utils
, xstreams
;
229 PANEL_SIGNATURE
= $4C4E4150; // 'PANL'
233 constructor TPanel
.Create(PanelRec
: TDynRecord
;
234 AddTextures
: TAddTextureArray
;
236 var Textures
: TLevelTextureArray
; aguid
: Integer);
245 Width
:= PanelRec
.Width
;
246 Height
:= PanelRec
.Height
;
255 mapId
:= PanelRec
.id
;
258 mMovingSpeed
:= PanelRec
.moveSpeed
;
259 mMovingStart
:= PanelRec
.moveStart
;
260 mMovingEnd
:= PanelRec
.moveEnd
;
261 mMovingActive
:= PanelRec
['move_active'].value
;
262 mOldMovingActive
:= mMovingActive
;
263 mMoveOnce
:= PanelRec
.moveOnce
;
265 mSizeSpeed
:= PanelRec
.sizeSpeed
;
266 mSizeEnd
:= PanelRec
.sizeEnd
;
268 mEndPosTrig
:= PanelRec
.endPosTrig
;
269 mEndSizeTrig
:= PanelRec
.endSizeTrig
;
274 PanelType
:= PanelRec
.PanelType
;
277 LiftType
:= LIFTTYPE_UP
;
278 hasTexTrigger
:= False;
281 PANEL_OPENDOOR
: begin Enabled
:= False; Door
:= True; end;
282 PANEL_CLOSEDOOR
: Door
:= True;
283 PANEL_LIFTUP
: LiftType
:= LIFTTYPE_UP
; //???
284 PANEL_LIFTDOWN
: LiftType
:= LIFTTYPE_DOWN
;
285 PANEL_LIFTLEFT
: LiftType
:= LIFTTYPE_LEFT
;
286 PANEL_LIFTRIGHT
: LiftType
:= LIFTTYPE_RIGHT
;
290 if ByteBool(PanelRec
.Flags
and PANEL_FLAG_HIDE
) then
292 SetLength(FTextureIDs
, 0);
296 // Ïàíåëè, íå èñïîëüçóþùèå òåêñòóðû:
297 if ByteBool(PanelType
and
302 PANEL_BLOCKMON
)) then
304 SetLength(FTextureIDs
, 0);
309 // Åñëè ýòî æèäêîñòü áåç òåêñòóðû - ñïåöòåêñòóðó:
310 if WordBool(PanelType
and (PANEL_WATER
or PANEL_ACID1
or PANEL_ACID2
)) and
311 (not ByteBool(PanelRec
.Flags
and PANEL_FLAG_WATERTEXTURES
)) then
313 SetLength(FTextureIDs
, 1);
314 FTextureIDs
[0].Anim
:= False;
316 case PanelRec
.PanelType
of
318 FTextureIDs
[0].Tex
:= LongWord(TEXTURE_SPECIAL_WATER
);
320 FTextureIDs
[0].Tex
:= LongWord(TEXTURE_SPECIAL_ACID1
);
322 FTextureIDs
[0].Tex
:= LongWord(TEXTURE_SPECIAL_ACID2
);
329 SetLength(FTextureIDs
, Length(AddTextures
));
334 if CurTex
>= Length(FTextureIDs
) then
335 FCurTexture
:= Length(FTextureIDs
) - 1
337 FCurTexture
:= CurTex
;
339 for i
:= 0 to Length(FTextureIDs
)-1 do
341 FTextureIDs
[i
].Anim
:= AddTextures
[i
].Anim
;
342 if FTextureIDs
[i
].Anim
then
343 begin // Àíèìèðîâàííàÿ òåêñòóðà
344 FTextureIDs
[i
].AnTex
:=
345 TAnimation
.Create(Textures
[AddTextures
[i
].Texture
].FramesID
,
346 True, Textures
[AddTextures
[i
].Texture
].Speed
);
347 FTextureIDs
[i
].AnTex
.Blending
:= ByteBool(PanelRec
.Flags
and PANEL_FLAG_BLENDING
);
348 FTextureIDs
[i
].AnTex
.Alpha
:= PanelRec
.Alpha
;
351 begin // Îáû÷íàÿ òåêñòóðà
352 FTextureIDs
[i
].Tex
:= Textures
[AddTextures
[i
].Texture
].TextureID
;
356 // Òåêñòóð íåñêîëüêî - íóæíî ñîõðàíÿòü òåêóùóþ:
357 //if Length(FTextureIDs) > 1 then SaveIt := True;
359 if (PanelRec
.TextureRec
= nil) then tnum
:= -1 else tnum
:= PanelRec
.tagInt
;
360 if (tnum
< 0) then tnum
:= Length(Textures
);
362 // Åñëè íå ñïåöòåêñòóðà, òî çàäàåì ðàçìåðû:
363 if ({PanelRec.TextureNum}tnum
> High(Textures
)) then
365 e_WriteLog(Format('WTF?! tnum is out of limits! (%d : %d)', [tnum
, High(Textures
)]), TMsgType
.Warning
);
369 FBlending
:= ByteBool(0);
371 else if not g_Map_IsSpecialTexture(Textures
[{PanelRec.TextureNum}tnum
].TextureName
) then
373 FTextureWidth
:= Textures
[{PanelRec.TextureNum}tnum
].Width
;
374 FTextureHeight
:= Textures
[{PanelRec.TextureNum}tnum
].Height
;
375 FAlpha
:= PanelRec
.Alpha
;
376 FBlending
:= ByteBool(PanelRec
.Flags
and PANEL_FLAG_BLENDING
);
380 destructor TPanel
.Destroy();
384 for i
:= 0 to High(FTextureIDs
) do
385 if FTextureIDs
[i
].Anim
then
386 FTextureIDs
[i
].AnTex
.Free();
387 SetLength(FTextureIDs
, 0);
392 procedure TPanel
.lerp (t
: Single; out tX
, tY
, tW
, tH
: Integer);
394 if mMovingActive
then
396 tX
:= nlerp(FOldX
, FX
, t
);
397 tY
:= nlerp(FOldY
, FY
, t
);
398 tW
:= nlerp(FOldW
, FWidth
, t
);
399 tH
:= nlerp(FOldH
, FHeight
, t
);
410 function TPanel
.getx1 (): Integer; inline; begin result
:= X
+Width
-1; end;
411 function TPanel
.gety1 (): Integer; inline; begin result
:= Y
+Height
-1; end;
412 function TPanel
.getvisvalid (): Boolean; inline; begin result
:= (Width
> 0) and (Height
> 0); end;
414 function TPanel
.getMovingSpeedX (): Integer; inline; begin result
:= mMovingSpeed
.X
; end;
415 procedure TPanel
.setMovingSpeedX (v
: Integer); inline; begin mMovingSpeed
.X
:= v
; end;
416 function TPanel
.getMovingSpeedY (): Integer; inline; begin result
:= mMovingSpeed
.Y
; end;
417 procedure TPanel
.setMovingSpeedY (v
: Integer); inline; begin mMovingSpeed
.Y
:= v
; end;
419 function TPanel
.getMovingStartX (): Integer; inline; begin result
:= mMovingStart
.X
; end;
420 procedure TPanel
.setMovingStartX (v
: Integer); inline; begin mMovingStart
.X
:= v
; end;
421 function TPanel
.getMovingStartY (): Integer; inline; begin result
:= mMovingStart
.Y
; end;
422 procedure TPanel
.setMovingStartY (v
: Integer); inline; begin mMovingStart
.Y
:= v
; end;
424 function TPanel
.getMovingEndX (): Integer; inline; begin result
:= mMovingEnd
.X
; end;
425 procedure TPanel
.setMovingEndX (v
: Integer); inline; begin mMovingEnd
.X
:= v
; end;
426 function TPanel
.getMovingEndY (): Integer; inline; begin result
:= mMovingEnd
.Y
; end;
427 procedure TPanel
.setMovingEndY (v
: Integer); inline; begin mMovingEnd
.Y
:= v
; end;
429 function TPanel
.getSizeSpeedX (): Integer; inline; begin result
:= mSizeSpeed
.w
; end;
430 procedure TPanel
.setSizeSpeedX (v
: Integer); inline; begin mSizeSpeed
.w
:= v
; end;
431 function TPanel
.getSizeSpeedY (): Integer; inline; begin result
:= mSizeSpeed
.h
; end;
432 procedure TPanel
.setSizeSpeedY (v
: Integer); inline; begin mSizeSpeed
.h
:= v
; end;
434 function TPanel
.getSizeEndX (): Integer; inline; begin result
:= mSizeEnd
.w
; end;
435 procedure TPanel
.setSizeEndX (v
: Integer); inline; begin mSizeEnd
.w
:= v
; end;
436 function TPanel
.getSizeEndY (): Integer; inline; begin result
:= mSizeEnd
.h
; end;
437 procedure TPanel
.setSizeEndY (v
: Integer); inline; begin mSizeEnd
.h
:= v
; end;
439 function TPanel
.getIsGBack (): Boolean; inline; begin result
:= ((tag
and GridTagBack
) <> 0); end;
440 function TPanel
.getIsGStep (): Boolean; inline; begin result
:= ((tag
and GridTagStep
) <> 0); end;
441 function TPanel
.getIsGWall (): Boolean; inline; begin result
:= ((tag
and (GridTagWall
or GridTagDoor
)) <> 0); end;
442 function TPanel
.getIsGAcid1 (): Boolean; inline; begin result
:= ((tag
and GridTagAcid1
) <> 0); end;
443 function TPanel
.getIsGAcid2 (): Boolean; inline; begin result
:= ((tag
and GridTagAcid2
) <> 0); end;
444 function TPanel
.getIsGWater (): Boolean; inline; begin result
:= ((tag
and GridTagWater
) <> 0); end;
445 function TPanel
.getIsGFore (): Boolean; inline; begin result
:= ((tag
and GridTagFore
) <> 0); end;
446 function TPanel
.getIsGLift (): Boolean; inline; begin result
:= ((tag
and GridTagLift
) <> 0); end;
447 function TPanel
.getIsGBlockMon (): Boolean; inline; begin result
:= ((tag
and GridTagBlockMon
) <> 0); end;
449 function TPanel
.gncNeedSend (): Boolean; inline; begin result
:= mNeedSend
; mNeedSend
:= false; end;
450 procedure TPanel
.setDirty (); inline; begin mNeedSend
:= true; end;
453 procedure TPanel
.Draw (hasAmbient
: Boolean; constref ambColor
: TDFColor
);
455 tx
, ty
, tw
, th
: Integer;
460 if {Enabled and} (FCurTexture
>= 0) and
461 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) {and
462 g_Collide(X, Y, Width, Height, sX, sY, sWidth, sHeight)} then
464 lerp(gLerpFactor
, tx
, ty
, tw
, th
);
465 if FTextureIDs
[FCurTexture
].Anim
then
466 begin // Àíèìèðîâàííàÿ òåêñòóðà
467 if FTextureIDs
[FCurTexture
].AnTex
= nil then
470 for xx
:= 0 to (tw
div FTextureWidth
)-1 do
471 for yy
:= 0 to (th
div FTextureHeight
)-1 do
472 FTextureIDs
[FCurTexture
].AnTex
.Draw(
473 tx
+ xx
*FTextureWidth
,
474 ty
+ yy
*FTextureHeight
, TMirrorType
.None
);
477 begin // Îáû÷íàÿ òåêñòóðà
478 case FTextureIDs
[FCurTexture
].Tex
of
479 LongWord(TEXTURE_SPECIAL_WATER
): e_DrawFillQuad(tx
, ty
, tx
+tw
-1, ty
+th
-1, 0, 0, 255, 0, TBlending
.Filter
);
480 LongWord(TEXTURE_SPECIAL_ACID1
): e_DrawFillQuad(tx
, ty
, tx
+tw
-1, ty
+th
-1, 0, 230, 0, 0, TBlending
.Filter
);
481 LongWord(TEXTURE_SPECIAL_ACID2
): e_DrawFillQuad(tx
, ty
, tx
+tw
-1, ty
+th
-1, 230, 0, 0, 0, TBlending
.Filter
);
482 LongWord(TEXTURE_NONE
):
483 if g_Texture_Get('NOTEXTURE', NoTextureID
) then
485 e_GetTextureSize(NoTextureID
, @NW
, @NH
);
486 e_DrawFill(NoTextureID
, tx
, ty
, tw
div NW
, th
div NH
, 0, False, False);
490 xx
:= tx
+ (tw
div 2);
491 yy
:= ty
+ (th
div 2);
492 e_DrawFillQuad(tx
, ty
, xx
, yy
, 255, 0, 255, 0);
493 e_DrawFillQuad(xx
, ty
, tx
+tw
-1, yy
, 255, 255, 0, 0);
494 e_DrawFillQuad(tx
, yy
, xx
, ty
+th
-1, 255, 255, 0, 0);
495 e_DrawFillQuad(xx
, yy
, tx
+tw
-1, ty
+th
-1, 255, 0, 255, 0);
499 if not mMovingActive
then
500 e_DrawFill(FTextureIDs
[FCurTexture
].Tex
, tx
, ty
, tw
div FTextureWidth
, th
div FTextureHeight
, FAlpha
, True, FBlending
, hasAmbient
)
502 e_DrawFillX(FTextureIDs
[FCurTexture
].Tex
, tx
, ty
, tw
, th
, FAlpha
, True, FBlending
, g_dbg_scale
, hasAmbient
);
503 if hasAmbient
then e_AmbientQuad(tx
, ty
, tw
, th
, ambColor
.r
, ambColor
.g
, ambColor
.b
, ambColor
.a
);
510 procedure TPanel
.DrawShadowVolume(lightX
: Integer; lightY
: Integer; radius
: Integer);
512 tx
, ty
, tw
, th
: Integer;
514 procedure extrude (x
: Integer; y
: Integer);
516 glVertex2i(x
+(x
-lightX
)*500, y
+(y
-lightY
)*500);
517 //e_WriteLog(Format(' : (%d,%d)', [x+(x-lightX)*300, y+(y-lightY)*300]), MSG_WARNING);
520 procedure drawLine (x0
: Integer; y0
: Integer; x1
: Integer; y1
: Integer);
522 // does this side facing the light?
523 if ((x1
-x0
)*(lightY
-y0
)-(lightX
-x0
)*(y1
-y0
) >= 0) then exit
;
524 //e_WriteLog(Format('lightpan: (%d,%d)-(%d,%d)', [x0, y0, x1, y1]), MSG_WARNING);
525 // this edge is facing the light, extrude and draw it
533 if radius
< 4 then exit
;
534 if Enabled
and (FCurTexture
>= 0) and (Width
> 0) and (Height
> 0) and (FAlpha
< 255) {and
535 g_Collide(X, Y, tw, th, sX, sY, sWidth, sHeight)} then
537 lerp(gLerpFactor
, tx
, ty
, tw
, th
);
538 if not FTextureIDs
[FCurTexture
].Anim
then
540 case FTextureIDs
[FCurTexture
].Tex
of
541 LongWord(TEXTURE_SPECIAL_WATER
): exit
;
542 LongWord(TEXTURE_SPECIAL_ACID1
): exit
;
543 LongWord(TEXTURE_SPECIAL_ACID2
): exit
;
544 LongWord(TEXTURE_NONE
): exit
;
547 if (tx
+tw
< lightX
-radius
) then exit
;
548 if (ty
+th
< lightY
-radius
) then exit
;
549 if (tx
> lightX
+radius
) then exit
;
550 if (ty
> lightY
+radius
) then exit
;
551 //e_DrawFill(FTextureIDs[FCurTexture].Tex, X, Y, tw div FTextureWidth, th div FTextureHeight, FAlpha, True, FBlending);
554 drawLine(tx
, ty
, tx
+tw
, ty
); // top
555 drawLine(tx
+tw
, ty
, tx
+tw
, ty
+th
); // right
556 drawLine(tx
+tw
, ty
+th
, tx
, ty
+th
); // bottom
557 drawLine(tx
, ty
+th
, tx
, ty
); // left
563 procedure TPanel
.positionChanged (); inline;
565 px
, py
, pw
, ph
: Integer;
567 if (proxyId
>= 0) then
569 mapGrid
.getBodyDims(proxyId
, px
, py
, pw
, ph
);
570 if (px
<> x
) or (py
<> y
) or (pw
<> Width
) or (ph
<> Height
) then
573 e_LogWritefln('panel moved: arridx=%s; guid=%s; proxyid=%s; old:(%s,%s)-(%sx%s); new:(%s,%s)-(%sx%s)',
574 [arrIdx, mGUID, proxyId, px, py, pw, ph, x, y, width, height]);
576 g_Mark(px
, py
, pw
, ph
, MARK_WALL
, false);
577 if (Width
< 1) or (Height
< 1) then
579 mapGrid
.proxyEnabled
[proxyId
] := false;
583 mapGrid
.proxyEnabled
[proxyId
] := Enabled
;
584 if (pw
<> Width
) or (ph
<> Height
) then
586 //writeln('panel resize!');
587 mapGrid
.moveResizeBody(proxyId
, X
, Y
, Width
, Height
)
591 mapGrid
.moveBody(proxyId
, X
, Y
);
593 g_Mark(X
, Y
, Width
, Height
, MARK_WALL
);
601 monCheckList
: array of TMonster
= nil;
602 monCheckListUsed
: Integer = 0;
604 procedure TPanel
.Update();
607 nx
, ny
, nw
, nh
: Integer;
608 ex
, ey
, nex
, ney
: Integer;
612 // return `true` if we should move by dx,dy
613 function tryMPlatMove (px
, py
, pw
, ph
: Integer; out dx
, dy
: Integer; out squash
: Boolean; ontop
: PBoolean=nil): Boolean;
624 pdx
:= mMovingSpeed
.X
;
625 pdy
:= mMovingSpeed
.Y
;
626 // standing on the platform?
629 if (ontop
<> nil) then ontop
^ := true;
630 // yes, move with it; but skip steps (no need to process size change here, 'cause platform top cannot be changed with it)
631 mapGrid
.traceBox(tex
, tey
, px
, py
, pw
, ph
, pdx
, pdy
, (GridTagWall
or GridTagDoor
));
635 if (ontop
<> nil) then ontop
^ := false;
636 // not standing on the platform: trace platform to see if it hits the entity
637 // first, process size change (as we cannot sweeptest both move and size change)
638 // but we don't have to check for pushing if the panel is shrinking
641 if (szdx
> 0) or (szdy
> 0) then
643 // ignore shrinking dimension
644 if (szdx
< 0) then szdx
:= 0;
645 if (szdy
< 0) then szdy
:= 0;
646 // move platform by szd* back, and check for szd* movement
647 if sweepAABB(ox
-szdx
, oy
-szdy
, nw
, nh
, szdx
, szdy
, px
, py
, pw
, ph
, @u0
) then
649 // yes, platform hits the entity, push the entity in the resizing direction
650 u0
:= 1.0-u0
; // how much path left?
651 szdx
:= trunc(szdx
*u0
);
652 szdy
:= trunc(szdy
*u0
);
653 if (szdx
<> 0) or (szdy
<> 0) then
655 // has some path to go, trace the entity
656 trtag
:= (GridTagWall
or GridTagDoor
);
657 // if we're moving down, consider steps too
658 if (szdy
> 0) then trtag
:= trtag
or GridTagStep
;
659 mapGrid
.traceBox(tex
, tey
, px
, py
, pw
, ph
, szdx
, szdy
, trtag
);
663 // second, process platform movement, using te* as entity starting point
664 if sweepAABB(ox
, oy
, nw
, nh
, pdx
, pdy
, tex
, tey
, pw
, ph
, @u0
) then
666 //e_LogWritefln('T: platsweep; u0=%s; u1=%s; hedge=%s; sweepAABB(%s, %s, %s, %s, %s, %s, %s, %s, %s, %s)', [u0, u1, hedge, ox, oy, mpw, mph, pdx, pdy, px-1, py-1, pw+2, ph+2]);
667 // yes, platform hits the entity, push the entity in the direction of the platform
668 u0
:= 1.0-u0
; // how much path left?
669 pdx
:= trunc(pdx
*u0
);
670 pdy
:= trunc(pdy
*u0
);
671 //e_LogWritefln(' platsweep; uleft=%s; pd=(%s,%s)', [u0, pdx, pdy]);
672 if (pdx
<> 0) or (pdy
<> 0) then
674 // has some path to go, trace the entity
675 trtag
:= (GridTagWall
or GridTagDoor
);
676 // if we're moving down, consider steps too
677 if (pdy
> 0) then trtag
:= trtag
or GridTagStep
;
678 mapGrid
.traceBox(tex
, tey
, px
, py
, pw
, ph
, pdx
, pdy
, trtag
);
682 // done with entity movement, new coords are in te*
685 result
:= (dx
<> 0) or (dy
<> 0);
686 if not conveyor
and ((tag
and (GridTagWall
or GridTagDoor
)) <> 0) then
688 // check for squashing; as entity cannot be pushed into a wall, check only collision with the platform itself
689 squash
:= g_Collide(tex
, tey
, pw
, ph
, nx
, ny
, nw
, nh
); // squash, if still in platform
693 function monCollect (mon
: TMonster
): Boolean;
695 result
:= false; // don't stop
696 if (monCheckListUsed
>= Length(monCheckList
)) then SetLength(monCheckList
, monCheckListUsed
+128);
697 monCheckList
[monCheckListUsed
] := mon
;
698 Inc(monCheckListUsed
);
702 cx0
, cy0
, cx1
, cy1
, cw
, ch
: Integer;
704 px
, py
, pw
, ph
, pdx
, pdy
: Integer;
714 actMoveTrig
: Boolean;
715 actSizeTrig
: Boolean;
717 if (not Enabled
) or (Width
< 1) or (Height
< 1) then exit
;
719 if (FCurTexture
>= 0) and
720 (FTextureIDs
[FCurTexture
].Anim
) and
721 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
724 FTextureIDs
[FCurTexture
].AnTex
.Update();
725 FCurFrame
:= FTextureIDs
[FCurTexture
].AnTex
.CurrentFrame
;
726 FCurFrameCount
:= FTextureIDs
[FCurTexture
].AnTex
.CurrentCounter
;
729 if not g_dbgpan_mplat_active
then exit
;
731 if (mOldMovingActive
<> mMovingActive
) then mNeedSend
:= true;
732 mOldMovingActive
:= mMovingActive
;
734 if not mMovingActive
then exit
;
735 if mMovingSpeed
.isZero
and mSizeSpeed
.isZero
then exit
;
737 //TODO: write wall size change processing
742 * collect all monsters and players (aka entities) along the possible platform path
743 * if entity is standing on a platform:
744 * try to move it along the platform path, checking wall collisions
745 * if entity is NOT standing on a platform, but hit with sweeped platform aabb:
747 * if we can't push entity all the way, squash it
754 // the mplat acts as a stationary conveyor belt when it's locked within a movement rect of zero area
755 conveyor
:= (mMovingEnd
.X
= mMovingStart
.X
) and (mMovingEnd
.Y
= mMovingStart
.Y
)
756 and (mMovingEnd
.X
= X
) and (mMovingEnd
.Y
= Y
);
758 nw
:= mpw
+mSizeSpeed
.w
;
759 nh
:= mph
+mSizeSpeed
.h
;
764 nx
+= mMovingSpeed
.X
;
765 ny
+= mMovingSpeed
.Y
;
768 // force network updates only if some sudden change happened
769 // set the flag here, so we can sync affected monsters
770 if not mSizeSpeed
.isZero
and (nw
= mSizeEnd
.w
) and (nh
= mSizeEnd
.h
) then
774 else if ((mMovingSpeed
.X
< 0) and (nx
<= mMovingStart
.X
)) or ((mMovingSpeed
.X
> 0) and (nx
>= mMovingEnd
.X
)) then
778 else if ((mMovingSpeed
.Y
< 0) and (ny
<= mMovingStart
.Y
)) or ((mMovingSpeed
.Y
> 0) and (ny
>= mMovingEnd
.Y
)) then
783 // if pannel disappeared, we don't have to do anything
784 if (nw
> 0) and (nh
> 0) then
795 cx1
:= nmax(ex
, nex
);
796 cy1
:= nmax(ey
, ney
);
805 // process "obstacle" panels
806 if ((tag
and GridTagObstacle
) <> 0) then
808 // temporarily turn off this panel, so it won't interfere with collision checks
809 mapGrid
.proxyEnabled
[proxyId
] := false;
812 for f
:= 0 to High(gPlayers
) do
815 if (plr
= nil) or (not plr
.alive
) then continue
;
816 plr
.getMapBox(px
, py
, pw
, ph
);
817 if not g_Collide(px
, py
, pw
, ph
, cx0
, cy0
, cw
, ch
) then continue
;
818 if tryMPlatMove(px
, py
, pw
, ph
, pdx
, pdy
, squash
) then
821 plr
.moveBy(pdx
, pdy
); // this will call `positionChanged()` for us
823 // squash player, if necessary
824 if not g_Game_IsClient
and squash
then plr
.Damage(15000, 0, 0, 0, HIT_TRAP
);
828 for f
:= 0 to High(gGibs
) do
831 if not gib
.alive
then continue
;
832 gib
.getMapBox(px
, py
, pw
, ph
);
833 if not g_Collide(px
, py
, pw
, ph
, cx0
, cy0
, cw
, ch
) then continue
;
834 if tryMPlatMove(px
, py
, pw
, ph
, pdx
, pdy
, squash
, @ontop
) then
837 gib
.moveBy(pdx
, pdy
); // this will call `positionChanged()` for us
841 // move and push corpses
842 for f
:= 0 to High(gCorpses
) do
845 if (cor
= nil) then continue
;
846 cor
.getMapBox(px
, py
, pw
, ph
);
847 if not g_Collide(px
, py
, pw
, ph
, cx0
, cy0
, cw
, ch
) then continue
;
848 if tryMPlatMove(px
, py
, pw
, ph
, pdx
, pdy
, squash
, @ontop
) then
851 cor
.moveBy(pdx
, pdy
); // this will call `positionChanged()` for us
855 // move and push flags
856 if gGameSettings
.GameMode
= GM_CTF
then
857 for f
:= FLAG_RED
to FLAG_BLUE
do
860 if (flg
.State
in [FLAG_STATE_NONE
, FLAG_STATE_CAPTURED
]) then continue
;
861 px
:= flg
.Obj
.X
+flg
.Obj
.Rect
.X
;
862 py
:= flg
.Obj
.Y
+flg
.Obj
.Rect
.Y
;
863 pw
:= flg
.Obj
.Rect
.Width
;
864 ph
:= flg
.Obj
.Rect
.Height
;
865 if not g_Collide(px
, py
, pw
, ph
, cx0
, cy0
, cw
, ch
) then continue
;
866 if tryMPlatMove(px
, py
, pw
, ph
, pdx
, pdy
, squash
, @ontop
) then
867 if (pdx
<> 0) or (pdy
<> 0) then
869 flg
.Obj
.X
:= flg
.Obj
.X
+ pdx
;
870 flg
.Obj
.Y
:= flg
.Obj
.Y
+ pdy
;
871 flg
.NeedSend
:= true;
875 // move and push items
876 itm
:= g_Items_NextAlive(-1);
881 itm
.getMapBox(px
, py
, pw
, ph
);
882 if g_Collide(px
, py
, pw
, ph
, cx0
, cy0
, cw
, ch
) then
883 if tryMPlatMove(px
, py
, pw
, ph
, pdx
, pdy
, squash
, @ontop
) then
884 itm
.moveBy(pdx
, pdy
); // this will call `positionChanged()` for us
886 itm
:= g_Items_NextAlive(itm
.myId
);
890 monCheckListUsed
:= 0;
891 g_Mons_ForEachAt(cx0
, cy0
, cw
, ch
, monCollect
);
893 // process collected monsters
894 if (monCheckListUsed
> 0) then
896 mpfrid
:= g_Mons_getNewMPlatFrameId();
897 for f
:= 0 to monCheckListUsed
do
899 mon
:= monCheckList
[f
];
900 if (mon
= nil) or (not mon
.alive
) or (mon
.mplatCheckFrameId
= mpfrid
) then continue
;
901 mon
.mplatCheckFrameId
:= mpfrid
;
902 mon
.getMapBox(px
, py
, pw
, ph
);
903 //if not g_Collide(px, py, pw, ph, cx0, cy0, cw, ch) then continue;
904 if tryMPlatMove(px
, py
, pw
, ph
, pdx
, pdy
, squash
) then
907 mon
.moveBy(pdx
, pdy
); // this will call `positionChanged()` for us
908 //???FIXME: do we really need to send monsters over the net?
909 // i don't think so, as dead reckoning should take care of 'em
910 // ok, send new monster position only if platform is going to change it's direction
911 if mNeedSend
then mon
.setDirty();
913 // squash monster, if necessary
914 if not g_Game_IsClient
and squash
then mon
.Damage(15000, 0, 0, 0, HIT_TRAP
);
918 // restore panel state
919 mapGrid
.proxyEnabled
[proxyId
] := true;
934 actMoveTrig
:= false;
935 actSizeTrig
:= false;
937 // `mNeedSend` was set above
940 if not mSizeSpeed
.isZero
and (nw
= mSizeEnd
.w
) and (nh
= mSizeEnd
.h
) then
945 if (nw
< 1) or (nh
< 1) then mMovingActive
:= false; //HACK!
950 // reverse moving direction, if necessary
951 if ((mMovingSpeed
.X
< 0) and (nx
<= mMovingStart
.X
)) or ((mMovingSpeed
.X
> 0) and (nx
>= mMovingEnd
.X
)) then
953 if mMoveOnce
then mMovingActive
:= false else mMovingSpeed
.X
:= -mMovingSpeed
.X
;
957 if ((mMovingSpeed
.Y
< 0) and (ny
<= mMovingStart
.Y
)) or ((mMovingSpeed
.Y
> 0) and (ny
>= mMovingEnd
.Y
)) then
959 if mMoveOnce
then mMovingActive
:= false else mMovingSpeed
.Y
:= -mMovingSpeed
.Y
;
963 if (mOldMovingActive
<> mMovingActive
) then mNeedSend
:= true;
964 mOldMovingActive
:= mMovingActive
;
967 if not g_Game_IsClient
then
969 if actMoveTrig
then g_Triggers_Press(mEndPosTrig
, ACTIVATE_CUSTOM
);
970 if actSizeTrig
then g_Triggers_Press(mEndSizeTrig
, ACTIVATE_CUSTOM
);
973 // some triggers may activate this, don't delay sending
974 //TODO: when triggers will be able to control speed and size, check that here too
975 if (mOldMovingActive
<> mMovingActive
) then mNeedSend
:= true;
976 mOldMovingActive
:= mMovingActive
;
981 procedure TPanel
.SetFrame(Frame
: Integer; Count
: Byte);
983 function ClampInt(X
, A
, B
: Integer): Integer;
986 if X
< A
then Result
:= A
else if X
> B
then Result
:= B
;
990 if Enabled
and (FCurTexture
>= 0) and
991 (FTextureIDs
[FCurTexture
].Anim
) and
992 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
993 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
995 FCurFrame
:= ClampInt(Frame
, 0, FTextureIDs
[FCurTexture
].AnTex
.TotalFrames
- 1);
996 FCurFrameCount
:= Count
;
997 FTextureIDs
[FCurTexture
].AnTex
.CurrentFrame
:= FCurFrame
;
998 FTextureIDs
[FCurTexture
].AnTex
.CurrentCounter
:= FCurFrameCount
;
1002 procedure TPanel
.NextTexture(AnimLoop
: Byte = 0);
1004 Assert(FCurTexture
>= -1, 'FCurTexture < -1');
1007 if Length(FTextureIDs
) = 0 then
1010 // Òîëüêî îäíà òåêñòóðà:
1011 if Length(FTextureIDs
) = 1 then
1013 if FCurTexture
= 0 then
1019 // Áîëüøå îäíîé òåêñòóðû:
1023 // Ñëåäóþùåé íåò - âîçâðàò ê íà÷àëó:
1024 if FCurTexture
>= Length(FTextureIDs
) then
1028 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
1029 if (FCurTexture
>= 0) and FTextureIDs
[FCurTexture
].Anim
then
1031 if (FTextureIDs
[FCurTexture
].AnTex
= nil) then
1033 g_FatalError(_lc
[I_GAME_ERROR_SWITCH_TEXTURE
]);
1037 if AnimLoop
= 1 then
1038 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= True
1040 if AnimLoop
= 2 then
1041 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= False;
1043 FTextureIDs
[FCurTexture
].AnTex
.Reset();
1046 LastAnimLoop
:= AnimLoop
;
1049 procedure TPanel
.SetTexture(ID
: Integer; AnimLoop
: Byte = 0);
1051 if (ID
>= -1) and (ID
< Length(FTextureIDs
)) then
1054 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
1055 if (FCurTexture
>= 0) and FTextureIDs
[FCurTexture
].Anim
then
1057 if (FTextureIDs
[FCurTexture
].AnTex
= nil) then
1059 g_FatalError(_lc
[I_GAME_ERROR_SWITCH_TEXTURE
]);
1063 if AnimLoop
= 1 then
1064 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= True
1066 if AnimLoop
= 2 then
1067 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= False;
1069 FTextureIDs
[FCurTexture
].AnTex
.Reset();
1072 LastAnimLoop
:= AnimLoop
;
1075 function TPanel
.GetTextureID(): DWORD
;
1077 Result
:= LongWord(TEXTURE_NONE
);
1079 if (FCurTexture
>= 0) then
1081 if FTextureIDs
[FCurTexture
].Anim
then
1082 Result
:= FTextureIDs
[FCurTexture
].AnTex
.FramesID
1084 Result
:= FTextureIDs
[FCurTexture
].Tex
;
1088 function TPanel
.GetTextureCount(): Integer;
1090 Result
:= Length(FTextureIDs
);
1091 if Enabled
and (FCurTexture
>= 0) then
1092 if (FTextureIDs
[FCurTexture
].Anim
) and
1093 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
1094 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
1095 Result
:= Result
+ 100;
1098 function TPanel
.CanChangeTexture(): Boolean;
1100 Result
:= (GetTextureCount() > 1) or hasTexTrigger
;
1104 PAN_SAVE_VERSION
= 1;
1106 procedure TPanel
.SaveState (st
: TStream
);
1110 if (st
= nil) then exit
;
1113 utils
.writeSign(st
, 'PANL');
1114 utils
.writeInt(st
, Byte(PAN_SAVE_VERSION
));
1115 // Îòêðûòà/çàêðûòà, åñëè äâåðü
1116 utils
.writeBool(st
, FEnabled
);
1117 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò
1118 utils
.writeInt(st
, Byte(FLiftType
));
1119 // Íîìåð òåêóùåé òåêñòóðû
1120 utils
.writeInt(st
, Integer(FCurTexture
));
1121 // Êîîðäèíàòû è ðàçìåð
1122 utils
.writeInt(st
, Integer(FX
));
1123 utils
.writeInt(st
, Integer(FY
));
1124 utils
.writeInt(st
, Word(FWidth
));
1125 utils
.writeInt(st
, Word(FHeight
));
1126 // Àíèìèðîâàíà ëè òåêóùàÿ òåêñòóðà
1127 if (FCurTexture
>= 0) and (FTextureIDs
[FCurTexture
].Anim
) then
1129 assert(FTextureIDs
[FCurTexture
].AnTex
<> nil, 'TPanel.SaveState: No animation object');
1136 utils
.writeBool(st
, anim
);
1137 // Åñëè äà - ñîõðàíÿåì àíèìàöèþ
1138 if anim
then FTextureIDs
[FCurTexture
].AnTex
.SaveState(st
);
1140 // moving platform state
1141 utils
.writeInt(st
, Integer(mMovingSpeed
.X
));
1142 utils
.writeInt(st
, Integer(mMovingSpeed
.Y
));
1143 utils
.writeInt(st
, Integer(mMovingStart
.X
));
1144 utils
.writeInt(st
, Integer(mMovingStart
.Y
));
1145 utils
.writeInt(st
, Integer(mMovingEnd
.X
));
1146 utils
.writeInt(st
, Integer(mMovingEnd
.Y
));
1148 utils
.writeInt(st
, Integer(mSizeSpeed
.w
));
1149 utils
.writeInt(st
, Integer(mSizeSpeed
.h
));
1150 utils
.writeInt(st
, Integer(mSizeEnd
.w
));
1151 utils
.writeInt(st
, Integer(mSizeEnd
.h
));
1153 utils
.writeBool(st
, mMovingActive
);
1154 utils
.writeBool(st
, mMoveOnce
);
1156 utils
.writeInt(st
, Integer(mEndPosTrig
));
1157 utils
.writeInt(st
, Integer(mEndSizeTrig
));
1161 procedure TPanel
.LoadState (st
: TStream
);
1163 if (st
= nil) then exit
;
1166 if not utils
.checkSign(st
, 'PANL') then raise XStreamError
.create('wrong panel signature');
1167 if (utils
.readByte(st
) <> PAN_SAVE_VERSION
) then raise XStreamError
.create('wrong panel version');
1168 // Îòêðûòà/çàêðûòà, åñëè äâåðü
1169 FEnabled
:= utils
.readBool(st
);
1170 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò
1171 FLiftType
:= utils
.readByte(st
);
1172 // Íîìåð òåêóùåé òåêñòóðû
1173 FCurTexture
:= utils
.readLongInt(st
);
1174 // Êîîðäèíàòû è ðàçìåð
1175 FX
:= utils
.readLongInt(st
);
1176 FY
:= utils
.readLongInt(st
);
1179 FWidth
:= utils
.readWord(st
);
1180 FHeight
:= utils
.readWord(st
);
1183 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà
1184 if utils
.readBool(st
) then
1186 // Åñëè äà - çàãðóæàåì àíèìàöèþ
1187 Assert((FCurTexture
>= 0) and
1188 (FTextureIDs
[FCurTexture
].Anim
) and
1189 (FTextureIDs
[FCurTexture
].AnTex
<> nil),
1190 'TPanel.LoadState: No animation object');
1191 FTextureIDs
[FCurTexture
].AnTex
.LoadState(st
);
1194 // moving platform state
1195 mMovingSpeed
.X
:= utils
.readLongInt(st
);
1196 mMovingSpeed
.Y
:= utils
.readLongInt(st
);
1197 mMovingStart
.X
:= utils
.readLongInt(st
);
1198 mMovingStart
.Y
:= utils
.readLongInt(st
);
1199 mMovingEnd
.X
:= utils
.readLongInt(st
);
1200 mMovingEnd
.Y
:= utils
.readLongInt(st
);
1202 mSizeSpeed
.w
:= utils
.readLongInt(st
);
1203 mSizeSpeed
.h
:= utils
.readLongInt(st
);
1204 mSizeEnd
.w
:= utils
.readLongInt(st
);
1205 mSizeEnd
.h
:= utils
.readLongInt(st
);
1207 mMovingActive
:= utils
.readBool(st
);
1208 mMoveOnce
:= utils
.readBool(st
);
1210 mEndPosTrig
:= utils
.readLongInt(st
);
1211 mEndSizeTrig
:= utils
.readLongInt(st
);
1214 //mapGrid.proxyEnabled[proxyId] := FEnabled; // done in g_map.pas