DEADSOFTWARE

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