DEADSOFTWARE

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