DEADSOFTWARE

experimental (and ugly) loading progress bar
[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, either version 3 of the License, or
6 * (at your option) any later version.
7 *
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.
12 *
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/>.
15 *)
16 {$INCLUDE ../shared/a_modes.inc}
17 {$M+}
18 unit g_panel;
20 interface
22 uses
23 SysUtils, Classes,
24 MAPDEF, g_textures, xdynrec;
26 type
27 TAddTextureArray = Array of
28 record
29 Texture: Cardinal;
30 Anim: Boolean;
31 end;
33 TPanel = Class (TObject)
34 private
35 const
36 private
37 mGUID: Integer; // will be assigned in "g_map.pas"
38 FTextureWidth: Word;
39 FTextureHeight: Word;
40 FAlpha: Byte;
41 FBlending: Boolean;
42 FTextureIDs: Array of
43 record
44 case Anim: Boolean of
45 False: (Tex: Cardinal);
46 True: (AnTex: TAnimation);
47 end;
49 mMovingSpeed: TDFPoint;
50 mMovingStart: TDFPoint;
51 mMovingEnd: TDFPoint;
52 mMovingActive: Boolean;
53 mMoveOnce: Boolean;
55 mOldMovingActive: Boolean;
57 mSizeSpeed: TDFSize;
58 mSizeEnd: TDFSize;
60 mEndPosTrig: Integer;
61 mEndSizeTrig: Integer;
63 mNeedSend: Boolean; // for network
65 private
66 function getx1 (): Integer; inline;
67 function gety1 (): Integer; inline;
68 function getvisvalid (): Boolean; inline;
70 function getMovingSpeedX (): Integer; inline;
71 procedure setMovingSpeedX (v: Integer); inline;
72 function getMovingSpeedY (): Integer; inline;
73 procedure setMovingSpeedY (v: Integer); inline;
75 function getMovingStartX (): Integer; inline;
76 procedure setMovingStartX (v: Integer); inline;
77 function getMovingStartY (): Integer; inline;
78 procedure setMovingStartY (v: Integer); inline;
80 function getMovingEndX (): Integer; inline;
81 procedure setMovingEndX (v: Integer); inline;
82 function getMovingEndY (): Integer; inline;
83 procedure setMovingEndY (v: Integer); inline;
85 function getSizeSpeedX (): Integer; inline;
86 procedure setSizeSpeedX (v: Integer); inline;
87 function getSizeSpeedY (): Integer; inline;
88 procedure setSizeSpeedY (v: Integer); inline;
90 function getSizeEndX (): Integer; inline;
91 procedure setSizeEndX (v: Integer); inline;
92 function getSizeEndY (): Integer; inline;
93 procedure setSizeEndY (v: Integer); inline;
95 public
96 FCurTexture: Integer; // Íîìåð òåêóùåé òåêñòóðû
97 FCurFrame: Integer;
98 FCurFrameCount: Byte;
99 FX, FY: Integer;
100 FWidth, FHeight: Word;
101 FPanelType: Word;
102 FEnabled: Boolean;
103 FDoor: Boolean;
104 FLiftType: Byte;
105 FLastAnimLoop: Byte;
106 // sorry, there fields are public to allow setting 'em in g_map; this should be fixed later
107 // for now, PLEASE, don't modify 'em, or all hell will break loose
108 arrIdx: Integer; // index in one of internal arrays; sorry
109 tag: Integer; // used in coldets and such; sorry; see g_map.GridTagXXX
110 proxyId: Integer; // proxy id in map grid (DO NOT USE!)
111 mapId: AnsiString; // taken directly from map file; dunno why it is here
113 constructor Create(PanelRec: TDynRecord;
114 AddTextures: TAddTextureArray;
115 CurTex: Integer;
116 var Textures: TLevelTextureArray; aguid: Integer);
117 destructor Destroy(); override;
119 procedure Draw (hasAmbient: Boolean; constref ambColor: TDFColor);
120 procedure DrawShadowVolume(lightX: Integer; lightY: Integer; radius: Integer);
121 procedure Update();
122 procedure SetFrame(Frame: Integer; Count: Byte);
123 procedure NextTexture(AnimLoop: Byte = 0);
124 procedure SetTexture(ID: Integer; AnimLoop: Byte = 0);
125 function GetTextureID(): Cardinal;
126 function GetTextureCount(): Integer;
128 procedure SaveState (st: TStream);
129 procedure LoadState (st: TStream);
131 procedure positionChanged (); inline;
133 function getIsGBack (): Boolean; inline; // gRenderBackgrounds
134 function getIsGStep (): Boolean; inline; // gSteps
135 function getIsGWall (): Boolean; inline; // gWalls
136 function getIsGAcid1 (): Boolean; inline; // gAcid1
137 function getIsGAcid2 (): Boolean; inline; // gAcid2
138 function getIsGWater (): Boolean; inline; // gWater
139 function getIsGFore (): Boolean; inline; // gRenderForegrounds
140 function getIsGLift (): Boolean; inline; // gLifts
141 function getIsGBlockMon (): Boolean; inline; // gBlockMon
143 // get-and-clear
144 function gncNeedSend (): Boolean; inline;
145 procedure setDirty (); inline; // why `dirty`? 'cause i may introduce property `needSend` later
147 public
148 property visvalid: Boolean read getvisvalid; // panel is "visvalid" when it's width and height are positive
150 published
151 property guid: Integer read mGUID; // will be assigned in "g_map.pas"
152 property x0: Integer read FX;
153 property y0: Integer read FY;
154 property x1: Integer read getx1; // inclusive!
155 property y1: Integer read gety1; // inclusive!
156 property x: Integer read FX write FX;
157 property y: Integer read FY write FY;
158 property width: Word read FWidth write FWidth;
159 property height: Word read FHeight write FHeight;
160 property panelType: Word read FPanelType write FPanelType;
161 property enabled: Boolean read FEnabled write FEnabled;
162 property door: Boolean read FDoor write FDoor;
163 property liftType: Byte read FLiftType write FLiftType;
164 property lastAnimLoop: Byte read FLastAnimLoop write FLastAnimLoop;
166 property movingSpeedX: Integer read getMovingSpeedX write setMovingSpeedX;
167 property movingSpeedY: Integer read getMovingSpeedY write setMovingSpeedY;
168 property movingStartX: Integer read getMovingStartX write setMovingStartX;
169 property movingStartY: Integer read getMovingStartY write setMovingStartY;
170 property movingEndX: Integer read getMovingEndX write setMovingEndX;
171 property movingEndY: Integer read getMovingEndY write setMovingEndY;
172 property movingActive: Boolean read mMovingActive write mMovingActive;
173 property moveOnce: Boolean read mMoveOnce write mMoveOnce;
175 property sizeSpeedX: Integer read getSizeSpeedX write setSizeSpeedX;
176 property sizeSpeedY: Integer read getSizeSpeedY write setSizeSpeedY;
177 property sizeEndX: Integer read getSizeEndX write setSizeEndX;
178 property sizeEndY: Integer read getSizeEndY write setSizeEndY;
180 property isGBack: Boolean read getIsGBack;
181 property isGStep: Boolean read getIsGStep;
182 property isGWall: Boolean read getIsGWall;
183 property isGAcid1: Boolean read getIsGAcid1;
184 property isGAcid2: Boolean read getIsGAcid2;
185 property isGWater: Boolean read getIsGWater;
186 property isGFore: Boolean read getIsGFore;
187 property isGLift: Boolean read getIsGLift;
188 property isGBlockMon: Boolean read getIsGBlockMon;
190 public
191 property movingSpeed: TDFPoint read mMovingSpeed write mMovingSpeed;
192 property movingStart: TDFPoint read mMovingStart write mMovingStart;
193 property movingEnd: TDFPoint read mMovingEnd write mMovingEnd;
195 property sizeSpeed: TDFSize read mSizeSpeed write mSizeSpeed;
196 property sizeEnd: TDFSize read mSizeEnd write mSizeEnd;
198 property endPosTrigId: Integer read mEndPosTrig write mEndPosTrig;
199 property endSizeTrigId: Integer read mEndSizeTrig write mEndSizeTrig;
200 end;
202 TPanelArray = Array of TPanel;
204 var
205 g_dbgpan_mplat_active: Boolean = {$IF DEFINED(D2F_DEBUG)}true{$ELSE}true{$ENDIF};
206 g_dbgpan_mplat_step: Boolean = false; // one step, and stop
209 implementation
211 uses
212 e_texture, g_basic, g_map, g_game, g_gfx, e_graphics, g_weapons, g_triggers,
213 g_console, g_language, g_monsters, g_player, g_grid, e_log, GL, geom, utils, xstreams;
215 const
216 PANEL_SIGNATURE = $4C4E4150; // 'PANL'
218 { T P a n e l : }
220 constructor TPanel.Create(PanelRec: TDynRecord;
221 AddTextures: TAddTextureArray;
222 CurTex: Integer;
223 var Textures: TLevelTextureArray; aguid: Integer);
224 var
225 i: Integer;
226 tnum: Integer;
227 begin
228 X := PanelRec.X;
229 Y := PanelRec.Y;
230 Width := PanelRec.Width;
231 Height := PanelRec.Height;
232 FAlpha := 0;
233 FBlending := False;
234 FCurFrame := 0;
235 FCurFrameCount := 0;
236 LastAnimLoop := 0;
238 mapId := PanelRec.id;
239 mGUID := aguid;
241 mMovingSpeed := PanelRec.moveSpeed;
242 mMovingStart := PanelRec.moveStart;
243 mMovingEnd := PanelRec.moveEnd;
244 mMovingActive := PanelRec['move_active'].value;
245 mOldMovingActive := mMovingActive;
246 mMoveOnce := PanelRec.moveOnce;
248 mSizeSpeed := PanelRec.sizeSpeed;
249 mSizeEnd := PanelRec.sizeEnd;
251 mEndPosTrig := PanelRec.endPosTrig;
252 mEndSizeTrig := PanelRec.endSizeTrig;
254 mNeedSend := false;
256 // Òèï ïàíåëè:
257 PanelType := PanelRec.PanelType;
258 Enabled := True;
259 Door := False;
260 LiftType := 0;
262 case PanelType of
263 PANEL_OPENDOOR: begin Enabled := False; Door := True; end;
264 PANEL_CLOSEDOOR: Door := True;
265 PANEL_LIFTUP: LiftType := 0; //???
266 PANEL_LIFTDOWN: LiftType := 1;
267 PANEL_LIFTLEFT: LiftType := 2;
268 PANEL_LIFTRIGHT: LiftType := 3;
269 end;
271 // Íåâèäèìàÿ:
272 if ByteBool(PanelRec.Flags and PANEL_FLAG_HIDE) then
273 begin
274 SetLength(FTextureIDs, 0);
275 FCurTexture := -1;
276 Exit;
277 end;
278 // Ïàíåëè, íå èñïîëüçóþùèå òåêñòóðû:
279 if ByteBool(PanelType and
280 (PANEL_LIFTUP or
281 PANEL_LIFTDOWN or
282 PANEL_LIFTLEFT or
283 PANEL_LIFTRIGHT or
284 PANEL_BLOCKMON)) then
285 begin
286 SetLength(FTextureIDs, 0);
287 FCurTexture := -1;
288 Exit;
289 end;
291 // Åñëè ýòî æèäêîñòü áåç òåêñòóðû - ñïåöòåêñòóðó:
292 if WordBool(PanelType and (PANEL_WATER or PANEL_ACID1 or PANEL_ACID2)) and
293 (not ByteBool(PanelRec.Flags and PANEL_FLAG_WATERTEXTURES)) then
294 begin
295 SetLength(FTextureIDs, 1);
296 FTextureIDs[0].Anim := False;
298 case PanelRec.PanelType of
299 PANEL_WATER:
300 FTextureIDs[0].Tex := LongWord(TEXTURE_SPECIAL_WATER);
301 PANEL_ACID1:
302 FTextureIDs[0].Tex := LongWord(TEXTURE_SPECIAL_ACID1);
303 PANEL_ACID2:
304 FTextureIDs[0].Tex := LongWord(TEXTURE_SPECIAL_ACID2);
305 end;
307 FCurTexture := 0;
308 Exit;
309 end;
311 SetLength(FTextureIDs, Length(AddTextures));
313 if CurTex < 0 then
314 FCurTexture := -1
315 else
316 if CurTex >= Length(FTextureIDs) then
317 FCurTexture := Length(FTextureIDs) - 1
318 else
319 FCurTexture := CurTex;
321 for i := 0 to Length(FTextureIDs)-1 do
322 begin
323 FTextureIDs[i].Anim := AddTextures[i].Anim;
324 if FTextureIDs[i].Anim then
325 begin // Àíèìèðîâàííàÿ òåêñòóðà
326 FTextureIDs[i].AnTex :=
327 TAnimation.Create(Textures[AddTextures[i].Texture].FramesID,
328 True, Textures[AddTextures[i].Texture].Speed);
329 FTextureIDs[i].AnTex.Blending := ByteBool(PanelRec.Flags and PANEL_FLAG_BLENDING);
330 FTextureIDs[i].AnTex.Alpha := PanelRec.Alpha;
331 end
332 else
333 begin // Îáû÷íàÿ òåêñòóðà
334 FTextureIDs[i].Tex := Textures[AddTextures[i].Texture].TextureID;
335 end;
336 end;
338 // Òåêñòóð íåñêîëüêî - íóæíî ñîõðàíÿòü òåêóùóþ:
339 //if Length(FTextureIDs) > 1 then SaveIt := True;
341 if (PanelRec.TextureRec = nil) then tnum := -1 else tnum := PanelRec.tagInt;
342 if (tnum < 0) then tnum := Length(Textures);
344 // Åñëè íå ñïåöòåêñòóðà, òî çàäàåì ðàçìåðû:
345 if ({PanelRec.TextureNum}tnum > High(Textures)) then
346 begin
347 e_WriteLog(Format('WTF?! tnum is out of limits! (%d : %d)', [tnum, High(Textures)]), TMsgType.Warning);
348 FTextureWidth := 2;
349 FTextureHeight := 2;
350 FAlpha := 0;
351 FBlending := ByteBool(0);
352 end
353 else if not g_Map_IsSpecialTexture(Textures[{PanelRec.TextureNum}tnum].TextureName) then
354 begin
355 FTextureWidth := Textures[{PanelRec.TextureNum}tnum].Width;
356 FTextureHeight := Textures[{PanelRec.TextureNum}tnum].Height;
357 FAlpha := PanelRec.Alpha;
358 FBlending := ByteBool(PanelRec.Flags and PANEL_FLAG_BLENDING);
359 end;
360 end;
362 destructor TPanel.Destroy();
363 var
364 i: Integer;
365 begin
366 for i := 0 to High(FTextureIDs) do
367 if FTextureIDs[i].Anim then
368 FTextureIDs[i].AnTex.Free();
369 SetLength(FTextureIDs, 0);
371 Inherited;
372 end;
374 function TPanel.getx1 (): Integer; inline; begin result := X+Width-1; end;
375 function TPanel.gety1 (): Integer; inline; begin result := Y+Height-1; end;
376 function TPanel.getvisvalid (): Boolean; inline; begin result := (Width > 0) and (Height > 0); end;
378 function TPanel.getMovingSpeedX (): Integer; inline; begin result := mMovingSpeed.X; end;
379 procedure TPanel.setMovingSpeedX (v: Integer); inline; begin mMovingSpeed.X := v; end;
380 function TPanel.getMovingSpeedY (): Integer; inline; begin result := mMovingSpeed.Y; end;
381 procedure TPanel.setMovingSpeedY (v: Integer); inline; begin mMovingSpeed.Y := v; end;
383 function TPanel.getMovingStartX (): Integer; inline; begin result := mMovingStart.X; end;
384 procedure TPanel.setMovingStartX (v: Integer); inline; begin mMovingStart.X := v; end;
385 function TPanel.getMovingStartY (): Integer; inline; begin result := mMovingStart.Y; end;
386 procedure TPanel.setMovingStartY (v: Integer); inline; begin mMovingStart.Y := v; end;
388 function TPanel.getMovingEndX (): Integer; inline; begin result := mMovingEnd.X; end;
389 procedure TPanel.setMovingEndX (v: Integer); inline; begin mMovingEnd.X := v; end;
390 function TPanel.getMovingEndY (): Integer; inline; begin result := mMovingEnd.Y; end;
391 procedure TPanel.setMovingEndY (v: Integer); inline; begin mMovingEnd.Y := v; end;
393 function TPanel.getSizeSpeedX (): Integer; inline; begin result := mSizeSpeed.w; end;
394 procedure TPanel.setSizeSpeedX (v: Integer); inline; begin mSizeSpeed.w := v; end;
395 function TPanel.getSizeSpeedY (): Integer; inline; begin result := mSizeSpeed.h; end;
396 procedure TPanel.setSizeSpeedY (v: Integer); inline; begin mSizeSpeed.h := v; end;
398 function TPanel.getSizeEndX (): Integer; inline; begin result := mSizeEnd.w; end;
399 procedure TPanel.setSizeEndX (v: Integer); inline; begin mSizeEnd.w := v; end;
400 function TPanel.getSizeEndY (): Integer; inline; begin result := mSizeEnd.h; end;
401 procedure TPanel.setSizeEndY (v: Integer); inline; begin mSizeEnd.h := v; end;
403 function TPanel.getIsGBack (): Boolean; inline; begin result := ((tag and GridTagBack) <> 0); end;
404 function TPanel.getIsGStep (): Boolean; inline; begin result := ((tag and GridTagStep) <> 0); end;
405 function TPanel.getIsGWall (): Boolean; inline; begin result := ((tag and (GridTagWall or GridTagDoor)) <> 0); end;
406 function TPanel.getIsGAcid1 (): Boolean; inline; begin result := ((tag and GridTagAcid1) <> 0); end;
407 function TPanel.getIsGAcid2 (): Boolean; inline; begin result := ((tag and GridTagAcid2) <> 0); end;
408 function TPanel.getIsGWater (): Boolean; inline; begin result := ((tag and GridTagWater) <> 0); end;
409 function TPanel.getIsGFore (): Boolean; inline; begin result := ((tag and GridTagFore) <> 0); end;
410 function TPanel.getIsGLift (): Boolean; inline; begin result := ((tag and GridTagLift) <> 0); end;
411 function TPanel.getIsGBlockMon (): Boolean; inline; begin result := ((tag and GridTagBlockMon) <> 0); end;
413 function TPanel.gncNeedSend (): Boolean; inline; begin result := mNeedSend; mNeedSend := false; end;
414 procedure TPanel.setDirty (); inline; begin mNeedSend := true; end;
417 procedure TPanel.Draw (hasAmbient: Boolean; constref ambColor: TDFColor);
418 var
419 xx, yy: Integer;
420 NoTextureID: DWORD;
421 NW, NH: Word;
422 begin
423 if {Enabled and} (FCurTexture >= 0) and
424 (Width > 0) and (Height > 0) and (FAlpha < 255) {and
425 g_Collide(X, Y, Width, Height, sX, sY, sWidth, sHeight)} then
426 begin
427 if FTextureIDs[FCurTexture].Anim then
428 begin // Àíèìèðîâàííàÿ òåêñòóðà
429 if FTextureIDs[FCurTexture].AnTex = nil then
430 Exit;
432 for xx := 0 to (Width div FTextureWidth)-1 do
433 for yy := 0 to (Height div FTextureHeight)-1 do
434 FTextureIDs[FCurTexture].AnTex.Draw(
435 X + xx*FTextureWidth,
436 Y + yy*FTextureHeight, TMirrorType.None);
437 end
438 else
439 begin // Îáû÷íàÿ òåêñòóðà
440 case FTextureIDs[FCurTexture].Tex of
441 LongWord(TEXTURE_SPECIAL_WATER): e_DrawFillQuad(X, Y, X+Width-1, Y+Height-1, 0, 0, 255, 0, TBlending.Filter);
442 LongWord(TEXTURE_SPECIAL_ACID1): e_DrawFillQuad(X, Y, X+Width-1, Y+Height-1, 0, 128, 0, 0, TBlending.Filter);
443 LongWord(TEXTURE_SPECIAL_ACID2): e_DrawFillQuad(X, Y, X+Width-1, Y+Height-1, 128, 0, 0, 0, TBlending.Filter);
444 LongWord(TEXTURE_NONE):
445 if g_Texture_Get('NOTEXTURE', NoTextureID) then
446 begin
447 e_GetTextureSize(NoTextureID, @NW, @NH);
448 e_DrawFill(NoTextureID, X, Y, Width div NW, Height div NH, 0, False, False);
449 end
450 else
451 begin
452 xx := X + (Width div 2);
453 yy := Y + (Height div 2);
454 e_DrawFillQuad(X, Y, xx, yy, 255, 0, 255, 0);
455 e_DrawFillQuad(xx, Y, X+Width-1, yy, 255, 255, 0, 0);
456 e_DrawFillQuad(X, yy, xx, Y+Height-1, 255, 255, 0, 0);
457 e_DrawFillQuad(xx, yy, X+Width-1, Y+Height-1, 255, 0, 255, 0);
458 end;
459 else
460 begin
461 if not mMovingActive then
462 e_DrawFill(FTextureIDs[FCurTexture].Tex, X, Y, Width div FTextureWidth, Height div FTextureHeight, FAlpha, True, FBlending, hasAmbient)
463 else
464 e_DrawFillX(FTextureIDs[FCurTexture].Tex, X, Y, Width, Height, FAlpha, True, FBlending, g_dbg_scale, hasAmbient);
465 if hasAmbient then e_AmbientQuad(X, Y, Width, Height, ambColor.r, ambColor.g, ambColor.b, ambColor.a);
466 end;
467 end;
468 end;
469 end;
470 end;
472 procedure TPanel.DrawShadowVolume(lightX: Integer; lightY: Integer; radius: Integer);
473 procedure extrude (x: Integer; y: Integer);
474 begin
475 glVertex2i(x+(x-lightX)*500, y+(y-lightY)*500);
476 //e_WriteLog(Format(' : (%d,%d)', [x+(x-lightX)*300, y+(y-lightY)*300]), MSG_WARNING);
477 end;
479 procedure drawLine (x0: Integer; y0: Integer; x1: Integer; y1: Integer);
480 begin
481 // does this side facing the light?
482 if ((x1-x0)*(lightY-y0)-(lightX-x0)*(y1-y0) >= 0) then exit;
483 //e_WriteLog(Format('lightpan: (%d,%d)-(%d,%d)', [x0, y0, x1, y1]), MSG_WARNING);
484 // this edge is facing the light, extrude and draw it
485 glVertex2i(x0, y0);
486 glVertex2i(x1, y1);
487 extrude(x1, y1);
488 extrude(x0, y0);
489 end;
491 begin
492 if radius < 4 then exit;
493 if Enabled and (FCurTexture >= 0) and (Width > 0) and (Height > 0) and (FAlpha < 255) {and
494 g_Collide(X, Y, Width, Height, sX, sY, sWidth, sHeight)} then
495 begin
496 if not FTextureIDs[FCurTexture].Anim then
497 begin
498 case FTextureIDs[FCurTexture].Tex of
499 LongWord(TEXTURE_SPECIAL_WATER): exit;
500 LongWord(TEXTURE_SPECIAL_ACID1): exit;
501 LongWord(TEXTURE_SPECIAL_ACID2): exit;
502 LongWord(TEXTURE_NONE): exit;
503 end;
504 end;
505 if (X+Width < lightX-radius) then exit;
506 if (Y+Height < lightY-radius) then exit;
507 if (X > lightX+radius) then exit;
508 if (Y > lightY+radius) then exit;
509 //e_DrawFill(FTextureIDs[FCurTexture].Tex, X, Y, Width div FTextureWidth, Height div FTextureHeight, FAlpha, True, FBlending);
511 glBegin(GL_QUADS);
512 drawLine(x, y, x+width, y); // top
513 drawLine(x+width, y, x+width, y+height); // right
514 drawLine(x+width, y+height, x, y+height); // bottom
515 drawLine(x, y+height, x, y); // left
516 glEnd();
517 end;
518 end;
521 procedure TPanel.positionChanged (); inline;
522 var
523 px, py, pw, ph: Integer;
524 begin
525 if (proxyId >= 0) then
526 begin
527 mapGrid.getBodyDims(proxyId, px, py, pw, ph);
528 if (px <> x) or (py <> y) or (pw <> Width) or (ph <> Height) then
529 begin
531 e_LogWritefln('panel moved: arridx=%s; guid=%s; proxyid=%s; old:(%s,%s)-(%sx%s); new:(%s,%s)-(%sx%s)',
532 [arrIdx, mGUID, proxyId, px, py, pw, ph, x, y, width, height]);
534 g_Mark(px, py, pw, ph, MARK_WALL, false);
535 if (Width < 1) or (Height < 1) then
536 begin
537 mapGrid.proxyEnabled[proxyId] := false;
538 end
539 else
540 begin
541 mapGrid.proxyEnabled[proxyId] := Enabled;
542 if (pw <> Width) or (ph <> Height) then
543 begin
544 //writeln('panel resize!');
545 mapGrid.moveResizeBody(proxyId, X, Y, Width, Height)
546 end
547 else
548 begin
549 mapGrid.moveBody(proxyId, X, Y);
550 end;
551 g_Mark(X, Y, Width, Height, MARK_WALL);
552 end;
553 end;
554 end;
555 end;
558 var
559 monCheckList: array of TMonster = nil;
560 monCheckListUsed: Integer = 0;
562 procedure TPanel.Update();
563 var
564 ox, oy: Integer;
565 nx, ny, nw, nh: Integer;
566 ex, ey, nex, ney: Integer;
567 mpw, mph: Integer;
569 // return `true` if we should move by dx,dy
570 function tryMPlatMove (px, py, pw, ph: Integer; out dx, dy: Integer; out squash: Boolean; ontop: PBoolean=nil): Boolean;
571 var
572 u0: Single;
573 tex, tey: Integer;
574 pdx, pdy: Integer;
575 trtag: Integer;
576 szdx, szdy: Integer;
577 begin
578 squash := false;
579 tex := px;
580 tey := py;
581 pdx := mMovingSpeed.X;
582 pdy := mMovingSpeed.Y;
583 // standing on the platform?
584 if (py+ph = oy) then
585 begin
586 if (ontop <> nil) then ontop^ := true;
587 // yes, move with it; but skip steps (no need to process size change here, 'cause platform top cannot be changed with it)
588 mapGrid.traceBox(tex, tey, px, py, pw, ph, pdx, pdy, nil, (GridTagWall or GridTagDoor));
589 end
590 else
591 begin
592 if (ontop <> nil) then ontop^ := false;
593 // not standing on the platform: trace platform to see if it hits the entity
594 // first, process size change (as we cannot sweeptest both move and size change)
595 // but we don't have to check for pushing if the panel is shrinking
596 szdx := nw-mpw;
597 szdy := nh-mph;
598 if (szdx > 0) or (szdy > 0) then
599 begin
600 // ignore shrinking dimension
601 if (szdx < 0) then szdx := 0;
602 if (szdy < 0) then szdy := 0;
603 // move platform by szd* back, and check for szd* movement
604 if sweepAABB(ox-szdx, oy-szdy, nw, nh, szdx, szdy, px, py, pw, ph, @u0) then
605 begin
606 // yes, platform hits the entity, push the entity in the resizing direction
607 u0 := 1.0-u0; // how much path left?
608 szdx := trunc(szdx*u0);
609 szdy := trunc(szdy*u0);
610 if (szdx <> 0) or (szdy <> 0) then
611 begin
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 (szdy > 0) then trtag := trtag or GridTagStep;
616 mapGrid.traceBox(tex, tey, px, py, pw, ph, szdx, szdy, nil, trtag);
617 end;
618 end;
619 end;
620 // second, process platform movement, using te* as entity starting point
621 if sweepAABB(ox, oy, nw, nh, pdx, pdy, tex, tey, pw, ph, @u0) then
622 begin
623 //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]);
624 // yes, platform hits the entity, push the entity in the direction of the platform
625 u0 := 1.0-u0; // how much path left?
626 pdx := trunc(pdx*u0);
627 pdy := trunc(pdy*u0);
628 //e_LogWritefln(' platsweep; uleft=%s; pd=(%s,%s)', [u0, pdx, pdy]);
629 if (pdx <> 0) or (pdy <> 0) then
630 begin
631 // has some path to go, trace the entity
632 trtag := (GridTagWall or GridTagDoor);
633 // if we're moving down, consider steps too
634 if (pdy > 0) then trtag := trtag or GridTagStep;
635 mapGrid.traceBox(tex, tey, px, py, pw, ph, pdx, pdy, nil, trtag);
636 end;
637 end;
638 end;
639 // done with entity movement, new coords are in te*
640 dx := tex-px;
641 dy := tey-py;
642 result := (dx <> 0) or (dy <> 0);
643 if ((tag and (GridTagWall or GridTagDoor)) <> 0) then
644 begin
645 // check for squashing; as entity cannot be pushed into a wall, check only collision with the platform itself
646 squash := g_Collide(tex, tey, pw, ph, nx, ny, nw, nh); // squash, if still in platform
647 end;
648 end;
650 function monCollect (mon: TMonster): Boolean;
651 begin
652 result := false; // don't stop
653 if (monCheckListUsed >= Length(monCheckList)) then SetLength(monCheckList, monCheckListUsed+128);
654 monCheckList[monCheckListUsed] := mon;
655 Inc(monCheckListUsed);
656 end;
658 var
659 cx0, cy0, cx1, cy1, cw, ch: Integer;
660 f: Integer;
661 px, py, pw, ph, pdx, pdy: Integer;
662 squash: Boolean;
663 plr: TPlayer;
664 gib: PGib;
665 cor: TCorpse;
666 mon: TMonster;
667 mpfrid: LongWord;
668 ontop: Boolean;
669 actMoveTrig: Boolean;
670 actSizeTrig: Boolean;
671 begin
672 if (not Enabled) or (Width < 1) or (Height < 1) then exit;
674 if (FCurTexture >= 0) and
675 (FTextureIDs[FCurTexture].Anim) and
676 (FTextureIDs[FCurTexture].AnTex <> nil) and
677 (FAlpha < 255) then
678 begin
679 FTextureIDs[FCurTexture].AnTex.Update();
680 FCurFrame := FTextureIDs[FCurTexture].AnTex.CurrentFrame;
681 FCurFrameCount := FTextureIDs[FCurTexture].AnTex.CurrentCounter;
682 end;
684 if not g_dbgpan_mplat_active then exit;
686 if (mOldMovingActive <> mMovingActive) then mNeedSend := true;
687 mOldMovingActive := mMovingActive;
689 if not mMovingActive then exit;
690 if mMovingSpeed.isZero and mSizeSpeed.isZero then exit;
692 //TODO: write wall size change processing
694 // moving platform?
695 begin
696 (*
697 * collect all monsters and players (aka entities) along the possible platform path
698 * if entity is standing on a platform:
699 * try to move it along the platform path, checking wall collisions
700 * if entity is NOT standing on a platform, but hit with sweeped platform aabb:
701 * try to push entity
702 * if we can't push entity all the way, squash it
703 *)
704 ox := X;
705 oy := Y;
706 mpw := Width;
707 mph := Height;
709 nw := mpw+mSizeSpeed.w;
710 nh := mph+mSizeSpeed.h;
711 nx := ox+mMovingSpeed.X;
712 ny := oy+mMovingSpeed.Y;
714 // force network updates only if some sudden change happened
715 // set the flag here, so we can sync affected monsters
716 if not mSizeSpeed.isZero and (nw = mSizeEnd.w) and (nh = mSizeEnd.h) then
717 begin
718 mNeedSend := true;
719 end
720 else if ((mMovingSpeed.X < 0) and (nx <= mMovingStart.X)) or ((mMovingSpeed.X > 0) and (nx >= mMovingEnd.X)) then
721 begin
722 mNeedSend := true;
723 end
724 else if ((mMovingSpeed.Y < 0) and (ny <= mMovingStart.Y)) or ((mMovingSpeed.Y > 0) and (ny >= mMovingEnd.Y)) then
725 begin
726 mNeedSend := true;
727 end;
729 // if pannel disappeared, we don't have to do anything
730 if (nw > 0) and (nh > 0) then
731 begin
732 // old rect
733 ex := ox+mpw-1;
734 ey := ox+mph-1;
735 // new rect
736 nex := nx+nw-1;
737 ney := ny+nh-1;
738 // full rect
739 cx0 := nmin(ox, nx);
740 cy0 := nmin(oy, ny);
741 cx1 := nmax(ex, nex);
742 cy1 := nmax(ey, ney);
743 // extrude
744 cx0 -= 1;
745 cy0 -= 1;
746 cx1 += 1;
747 cy1 += 1;
748 cw := cx1-cx0+1;
749 ch := cy1-cy0+1;
751 // process "obstacle" panels
752 if ((tag and GridTagObstacle) <> 0) then
753 begin
754 // temporarily turn off this panel, so it won't interfere with collision checks
755 mapGrid.proxyEnabled[proxyId] := false;
757 // process players
758 for f := 0 to High(gPlayers) do
759 begin
760 plr := gPlayers[f];
761 if (plr = nil) or (not plr.alive) then continue;
762 plr.getMapBox(px, py, pw, ph);
763 if not g_Collide(px, py, pw, ph, cx0, cy0, cw, ch) then continue;
764 if tryMPlatMove(px, py, pw, ph, pdx, pdy, squash) then
765 begin
766 // set new position
767 plr.moveBy(pdx, pdy); // this will call `positionChanged()` for us
768 end;
769 // squash player, if necessary
770 if not g_Game_IsClient and squash then plr.Damage(15000, 0, 0, 0, HIT_TRAP);
771 end;
773 // process gibs
774 for f := 0 to High(gGibs) do
775 begin
776 gib := @gGibs[f];
777 if not gib.alive then continue;
778 gib.getMapBox(px, py, pw, ph);
779 if not g_Collide(px, py, pw, ph, cx0, cy0, cw, ch) then continue;
780 if tryMPlatMove(px, py, pw, ph, pdx, pdy, squash, @ontop) then
781 begin
782 // set new position
783 gib.moveBy(pdx, pdy); // this will call `positionChanged()` for us
784 end;
785 end;
787 // move and push corpses
788 for f := 0 to High(gCorpses) do
789 begin
790 cor := gCorpses[f];
791 if (cor = nil) then continue;
792 cor.getMapBox(px, py, pw, ph);
793 if not g_Collide(px, py, pw, ph, cx0, cy0, cw, ch) then continue;
794 if tryMPlatMove(px, py, pw, ph, pdx, pdy, squash, @ontop) then
795 begin
796 // set new position
797 cor.moveBy(pdx, pdy); // this will call `positionChanged()` for us
798 end;
799 end;
801 // collect monsters
802 monCheckListUsed := 0;
803 g_Mons_ForEachAt(cx0, cy0, cw, ch, monCollect);
805 // process collected monsters
806 if (monCheckListUsed > 0) then
807 begin
808 mpfrid := g_Mons_getNewMPlatFrameId();
809 for f := 0 to monCheckListUsed do
810 begin
811 mon := monCheckList[f];
812 if (mon = nil) or (not mon.alive) or (mon.mplatCheckFrameId = mpfrid) then continue;
813 mon.mplatCheckFrameId := mpfrid;
814 mon.getMapBox(px, py, pw, ph);
815 //if not g_Collide(px, py, pw, ph, cx0, cy0, cw, ch) then continue;
816 if tryMPlatMove(px, py, pw, ph, pdx, pdy, squash) then
817 begin
818 // set new position
819 mon.moveBy(pdx, pdy); // this will call `positionChanged()` for us
820 //???FIXME: do we really need to send monsters over the net?
821 // i don't think so, as dead reckoning should take care of 'em
822 // ok, send new monster position only if platform is going to change it's direction
823 if mNeedSend then mon.setDirty();
824 end;
825 // squash monster, if necessary
826 if not g_Game_IsClient and squash then mon.Damage(15000, 0, 0, 0, HIT_TRAP);
827 end;
828 end;
830 // restore panel state
831 mapGrid.proxyEnabled[proxyId] := true;
832 end;
833 end;
835 // move panel
836 X := nx;
837 Y := ny;
838 FWidth := nw;
839 FHeight := nh;
840 positionChanged();
842 actMoveTrig := false;
843 actSizeTrig := false;
845 // `mNeedSend` was set above
847 // check "size stop"
848 if not mSizeSpeed.isZero and (nw = mSizeEnd.w) and (nh = mSizeEnd.h) then
849 begin
850 mSizeSpeed.w := 0;
851 mSizeSpeed.h := 0;
852 actSizeTrig := true;
853 if (nw < 1) or (nh < 1) then mMovingActive := false; //HACK!
854 end;
856 // reverse moving direction, if necessary
857 if ((mMovingSpeed.X < 0) and (nx <= mMovingStart.X)) or ((mMovingSpeed.X > 0) and (nx >= mMovingEnd.X)) then
858 begin
859 if mMoveOnce then mMovingActive := false else mMovingSpeed.X := -mMovingSpeed.X;
860 actMoveTrig := true;
861 end;
863 if ((mMovingSpeed.Y < 0) and (ny <= mMovingStart.Y)) or ((mMovingSpeed.Y > 0) and (ny >= mMovingEnd.Y)) then
864 begin
865 if mMoveOnce then mMovingActive := false else mMovingSpeed.Y := -mMovingSpeed.Y;
866 actMoveTrig := true;
867 end;
869 if (mOldMovingActive <> mMovingActive) then mNeedSend := true;
870 mOldMovingActive := mMovingActive;
872 if not g_Game_IsClient then
873 begin
874 if actMoveTrig then g_Triggers_Press(mEndPosTrig, ACTIVATE_CUSTOM);
875 if actSizeTrig then g_Triggers_Press(mEndSizeTrig, ACTIVATE_CUSTOM);
876 end;
878 // some triggers may activate this, don't delay sending
879 //TODO: when triggers will be able to control speed and size, check that here too
880 if (mOldMovingActive <> mMovingActive) then mNeedSend := true;
881 mOldMovingActive := mMovingActive;
882 end;
883 end;
886 procedure TPanel.SetFrame(Frame: Integer; Count: Byte);
888 function ClampInt(X, A, B: Integer): Integer;
889 begin
890 Result := X;
891 if X < A then Result := A else if X > B then Result := B;
892 end;
894 begin
895 if Enabled and (FCurTexture >= 0) and
896 (FTextureIDs[FCurTexture].Anim) and
897 (FTextureIDs[FCurTexture].AnTex <> nil) and
898 (Width > 0) and (Height > 0) and (FAlpha < 255) then
899 begin
900 FCurFrame := ClampInt(Frame, 0, FTextureIDs[FCurTexture].AnTex.TotalFrames);
901 FCurFrameCount := Count;
902 FTextureIDs[FCurTexture].AnTex.CurrentFrame := FCurFrame;
903 FTextureIDs[FCurTexture].AnTex.CurrentCounter := FCurFrameCount;
904 end;
905 end;
907 procedure TPanel.NextTexture(AnimLoop: Byte = 0);
908 begin
909 Assert(FCurTexture >= -1, 'FCurTexture < -1');
911 // Íåò òåêñòóð:
912 if Length(FTextureIDs) = 0 then
913 FCurTexture := -1
914 else
915 // Òîëüêî îäíà òåêñòóðà:
916 if Length(FTextureIDs) = 1 then
917 begin
918 if FCurTexture = 0 then
919 FCurTexture := -1
920 else
921 FCurTexture := 0;
922 end
923 else
924 // Áîëüøå îäíîé òåêñòóðû:
925 begin
926 // Ñëåäóþùàÿ:
927 Inc(FCurTexture);
928 // Ñëåäóþùåé íåò - âîçâðàò ê íà÷àëó:
929 if FCurTexture >= Length(FTextureIDs) then
930 FCurTexture := 0;
931 end;
933 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
934 if (FCurTexture >= 0) and FTextureIDs[FCurTexture].Anim then
935 begin
936 if (FTextureIDs[FCurTexture].AnTex = nil) then
937 begin
938 g_FatalError(_lc[I_GAME_ERROR_SWITCH_TEXTURE]);
939 Exit;
940 end;
942 if AnimLoop = 1 then
943 FTextureIDs[FCurTexture].AnTex.Loop := True
944 else
945 if AnimLoop = 2 then
946 FTextureIDs[FCurTexture].AnTex.Loop := False;
948 FTextureIDs[FCurTexture].AnTex.Reset();
949 end;
951 LastAnimLoop := AnimLoop;
952 end;
954 procedure TPanel.SetTexture(ID: Integer; AnimLoop: Byte = 0);
955 begin
956 // Íåò òåêñòóð:
957 if Length(FTextureIDs) = 0 then
958 FCurTexture := -1
959 else
960 // Òîëüêî îäíà òåêñòóðà:
961 if Length(FTextureIDs) = 1 then
962 begin
963 if (ID = 0) or (ID = -1) then
964 FCurTexture := ID;
965 end
966 else
967 // Áîëüøå îäíîé òåêñòóðû:
968 begin
969 if (ID >= -1) and (ID <= High(FTextureIDs)) then
970 FCurTexture := ID;
971 end;
973 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
974 if (FCurTexture >= 0) and FTextureIDs[FCurTexture].Anim then
975 begin
976 if (FTextureIDs[FCurTexture].AnTex = nil) then
977 begin
978 g_FatalError(_lc[I_GAME_ERROR_SWITCH_TEXTURE]);
979 Exit;
980 end;
982 if AnimLoop = 1 then
983 FTextureIDs[FCurTexture].AnTex.Loop := True
984 else
985 if AnimLoop = 2 then
986 FTextureIDs[FCurTexture].AnTex.Loop := False;
988 FTextureIDs[FCurTexture].AnTex.Reset();
989 end;
991 LastAnimLoop := AnimLoop;
992 end;
994 function TPanel.GetTextureID(): DWORD;
995 begin
996 Result := LongWord(TEXTURE_NONE);
998 if (FCurTexture >= 0) then
999 begin
1000 if FTextureIDs[FCurTexture].Anim then
1001 Result := FTextureIDs[FCurTexture].AnTex.FramesID
1002 else
1003 Result := FTextureIDs[FCurTexture].Tex;
1004 end;
1005 end;
1007 function TPanel.GetTextureCount(): Integer;
1008 begin
1009 Result := Length(FTextureIDs);
1010 if Enabled and (FCurTexture >= 0) then
1011 if (FTextureIDs[FCurTexture].Anim) and
1012 (FTextureIDs[FCurTexture].AnTex <> nil) and
1013 (Width > 0) and (Height > 0) and (FAlpha < 255) then
1014 Result := Result + 100;
1015 end;
1018 const
1019 PAN_SAVE_VERSION = 1;
1021 procedure TPanel.SaveState (st: TStream);
1022 var
1023 anim: Boolean;
1024 begin
1025 if (st = nil) then exit;
1027 // Ñèãíàòóðà ïàíåëè
1028 utils.writeSign(st, 'PANL');
1029 utils.writeInt(st, Byte(PAN_SAVE_VERSION));
1030 // Îòêðûòà/çàêðûòà, åñëè äâåðü
1031 utils.writeBool(st, FEnabled);
1032 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò
1033 utils.writeInt(st, Byte(FLiftType));
1034 // Íîìåð òåêóùåé òåêñòóðû
1035 utils.writeInt(st, Integer(FCurTexture));
1036 // Êîîðäèíàòû è ðàçìåð
1037 utils.writeInt(st, Integer(FX));
1038 utils.writeInt(st, Integer(FY));
1039 utils.writeInt(st, Word(FWidth));
1040 utils.writeInt(st, Word(FHeight));
1041 // Àíèìèðîâàíà ëè òåêóùàÿ òåêñòóðà
1042 if (FCurTexture >= 0) and (FTextureIDs[FCurTexture].Anim) then
1043 begin
1044 assert(FTextureIDs[FCurTexture].AnTex <> nil, 'TPanel.SaveState: No animation object');
1045 anim := true;
1046 end
1047 else
1048 begin
1049 anim := false;
1050 end;
1051 utils.writeBool(st, anim);
1052 // Åñëè äà - ñîõðàíÿåì àíèìàöèþ
1053 if anim then FTextureIDs[FCurTexture].AnTex.SaveState(st);
1055 // moving platform state
1056 utils.writeInt(st, Integer(mMovingSpeed.X));
1057 utils.writeInt(st, Integer(mMovingSpeed.Y));
1058 utils.writeInt(st, Integer(mMovingStart.X));
1059 utils.writeInt(st, Integer(mMovingStart.Y));
1060 utils.writeInt(st, Integer(mMovingEnd.X));
1061 utils.writeInt(st, Integer(mMovingEnd.Y));
1063 utils.writeInt(st, Integer(mSizeSpeed.w));
1064 utils.writeInt(st, Integer(mSizeSpeed.h));
1065 utils.writeInt(st, Integer(mSizeEnd.w));
1066 utils.writeInt(st, Integer(mSizeEnd.h));
1068 utils.writeBool(st, mMovingActive);
1069 utils.writeBool(st, mMoveOnce);
1071 utils.writeInt(st, Integer(mEndPosTrig));
1072 utils.writeInt(st, Integer(mEndSizeTrig));
1073 end;
1076 procedure TPanel.LoadState (st: TStream);
1077 begin
1078 if (st = nil) then exit;
1080 // Ñèãíàòóðà ïàíåëè
1081 if not utils.checkSign(st, 'PANL') then raise XStreamError.create('wrong panel signature');
1082 if (utils.readByte(st) <> PAN_SAVE_VERSION) then raise XStreamError.create('wrong panel version');
1083 // Îòêðûòà/çàêðûòà, åñëè äâåðü
1084 FEnabled := utils.readBool(st);
1085 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò
1086 FLiftType := utils.readByte(st);
1087 // Íîìåð òåêóùåé òåêñòóðû
1088 FCurTexture := utils.readLongInt(st);
1089 // Êîîðäèíàòû è ðàçìåð
1090 FX := utils.readLongInt(st);
1091 FY := utils.readLongInt(st);
1092 FWidth := utils.readWord(st);
1093 FHeight := utils.readWord(st);
1094 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà
1095 if utils.readBool(st) then
1096 begin
1097 // Åñëè äà - çàãðóæàåì àíèìàöèþ
1098 Assert((FCurTexture >= 0) and
1099 (FTextureIDs[FCurTexture].Anim) and
1100 (FTextureIDs[FCurTexture].AnTex <> nil),
1101 'TPanel.LoadState: No animation object');
1102 FTextureIDs[FCurTexture].AnTex.LoadState(st);
1103 end;
1105 // moving platform state
1106 mMovingSpeed.X := utils.readLongInt(st);
1107 mMovingSpeed.Y := utils.readLongInt(st);
1108 mMovingStart.X := utils.readLongInt(st);
1109 mMovingStart.Y := utils.readLongInt(st);
1110 mMovingEnd.X := utils.readLongInt(st);
1111 mMovingEnd.Y := utils.readLongInt(st);
1113 mSizeSpeed.w := utils.readLongInt(st);
1114 mSizeSpeed.h := utils.readLongInt(st);
1115 mSizeEnd.w := utils.readLongInt(st);
1116 mSizeEnd.h := utils.readLongInt(st);
1118 mMovingActive := utils.readBool(st);
1119 mMoveOnce := utils.readBool(st);
1121 mEndPosTrig := utils.readLongInt(st);
1122 mEndSizeTrig := utils.readLongInt(st);
1124 positionChanged();
1125 //mapGrid.proxyEnabled[proxyId] := FEnabled; // done in g_map.pas
1126 end;
1129 end.