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_animations
, xdynrec
;
26 TLevelTexture
= record
27 TextureName
: AnsiString; // as stored in wad
28 FullName
: AnsiString; // full path to texture // !!! merge it with TextureName
31 TLevelTextureArray
= array of TLevelTexture
;
33 TAddTextureArray
= array of record
34 Texture
: Cardinal; // Textures[Texture]
37 ATextureID
= array of record
38 Texture
: Cardinal; // Textures[Texture]
42 TPanel
= Class (TObject
)
46 mGUID
: Integer; // will be assigned in "g_map.pas"
49 FTextureIDs
: ATextureID
;
52 mMovingSpeed
: TDFPoint
;
53 mMovingStart
: TDFPoint
;
55 mMovingActive
: Boolean;
58 mOldMovingActive
: Boolean;
64 mEndSizeTrig
: Integer;
66 mNeedSend
: Boolean; // for network
69 function getx1 (): Integer; inline;
70 function gety1 (): Integer; inline;
71 function getvisvalid (): Boolean; inline;
73 function getMovingSpeedX (): Integer; inline;
74 procedure setMovingSpeedX (v
: Integer); inline;
75 function getMovingSpeedY (): Integer; inline;
76 procedure setMovingSpeedY (v
: Integer); inline;
78 function getMovingStartX (): Integer; inline;
79 procedure setMovingStartX (v
: Integer); inline;
80 function getMovingStartY (): Integer; inline;
81 procedure setMovingStartY (v
: Integer); inline;
83 function getMovingEndX (): Integer; inline;
84 procedure setMovingEndX (v
: Integer); inline;
85 function getMovingEndY (): Integer; inline;
86 procedure setMovingEndY (v
: Integer); inline;
88 function getSizeSpeedX (): Integer; inline;
89 procedure setSizeSpeedX (v
: Integer); inline;
90 function getSizeSpeedY (): Integer; inline;
91 procedure setSizeSpeedY (v
: Integer); inline;
93 function getSizeEndX (): Integer; inline;
94 procedure setSizeEndX (v
: Integer); inline;
95 function getSizeEndY (): Integer; inline;
96 procedure setSizeEndY (v
: Integer); inline;
99 FCurTexture
: Integer; // Номер текущей текстуры
101 FOldX
, FOldY
: Integer;
102 FWidth
, FHeight
: Word;
109 // sorry, there fields are public to allow setting 'em in g_map; this should be fixed later
110 // for now, PLEASE, don't modify 'em, or all hell will break loose
111 arrIdx
: Integer; // index in one of internal arrays; sorry
112 tag
: Integer; // used in coldets and such; sorry; see g_map.GridTagXXX
113 proxyId
: Integer; // proxy id in map grid (DO NOT USE!)
114 mapId
: AnsiString; // taken directly from map file; dunno why it is here
115 hasTexTrigger
: Boolean; // HACK: true when there's a trigger than can change my texture
117 constructor Create(PanelRec
: TDynRecord
;
118 AddTextures
: TAddTextureArray
;
120 var Textures
: TLevelTextureArray
; aguid
: Integer);
121 destructor Destroy(); override;
124 procedure SetFrame(StartTime
: LongWord);
125 procedure NextTexture(AnimLoop
: Byte = 0);
126 procedure SetTexture(ID
: Integer; AnimLoop
: Byte = 0);
127 function GetTextureID(): Cardinal;
128 function GetTextureCount(): Integer;
129 function CanChangeTexture(): Boolean;
131 procedure SaveState (st
: TStream
);
132 procedure LoadState (st
: TStream
);
134 procedure positionChanged (); inline;
136 function getIsGBack (): Boolean; inline; // gRenderBackgrounds
137 function getIsGStep (): Boolean; inline; // gSteps
138 function getIsGWall (): Boolean; inline; // gWalls
139 function getIsGAcid1 (): Boolean; inline; // gAcid1
140 function getIsGAcid2 (): Boolean; inline; // gAcid2
141 function getIsGWater (): Boolean; inline; // gWater
142 function getIsGFore (): Boolean; inline; // gRenderForegrounds
143 function getIsGLift (): Boolean; inline; // gLifts
144 function getIsGBlockMon (): Boolean; inline; // gBlockMon
147 function gncNeedSend (): Boolean; inline;
148 procedure setDirty (); inline; // why `dirty`? 'cause i may introduce property `needSend` later
151 property visvalid
: Boolean read getvisvalid
; // panel is "visvalid" when it's width and height are positive
154 property guid
: Integer read mGUID
; // will be assigned in "g_map.pas"
155 property x0
: Integer read FX
;
156 property y0
: Integer read FY
;
157 property x1
: Integer read getx1
; // inclusive!
158 property y1
: Integer read gety1
; // inclusive!
159 property x
: Integer read FX write FX
;
160 property y
: Integer read FY write FY
;
161 property width
: Word read FWidth write FWidth
;
162 property height
: Word read FHeight write FHeight
;
163 property oldX
: Integer read FOldX
;
164 property oldY
: Integer read FOldY
;
165 property oldWidth
: Word read FOldW
;
166 property oldHeight
: Word read FOldH
;
167 property oldMovingActive
: Boolean read mOldMovingActive write mOldMovingActive
;
168 property panelType
: Word read FPanelType write FPanelType
;
169 property enabled
: Boolean read FEnabled write FEnabled
;
170 property door
: Boolean read FDoor write FDoor
;
171 property liftType
: Byte read FLiftType write FLiftType
;
172 property lastAnimLoop
: Byte read FLastAnimLoop write FLastAnimLoop
;
174 property movingSpeedX
: Integer read getMovingSpeedX write setMovingSpeedX
;
175 property movingSpeedY
: Integer read getMovingSpeedY write setMovingSpeedY
;
176 property movingStartX
: Integer read getMovingStartX write setMovingStartX
;
177 property movingStartY
: Integer read getMovingStartY write setMovingStartY
;
178 property movingEndX
: Integer read getMovingEndX write setMovingEndX
;
179 property movingEndY
: Integer read getMovingEndY write setMovingEndY
;
180 property movingActive
: Boolean read mMovingActive write mMovingActive
;
181 property moveOnce
: Boolean read mMoveOnce write mMoveOnce
;
183 property sizeSpeedX
: Integer read getSizeSpeedX write setSizeSpeedX
;
184 property sizeSpeedY
: Integer read getSizeSpeedY write setSizeSpeedY
;
185 property sizeEndX
: Integer read getSizeEndX write setSizeEndX
;
186 property sizeEndY
: Integer read getSizeEndY write setSizeEndY
;
188 property isGBack
: Boolean read getIsGBack
;
189 property isGStep
: Boolean read getIsGStep
;
190 property isGWall
: Boolean read getIsGWall
;
191 property isGAcid1
: Boolean read getIsGAcid1
;
192 property isGAcid2
: Boolean read getIsGAcid2
;
193 property isGWater
: Boolean read getIsGWater
;
194 property isGFore
: Boolean read getIsGFore
;
195 property isGLift
: Boolean read getIsGLift
;
196 property isGBlockMon
: Boolean read getIsGBlockMon
;
198 property Alpha
: Byte read FAlpha
;
199 property Blending
: Boolean read FBlending
;
200 property TextureIDs
: ATextureID read FTextureIDs
;
201 property AnimTime
: LongWord read FAnimTime
;
202 property AnimLoop
: Boolean read FAnimLoop
;
205 property movingSpeed
: TDFPoint read mMovingSpeed write mMovingSpeed
;
206 property movingStart
: TDFPoint read mMovingStart write mMovingStart
;
207 property movingEnd
: TDFPoint read mMovingEnd write mMovingEnd
;
209 property sizeSpeed
: TDFSize read mSizeSpeed write mSizeSpeed
;
210 property sizeEnd
: TDFSize read mSizeEnd write mSizeEnd
;
212 property endPosTrigId
: Integer read mEndPosTrig write mEndPosTrig
;
213 property endSizeTrigId
: Integer read mEndSizeTrig write mEndSizeTrig
;
216 TPanelArray
= Array of TPanel
;
225 g_dbgpan_mplat_active
: Boolean = {$IF DEFINED(D2F_DEBUG)}true{$ELSE}true{$ENDIF};
226 g_dbgpan_mplat_step
: Boolean = false; // one step, and stop
238 {$IFDEF ENABLE_CORPSES}
241 g_basic
, g_map
, g_game
, g_weapons
, g_triggers
, g_items
,
242 g_console
, g_language
, g_monsters
, g_player
, g_grid
, e_log
, geom
, utils
, xstreams
246 PANEL_SIGNATURE
= $4C4E4150; // 'PANL'
250 function GetSpecialTexture (const name
: String): Integer;
251 (* HACK: get texture id, if not present -> insert it into list *)
252 (* required for older maps *)
256 if Textures
<> nil then
258 len
:= Length(Textures
);
259 while (i
< len
) and (Textures
[i
].TextureName
<> name
) do
265 SetLength(Textures
, len
+ 1);
266 Textures
[i
].TextureName
:= name
;
271 constructor TPanel
.Create(PanelRec
: TDynRecord
;
272 AddTextures
: TAddTextureArray
;
274 var Textures
: TLevelTextureArray
; aguid
: Integer);
283 Width
:= PanelRec
.Width
;
284 Height
:= PanelRec
.Height
;
291 mapId
:= PanelRec
.id
;
294 mMovingSpeed
:= PanelRec
.moveSpeed
;
295 mMovingStart
:= PanelRec
.moveStart
;
296 mMovingEnd
:= PanelRec
.moveEnd
;
297 mMovingActive
:= PanelRec
['move_active'].value
;
298 mOldMovingActive
:= mMovingActive
;
299 mMoveOnce
:= PanelRec
.moveOnce
;
301 mSizeSpeed
:= PanelRec
.sizeSpeed
;
302 mSizeEnd
:= PanelRec
.sizeEnd
;
304 mEndPosTrig
:= PanelRec
.endPosTrig
;
305 mEndSizeTrig
:= PanelRec
.endSizeTrig
;
310 PanelType
:= PanelRec
.PanelType
;
313 LiftType
:= LIFTTYPE_UP
;
314 hasTexTrigger
:= False;
317 PANEL_OPENDOOR
: begin Enabled
:= False; Door
:= True; end;
318 PANEL_CLOSEDOOR
: Door
:= True;
319 PANEL_LIFTUP
: LiftType
:= LIFTTYPE_UP
; //???
320 PANEL_LIFTDOWN
: LiftType
:= LIFTTYPE_DOWN
;
321 PANEL_LIFTLEFT
: LiftType
:= LIFTTYPE_LEFT
;
322 PANEL_LIFTRIGHT
: LiftType
:= LIFTTYPE_RIGHT
;
326 if ByteBool(PanelRec
.Flags
and PANEL_FLAG_HIDE
) then
328 SetLength(FTextureIDs
, 0);
332 // Панели, не использующие текстуры:
333 if ByteBool(PanelType
and
338 PANEL_BLOCKMON
)) then
340 SetLength(FTextureIDs
, 0);
345 // Если это жидкость без текстуры - спецтекстуру:
346 if WordBool(PanelType
and (PANEL_WATER
or PANEL_ACID1
or PANEL_ACID2
)) and
347 (not ByteBool(PanelRec
.Flags
and PANEL_FLAG_WATERTEXTURES
)) then
349 SetLength(FTextureIDs
, 1);
350 case PanelRec
.PanelType
of
351 PANEL_WATER
: FTextureIDs
[0].Texture
:= GetSpecialTexture(TEXTURE_NAME_WATER
);
352 PANEL_ACID1
: FTextureIDs
[0].Texture
:= GetSpecialTexture(TEXTURE_NAME_ACID1
);
353 PANEL_ACID2
: FTextureIDs
[0].Texture
:= GetSpecialTexture(TEXTURE_NAME_ACID2
);
359 SetLength(FTextureIDs
, Length(AddTextures
));
364 if CurTex
>= Length(FTextureIDs
) then
365 FCurTexture
:= Length(FTextureIDs
) - 1
367 FCurTexture
:= CurTex
;
369 for i
:= 0 to Length(FTextureIDs
) - 1 do
370 FTextureIDs
[i
].Texture
:= AddTextures
[i
].Texture
;
375 // Текстур несколько - нужно сохранять текущую:
376 //if Length(FTextureIDs) > 1 then SaveIt := True;
378 if (PanelRec
.TextureRec
= nil) then tnum
:= -1 else tnum
:= PanelRec
.tagInt
;
379 if (tnum
< 0) then tnum
:= Length(Textures
);
381 // Если не спецтекстура, то задаем размеры:
382 if ({PanelRec.TextureNum}tnum
> High(Textures
)) then
384 e_WriteLog(Format('WTF?! tnum is out of limits! (%d : %d)', [tnum
, High(Textures
)]), TMsgType
.Warning
);
386 FBlending
:= ByteBool(0);
388 else if not g_Map_IsSpecialTexture(Textures
[{PanelRec.TextureNum}tnum
].TextureName
) then
390 FAlpha
:= PanelRec
.Alpha
;
391 FBlending
:= ByteBool(PanelRec
.Flags
and PANEL_FLAG_BLENDING
);
395 destructor TPanel
.Destroy();
397 SetLength(FTextureIDs
, 0);
401 function TPanel
.getx1 (): Integer; inline; begin result
:= X
+Width
-1; end;
402 function TPanel
.gety1 (): Integer; inline; begin result
:= Y
+Height
-1; end;
403 function TPanel
.getvisvalid (): Boolean; inline; begin result
:= (Width
> 0) and (Height
> 0); end;
405 function TPanel
.getMovingSpeedX (): Integer; inline; begin result
:= mMovingSpeed
.X
; end;
406 procedure TPanel
.setMovingSpeedX (v
: Integer); inline; begin mMovingSpeed
.X
:= v
; end;
407 function TPanel
.getMovingSpeedY (): Integer; inline; begin result
:= mMovingSpeed
.Y
; end;
408 procedure TPanel
.setMovingSpeedY (v
: Integer); inline; begin mMovingSpeed
.Y
:= v
; end;
410 function TPanel
.getMovingStartX (): Integer; inline; begin result
:= mMovingStart
.X
; end;
411 procedure TPanel
.setMovingStartX (v
: Integer); inline; begin mMovingStart
.X
:= v
; end;
412 function TPanel
.getMovingStartY (): Integer; inline; begin result
:= mMovingStart
.Y
; end;
413 procedure TPanel
.setMovingStartY (v
: Integer); inline; begin mMovingStart
.Y
:= v
; end;
415 function TPanel
.getMovingEndX (): Integer; inline; begin result
:= mMovingEnd
.X
; end;
416 procedure TPanel
.setMovingEndX (v
: Integer); inline; begin mMovingEnd
.X
:= v
; end;
417 function TPanel
.getMovingEndY (): Integer; inline; begin result
:= mMovingEnd
.Y
; end;
418 procedure TPanel
.setMovingEndY (v
: Integer); inline; begin mMovingEnd
.Y
:= v
; end;
420 function TPanel
.getSizeSpeedX (): Integer; inline; begin result
:= mSizeSpeed
.w
; end;
421 procedure TPanel
.setSizeSpeedX (v
: Integer); inline; begin mSizeSpeed
.w
:= v
; end;
422 function TPanel
.getSizeSpeedY (): Integer; inline; begin result
:= mSizeSpeed
.h
; end;
423 procedure TPanel
.setSizeSpeedY (v
: Integer); inline; begin mSizeSpeed
.h
:= v
; end;
425 function TPanel
.getSizeEndX (): Integer; inline; begin result
:= mSizeEnd
.w
; end;
426 procedure TPanel
.setSizeEndX (v
: Integer); inline; begin mSizeEnd
.w
:= v
; end;
427 function TPanel
.getSizeEndY (): Integer; inline; begin result
:= mSizeEnd
.h
; end;
428 procedure TPanel
.setSizeEndY (v
: Integer); inline; begin mSizeEnd
.h
:= v
; end;
430 function TPanel
.getIsGBack (): Boolean; inline; begin result
:= ((tag
and GridTagBack
) <> 0); end;
431 function TPanel
.getIsGStep (): Boolean; inline; begin result
:= ((tag
and GridTagStep
) <> 0); end;
432 function TPanel
.getIsGWall (): Boolean; inline; begin result
:= ((tag
and (GridTagWall
or GridTagDoor
)) <> 0); end;
433 function TPanel
.getIsGAcid1 (): Boolean; inline; begin result
:= ((tag
and GridTagAcid1
) <> 0); end;
434 function TPanel
.getIsGAcid2 (): Boolean; inline; begin result
:= ((tag
and GridTagAcid2
) <> 0); end;
435 function TPanel
.getIsGWater (): Boolean; inline; begin result
:= ((tag
and GridTagWater
) <> 0); end;
436 function TPanel
.getIsGFore (): Boolean; inline; begin result
:= ((tag
and GridTagFore
) <> 0); end;
437 function TPanel
.getIsGLift (): Boolean; inline; begin result
:= ((tag
and GridTagLift
) <> 0); end;
438 function TPanel
.getIsGBlockMon (): Boolean; inline; begin result
:= ((tag
and GridTagBlockMon
) <> 0); end;
440 function TPanel
.gncNeedSend (): Boolean; inline; begin result
:= mNeedSend
; mNeedSend
:= false; end;
441 procedure TPanel
.setDirty (); inline; begin mNeedSend
:= true; end;
443 procedure TPanel
.positionChanged (); inline;
445 px
, py
, pw
, ph
: Integer;
447 if (proxyId
>= 0) then
449 mapGrid
.getBodyDims(proxyId
, px
, py
, pw
, ph
);
450 if (px
<> x
) or (py
<> y
) or (pw
<> Width
) or (ph
<> Height
) then
453 e_LogWritefln('panel moved: arridx=%s; guid=%s; proxyid=%s; old:(%s,%s)-(%sx%s); new:(%s,%s)-(%sx%s)',
454 [arrIdx, mGUID, proxyId, px, py, pw, ph, x, y, width, height]);
457 g_Mark(px
, py
, pw
, ph
, MARK_WALL
, false);
459 if (Width
< 1) or (Height
< 1) then
461 mapGrid
.proxyEnabled
[proxyId
] := false;
465 mapGrid
.proxyEnabled
[proxyId
] := Enabled
;
466 if (pw
<> Width
) or (ph
<> Height
) then
468 //writeln('panel resize!');
469 mapGrid
.moveResizeBody(proxyId
, X
, Y
, Width
, Height
)
473 mapGrid
.moveBody(proxyId
, X
, Y
);
476 g_Mark(X
, Y
, Width
, Height
, MARK_WALL
);
485 monCheckList
: array of TMonster
= nil;
486 monCheckListUsed
: Integer = 0;
488 procedure TPanel
.Update();
491 nx
, ny
, nw
, nh
: Integer;
492 ex
, ey
, nex
, ney
: Integer;
496 // return `true` if we should move by dx,dy
497 function tryMPlatMove (px
, py
, pw
, ph
: Integer; out dx
, dy
: Integer; out squash
: Boolean; ontop
: PBoolean=nil): Boolean;
508 pdx
:= mMovingSpeed
.X
;
509 pdy
:= mMovingSpeed
.Y
;
510 // standing on the platform?
513 if (ontop
<> nil) then ontop
^ := true;
514 // yes, move with it; but skip steps (no need to process size change here, 'cause platform top cannot be changed with it)
515 mapGrid
.traceBox(tex
, tey
, px
, py
, pw
, ph
, pdx
, pdy
, (GridTagWall
or GridTagDoor
));
519 if (ontop
<> nil) then ontop
^ := false;
520 // not standing on the platform: trace platform to see if it hits the entity
521 // first, process size change (as we cannot sweeptest both move and size change)
522 // but we don't have to check for pushing if the panel is shrinking
525 if (szdx
> 0) or (szdy
> 0) then
527 // ignore shrinking dimension
528 if (szdx
< 0) then szdx
:= 0;
529 if (szdy
< 0) then szdy
:= 0;
530 // move platform by szd* back, and check for szd* movement
531 if sweepAABB(ox
-szdx
, oy
-szdy
, nw
, nh
, szdx
, szdy
, px
, py
, pw
, ph
, @u0
) then
533 // yes, platform hits the entity, push the entity in the resizing direction
534 u0
:= 1.0-u0
; // how much path left?
535 szdx
:= trunc(szdx
*u0
);
536 szdy
:= trunc(szdy
*u0
);
537 if (szdx
<> 0) or (szdy
<> 0) then
539 // has some path to go, trace the entity
540 trtag
:= (GridTagWall
or GridTagDoor
);
541 // if we're moving down, consider steps too
542 if (szdy
> 0) then trtag
:= trtag
or GridTagStep
;
543 mapGrid
.traceBox(tex
, tey
, px
, py
, pw
, ph
, szdx
, szdy
, trtag
);
547 // second, process platform movement, using te* as entity starting point
548 if sweepAABB(ox
, oy
, nw
, nh
, pdx
, pdy
, tex
, tey
, pw
, ph
, @u0
) then
550 //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]);
551 // yes, platform hits the entity, push the entity in the direction of the platform
552 u0
:= 1.0-u0
; // how much path left?
553 pdx
:= trunc(pdx
*u0
);
554 pdy
:= trunc(pdy
*u0
);
555 //e_LogWritefln(' platsweep; uleft=%s; pd=(%s,%s)', [u0, pdx, pdy]);
556 if (pdx
<> 0) or (pdy
<> 0) then
558 // has some path to go, trace the entity
559 trtag
:= (GridTagWall
or GridTagDoor
);
560 // if we're moving down, consider steps too
561 if (pdy
> 0) then trtag
:= trtag
or GridTagStep
;
562 mapGrid
.traceBox(tex
, tey
, px
, py
, pw
, ph
, pdx
, pdy
, trtag
);
566 // done with entity movement, new coords are in te*
569 result
:= (dx
<> 0) or (dy
<> 0);
570 if not conveyor
and ((tag
and (GridTagWall
or GridTagDoor
)) <> 0) then
572 // check for squashing; as entity cannot be pushed into a wall, check only collision with the platform itself
573 squash
:= g_Collide(tex
, tey
, pw
, ph
, nx
, ny
, nw
, nh
); // squash, if still in platform
577 function monCollect (mon
: TMonster
): Boolean;
579 result
:= false; // don't stop
580 if (monCheckListUsed
>= Length(monCheckList
)) then SetLength(monCheckList
, monCheckListUsed
+128);
581 monCheckList
[monCheckListUsed
] := mon
;
582 Inc(monCheckListUsed
);
586 cx0
, cy0
, cx1
, cy1
, cw
, ch
: Integer;
588 px
, py
, pw
, ph
, pdx
, pdy
: Integer;
594 {$IFDEF ENABLE_CORPSES}
602 actMoveTrig
: Boolean;
603 actSizeTrig
: Boolean;
605 if (not Enabled
) or (Width
< 1) or (Height
< 1) then exit
;
607 if not g_dbgpan_mplat_active
then exit
;
609 if (mOldMovingActive
<> mMovingActive
) then mNeedSend
:= true;
610 mOldMovingActive
:= mMovingActive
;
612 if not mMovingActive
then exit
;
613 if mMovingSpeed
.isZero
and mSizeSpeed
.isZero
then exit
;
615 //TODO: write wall size change processing
620 * collect all monsters and players (aka entities) along the possible platform path
621 * if entity is standing on a platform:
622 * try to move it along the platform path, checking wall collisions
623 * if entity is NOT standing on a platform, but hit with sweeped platform aabb:
625 * if we can't push entity all the way, squash it
632 // the mplat acts as a stationary conveyor belt when it's locked within a movement rect of zero area
633 conveyor
:= (mMovingEnd
.X
= mMovingStart
.X
) and (mMovingEnd
.Y
= mMovingStart
.Y
)
634 and (mMovingEnd
.X
= X
) and (mMovingEnd
.Y
= Y
);
636 nw
:= mpw
+mSizeSpeed
.w
;
637 nh
:= mph
+mSizeSpeed
.h
;
642 nx
+= mMovingSpeed
.X
;
643 ny
+= mMovingSpeed
.Y
;
646 // force network updates only if some sudden change happened
647 // set the flag here, so we can sync affected monsters
648 if not mSizeSpeed
.isZero
and (nw
= mSizeEnd
.w
) and (nh
= mSizeEnd
.h
) then
652 else if ((mMovingSpeed
.X
< 0) and (nx
<= mMovingStart
.X
)) or ((mMovingSpeed
.X
> 0) and (nx
>= mMovingEnd
.X
)) then
656 else if ((mMovingSpeed
.Y
< 0) and (ny
<= mMovingStart
.Y
)) or ((mMovingSpeed
.Y
> 0) and (ny
>= mMovingEnd
.Y
)) then
661 // if pannel disappeared, we don't have to do anything
662 if (nw
> 0) and (nh
> 0) then
673 cx1
:= nmax(ex
, nex
);
674 cy1
:= nmax(ey
, ney
);
683 // process "obstacle" panels
684 if ((tag
and GridTagObstacle
) <> 0) then
686 // temporarily turn off this panel, so it won't interfere with collision checks
687 mapGrid
.proxyEnabled
[proxyId
] := false;
690 for f
:= 0 to High(gPlayers
) do
693 if (plr
= nil) or (not plr
.alive
) then continue
;
694 plr
.getMapBox(px
, py
, pw
, ph
);
695 if not g_Collide(px
, py
, pw
, ph
, cx0
, cy0
, cw
, ch
) then continue
;
696 if tryMPlatMove(px
, py
, pw
, ph
, pdx
, pdy
, squash
) then
699 plr
.moveBy(pdx
, pdy
); // this will call `positionChanged()` for us
701 // squash player, if necessary
702 if not g_Game_IsClient
and squash
then plr
.Damage(15000, 0, 0, 0, HIT_TRAP
);
707 for f
:= 0 to High(gGibs
) do
710 if not gib
.alive
then continue
;
711 gib
.getMapBox(px
, py
, pw
, ph
);
712 if not g_Collide(px
, py
, pw
, ph
, cx0
, cy0
, cw
, ch
) then continue
;
713 if tryMPlatMove(px
, py
, pw
, ph
, pdx
, pdy
, squash
, @ontop
) then
716 gib
.moveBy(pdx
, pdy
); // this will call `positionChanged()` for us
721 {$IFDEF ENABLE_CORPSES}
722 // move and push corpses
723 for f
:= 0 to High(gCorpses
) do
726 if (cor
= nil) then continue
;
727 cor
.getMapBox(px
, py
, pw
, ph
);
728 if not g_Collide(px
, py
, pw
, ph
, cx0
, cy0
, cw
, ch
) then continue
;
729 if tryMPlatMove(px
, py
, pw
, ph
, pdx
, pdy
, squash
, @ontop
) then
732 cor
.moveBy(pdx
, pdy
); // this will call `positionChanged()` for us
737 // move and push flags
738 if gGameSettings
.GameMode
= GM_CTF
then
739 for f
:= FLAG_RED
to FLAG_BLUE
do
742 if (flg
.State
in [FLAG_STATE_NONE
, FLAG_STATE_CAPTURED
]) then continue
;
743 px
:= flg
.Obj
.X
+flg
.Obj
.Rect
.X
;
744 py
:= flg
.Obj
.Y
+flg
.Obj
.Rect
.Y
;
745 pw
:= flg
.Obj
.Rect
.Width
;
746 ph
:= flg
.Obj
.Rect
.Height
;
747 if not g_Collide(px
, py
, pw
, ph
, cx0
, cy0
, cw
, ch
) then continue
;
748 if tryMPlatMove(px
, py
, pw
, ph
, pdx
, pdy
, squash
, @ontop
) then
749 if (pdx
<> 0) or (pdy
<> 0) then
751 flg
.Obj
.X
:= flg
.Obj
.X
+ pdx
;
752 flg
.Obj
.Y
:= flg
.Obj
.Y
+ pdy
;
753 flg
.NeedSend
:= true;
757 // move and push items
758 itm
:= g_Items_NextAlive(-1);
763 itm
.getMapBox(px
, py
, pw
, ph
);
764 if g_Collide(px
, py
, pw
, ph
, cx0
, cy0
, cw
, ch
) then
765 if tryMPlatMove(px
, py
, pw
, ph
, pdx
, pdy
, squash
, @ontop
) then
766 itm
.moveBy(pdx
, pdy
); // this will call `positionChanged()` for us
768 itm
:= g_Items_NextAlive(itm
.myId
);
772 monCheckListUsed
:= 0;
773 g_Mons_ForEachAt(cx0
, cy0
, cw
, ch
, monCollect
);
775 // process collected monsters
776 if (monCheckListUsed
> 0) then
778 mpfrid
:= g_Mons_getNewMPlatFrameId();
779 for f
:= 0 to monCheckListUsed
do
781 mon
:= monCheckList
[f
];
782 if (mon
= nil) or (not mon
.alive
) or (mon
.mplatCheckFrameId
= mpfrid
) then continue
;
783 mon
.mplatCheckFrameId
:= mpfrid
;
784 mon
.getMapBox(px
, py
, pw
, ph
);
785 //if not g_Collide(px, py, pw, ph, cx0, cy0, cw, ch) then continue;
786 if tryMPlatMove(px
, py
, pw
, ph
, pdx
, pdy
, squash
) then
789 mon
.moveBy(pdx
, pdy
); // this will call `positionChanged()` for us
790 //???FIXME: do we really need to send monsters over the net?
791 // i don't think so, as dead reckoning should take care of 'em
792 // ok, send new monster position only if platform is going to change it's direction
793 if mNeedSend
then mon
.setDirty();
795 // squash monster, if necessary
796 if not g_Game_IsClient
and squash
then mon
.Damage(15000, 0, 0, 0, HIT_TRAP
);
800 // restore panel state
801 mapGrid
.proxyEnabled
[proxyId
] := true;
816 actMoveTrig
:= false;
817 actSizeTrig
:= false;
819 // `mNeedSend` was set above
822 if not mSizeSpeed
.isZero
and (nw
= mSizeEnd
.w
) and (nh
= mSizeEnd
.h
) then
827 if (nw
< 1) or (nh
< 1) then mMovingActive
:= false; //HACK!
832 // reverse moving direction, if necessary
833 if ((mMovingSpeed
.X
< 0) and (nx
<= mMovingStart
.X
)) or ((mMovingSpeed
.X
> 0) and (nx
>= mMovingEnd
.X
)) then
835 if mMoveOnce
then mMovingActive
:= false else mMovingSpeed
.X
:= -mMovingSpeed
.X
;
839 if ((mMovingSpeed
.Y
< 0) and (ny
<= mMovingStart
.Y
)) or ((mMovingSpeed
.Y
> 0) and (ny
>= mMovingEnd
.Y
)) then
841 if mMoveOnce
then mMovingActive
:= false else mMovingSpeed
.Y
:= -mMovingSpeed
.Y
;
845 if (mOldMovingActive
<> mMovingActive
) then mNeedSend
:= true;
846 mOldMovingActive
:= mMovingActive
;
849 if not g_Game_IsClient
then
851 if actMoveTrig
then g_Triggers_Press(mEndPosTrig
, ACTIVATE_CUSTOM
);
852 if actSizeTrig
then g_Triggers_Press(mEndSizeTrig
, ACTIVATE_CUSTOM
);
855 // some triggers may activate this, don't delay sending
856 //TODO: when triggers will be able to control speed and size, check that here too
857 if (mOldMovingActive
<> mMovingActive
) then mNeedSend
:= true;
858 mOldMovingActive
:= mMovingActive
;
862 procedure TPanel
.SetFrame (StartTime
: LongWord);
864 if Enabled
and (FCurTexture
>= 0) and (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
865 FAnimTime
:= StartTime
;
868 procedure TPanel
.NextTexture(AnimLoop
: Byte = 0);
870 Assert(FCurTexture
>= -1, 'FCurTexture < -1');
873 if Length(FTextureIDs
) = 0 then
876 // Только одна текстура:
877 if Length(FTextureIDs
) = 1 then
879 if FCurTexture
= 0 then
885 // Больше одной текстуры:
889 // Следующей нет - возврат к началу:
890 if FCurTexture
>= Length(FTextureIDs
) then
894 if FCurTexture
>= 0 then
897 1: FAnimLoop
:= true;
898 2: FAnimLoop
:= false;
903 LastAnimLoop
:= AnimLoop
;
906 procedure TPanel
.SetTexture(ID
: Integer; AnimLoop
: Byte = 0);
908 if (ID
>= -1) and (ID
< Length(FTextureIDs
)) then
911 if FCurTexture
>= 0 then
914 1: FAnimLoop
:= true;
915 2: FAnimLoop
:= false;
920 LastAnimLoop
:= AnimLoop
;
923 function TPanel
.GetTextureID(): DWORD
;
924 var Texture
: Integer;
926 Result
:= LongWord(TEXTURE_NONE
);
927 if (FCurTexture
>= 0) then
929 Texture
:= FTextureIDs
[FCurTexture
].Texture
;
932 case Textures
[Texture
].TextureName
of (* TODO: optimize it *)
933 TEXTURE_NAME_WATER
: Result
:= DWORD(TEXTURE_SPECIAL_WATER
);
934 TEXTURE_NAME_ACID1
: Result
:= DWORD(TEXTURE_SPECIAL_ACID1
);
935 TEXTURE_NAME_ACID2
: Result
:= DWORD(TEXTURE_SPECIAL_ACID2
);
941 function TPanel
.GetTextureCount(): Integer;
943 Result
:= Length(FTextureIDs
);
944 if Enabled
and (FCurTexture
>= 0) and (Width
> 0) and (Height
> 0) and (FAlpha
< 255) then
945 Result
:= Result
+ 100; // ???
948 function TPanel
.CanChangeTexture(): Boolean;
950 Result
:= (GetTextureCount() > 1) or hasTexTrigger
;
954 PAN_SAVE_VERSION
= 1;
956 procedure TPanel
.SaveState (st
: TStream
);
957 var anim
: Boolean; stub
: TAnimState
;
959 if (st
= nil) then exit
;
962 utils
.writeSign(st
, 'PANL');
963 utils
.writeInt(st
, Byte(PAN_SAVE_VERSION
));
964 // Открыта/закрыта, если дверь
965 utils
.writeBool(st
, FEnabled
);
966 // Направление лифта, если лифт
967 utils
.writeInt(st
, Byte(FLiftType
));
968 // Номер текущей текстуры
969 utils
.writeInt(st
, Integer(FCurTexture
));
970 // Координаты и размер
971 utils
.writeInt(st
, Integer(FX
));
972 utils
.writeInt(st
, Integer(FY
));
973 utils
.writeInt(st
, Word(FWidth
));
974 utils
.writeInt(st
, Word(FHeight
));
975 // Анимирована ли текущая текстура
976 anim
:= FCurTexture
>= 0;
977 utils
.writeBool(st
, anim
);
978 // Если да - сохраняем анимацию
981 stub
:= TAnimState
.Create(FAnimLoop
, 1, 1);
982 stub
.SaveState(st
, FAlpha
, FBlending
);
986 // moving platform state
987 utils
.writeInt(st
, Integer(mMovingSpeed
.X
));
988 utils
.writeInt(st
, Integer(mMovingSpeed
.Y
));
989 utils
.writeInt(st
, Integer(mMovingStart
.X
));
990 utils
.writeInt(st
, Integer(mMovingStart
.Y
));
991 utils
.writeInt(st
, Integer(mMovingEnd
.X
));
992 utils
.writeInt(st
, Integer(mMovingEnd
.Y
));
994 utils
.writeInt(st
, Integer(mSizeSpeed
.w
));
995 utils
.writeInt(st
, Integer(mSizeSpeed
.h
));
996 utils
.writeInt(st
, Integer(mSizeEnd
.w
));
997 utils
.writeInt(st
, Integer(mSizeEnd
.h
));
999 utils
.writeBool(st
, mMovingActive
);
1000 utils
.writeBool(st
, mMoveOnce
);
1002 utils
.writeInt(st
, Integer(mEndPosTrig
));
1003 utils
.writeInt(st
, Integer(mEndSizeTrig
));
1007 procedure TPanel
.LoadState (st
: TStream
);
1008 var stub
: TAnimState
;
1010 if (st
= nil) then exit
;
1013 if not utils
.checkSign(st
, 'PANL') then raise XStreamError
.create('wrong panel signature');
1014 if (utils
.readByte(st
) <> PAN_SAVE_VERSION
) then raise XStreamError
.create('wrong panel version');
1015 // Открыта/закрыта, если дверь
1016 FEnabled
:= utils
.readBool(st
);
1017 // Направление лифта, если лифт
1018 FLiftType
:= utils
.readByte(st
);
1019 // Номер текущей текстуры
1020 FCurTexture
:= utils
.readLongInt(st
);
1021 // Координаты и размер
1022 FX
:= utils
.readLongInt(st
);
1023 FY
:= utils
.readLongInt(st
);
1026 FWidth
:= utils
.readWord(st
);
1027 FHeight
:= utils
.readWord(st
);
1030 // Анимированная ли текущая текстура
1031 if utils
.readBool(st
) then
1033 // Если да - загружаем анимацию
1034 Assert(FCurTexture
>= 0, 'TPanel.LoadState: No animation object');
1035 stub
:= TAnimState
.Create(FAnimLoop
, 1, 1);
1036 stub
.LoadState(st
, FAlpha
, FBlending
);
1040 // moving platform state
1041 mMovingSpeed
.X
:= utils
.readLongInt(st
);
1042 mMovingSpeed
.Y
:= utils
.readLongInt(st
);
1043 mMovingStart
.X
:= utils
.readLongInt(st
);
1044 mMovingStart
.Y
:= utils
.readLongInt(st
);
1045 mMovingEnd
.X
:= utils
.readLongInt(st
);
1046 mMovingEnd
.Y
:= utils
.readLongInt(st
);
1048 mSizeSpeed
.w
:= utils
.readLongInt(st
);
1049 mSizeSpeed
.h
:= utils
.readLongInt(st
);
1050 mSizeEnd
.w
:= utils
.readLongInt(st
);
1051 mSizeEnd
.h
:= utils
.readLongInt(st
);
1053 mMovingActive
:= utils
.readBool(st
);
1054 mMoveOnce
:= utils
.readBool(st
);
1056 mEndPosTrig
:= utils
.readLongInt(st
);
1057 mEndSizeTrig
:= utils
.readLongInt(st
);
1060 //mapGrid.proxyEnabled[proxyId] := FEnabled; // done in g_map.pas