DEADSOFTWARE

game: disable corpses for server
[d2df-sdl.git] / src / game / g_panel.pas
1 (* Copyright (C) Doom 2D: Forever Developers
2 *
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.
6 *
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.
11 *
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/>.
14 *)
15 {$INCLUDE ../shared/a_modes.inc}
16 {$M+}
17 unit g_panel;
19 interface
21 uses
22 SysUtils, Classes,
23 MAPDEF, g_textures, xdynrec;
25 type
26 TAddTextureArray = array of record
27 Texture: Cardinal; // Textures[Texture]
28 end;
30 ATextureID = array of record
31 Texture: Cardinal; // Textures[Texture]
32 case Anim: Boolean of
33 False: ();
34 True: (AnTex: TAnimationState);
35 end;
37 PPanel = ^TPanel;
38 TPanel = Class (TObject)
39 private
40 const
41 private
42 mGUID: Integer; // will be assigned in "g_map.pas"
43 FAlpha: Byte;
44 FBlending: Boolean;
45 FTextureIDs: ATextureID;
46 mMovingSpeed: TDFPoint;
47 mMovingStart: TDFPoint;
48 mMovingEnd: TDFPoint;
49 mMovingActive: Boolean;
50 mMoveOnce: Boolean;
52 mOldMovingActive: Boolean;
54 mSizeSpeed: TDFSize;
55 mSizeEnd: TDFSize;
57 mEndPosTrig: Integer;
58 mEndSizeTrig: Integer;
60 mNeedSend: Boolean; // for network
62 private
63 function getx1 (): Integer; inline;
64 function gety1 (): Integer; inline;
65 function getvisvalid (): Boolean; inline;
67 function getMovingSpeedX (): Integer; inline;
68 procedure setMovingSpeedX (v: Integer); inline;
69 function getMovingSpeedY (): Integer; inline;
70 procedure setMovingSpeedY (v: Integer); inline;
72 function getMovingStartX (): Integer; inline;
73 procedure setMovingStartX (v: Integer); inline;
74 function getMovingStartY (): Integer; inline;
75 procedure setMovingStartY (v: Integer); inline;
77 function getMovingEndX (): Integer; inline;
78 procedure setMovingEndX (v: Integer); inline;
79 function getMovingEndY (): Integer; inline;
80 procedure setMovingEndY (v: Integer); inline;
82 function getSizeSpeedX (): Integer; inline;
83 procedure setSizeSpeedX (v: Integer); inline;
84 function getSizeSpeedY (): Integer; inline;
85 procedure setSizeSpeedY (v: Integer); inline;
87 function getSizeEndX (): Integer; inline;
88 procedure setSizeEndX (v: Integer); inline;
89 function getSizeEndY (): Integer; inline;
90 procedure setSizeEndY (v: Integer); inline;
92 public
93 FCurTexture: Integer; // Íîìåð òåêóùåé òåêñòóðû
94 FCurFrame: Integer;
95 FCurFrameCount: Byte;
96 FX, FY: Integer;
97 FWidth, FHeight: Word;
98 FPanelType: Word;
99 FEnabled: Boolean;
100 FDoor: Boolean;
101 FLiftType: Byte;
102 FLastAnimLoop: Byte;
103 // sorry, there fields are public to allow setting 'em in g_map; this should be fixed later
104 // for now, PLEASE, don't modify 'em, or all hell will break loose
105 arrIdx: Integer; // index in one of internal arrays; sorry
106 tag: Integer; // used in coldets and such; sorry; see g_map.GridTagXXX
107 proxyId: Integer; // proxy id in map grid (DO NOT USE!)
108 mapId: AnsiString; // taken directly from map file; dunno why it is here
109 hasTexTrigger: Boolean; // HACK: true when there's a trigger than can change my texture
111 constructor Create(PanelRec: TDynRecord;
112 AddTextures: TAddTextureArray;
113 CurTex: Integer;
114 var Textures: TLevelTextureArray; aguid: Integer);
115 destructor Destroy(); override;
117 procedure Update();
118 procedure SetFrame(Frame: Integer; Count: Byte);
119 procedure NextTexture(AnimLoop: Byte = 0);
120 procedure SetTexture(ID: Integer; AnimLoop: Byte = 0);
121 function GetTextureID(): Cardinal;
122 function GetTextureCount(): Integer;
123 function CanChangeTexture(): Boolean;
125 procedure SaveState (st: TStream);
126 procedure LoadState (st: TStream);
128 procedure positionChanged (); inline;
130 function getIsGBack (): Boolean; inline; // gRenderBackgrounds
131 function getIsGStep (): Boolean; inline; // gSteps
132 function getIsGWall (): Boolean; inline; // gWalls
133 function getIsGAcid1 (): Boolean; inline; // gAcid1
134 function getIsGAcid2 (): Boolean; inline; // gAcid2
135 function getIsGWater (): Boolean; inline; // gWater
136 function getIsGFore (): Boolean; inline; // gRenderForegrounds
137 function getIsGLift (): Boolean; inline; // gLifts
138 function getIsGBlockMon (): Boolean; inline; // gBlockMon
140 // get-and-clear
141 function gncNeedSend (): Boolean; inline;
142 procedure setDirty (); inline; // why `dirty`? 'cause i may introduce property `needSend` later
144 public
145 property visvalid: Boolean read getvisvalid; // panel is "visvalid" when it's width and height are positive
147 published
148 property guid: Integer read mGUID; // will be assigned in "g_map.pas"
149 property x0: Integer read FX;
150 property y0: Integer read FY;
151 property x1: Integer read getx1; // inclusive!
152 property y1: Integer read gety1; // inclusive!
153 property x: Integer read FX write FX;
154 property y: Integer read FY write FY;
155 property width: Word read FWidth write FWidth;
156 property height: Word read FHeight write FHeight;
157 property panelType: Word read FPanelType write FPanelType;
158 property enabled: Boolean read FEnabled write FEnabled;
159 property door: Boolean read FDoor write FDoor;
160 property liftType: Byte read FLiftType write FLiftType;
161 property lastAnimLoop: Byte read FLastAnimLoop write FLastAnimLoop;
163 property movingSpeedX: Integer read getMovingSpeedX write setMovingSpeedX;
164 property movingSpeedY: Integer read getMovingSpeedY write setMovingSpeedY;
165 property movingStartX: Integer read getMovingStartX write setMovingStartX;
166 property movingStartY: Integer read getMovingStartY write setMovingStartY;
167 property movingEndX: Integer read getMovingEndX write setMovingEndX;
168 property movingEndY: Integer read getMovingEndY write setMovingEndY;
169 property movingActive: Boolean read mMovingActive write mMovingActive;
170 property moveOnce: Boolean read mMoveOnce write mMoveOnce;
172 property sizeSpeedX: Integer read getSizeSpeedX write setSizeSpeedX;
173 property sizeSpeedY: Integer read getSizeSpeedY write setSizeSpeedY;
174 property sizeEndX: Integer read getSizeEndX write setSizeEndX;
175 property sizeEndY: Integer read getSizeEndY write setSizeEndY;
177 property isGBack: Boolean read getIsGBack;
178 property isGStep: Boolean read getIsGStep;
179 property isGWall: Boolean read getIsGWall;
180 property isGAcid1: Boolean read getIsGAcid1;
181 property isGAcid2: Boolean read getIsGAcid2;
182 property isGWater: Boolean read getIsGWater;
183 property isGFore: Boolean read getIsGFore;
184 property isGLift: Boolean read getIsGLift;
185 property isGBlockMon: Boolean read getIsGBlockMon;
187 (* private state *)
188 property Alpha: Byte read FAlpha;
189 property Blending: Boolean read FBlending;
190 property TextureIDs: ATextureID read FTextureIDs;
192 public
193 property movingSpeed: TDFPoint read mMovingSpeed write mMovingSpeed;
194 property movingStart: TDFPoint read mMovingStart write mMovingStart;
195 property movingEnd: TDFPoint read mMovingEnd write mMovingEnd;
197 property sizeSpeed: TDFSize read mSizeSpeed write mSizeSpeed;
198 property sizeEnd: TDFSize read mSizeEnd write mSizeEnd;
200 property endPosTrigId: Integer read mEndPosTrig write mEndPosTrig;
201 property endSizeTrigId: Integer read mEndSizeTrig write mEndSizeTrig;
202 end;
204 TPanelArray = Array of TPanel;
206 const
207 LIFTTYPE_UP = 0;
208 LIFTTYPE_DOWN = 1;
209 LIFTTYPE_LEFT = 2;
210 LIFTTYPE_RIGHT = 3;
212 var
213 g_dbgpan_mplat_active: Boolean = {$IF DEFINED(D2F_DEBUG)}true{$ELSE}true{$ENDIF};
214 g_dbgpan_mplat_step: Boolean = false; // one step, and stop
217 implementation
219 uses
220 {$IFDEF ENABLE_GFX}
221 g_gfx,
222 {$ENDIF}
223 {$IFDEF ENABLE_GIBS}
224 g_gibs,
225 {$ENDIF}
226 {$IFDEF ENABLE_CORPSES}
227 g_corpses,
228 {$ENDIF}
229 g_basic, g_map, g_game, g_weapons, g_triggers,
230 g_console, g_language, g_monsters, g_player, g_grid, e_log, geom, utils, xstreams
233 const
234 PANEL_SIGNATURE = $4C4E4150; // 'PANL'
236 { T P a n e l : }
238 function FindTextureByName (const name: String): Integer;
239 var i: Integer;
240 begin
241 Result := -1;
242 if Textures <> nil then
243 begin
244 for i := 0 to High(Textures) do
245 begin
246 if Textures[i].TextureName = name then
247 begin
248 Result := i;
249 break;
250 end
251 end
252 end
253 end;
255 constructor TPanel.Create(PanelRec: TDynRecord;
256 AddTextures: TAddTextureArray;
257 CurTex: Integer;
258 var Textures: TLevelTextureArray; aguid: Integer);
259 var
260 i: Integer;
261 tnum: Integer;
262 begin
263 X := PanelRec.X;
264 Y := PanelRec.Y;
265 Width := PanelRec.Width;
266 Height := PanelRec.Height;
267 FAlpha := 0;
268 FBlending := False;
269 FCurFrame := 0;
270 FCurFrameCount := 0;
271 LastAnimLoop := 0;
273 mapId := PanelRec.id;
274 mGUID := aguid;
276 mMovingSpeed := PanelRec.moveSpeed;
277 mMovingStart := PanelRec.moveStart;
278 mMovingEnd := PanelRec.moveEnd;
279 mMovingActive := PanelRec['move_active'].value;
280 mOldMovingActive := mMovingActive;
281 mMoveOnce := PanelRec.moveOnce;
283 mSizeSpeed := PanelRec.sizeSpeed;
284 mSizeEnd := PanelRec.sizeEnd;
286 mEndPosTrig := PanelRec.endPosTrig;
287 mEndSizeTrig := PanelRec.endSizeTrig;
289 mNeedSend := false;
291 // Òèï ïàíåëè:
292 PanelType := PanelRec.PanelType;
293 Enabled := True;
294 Door := False;
295 LiftType := LIFTTYPE_UP;
296 hasTexTrigger := False;
298 case PanelType of
299 PANEL_OPENDOOR: begin Enabled := False; Door := True; end;
300 PANEL_CLOSEDOOR: Door := True;
301 PANEL_LIFTUP: LiftType := LIFTTYPE_UP; //???
302 PANEL_LIFTDOWN: LiftType := LIFTTYPE_DOWN;
303 PANEL_LIFTLEFT: LiftType := LIFTTYPE_LEFT;
304 PANEL_LIFTRIGHT: LiftType := LIFTTYPE_RIGHT;
305 end;
307 // Íåâèäèìàÿ:
308 if ByteBool(PanelRec.Flags and PANEL_FLAG_HIDE) then
309 begin
310 SetLength(FTextureIDs, 0);
311 FCurTexture := -1;
312 Exit;
313 end;
314 // Ïàíåëè, íå èñïîëüçóþùèå òåêñòóðû:
315 if ByteBool(PanelType and
316 (PANEL_LIFTUP or
317 PANEL_LIFTDOWN or
318 PANEL_LIFTLEFT or
319 PANEL_LIFTRIGHT or
320 PANEL_BLOCKMON)) then
321 begin
322 SetLength(FTextureIDs, 0);
323 FCurTexture := -1;
324 Exit;
325 end;
327 // Åñëè ýòî æèäêîñòü áåç òåêñòóðû - ñïåöòåêñòóðó:
328 if WordBool(PanelType and (PANEL_WATER or PANEL_ACID1 or PANEL_ACID2)) and
329 (not ByteBool(PanelRec.Flags and PANEL_FLAG_WATERTEXTURES)) then
330 begin
331 SetLength(FTextureIDs, 1);
332 FTextureIDs[0].Anim := False;
333 case PanelRec.PanelType of
334 PANEL_WATER: FTextureIDs[0].Texture := FindTextureByName(TEXTURE_NAME_WATER);
335 PANEL_ACID1: FTextureIDs[0].Texture := FindTextureByName(TEXTURE_NAME_ACID1);
336 PANEL_ACID2: FTextureIDs[0].Texture := FindTextureByName(TEXTURE_NAME_ACID2);
337 end;
338 FCurTexture := 0;
339 Exit;
340 end;
342 SetLength(FTextureIDs, Length(AddTextures));
344 if CurTex < 0 then
345 FCurTexture := -1
346 else
347 if CurTex >= Length(FTextureIDs) then
348 FCurTexture := Length(FTextureIDs) - 1
349 else
350 FCurTexture := CurTex;
352 for i := 0 to Length(FTextureIDs)-1 do
353 begin
354 FTextureIDs[i].Texture := AddTextures[i].Texture;
355 FTextureIDs[i].Anim := Textures[AddTextures[i].Texture].FramesCount > 0;
356 if FTextureIDs[i].Anim then
357 begin // Àíèìèðîâàííàÿ òåêñòóðà
358 FTextureIDs[i].AnTex := TAnimationState.Create(True, Textures[AddTextures[i].Texture].Speed, Textures[AddTextures[i].Texture].FramesCount);
359 end
360 end;
362 // Òåêñòóð íåñêîëüêî - íóæíî ñîõðàíÿòü òåêóùóþ:
363 //if Length(FTextureIDs) > 1 then SaveIt := True;
365 if (PanelRec.TextureRec = nil) then tnum := -1 else tnum := PanelRec.tagInt;
366 if (tnum < 0) then tnum := Length(Textures);
368 // Åñëè íå ñïåöòåêñòóðà, òî çàäàåì ðàçìåðû:
369 if ({PanelRec.TextureNum}tnum > High(Textures)) then
370 begin
371 e_WriteLog(Format('WTF?! tnum is out of limits! (%d : %d)', [tnum, High(Textures)]), TMsgType.Warning);
372 FAlpha := 0;
373 FBlending := ByteBool(0);
374 end
375 else if not g_Map_IsSpecialTexture(Textures[{PanelRec.TextureNum}tnum].TextureName) then
376 begin
377 FAlpha := PanelRec.Alpha;
378 FBlending := ByteBool(PanelRec.Flags and PANEL_FLAG_BLENDING);
379 end;
380 end;
382 destructor TPanel.Destroy();
383 var
384 i: Integer;
385 begin
386 for i := 0 to High(FTextureIDs) do
387 if FTextureIDs[i].Anim then
388 FTextureIDs[i].AnTex.Free();
389 SetLength(FTextureIDs, 0);
391 Inherited;
392 end;
394 function TPanel.getx1 (): Integer; inline; begin result := X+Width-1; end;
395 function TPanel.gety1 (): Integer; inline; begin result := Y+Height-1; end;
396 function TPanel.getvisvalid (): Boolean; inline; begin result := (Width > 0) and (Height > 0); end;
398 function TPanel.getMovingSpeedX (): Integer; inline; begin result := mMovingSpeed.X; end;
399 procedure TPanel.setMovingSpeedX (v: Integer); inline; begin mMovingSpeed.X := v; end;
400 function TPanel.getMovingSpeedY (): Integer; inline; begin result := mMovingSpeed.Y; end;
401 procedure TPanel.setMovingSpeedY (v: Integer); inline; begin mMovingSpeed.Y := v; end;
403 function TPanel.getMovingStartX (): Integer; inline; begin result := mMovingStart.X; end;
404 procedure TPanel.setMovingStartX (v: Integer); inline; begin mMovingStart.X := v; end;
405 function TPanel.getMovingStartY (): Integer; inline; begin result := mMovingStart.Y; end;
406 procedure TPanel.setMovingStartY (v: Integer); inline; begin mMovingStart.Y := v; end;
408 function TPanel.getMovingEndX (): Integer; inline; begin result := mMovingEnd.X; end;
409 procedure TPanel.setMovingEndX (v: Integer); inline; begin mMovingEnd.X := v; end;
410 function TPanel.getMovingEndY (): Integer; inline; begin result := mMovingEnd.Y; end;
411 procedure TPanel.setMovingEndY (v: Integer); inline; begin mMovingEnd.Y := v; end;
413 function TPanel.getSizeSpeedX (): Integer; inline; begin result := mSizeSpeed.w; end;
414 procedure TPanel.setSizeSpeedX (v: Integer); inline; begin mSizeSpeed.w := v; end;
415 function TPanel.getSizeSpeedY (): Integer; inline; begin result := mSizeSpeed.h; end;
416 procedure TPanel.setSizeSpeedY (v: Integer); inline; begin mSizeSpeed.h := v; end;
418 function TPanel.getSizeEndX (): Integer; inline; begin result := mSizeEnd.w; end;
419 procedure TPanel.setSizeEndX (v: Integer); inline; begin mSizeEnd.w := v; end;
420 function TPanel.getSizeEndY (): Integer; inline; begin result := mSizeEnd.h; end;
421 procedure TPanel.setSizeEndY (v: Integer); inline; begin mSizeEnd.h := v; end;
423 function TPanel.getIsGBack (): Boolean; inline; begin result := ((tag and GridTagBack) <> 0); end;
424 function TPanel.getIsGStep (): Boolean; inline; begin result := ((tag and GridTagStep) <> 0); end;
425 function TPanel.getIsGWall (): Boolean; inline; begin result := ((tag and (GridTagWall or GridTagDoor)) <> 0); end;
426 function TPanel.getIsGAcid1 (): Boolean; inline; begin result := ((tag and GridTagAcid1) <> 0); end;
427 function TPanel.getIsGAcid2 (): Boolean; inline; begin result := ((tag and GridTagAcid2) <> 0); end;
428 function TPanel.getIsGWater (): Boolean; inline; begin result := ((tag and GridTagWater) <> 0); end;
429 function TPanel.getIsGFore (): Boolean; inline; begin result := ((tag and GridTagFore) <> 0); end;
430 function TPanel.getIsGLift (): Boolean; inline; begin result := ((tag and GridTagLift) <> 0); end;
431 function TPanel.getIsGBlockMon (): Boolean; inline; begin result := ((tag and GridTagBlockMon) <> 0); end;
433 function TPanel.gncNeedSend (): Boolean; inline; begin result := mNeedSend; mNeedSend := false; end;
434 procedure TPanel.setDirty (); inline; begin mNeedSend := true; end;
436 procedure TPanel.positionChanged (); inline;
437 var
438 px, py, pw, ph: Integer;
439 begin
440 if (proxyId >= 0) then
441 begin
442 mapGrid.getBodyDims(proxyId, px, py, pw, ph);
443 if (px <> x) or (py <> y) or (pw <> Width) or (ph <> Height) then
444 begin
446 e_LogWritefln('panel moved: arridx=%s; guid=%s; proxyid=%s; old:(%s,%s)-(%sx%s); new:(%s,%s)-(%sx%s)',
447 [arrIdx, mGUID, proxyId, px, py, pw, ph, x, y, width, height]);
449 {$IFDEF ENABLE_GFX}
450 g_Mark(px, py, pw, ph, MARK_WALL, false);
451 {$ENDIF}
452 if (Width < 1) or (Height < 1) then
453 begin
454 mapGrid.proxyEnabled[proxyId] := false;
455 end
456 else
457 begin
458 mapGrid.proxyEnabled[proxyId] := Enabled;
459 if (pw <> Width) or (ph <> Height) then
460 begin
461 //writeln('panel resize!');
462 mapGrid.moveResizeBody(proxyId, X, Y, Width, Height)
463 end
464 else
465 begin
466 mapGrid.moveBody(proxyId, X, Y);
467 end;
468 {$IFDEF ENABLE_GFX}
469 g_Mark(X, Y, Width, Height, MARK_WALL);
470 {$ENDIF}
471 end;
472 end;
473 end;
474 end;
477 var
478 monCheckList: array of TMonster = nil;
479 monCheckListUsed: Integer = 0;
481 procedure TPanel.Update();
482 var
483 ox, oy: Integer;
484 nx, ny, nw, nh: Integer;
485 ex, ey, nex, ney: Integer;
486 mpw, mph: Integer;
488 // return `true` if we should move by dx,dy
489 function tryMPlatMove (px, py, pw, ph: Integer; out dx, dy: Integer; out squash: Boolean; ontop: PBoolean=nil): Boolean;
490 var
491 u0: Single;
492 tex, tey: Integer;
493 pdx, pdy: Integer;
494 trtag: Integer;
495 szdx, szdy: Integer;
496 begin
497 squash := false;
498 tex := px;
499 tey := py;
500 pdx := mMovingSpeed.X;
501 pdy := mMovingSpeed.Y;
502 // standing on the platform?
503 if (py+ph = oy) then
504 begin
505 if (ontop <> nil) then ontop^ := true;
506 // yes, move with it; but skip steps (no need to process size change here, 'cause platform top cannot be changed with it)
507 mapGrid.traceBox(tex, tey, px, py, pw, ph, pdx, pdy, (GridTagWall or GridTagDoor));
508 end
509 else
510 begin
511 if (ontop <> nil) then ontop^ := false;
512 // not standing on the platform: trace platform to see if it hits the entity
513 // first, process size change (as we cannot sweeptest both move and size change)
514 // but we don't have to check for pushing if the panel is shrinking
515 szdx := nw-mpw;
516 szdy := nh-mph;
517 if (szdx > 0) or (szdy > 0) then
518 begin
519 // ignore shrinking dimension
520 if (szdx < 0) then szdx := 0;
521 if (szdy < 0) then szdy := 0;
522 // move platform by szd* back, and check for szd* movement
523 if sweepAABB(ox-szdx, oy-szdy, nw, nh, szdx, szdy, px, py, pw, ph, @u0) then
524 begin
525 // yes, platform hits the entity, push the entity in the resizing direction
526 u0 := 1.0-u0; // how much path left?
527 szdx := trunc(szdx*u0);
528 szdy := trunc(szdy*u0);
529 if (szdx <> 0) or (szdy <> 0) then
530 begin
531 // has some path to go, trace the entity
532 trtag := (GridTagWall or GridTagDoor);
533 // if we're moving down, consider steps too
534 if (szdy > 0) then trtag := trtag or GridTagStep;
535 mapGrid.traceBox(tex, tey, px, py, pw, ph, szdx, szdy, trtag);
536 end;
537 end;
538 end;
539 // second, process platform movement, using te* as entity starting point
540 if sweepAABB(ox, oy, nw, nh, pdx, pdy, tex, tey, pw, ph, @u0) then
541 begin
542 //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]);
543 // yes, platform hits the entity, push the entity in the direction of the platform
544 u0 := 1.0-u0; // how much path left?
545 pdx := trunc(pdx*u0);
546 pdy := trunc(pdy*u0);
547 //e_LogWritefln(' platsweep; uleft=%s; pd=(%s,%s)', [u0, pdx, pdy]);
548 if (pdx <> 0) or (pdy <> 0) then
549 begin
550 // has some path to go, trace the entity
551 trtag := (GridTagWall or GridTagDoor);
552 // if we're moving down, consider steps too
553 if (pdy > 0) then trtag := trtag or GridTagStep;
554 mapGrid.traceBox(tex, tey, px, py, pw, ph, pdx, pdy, trtag);
555 end;
556 end;
557 end;
558 // done with entity movement, new coords are in te*
559 dx := tex-px;
560 dy := tey-py;
561 result := (dx <> 0) or (dy <> 0);
562 if ((tag and (GridTagWall or GridTagDoor)) <> 0) then
563 begin
564 // check for squashing; as entity cannot be pushed into a wall, check only collision with the platform itself
565 squash := g_Collide(tex, tey, pw, ph, nx, ny, nw, nh); // squash, if still in platform
566 end;
567 end;
569 function monCollect (mon: TMonster): Boolean;
570 begin
571 result := false; // don't stop
572 if (monCheckListUsed >= Length(monCheckList)) then SetLength(monCheckList, monCheckListUsed+128);
573 monCheckList[monCheckListUsed] := mon;
574 Inc(monCheckListUsed);
575 end;
577 var
578 cx0, cy0, cx1, cy1, cw, ch: Integer;
579 f: Integer;
580 px, py, pw, ph, pdx, pdy: Integer;
581 squash: Boolean;
582 plr: TPlayer;
583 {$IFDEF ENABLE_GIBS}
584 gib: PGib;
585 {$ENDIF}
586 {$IFDEF ENABLE_CORPSES}
587 cor: TCorpse;
588 {$ENDIF}
589 {$IF DEFINED(ENABLE_GIBS) OR DEFINED(ENABLE_CORPSES)}
590 ontop: Boolean;
591 {$ENDIF}
592 mon: TMonster;
593 mpfrid: LongWord;
594 actMoveTrig: Boolean;
595 actSizeTrig: Boolean;
596 begin
597 if (not Enabled) or (Width < 1) or (Height < 1) then exit;
599 if (FCurTexture >= 0) and
600 (FTextureIDs[FCurTexture].Anim) and
601 (FTextureIDs[FCurTexture].AnTex <> nil) and
602 (FAlpha < 255) then
603 begin
604 FTextureIDs[FCurTexture].AnTex.Update();
605 FCurFrame := FTextureIDs[FCurTexture].AnTex.CurrentFrame;
606 FCurFrameCount := FTextureIDs[FCurTexture].AnTex.CurrentCounter;
607 end;
609 if not g_dbgpan_mplat_active then exit;
611 if (mOldMovingActive <> mMovingActive) then mNeedSend := true;
612 mOldMovingActive := mMovingActive;
614 if not mMovingActive then exit;
615 if mMovingSpeed.isZero and mSizeSpeed.isZero then exit;
617 //TODO: write wall size change processing
619 // moving platform?
620 begin
621 (*
622 * collect all monsters and players (aka entities) along the possible platform path
623 * if entity is standing on a platform:
624 * try to move it along the platform path, checking wall collisions
625 * if entity is NOT standing on a platform, but hit with sweeped platform aabb:
626 * try to push entity
627 * if we can't push entity all the way, squash it
628 *)
629 ox := X;
630 oy := Y;
631 mpw := Width;
632 mph := Height;
634 nw := mpw+mSizeSpeed.w;
635 nh := mph+mSizeSpeed.h;
636 nx := ox+mMovingSpeed.X;
637 ny := oy+mMovingSpeed.Y;
639 // force network updates only if some sudden change happened
640 // set the flag here, so we can sync affected monsters
641 if not mSizeSpeed.isZero and (nw = mSizeEnd.w) and (nh = mSizeEnd.h) then
642 begin
643 mNeedSend := true;
644 end
645 else if ((mMovingSpeed.X < 0) and (nx <= mMovingStart.X)) or ((mMovingSpeed.X > 0) and (nx >= mMovingEnd.X)) then
646 begin
647 mNeedSend := true;
648 end
649 else if ((mMovingSpeed.Y < 0) and (ny <= mMovingStart.Y)) or ((mMovingSpeed.Y > 0) and (ny >= mMovingEnd.Y)) then
650 begin
651 mNeedSend := true;
652 end;
654 // if pannel disappeared, we don't have to do anything
655 if (nw > 0) and (nh > 0) then
656 begin
657 // old rect
658 ex := ox+mpw-1;
659 ey := ox+mph-1;
660 // new rect
661 nex := nx+nw-1;
662 ney := ny+nh-1;
663 // full rect
664 cx0 := nmin(ox, nx);
665 cy0 := nmin(oy, ny);
666 cx1 := nmax(ex, nex);
667 cy1 := nmax(ey, ney);
668 // extrude
669 cx0 -= 1;
670 cy0 -= 1;
671 cx1 += 1;
672 cy1 += 1;
673 cw := cx1-cx0+1;
674 ch := cy1-cy0+1;
676 // process "obstacle" panels
677 if ((tag and GridTagObstacle) <> 0) then
678 begin
679 // temporarily turn off this panel, so it won't interfere with collision checks
680 mapGrid.proxyEnabled[proxyId] := false;
682 // process players
683 for f := 0 to High(gPlayers) do
684 begin
685 plr := gPlayers[f];
686 if (plr = nil) or (not plr.alive) then continue;
687 plr.getMapBox(px, py, pw, ph);
688 if not g_Collide(px, py, pw, ph, cx0, cy0, cw, ch) then continue;
689 if tryMPlatMove(px, py, pw, ph, pdx, pdy, squash) then
690 begin
691 // set new position
692 plr.moveBy(pdx, pdy); // this will call `positionChanged()` for us
693 end;
694 // squash player, if necessary
695 if not g_Game_IsClient and squash then plr.Damage(15000, 0, 0, 0, HIT_TRAP);
696 end;
698 {$IFDEF ENABLE_GIBS}
699 // process gibs
700 for f := 0 to High(gGibs) do
701 begin
702 gib := @gGibs[f];
703 if not gib.alive then continue;
704 gib.getMapBox(px, py, pw, ph);
705 if not g_Collide(px, py, pw, ph, cx0, cy0, cw, ch) then continue;
706 if tryMPlatMove(px, py, pw, ph, pdx, pdy, squash, @ontop) then
707 begin
708 // set new position
709 gib.moveBy(pdx, pdy); // this will call `positionChanged()` for us
710 end;
711 end;
712 {$ENDIF}
714 {$IFDEF ENABLE_CORPSES}
715 // move and push corpses
716 for f := 0 to High(gCorpses) do
717 begin
718 cor := gCorpses[f];
719 if (cor = nil) then continue;
720 cor.getMapBox(px, py, pw, ph);
721 if not g_Collide(px, py, pw, ph, cx0, cy0, cw, ch) then continue;
722 if tryMPlatMove(px, py, pw, ph, pdx, pdy, squash, @ontop) then
723 begin
724 // set new position
725 cor.moveBy(pdx, pdy); // this will call `positionChanged()` for us
726 end;
727 end;
728 {$ENDIF}
730 // collect monsters
731 monCheckListUsed := 0;
732 g_Mons_ForEachAt(cx0, cy0, cw, ch, monCollect);
734 // process collected monsters
735 if (monCheckListUsed > 0) then
736 begin
737 mpfrid := g_Mons_getNewMPlatFrameId();
738 for f := 0 to monCheckListUsed do
739 begin
740 mon := monCheckList[f];
741 if (mon = nil) or (not mon.alive) or (mon.mplatCheckFrameId = mpfrid) then continue;
742 mon.mplatCheckFrameId := mpfrid;
743 mon.getMapBox(px, py, pw, ph);
744 //if not g_Collide(px, py, pw, ph, cx0, cy0, cw, ch) then continue;
745 if tryMPlatMove(px, py, pw, ph, pdx, pdy, squash) then
746 begin
747 // set new position
748 mon.moveBy(pdx, pdy); // this will call `positionChanged()` for us
749 //???FIXME: do we really need to send monsters over the net?
750 // i don't think so, as dead reckoning should take care of 'em
751 // ok, send new monster position only if platform is going to change it's direction
752 if mNeedSend then mon.setDirty();
753 end;
754 // squash monster, if necessary
755 if not g_Game_IsClient and squash then mon.Damage(15000, 0, 0, 0, HIT_TRAP);
756 end;
757 end;
759 // restore panel state
760 mapGrid.proxyEnabled[proxyId] := true;
761 end;
762 end;
764 // move panel
765 X := nx;
766 Y := ny;
767 FWidth := nw;
768 FHeight := nh;
769 positionChanged();
771 actMoveTrig := false;
772 actSizeTrig := false;
774 // `mNeedSend` was set above
776 // check "size stop"
777 if not mSizeSpeed.isZero and (nw = mSizeEnd.w) and (nh = mSizeEnd.h) then
778 begin
779 mSizeSpeed.w := 0;
780 mSizeSpeed.h := 0;
781 actSizeTrig := true;
782 if (nw < 1) or (nh < 1) then mMovingActive := false; //HACK!
783 end;
785 // reverse moving direction, if necessary
786 if ((mMovingSpeed.X < 0) and (nx <= mMovingStart.X)) or ((mMovingSpeed.X > 0) and (nx >= mMovingEnd.X)) then
787 begin
788 if mMoveOnce then mMovingActive := false else mMovingSpeed.X := -mMovingSpeed.X;
789 actMoveTrig := true;
790 end;
792 if ((mMovingSpeed.Y < 0) and (ny <= mMovingStart.Y)) or ((mMovingSpeed.Y > 0) and (ny >= mMovingEnd.Y)) then
793 begin
794 if mMoveOnce then mMovingActive := false else mMovingSpeed.Y := -mMovingSpeed.Y;
795 actMoveTrig := true;
796 end;
798 if (mOldMovingActive <> mMovingActive) then mNeedSend := true;
799 mOldMovingActive := mMovingActive;
801 if not g_Game_IsClient then
802 begin
803 if actMoveTrig then g_Triggers_Press(mEndPosTrig, ACTIVATE_CUSTOM);
804 if actSizeTrig then g_Triggers_Press(mEndSizeTrig, ACTIVATE_CUSTOM);
805 end;
807 // some triggers may activate this, don't delay sending
808 //TODO: when triggers will be able to control speed and size, check that here too
809 if (mOldMovingActive <> mMovingActive) then mNeedSend := true;
810 mOldMovingActive := mMovingActive;
811 end;
812 end;
815 procedure TPanel.SetFrame(Frame: Integer; Count: Byte);
817 function ClampInt(X, A, B: Integer): Integer;
818 begin
819 Result := X;
820 if X < A then Result := A else if X > B then Result := B;
821 end;
823 begin
824 if Enabled and (FCurTexture >= 0) and
825 (FTextureIDs[FCurTexture].Anim) and
826 (FTextureIDs[FCurTexture].AnTex <> nil) and
827 (Width > 0) and (Height > 0) and (FAlpha < 255) then
828 begin
829 FCurFrame := ClampInt(Frame, 0, FTextureIDs[FCurTexture].AnTex.TotalFrames - 1);
830 FCurFrameCount := Count;
831 FTextureIDs[FCurTexture].AnTex.CurrentFrame := FCurFrame;
832 FTextureIDs[FCurTexture].AnTex.CurrentCounter := FCurFrameCount;
833 end;
834 end;
836 procedure TPanel.NextTexture(AnimLoop: Byte = 0);
837 begin
838 Assert(FCurTexture >= -1, 'FCurTexture < -1');
840 // Íåò òåêñòóð:
841 if Length(FTextureIDs) = 0 then
842 FCurTexture := -1
843 else
844 // Òîëüêî îäíà òåêñòóðà:
845 if Length(FTextureIDs) = 1 then
846 begin
847 if FCurTexture = 0 then
848 FCurTexture := -1
849 else
850 FCurTexture := 0;
851 end
852 else
853 // Áîëüøå îäíîé òåêñòóðû:
854 begin
855 // Ñëåäóþùàÿ:
856 Inc(FCurTexture);
857 // Ñëåäóþùåé íåò - âîçâðàò ê íà÷àëó:
858 if FCurTexture >= Length(FTextureIDs) then
859 FCurTexture := 0;
860 end;
862 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
863 if (FCurTexture >= 0) and FTextureIDs[FCurTexture].Anim then
864 begin
865 if (FTextureIDs[FCurTexture].AnTex = nil) then
866 begin
867 g_FatalError(_lc[I_GAME_ERROR_SWITCH_TEXTURE]);
868 Exit;
869 end;
871 if AnimLoop = 1 then
872 FTextureIDs[FCurTexture].AnTex.Loop := True
873 else
874 if AnimLoop = 2 then
875 FTextureIDs[FCurTexture].AnTex.Loop := False;
877 FTextureIDs[FCurTexture].AnTex.Reset();
878 end;
880 LastAnimLoop := AnimLoop;
881 end;
883 procedure TPanel.SetTexture(ID: Integer; AnimLoop: Byte = 0);
884 begin
885 if (ID >= -1) and (ID < Length(FTextureIDs)) then
886 FCurTexture := ID;
888 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
889 if (FCurTexture >= 0) and FTextureIDs[FCurTexture].Anim then
890 begin
891 if (FTextureIDs[FCurTexture].AnTex = nil) then
892 begin
893 g_FatalError(_lc[I_GAME_ERROR_SWITCH_TEXTURE]);
894 Exit;
895 end;
897 if AnimLoop = 1 then
898 FTextureIDs[FCurTexture].AnTex.Loop := True
899 else
900 if AnimLoop = 2 then
901 FTextureIDs[FCurTexture].AnTex.Loop := False;
903 FTextureIDs[FCurTexture].AnTex.Reset();
904 end;
906 LastAnimLoop := AnimLoop;
907 end;
909 function TPanel.GetTextureID(): DWORD;
910 var Texture: Integer;
911 begin
912 Result := LongWord(TEXTURE_NONE);
913 if (FCurTexture >= 0) then
914 begin
915 Texture := FTextureIDs[FCurTexture].Texture;
916 case Textures[Texture].TextureName of
917 TEXTURE_NAME_WATER: Result := DWORD(TEXTURE_SPECIAL_WATER);
918 TEXTURE_NAME_ACID1: Result := DWORD(TEXTURE_SPECIAL_ACID1);
919 TEXTURE_NAME_ACID2: Result := DWORD(TEXTURE_SPECIAL_ACID2);
920 end
921 end
922 end;
924 function TPanel.GetTextureCount(): Integer;
925 begin
926 Result := Length(FTextureIDs);
927 if Enabled and (FCurTexture >= 0) then
928 if (FTextureIDs[FCurTexture].Anim) and
929 (FTextureIDs[FCurTexture].AnTex <> nil) and
930 (Width > 0) and (Height > 0) and (FAlpha < 255) then
931 Result := Result + 100;
932 end;
934 function TPanel.CanChangeTexture(): Boolean;
935 begin
936 Result := (GetTextureCount() > 1) or hasTexTrigger;
937 end;
939 const
940 PAN_SAVE_VERSION = 1;
942 procedure TPanel.SaveState (st: TStream);
943 var
944 anim: Boolean;
945 begin
946 if (st = nil) then exit;
948 // Ñèãíàòóðà ïàíåëè
949 utils.writeSign(st, 'PANL');
950 utils.writeInt(st, Byte(PAN_SAVE_VERSION));
951 // Îòêðûòà/çàêðûòà, åñëè äâåðü
952 utils.writeBool(st, FEnabled);
953 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò
954 utils.writeInt(st, Byte(FLiftType));
955 // Íîìåð òåêóùåé òåêñòóðû
956 utils.writeInt(st, Integer(FCurTexture));
957 // Êîîðäèíàòû è ðàçìåð
958 utils.writeInt(st, Integer(FX));
959 utils.writeInt(st, Integer(FY));
960 utils.writeInt(st, Word(FWidth));
961 utils.writeInt(st, Word(FHeight));
962 // Àíèìèðîâàíà ëè òåêóùàÿ òåêñòóðà
963 if (FCurTexture >= 0) and (FTextureIDs[FCurTexture].Anim) then
964 begin
965 assert(FTextureIDs[FCurTexture].AnTex <> nil, 'TPanel.SaveState: No animation object');
966 anim := true;
967 end
968 else
969 begin
970 anim := false;
971 end;
972 utils.writeBool(st, anim);
973 // Åñëè äà - ñîõðàíÿåì àíèìàöèþ
974 if anim then FTextureIDs[FCurTexture].AnTex.SaveState(st, FAlpha, FBlending);
976 // moving platform state
977 utils.writeInt(st, Integer(mMovingSpeed.X));
978 utils.writeInt(st, Integer(mMovingSpeed.Y));
979 utils.writeInt(st, Integer(mMovingStart.X));
980 utils.writeInt(st, Integer(mMovingStart.Y));
981 utils.writeInt(st, Integer(mMovingEnd.X));
982 utils.writeInt(st, Integer(mMovingEnd.Y));
984 utils.writeInt(st, Integer(mSizeSpeed.w));
985 utils.writeInt(st, Integer(mSizeSpeed.h));
986 utils.writeInt(st, Integer(mSizeEnd.w));
987 utils.writeInt(st, Integer(mSizeEnd.h));
989 utils.writeBool(st, mMovingActive);
990 utils.writeBool(st, mMoveOnce);
992 utils.writeInt(st, Integer(mEndPosTrig));
993 utils.writeInt(st, Integer(mEndSizeTrig));
994 end;
997 procedure TPanel.LoadState (st: TStream);
998 begin
999 if (st = nil) then exit;
1001 // Ñèãíàòóðà ïàíåëè
1002 if not utils.checkSign(st, 'PANL') then raise XStreamError.create('wrong panel signature');
1003 if (utils.readByte(st) <> PAN_SAVE_VERSION) then raise XStreamError.create('wrong panel version');
1004 // Îòêðûòà/çàêðûòà, åñëè äâåðü
1005 FEnabled := utils.readBool(st);
1006 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò
1007 FLiftType := utils.readByte(st);
1008 // Íîìåð òåêóùåé òåêñòóðû
1009 FCurTexture := utils.readLongInt(st);
1010 // Êîîðäèíàòû è ðàçìåð
1011 FX := utils.readLongInt(st);
1012 FY := utils.readLongInt(st);
1013 FWidth := utils.readWord(st);
1014 FHeight := utils.readWord(st);
1015 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà
1016 if utils.readBool(st) then
1017 begin
1018 // Åñëè äà - çàãðóæàåì àíèìàöèþ
1019 Assert((FCurTexture >= 0) and
1020 (FTextureIDs[FCurTexture].Anim) and
1021 (FTextureIDs[FCurTexture].AnTex <> nil),
1022 'TPanel.LoadState: No animation object');
1023 FTextureIDs[FCurTexture].AnTex.LoadState(st, FAlpha, FBlending);
1024 end;
1026 // moving platform state
1027 mMovingSpeed.X := utils.readLongInt(st);
1028 mMovingSpeed.Y := utils.readLongInt(st);
1029 mMovingStart.X := utils.readLongInt(st);
1030 mMovingStart.Y := utils.readLongInt(st);
1031 mMovingEnd.X := utils.readLongInt(st);
1032 mMovingEnd.Y := utils.readLongInt(st);
1034 mSizeSpeed.w := utils.readLongInt(st);
1035 mSizeSpeed.h := utils.readLongInt(st);
1036 mSizeEnd.w := utils.readLongInt(st);
1037 mSizeEnd.h := utils.readLongInt(st);
1039 mMovingActive := utils.readBool(st);
1040 mMoveOnce := utils.readBool(st);
1042 mEndPosTrig := utils.readLongInt(st);
1043 mEndSizeTrig := utils.readLongInt(st);
1045 positionChanged();
1046 //mapGrid.proxyEnabled[proxyId] := FEnabled; // done in g_map.pas
1047 end;
1050 end.