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;
58 mEndSizeTrig
: Integer;
61 function getx1 (): Integer; inline;
62 function gety1 (): Integer; inline;
63 function getvisvalid (): Boolean; inline;
65 function getMovingSpeedX (): Integer; inline;
66 procedure setMovingSpeedX (v
: Integer); inline;
67 function getMovingSpeedY (): Integer; inline;
68 procedure setMovingSpeedY (v
: Integer); inline;
70 function getMovingStartX (): Integer; inline;
71 procedure setMovingStartX (v
: Integer); inline;
72 function getMovingStartY (): Integer; inline;
73 procedure setMovingStartY (v
: Integer); inline;
75 function getMovingEndX (): Integer; inline;
76 procedure setMovingEndX (v
: Integer); inline;
77 function getMovingEndY (): Integer; inline;
78 procedure setMovingEndY (v
: Integer); inline;
81 FCurTexture
: Integer; // Íîìåð òåêóùåé òåêñòóðû
85 FWidth
, FHeight
: Word;
87 FSaveIt
: Boolean; // Ñîõðàíÿòü ïðè SaveState?
93 // sorry, there fields are public to allow setting 'em in g_map; this should be fixed later
94 // for now, PLEASE, don't modify 'em, or all hell will break loose
95 arrIdx
: Integer; // index in one of internal arrays; sorry
96 tag
: Integer; // used in coldets and such; sorry; see g_map.GridTagXXX
97 proxyId
: Integer; // proxy id in map grid (DO NOT USE!)
98 mapId
: AnsiString; // taken directly from map file; dunno why it is here
100 constructor Create(PanelRec
: TDynRecord
;
101 AddTextures
: TAddTextureArray
;
103 var Textures
: TLevelTextureArray
; aguid
: Integer);
104 destructor Destroy(); override;
107 procedure DrawShadowVolume(lightX
: Integer; lightY
: Integer; radius
: Integer);
109 procedure SetFrame(Frame
: Integer; Count
: Byte);
110 procedure NextTexture(AnimLoop
: Byte = 0);
111 procedure SetTexture(ID
: Integer; AnimLoop
: Byte = 0);
112 function GetTextureID(): Cardinal;
113 function GetTextureCount(): Integer;
115 procedure SaveState(var Mem
: TBinMemoryWriter
);
116 procedure LoadState(var Mem
: TBinMemoryReader
);
118 procedure positionChanged (); inline;
120 function getIsGBack (): Boolean; inline; // gRenderBackgrounds
121 function getIsGStep (): Boolean; inline; // gSteps
122 function getIsGWall (): Boolean; inline; // gWalls
123 function getIsGAcid1 (): Boolean; inline; // gAcid1
124 function getIsGAcid2 (): Boolean; inline; // gAcid2
125 function getIsGWater (): Boolean; inline; // gWater
126 function getIsGFore (): Boolean; inline; // gRenderForegrounds
127 function getIsGLift (): Boolean; inline; // gLifts
128 function getIsGBlockMon (): Boolean; inline; // gBlockMon
131 property visvalid
: Boolean read getvisvalid
; // panel is "visvalid" when it's width and height are positive
134 property guid
: Integer read mGUID
; // will be assigned in "g_map.pas"
135 property x0
: Integer read FX
;
136 property y0
: Integer read FY
;
137 property x1
: Integer read getx1
; // inclusive!
138 property y1
: Integer read gety1
; // inclusive!
139 property x
: Integer read FX write FX
;
140 property y
: Integer read FY write FY
;
141 property width
: Word read FWidth write FWidth
;
142 property height
: Word read FHeight write FHeight
;
143 property panelType
: Word read FPanelType write FPanelType
;
144 property saveIt
: Boolean read FSaveIt write FSaveIt
; // Ñîõðàíÿòü ïðè SaveState?
145 property enabled
: Boolean read FEnabled write FEnabled
; // Ñîõðàíÿòü ïðè SaveState?
146 property door
: Boolean read FDoor write FDoor
; // Ñîõðàíÿòü ïðè SaveState?
147 property moved
: Boolean read FMoved write FMoved
; // Ñîõðàíÿòü ïðè SaveState?
148 property liftType
: Byte read FLiftType write FLiftType
; // Ñîõðàíÿòü ïðè SaveState?
149 property lastAnimLoop
: Byte read FLastAnimLoop write FLastAnimLoop
; // Ñîõðàíÿòü ïðè SaveState?
151 property movingSpeedX
: Integer read getMovingSpeedX write setMovingSpeedX
;
152 property movingSpeedY
: Integer read getMovingSpeedY write setMovingSpeedY
;
153 property movingStartX
: Integer read getMovingStartX write setMovingStartX
;
154 property movingStartY
: Integer read getMovingStartY write setMovingStartY
;
155 property movingEndX
: Integer read getMovingEndX write setMovingEndX
;
156 property movingEndY
: Integer read getMovingEndY write setMovingEndY
;
157 property movingActive
: Boolean read mMovingActive write mMovingActive
;
158 property moveOnce
: Boolean read mMoveOnce write mMoveOnce
;
160 property isGBack
: Boolean read getIsGBack
;
161 property isGStep
: Boolean read getIsGStep
;
162 property isGWall
: Boolean read getIsGWall
;
163 property isGAcid1
: Boolean read getIsGAcid1
;
164 property isGAcid2
: Boolean read getIsGAcid2
;
165 property isGWater
: Boolean read getIsGWater
;
166 property isGFore
: Boolean read getIsGFore
;
167 property isGLift
: Boolean read getIsGLift
;
168 property isGBlockMon
: Boolean read getIsGBlockMon
;
171 property movingSpeed
: TDFPoint read mMovingSpeed write mMovingSpeed
;
172 property movingStart
: TDFPoint read mMovingStart write mMovingStart
;
173 property movingEnd
: TDFPoint read mMovingEnd write mMovingEnd
;
175 property endPosTrigId
: Integer read mEndPosTrig write mEndPosTrig
;
176 property endSizeTrigId
: Integer read mEndSizeTrig write mEndSizeTrig
;
179 TPanelArray
= Array of TPanel
;
182 g_dbgpan_mplat_active
: Boolean = {$IF DEFINED(D2F_DEBUG)}true{$ELSE}true{$ENDIF};
183 g_dbgpan_mplat_step
: Boolean = false; // one step, and stop
189 SysUtils
, g_basic
, g_map
, g_game
, g_gfx
, e_graphics
, g_weapons
, g_triggers
,
190 g_console
, g_language
, g_monsters
, g_player
, g_grid
, e_log
, GL
, utils
;
193 PANEL_SIGNATURE
= $4C4E4150; // 'PANL'
197 constructor TPanel
.Create(PanelRec
: TDynRecord
;
198 AddTextures
: TAddTextureArray
;
200 var Textures
: TLevelTextureArray
; aguid
: Integer);
206 Width
:= PanelRec
.Width
;
207 Height
:= PanelRec
.Height
;
215 mapId
:= PanelRec
.id
;
218 mMovingSpeed
:= PanelRec
.moveSpeed
;
219 mMovingStart
:= PanelRec
.moveStart
;
220 mMovingEnd
:= PanelRec
.moveEnd
;
221 mMovingActive
:= PanelRec
['move_active'].varvalue
;
222 mMoveOnce
:= PanelRec
.moveOnce
;
224 mSizeSpeed
:= PanelRec
.sizeSpeed
;
225 mSizeEnd
:= PanelRec
.sizeEnd
;
227 mEndPosTrig
:= PanelRec
.endPosTrig
;
228 mEndSizeTrig
:= PanelRec
.endSizeTrig
;
231 PanelType
:= PanelRec
.PanelType
;
269 if ByteBool(PanelRec
.Flags
and PANEL_FLAG_HIDE
) then
271 SetLength(FTextureIDs
, 0);
275 // Ïàíåëè, íå èñïîëüçóþùèå òåêñòóðû:
276 if ByteBool(PanelType
and
281 PANEL_BLOCKMON
)) then
283 SetLength(FTextureIDs
, 0);
288 // Åñëè ýòî æèäêîñòü áåç òåêñòóðû - ñïåöòåêñòóðó:
289 if WordBool(PanelType
and (PANEL_WATER
or PANEL_ACID1
or PANEL_ACID2
)) and
290 (not ByteBool(PanelRec
.Flags
and PANEL_FLAG_WATERTEXTURES
)) then
292 SetLength(FTextureIDs
, 1);
293 FTextureIDs
[0].Anim
:= False;
295 case PanelRec
.PanelType
of
297 FTextureIDs
[0].Tex
:= LongWord(TEXTURE_SPECIAL_WATER
);
299 FTextureIDs
[0].Tex
:= LongWord(TEXTURE_SPECIAL_ACID1
);
301 FTextureIDs
[0].Tex
:= LongWord(TEXTURE_SPECIAL_ACID2
);
308 SetLength(FTextureIDs
, Length(AddTextures
));
313 if CurTex
>= Length(FTextureIDs
) then
314 FCurTexture
:= Length(FTextureIDs
) - 1
316 FCurTexture
:= CurTex
;
318 for i
:= 0 to Length(FTextureIDs
)-1 do
320 FTextureIDs
[i
].Anim
:= AddTextures
[i
].Anim
;
321 if FTextureIDs
[i
].Anim
then
322 begin // Àíèìèðîâàííàÿ òåêñòóðà
323 FTextureIDs
[i
].AnTex
:=
324 TAnimation
.Create(Textures
[AddTextures
[i
].Texture
].FramesID
,
325 True, Textures
[AddTextures
[i
].Texture
].Speed
);
326 FTextureIDs
[i
].AnTex
.Blending
:= ByteBool(PanelRec
.Flags
and PANEL_FLAG_BLENDING
);
327 FTextureIDs
[i
].AnTex
.Alpha
:= PanelRec
.Alpha
;
331 begin // Îáû÷íàÿ òåêñòóðà
332 FTextureIDs
[i
].Tex
:= Textures
[AddTextures
[i
].Texture
].TextureID
;
336 // Òåêñòóð íåñêîëüêî - íóæíî ñîõðàíÿòü òåêóùóþ:
337 if Length(FTextureIDs
) > 1 then
340 // Åñëè íå ñïåöòåêñòóðà, òî çàäàåì ðàçìåðû:
341 if PanelRec
.TextureNum
> High(Textures
) then
343 e_WriteLog(Format('WTF?! PanelRec.TextureNum is out of limits! (%d : %d)', [PanelRec
.TextureNum
, High(Textures
)]), MSG_FATALERROR
);
347 FBlending
:= ByteBool(0);
349 else if not g_Map_IsSpecialTexture(Textures
[PanelRec
.TextureNum
].TextureName
) then
351 FTextureWidth
:= Textures
[PanelRec
.TextureNum
].Width
;
352 FTextureHeight
:= Textures
[PanelRec
.TextureNum
].Height
;
353 FAlpha
:= PanelRec
.Alpha
;
354 FBlending
:= ByteBool(PanelRec
.Flags
and PANEL_FLAG_BLENDING
);
358 destructor TPanel
.Destroy();
362 for i
:= 0 to High(FTextureIDs
) do
363 if FTextureIDs
[i
].Anim
then
364 FTextureIDs
[i
].AnTex
.Free();
365 SetLength(FTextureIDs
, 0);
370 function TPanel
.getx1 (): Integer; inline; begin result
:= X
+Width
-1; end;
371 function TPanel
.gety1 (): Integer; inline; begin result
:= Y
+Height
-1; end;
372 function TPanel
.getvisvalid (): Boolean; inline; begin result
:= (Width
> 0) and (Height
> 0); end;
374 function TPanel
.getMovingSpeedX (): Integer; inline; begin result
:= mMovingSpeed
.X
; end;
375 procedure TPanel
.setMovingSpeedX (v
: Integer); inline; begin mMovingSpeed
.X
:= v
; end;
376 function TPanel
.getMovingSpeedY (): Integer; inline; begin result
:= mMovingSpeed
.Y
; end;
377 procedure TPanel
.setMovingSpeedY (v
: Integer); inline; begin mMovingSpeed
.Y
:= v
; end;
379 function TPanel
.getMovingStartX (): Integer; inline; begin result
:= mMovingStart
.X
; end;
380 procedure TPanel
.setMovingStartX (v
: Integer); inline; begin mMovingStart
.X
:= v
; end;
381 function TPanel
.getMovingStartY (): Integer; inline; begin result
:= mMovingStart
.Y
; end;
382 procedure TPanel
.setMovingStartY (v
: Integer); inline; begin mMovingStart
.Y
:= v
; end;
384 function TPanel
.getMovingEndX (): Integer; inline; begin result
:= mMovingEnd
.X
; end;
385 procedure TPanel
.setMovingEndX (v
: Integer); inline; begin mMovingEnd
.X
:= v
; end;
386 function TPanel
.getMovingEndY (): Integer; inline; begin result
:= mMovingEnd
.Y
; end;
387 procedure TPanel
.setMovingEndY (v
: Integer); inline; begin mMovingEnd
.Y
:= v
; end;
389 function TPanel
.getIsGBack (): Boolean; inline; begin result
:= ((tag
and GridTagBack
) <> 0); end;
390 function TPanel
.getIsGStep (): Boolean; inline; begin result
:= ((tag
and GridTagStep
) <> 0); end;
391 function TPanel
.getIsGWall (): Boolean; inline; begin result
:= ((tag
and (GridTagWall
or GridTagDoor
)) <> 0); end;
392 function TPanel
.getIsGAcid1 (): Boolean; inline; begin result
:= ((tag
and GridTagAcid1
) <> 0); end;
393 function TPanel
.getIsGAcid2 (): Boolean; inline; begin result
:= ((tag
and GridTagAcid2
) <> 0); end;
394 function TPanel
.getIsGWater (): Boolean; inline; begin result
:= ((tag
and GridTagWater
) <> 0); end;
395 function TPanel
.getIsGFore (): Boolean; inline; begin result
:= ((tag
and GridTagFore
) <> 0); end;
396 function TPanel
.getIsGLift (): Boolean; inline; begin result
:= ((tag
and GridTagLift
) <> 0); end;
397 function TPanel
.getIsGBlockMon (): Boolean; inline; begin result
:= ((tag
and GridTagBlockMon
) <> 0); end;
399 procedure TPanel
.Draw();
405 if {Enabled and} (FCurTexture
>= 0) and
406 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) and
407 ((g_dbg_scale
<> 1.0) or g_Collide(X
, Y
, Width
, Height
, sX
, sY
, sWidth
, sHeight
)) then
409 if FTextureIDs
[FCurTexture
].Anim
then
410 begin // Àíèìèðîâàííàÿ òåêñòóðà
411 if FTextureIDs
[FCurTexture
].AnTex
= nil then
414 for xx
:= 0 to (Width
div FTextureWidth
)-1 do
415 for yy
:= 0 to (Height
div FTextureHeight
)-1 do
416 FTextureIDs
[FCurTexture
].AnTex
.Draw(
417 X
+ xx
*FTextureWidth
,
418 Y
+ yy
*FTextureHeight
, M_NONE
);
421 begin // Îáû÷íàÿ òåêñòóðà
422 case FTextureIDs
[FCurTexture
].Tex
of
423 LongWord(TEXTURE_SPECIAL_WATER
):
424 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
425 0, 0, 255, 0, B_FILTER
);
426 LongWord(TEXTURE_SPECIAL_ACID1
):
427 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
428 0, 128, 0, 0, B_FILTER
);
429 LongWord(TEXTURE_SPECIAL_ACID2
):
430 e_DrawFillQuad(X
, Y
, X
+Width
-1, Y
+Height
-1,
431 128, 0, 0, 0, B_FILTER
);
432 LongWord(TEXTURE_NONE
):
433 if g_Texture_Get('NOTEXTURE', NoTextureID
) then
435 e_GetTextureSize(NoTextureID
, @NW
, @NH
);
436 e_DrawFill(NoTextureID
, X
, Y
, Width
div NW
, Height
div NH
,
440 xx
:= X
+ (Width
div 2);
441 yy
:= Y
+ (Height
div 2);
442 e_DrawFillQuad(X
, Y
, xx
, yy
,
444 e_DrawFillQuad(xx
, Y
, X
+Width
-1, yy
,
446 e_DrawFillQuad(X
, yy
, xx
, Y
+Height
-1,
448 e_DrawFillQuad(xx
, yy
, X
+Width
-1, Y
+Height
-1,
453 if not mMovingActive
then
454 e_DrawFill(FTextureIDs
[FCurTexture
].Tex
, X
, Y
, Width
div FTextureWidth
, Height
div FTextureHeight
, FAlpha
, True, FBlending
)
456 e_DrawFillX(FTextureIDs
[FCurTexture
].Tex
, X
, Y
, Width
, Height
, FAlpha
, True, FBlending
, g_dbg_scale
);
462 procedure TPanel
.DrawShadowVolume(lightX
: Integer; lightY
: Integer; radius
: Integer);
463 procedure extrude (x
: Integer; y
: Integer);
465 glVertex2i(x
+(x
-lightX
)*500, y
+(y
-lightY
)*500);
466 //e_WriteLog(Format(' : (%d,%d)', [x+(x-lightX)*300, y+(y-lightY)*300]), MSG_WARNING);
469 procedure drawLine (x0
: Integer; y0
: Integer; x1
: Integer; y1
: Integer);
471 // does this side facing the light?
472 if ((x1
-x0
)*(lightY
-y0
)-(lightX
-x0
)*(y1
-y0
) >= 0) then exit
;
473 //e_WriteLog(Format('lightpan: (%d,%d)-(%d,%d)', [x0, y0, x1, y1]), MSG_WARNING);
474 // this edge is facing the light, extrude and draw it
482 if radius
< 4 then exit
;
483 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
485 if not FTextureIDs
[FCurTexture
].Anim
then
487 case FTextureIDs
[FCurTexture
].Tex
of
488 LongWord(TEXTURE_SPECIAL_WATER
): exit
;
489 LongWord(TEXTURE_SPECIAL_ACID1
): exit
;
490 LongWord(TEXTURE_SPECIAL_ACID2
): exit
;
491 LongWord(TEXTURE_NONE
): exit
;
494 if (X
+Width
< lightX
-radius
) then exit
;
495 if (Y
+Height
< lightY
-radius
) then exit
;
496 if (X
> lightX
+radius
) then exit
;
497 if (Y
> lightY
+radius
) then exit
;
498 //e_DrawFill(FTextureIDs[FCurTexture].Tex, X, Y, Width div FTextureWidth, Height div FTextureHeight, FAlpha, True, FBlending);
501 drawLine(x
, y
, x
+width
, y
); // top
502 drawLine(x
+width
, y
, x
+width
, y
+height
); // right
503 drawLine(x
+width
, y
+height
, x
, y
+height
); // bottom
504 drawLine(x
, y
+height
, x
, y
); // left
510 procedure TPanel
.positionChanged (); inline;
512 px
, py
, pw
, ph
: Integer;
514 if (proxyId
>= 0) then
516 mapGrid
.getBodyDims(proxyId
, px
, py
, pw
, ph
);
517 if (px
<> x
) or (py
<> y
) or (pw
<> Width
) or (ph
<> Height
) then
520 e_LogWritefln('panel moved: arridx=%s; guid=%s; proxyid=%s; old:(%s,%s)-(%sx%s); new:(%s,%s)-(%sx%s)',
521 [arrIdx, mGUID, proxyId, px, py, pw, ph, x, y, width, height]);
523 g_Mark(px
, py
, pw
, ph
, MARK_WALL
, false);
524 if (Width
< 1) or (Height
< 1) then
526 mapGrid
.proxyEnabled
[proxyId
] := false;
530 mapGrid
.proxyEnabled
[proxyId
] := Enabled
;
531 if (pw
<> Width
) or (ph
<> Height
) then
533 //writeln('panel resize!');
534 mapGrid
.moveResizeBody(proxyId
, X
, Y
, Width
, Height
)
538 mapGrid
.moveBody(proxyId
, X
, Y
);
540 g_Mark(X
, Y
, Width
, Height
, MARK_WALL
);
548 monCheckList
: array of TMonster
= nil;
549 monCheckListUsed
: Integer = 0;
551 procedure TPanel
.Update();
555 ex
, ey
, nex
, ney
: Integer;
558 // return `true` if we should move by dx,dy
559 function tryMPlatMove (px
, py
, pw
, ph
: Integer; out dx
, dy
: Integer; out squash
: Boolean; ontop
: PBoolean=nil): Boolean;
571 pdx
:= mMovingSpeed
.X
;
572 pdy
:= mMovingSpeed
.Y
;
573 // standing on the platform?
576 if (ontop
<> nil) then ontop
^ := true;
577 // yes, move with it; but skip steps
578 pan
:= mapGrid
.traceBox(tex
, tey
, px
, py
, pw
, ph
, pdx
, pdy
, nil, (GridTagWall
or GridTagDoor
));
581 //e_LogWritefln('entity on the platform; tracing=(%s,%s); endpoint=(%s,%s); mustbe=(%s,%s)', [px, py, tex, tey, px+pdx, py+pdy]);
582 // if we cannot move, only walls should squash the entity
584 if ((tag and (GridTagWall or GridTagDoor)) <> 0) then
586 if (tex = px) and (tey = py) then squash := true;
593 if (ontop
<> nil) then ontop
^ := false;
594 // not standing on the platform: trace platform to see if it hits the entity
595 // hitedge (for `it`): 0: top; 1: right; 2: bottom; 3: left
597 if g_Collide(px, py, pw, ph, ox, oy, mpw, mph) then
599 e_LogWritefln('entity is embedded: plr=(%s,%s)-(%s,%s); mpl=(%s,%s)-(%s,%s)', [px, py, px+pw-1, py+ph-1, ox, oy, ox+mpw-1, oy+mph-1]);
602 if sweepAABB(ox
, oy
, mpw
, mph
, pdx
, pdy
, px
, py
, pw
, ph
, @u0
, @hedge
, @u1
) then
604 //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]);
605 // yes, platform hits the entity, push the entity in the direction of the platform
606 u0
:= 1.0-u0
; // how much path left?
607 pdx
:= trunc(pdx
*u0
);
608 pdy
:= trunc(pdy
*u0
);
609 //e_LogWritefln(' platsweep; uleft=%s; pd=(%s,%s)', [u0, pdx, pdy]);
610 if (pdx
<> 0) or (pdy
<> 0) then
612 // has some path to go, trace the entity
613 trtag
:= (GridTagWall
or GridTagDoor
);
614 // if we're moving down, consider steps too
615 if (pdy
> 0) then trtag
:= trtag
or GridTagStep
;
616 pan
:= mapGrid
.traceBox(tex
, tey
, px
, py
, pw
, ph
, pdx
, pdy
, nil, trtag
);
617 //e_LogWritefln(' tracebox: te=(%s,%s)', [tex, tey]);
618 // if we cannot move, only walls should squash the entity
620 if ((tag and (GridTagWall or GridTagDoor)) <> 0) then
622 if (pan <> nil) and (tex = px) and (tey = py) then squash := true;
629 // no collistion, but may be embedded
630 //e_LogWritefln('F: platsweep; u0=%s; u1=%s; sweepAABB(%s, %s, %s, %s, %s, %s, %s, %s, %s, %s)', [u0, u1, ox, oy, mpw, mph, pdx, pdy, px-1, py-1, pw+2, ph+2]);
631 //squash := (u1 >= 0.0);
636 result
:= (dx
<> 0) or (dy
<> 0);
637 if (not squash
) and ((tag
and (GridTagWall
or GridTagDoor
)) <> 0) then
639 squash
:= g_Collide(tex
, tey
, pw
, ph
, nx
, ny
, mpw
, mph
); // still in platform?
640 //if not squash then squash := g_Map_CollidePanel(tex, tey, pw, ph, (PANEL_WALL or PANEL_OPENDOOR or PANEL_CLOSEDOOR));
644 function monCollect (mon
: TMonster
): Boolean;
646 result
:= false; // don't stop
647 if (monCheckListUsed
>= Length(monCheckList
)) then SetLength(monCheckList
, monCheckListUsed
+128);
648 monCheckList
[monCheckListUsed
] := mon
;
649 Inc(monCheckListUsed
);
653 cx0
, cy0
, cx1
, cy1
, cw
, ch
: Integer;
655 px
, py
, pw
, ph
, pdx
, pdy
: Integer;
663 actMoveTrig
: Boolean;
664 actSizeTrig
: Boolean;
666 if (not Enabled
) or (Width
< 1) or (Height
< 1) then exit
;
668 if (FCurTexture
>= 0) and
669 (FTextureIDs
[FCurTexture
].Anim
) and
670 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
673 FTextureIDs
[FCurTexture
].AnTex
.Update();
674 FCurFrame
:= FTextureIDs
[FCurTexture
].AnTex
.CurrentFrame
;
675 FCurFrameCount
:= FTextureIDs
[FCurTexture
].AnTex
.CurrentCounter
;
678 if not g_dbgpan_mplat_active
then exit
;
680 if not mMovingActive
then exit
;
681 if mMovingSpeed
.isZero
and mSizeSpeed
.isZero
then exit
;
683 //TODO: write wall size change processing
688 * collect all monsters and players (aka entities) along the possible platform path
689 * if entity is standing on a platform:
690 * try to move it along the platform path, checking wall collisions
691 * if entity is NOT standing on a platform, but hit with sweeped platform aabb:
693 * if we can't push entity all the way, squash it
704 nx
:= ox
+mMovingSpeed
.X
;
705 ny
:= oy
+mMovingSpeed
.Y
;
711 cx1
:= nmax(ex
, nex
);
712 cy1
:= nmax(ey
, ney
);
721 // process "obstacle" panels
722 if ((tag
and GridTagObstacle
) <> 0) then
724 // temporarily turn off this panel, so it won't interfere with collision checks
725 mapGrid
.proxyEnabled
[proxyId
] := false;
728 for f
:= 0 to High(gPlayers
) do
731 if (plr
= nil) or (not plr
.alive
) then continue
;
732 plr
.getMapBox(px
, py
, pw
, ph
);
733 if not g_Collide(px
, py
, pw
, ph
, cx0
, cy0
, cw
, ch
) then continue
;
734 if tryMPlatMove(px
, py
, pw
, ph
, pdx
, pdy
, squash
) then
737 plr
.moveBy(pdx
, pdy
); // this will call `positionChanged()` for us
739 // squash player, if necessary
740 if squash
then plr
.Damage(15000, 0, 0, 0, HIT_TRAP
);
744 for f
:= 0 to High(gGibs
) do
747 if not gib
.alive
then continue
;
748 gib
.getMapBox(px
, py
, pw
, ph
);
749 if not g_Collide(px
, py
, pw
, ph
, cx0
, cy0
, cw
, ch
) then continue
;
750 if tryMPlatMove(px
, py
, pw
, ph
, pdx
, pdy
, squash
, @ontop
) then
753 gib
.moveBy(pdx
, pdy
); // this will call `positionChanged()` for us
757 gib.Obj.Vel.X += pdx;
758 gib.Obj.Vel.Y += pdy;
764 // move and push corpses
765 for f
:= 0 to High(gCorpses
) do
768 if (cor
= nil) then continue
;
769 cor
.getMapBox(px
, py
, pw
, ph
);
770 if not g_Collide(px
, py
, pw
, ph
, cx0
, cy0
, cw
, ch
) then continue
;
771 if tryMPlatMove(px
, py
, pw
, ph
, pdx
, pdy
, squash
, @ontop
) then
774 cor
.moveBy(pdx
, pdy
); // this will call `positionChanged()` for us
778 cor.ObjPtr.Vel.X += pdx;
779 cor.ObjPtr.Vel.Y += pdy;
786 monCheckListUsed
:= 0;
787 g_Mons_ForEachAt(cx0
, cy0
, cw
, ch
, monCollect
);
789 // process collected monsters
790 if (monCheckListUsed
> 0) then
792 mpfrid
:= g_Mons_getNewMPlatFrameId();
793 for f
:= 0 to monCheckListUsed
do
795 mon
:= monCheckList
[f
];
796 if (mon
= nil) or (not mon
.alive
) or (mon
.mplatCheckFrameId
= mpfrid
) then continue
;
797 mon
.mplatCheckFrameId
:= mpfrid
;
798 mon
.getMapBox(px
, py
, pw
, ph
);
799 //if not g_Collide(px, py, pw, ph, cx0, cy0, cw, ch) then continue;
800 if tryMPlatMove(px
, py
, pw
, ph
, pdx
, pdy
, squash
) then
803 mon
.moveBy(pdx
, pdy
); // this will call `positionChanged()` for us
805 // squash player, if necessary
806 if squash
then mon
.Damage(15000, 0, 0, 0, HIT_TRAP
);
810 // restore panel state
811 mapGrid
.proxyEnabled
[proxyId
] := true;
817 FWidth
+= mSizeSpeed
.w
;
818 FHeight
+= mSizeSpeed
.h
;
821 actMoveTrig
:= false;
822 actSizeTrig
:= false;
825 if not mSizeSpeed.isZero then
827 e_LogWritefln('ss: size_speed=(%s,%s); size=(%s,%s); move_speed=(%s,%s); oy=%s; ny=%s; etp:%s; ets:%s', [mSizeSpeed.w, mSizeSpeed.h, FWidth, FHeight, mMovingSpeed.X, mMovingSpeed.Y, oy, ny, mEndPosTrig, mEndSizeTrig]);
831 // reverse moving direction, if necessary
832 if ((mMovingSpeed
.X
< 0) and (nx
<= mMovingStart
.X
)) or ((mMovingSpeed
.X
> 0) and (nx
>= mMovingEnd
.X
)) then
834 if mMoveOnce
then mMovingActive
:= false else mMovingSpeed
.X
:= -mMovingSpeed
.X
;
838 if ((mMovingSpeed
.Y
< 0) and (ny
<= mMovingStart
.Y
)) or ((mMovingSpeed
.Y
> 0) and (ny
>= mMovingEnd
.Y
)) then
840 if mMoveOnce
then mMovingActive
:= false else mMovingSpeed
.Y
:= -mMovingSpeed
.Y
;
845 if not mSizeSpeed
.isZero
and (Width
= mSizeEnd
.w
) and (Height
= mSizeEnd
.h
) then
850 if (Width
< 1) or (Height
< 1) then mMovingActive
:= false; //HACK!
851 //e_LogWritefln('FUUUUUUUUUUUUUU', []);
857 g_Triggers_Press(mEndPosTrig
, ACTIVATE_CUSTOM
);
862 g_Triggers_Press(mEndSizeTrig
, ACTIVATE_CUSTOM
);
867 procedure TPanel
.SetFrame(Frame
: Integer; Count
: Byte);
869 function ClampInt(X
, A
, B
: Integer): Integer;
872 if X
< A
then Result
:= A
else if X
> B
then Result
:= B
;
876 if Enabled
and (FCurTexture
>= 0) and
877 (FTextureIDs
[FCurTexture
].Anim
) and
878 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
879 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
881 FCurFrame
:= ClampInt(Frame
, 0, FTextureIDs
[FCurTexture
].AnTex
.TotalFrames
);
882 FCurFrameCount
:= Count
;
883 FTextureIDs
[FCurTexture
].AnTex
.CurrentFrame
:= FCurFrame
;
884 FTextureIDs
[FCurTexture
].AnTex
.CurrentCounter
:= FCurFrameCount
;
888 procedure TPanel
.NextTexture(AnimLoop
: Byte = 0);
890 Assert(FCurTexture
>= -1, 'FCurTexture < -1');
893 if Length(FTextureIDs
) = 0 then
896 // Òîëüêî îäíà òåêñòóðà:
897 if Length(FTextureIDs
) = 1 then
899 if FCurTexture
= 0 then
905 // Áîëüøå îäíîé òåêñòóðû:
909 // Ñëåäóþùåé íåò - âîçâðàò ê íà÷àëó:
910 if FCurTexture
>= Length(FTextureIDs
) then
914 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
915 if (FCurTexture
>= 0) and FTextureIDs
[FCurTexture
].Anim
then
917 if (FTextureIDs
[FCurTexture
].AnTex
= nil) then
919 g_FatalError(_lc
[I_GAME_ERROR_SWITCH_TEXTURE
]);
924 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= True
927 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= False;
929 FTextureIDs
[FCurTexture
].AnTex
.Reset();
932 LastAnimLoop
:= AnimLoop
;
935 procedure TPanel
.SetTexture(ID
: Integer; AnimLoop
: Byte = 0);
938 if Length(FTextureIDs
) = 0 then
941 // Òîëüêî îäíà òåêñòóðà:
942 if Length(FTextureIDs
) = 1 then
944 if (ID
= 0) or (ID
= -1) then
948 // Áîëüøå îäíîé òåêñòóðû:
950 if (ID
>= -1) and (ID
<= High(FTextureIDs
)) then
954 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
955 if (FCurTexture
>= 0) and FTextureIDs
[FCurTexture
].Anim
then
957 if (FTextureIDs
[FCurTexture
].AnTex
= nil) then
959 g_FatalError(_lc
[I_GAME_ERROR_SWITCH_TEXTURE
]);
964 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= True
967 FTextureIDs
[FCurTexture
].AnTex
.Loop
:= False;
969 FTextureIDs
[FCurTexture
].AnTex
.Reset();
972 LastAnimLoop
:= AnimLoop
;
975 function TPanel
.GetTextureID(): DWORD
;
977 Result
:= LongWord(TEXTURE_NONE
);
979 if (FCurTexture
>= 0) then
981 if FTextureIDs
[FCurTexture
].Anim
then
982 Result
:= FTextureIDs
[FCurTexture
].AnTex
.FramesID
984 Result
:= FTextureIDs
[FCurTexture
].Tex
;
988 function TPanel
.GetTextureCount(): Integer;
990 Result
:= Length(FTextureIDs
);
991 if Enabled
and (FCurTexture
>= 0) then
992 if (FTextureIDs
[FCurTexture
].Anim
) and
993 (FTextureIDs
[FCurTexture
].AnTex
<> nil) and
994 (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
995 Result
:= Result
+ 100;
998 procedure TPanel
.SaveState(Var Mem
: TBinMemoryWriter
);
1003 if (Mem
= nil) then exit
;
1004 //if not SaveIt then exit;
1006 // Ñèãíàòóðà ïàíåëè:
1007 sig
:= PANEL_SIGNATURE
; // 'PANL'
1008 Mem
.WriteDWORD(sig
);
1009 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
1010 Mem
.WriteBoolean(FEnabled
);
1011 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
1012 Mem
.WriteByte(FLiftType
);
1013 // Íîìåð òåêóùåé òåêñòóðû:
1014 Mem
.WriteInt(FCurTexture
);
1018 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
1019 if (FCurTexture
>= 0) and (FTextureIDs
[FCurTexture
].Anim
) then
1021 Assert(FTextureIDs
[FCurTexture
].AnTex
<> nil,
1022 'TPanel.SaveState: No animation object');
1027 Mem
.WriteBoolean(anim
);
1028 // Åñëè äà - ñîõðàíÿåì àíèìàöèþ:
1030 FTextureIDs
[FCurTexture
].AnTex
.SaveState(Mem
);
1031 // moving platform state
1032 Mem
.WriteInt(mMovingSpeed
.X
);
1033 Mem
.WriteInt(mMovingSpeed
.Y
);
1034 Mem
.WriteInt(mMovingStart
.X
);
1035 Mem
.WriteInt(mMovingStart
.Y
);
1036 Mem
.WriteInt(mMovingEnd
.X
);
1037 Mem
.WriteInt(mMovingEnd
.Y
);
1038 Mem
.WriteBoolean(mMovingActive
);
1041 procedure TPanel
.LoadState(var Mem
: TBinMemoryReader
);
1047 if (Mem
= nil) then exit
;
1048 //if not SaveIt then exit;
1050 // Ñèãíàòóðà ïàíåëè:
1052 if sig
<> PANEL_SIGNATURE
then // 'PANL'
1054 raise EBinSizeError
.Create('TPanel.LoadState: Wrong Panel Signature');
1056 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
1057 Mem
.ReadBoolean(FEnabled
);
1058 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
1059 Mem
.ReadByte(FLiftType
);
1060 // Íîìåð òåêóùåé òåêñòóðû:
1061 Mem
.ReadInt(FCurTexture
);
1067 //e_LogWritefln('panel %s(%s): old=(%s,%s); new=(%s,%s); delta=(%s,%s)', [arrIdx, proxyId, ox, oy, FX, FY, FX-ox, FY-oy]);
1068 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
1069 Mem
.ReadBoolean(anim
);
1070 // Åñëè äà - çàãðóæàåì àíèìàöèþ:
1073 Assert((FCurTexture
>= 0) and
1074 (FTextureIDs
[FCurTexture
].Anim
) and
1075 (FTextureIDs
[FCurTexture
].AnTex
<> nil),
1076 'TPanel.LoadState: No animation object');
1077 FTextureIDs
[FCurTexture
].AnTex
.LoadState(Mem
);
1079 // moving platform state
1080 Mem
.ReadInt(mMovingSpeed
.X
);
1081 Mem
.ReadInt(mMovingSpeed
.Y
);
1082 Mem
.ReadInt(mMovingStart
.X
);
1083 Mem
.ReadInt(mMovingStart
.Y
);
1084 Mem
.ReadInt(mMovingEnd
.X
);
1085 Mem
.ReadInt(mMovingEnd
.Y
);
1086 Mem
.ReadBoolean(mMovingActive
);
1089 //mapGrid.proxyEnabled[proxyId] := FEnabled; // done in g_map.pas