DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
untested code for NPOT resizing panels
[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 mapGrid.moveResizeBody(proxyId, X, Y, Width, Height)
532 else mapGrid.moveBody(proxyId, X, Y);
533 g_Mark(X, Y, Width, Height, MARK_WALL);
534 end;
535 end;
536 end;
537 end;
538
539
540 var
541 monCheckList: array of TMonster = nil;
542 monCheckListUsed: Integer = 0;
543
544 procedure TPanel.Update();
545 var
546 ox, oy: Integer;
547 nx, ny: Integer;
548 ex, ey, nex, ney: Integer;
549 mpw, mph: Integer;
550
551 // return `true` if we should move by dx,dy
552 function tryMPlatMove (px, py, pw, ph: Integer; out dx, dy: Integer; out squash: Boolean; ontop: PBoolean=nil): Boolean;
553 var
554 u0, u1: Single;
555 tex, tey: Integer;
556 pdx, pdy: Integer;
557 pan: TPanel;
558 trtag: Integer;
559 hedge: Integer;
560 begin
561 squash := false;
562 tex := px;
563 tey := py;
564 pdx := mMovingSpeed.X;
565 pdy := mMovingSpeed.Y;
566 // standing on the platform?
567 if (py+ph = oy) then
568 begin
569 if (ontop <> nil) then ontop^ := true;
570 // yes, move with it; but skip steps
571 pan := mapGrid.traceBox(tex, tey, px, py, pw, ph, pdx, pdy, nil, (GridTagWall or GridTagDoor));
572 if (pan <> nil) then
573 begin
574 //e_LogWritefln('entity on the platform; tracing=(%s,%s); endpoint=(%s,%s); mustbe=(%s,%s)', [px, py, tex, tey, px+pdx, py+pdy]);
575 // if we cannot move, only walls should squash the entity
576 {
577 if ((tag and (GridTagWall or GridTagDoor)) <> 0) then
578 begin
579 if (tex = px) and (tey = py) then squash := true;
580 end;
581 }
582 end;
583 end
584 else
585 begin
586 if (ontop <> nil) then ontop^ := false;
587 // not standing on the platform: trace platform to see if it hits the entity
588 // hitedge (for `it`): 0: top; 1: right; 2: bottom; 3: left
589 {
590 if g_Collide(px, py, pw, ph, ox, oy, mpw, mph) then
591 begin
592 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]);
593 end;
594 }
595 if sweepAABB(ox, oy, mpw, mph, pdx, pdy, px, py, pw, ph, @u0, @hedge, @u1) then
596 begin
597 //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]);
598 // yes, platform hits the entity, push the entity in the direction of the platform
599 u0 := 1.0-u0; // how much path left?
600 pdx := trunc(pdx*u0);
601 pdy := trunc(pdy*u0);
602 //e_LogWritefln(' platsweep; uleft=%s; pd=(%s,%s)', [u0, pdx, pdy]);
603 if (pdx <> 0) or (pdy <> 0) then
604 begin
605 // has some path to go, trace the entity
606 trtag := (GridTagWall or GridTagDoor);
607 // if we're moving down, consider steps too
608 if (pdy > 0) then trtag := trtag or GridTagStep;
609 pan := mapGrid.traceBox(tex, tey, px, py, pw, ph, pdx, pdy, nil, trtag);
610 //e_LogWritefln(' tracebox: te=(%s,%s)', [tex, tey]);
611 // if we cannot move, only walls should squash the entity
612 {
613 if ((tag and (GridTagWall or GridTagDoor)) <> 0) then
614 begin
615 if (pan <> nil) and (tex = px) and (tey = py) then squash := true;
616 end;
617 }
618 end;
619 end
620 else
621 begin
622 // no collistion, but may be embedded
623 //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]);
624 //squash := (u1 >= 0.0);
625 end;
626 end;
627 dx := tex-px;
628 dy := tey-py;
629 result := (dx <> 0) or (dy <> 0);
630 if (not squash) and ((tag and (GridTagWall or GridTagDoor)) <> 0) then
631 begin
632 squash := g_Collide(tex, tey, pw, ph, nx, ny, mpw, mph); // still in platform?
633 //if not squash then squash := g_Map_CollidePanel(tex, tey, pw, ph, (PANEL_WALL or PANEL_OPENDOOR or PANEL_CLOSEDOOR));
634 end;
635 end;
636
637 function monCollect (mon: TMonster): Boolean;
638 begin
639 result := false; // don't stop
640 if (monCheckListUsed >= Length(monCheckList)) then SetLength(monCheckList, monCheckListUsed+128);
641 monCheckList[monCheckListUsed] := mon;
642 Inc(monCheckListUsed);
643 end;
644
645 var
646 cx0, cy0, cx1, cy1, cw, ch: Integer;
647 f: Integer;
648 px, py, pw, ph, pdx, pdy: Integer;
649 squash: Boolean;
650 plr: TPlayer;
651 gib: PGib;
652 cor: TCorpse;
653 mon: TMonster;
654 mpfrid: LongWord;
655 ontop: Boolean;
656 actMoveTrig: Boolean;
657 actSizeTrig: Boolean;
658 begin
659 if (not Enabled) or (Width < 1) or (Height < 1) then exit;
660
661 if (FCurTexture >= 0) and
662 (FTextureIDs[FCurTexture].Anim) and
663 (FTextureIDs[FCurTexture].AnTex <> nil) and
664 (FAlpha < 255) then
665 begin
666 FTextureIDs[FCurTexture].AnTex.Update();
667 FCurFrame := FTextureIDs[FCurTexture].AnTex.CurrentFrame;
668 FCurFrameCount := FTextureIDs[FCurTexture].AnTex.CurrentCounter;
669 end;
670
671 if not g_dbgpan_mplat_active then exit;
672
673 if not mMovingActive then exit;
674 if mMovingSpeed.isZero and mSizeSpeed.isZero then exit;
675
676 //TODO: write wall size change processing
677
678 // moving platform?
679 begin
680 (*
681 * collect all monsters and players (aka entities) along the possible platform path
682 * if entity is standing on a platform:
683 * try to move it along the platform path, checking wall collisions
684 * if entity is NOT standing on a platform, but hit with sweeped platform aabb:
685 * try to push entity
686 * if we can't push entity all the way, squash it
687 *)
688 mpw := Width;
689 mph := Height;
690
691 // old rect
692 ox := X;
693 oy := Y;
694 ex := ox+mpw-1;
695 ey := ox+mph-1;
696 // new rect
697 nx := ox+mMovingSpeed.X;
698 ny := oy+mMovingSpeed.Y;
699 nex := nx+mpw-1;
700 ney := ny+mph-1;
701 // full rect
702 cx0 := nmin(ox, nx);
703 cy0 := nmin(oy, ny);
704 cx1 := nmax(ex, nex);
705 cy1 := nmax(ey, ney);
706 // extrude
707 cx0 -= 1;
708 cy0 -= 1;
709 cx1 += 1;
710 cy1 += 1;
711 cw := cx1-cx0+1;
712 ch := cy1-cy0+1;
713
714 // process "obstacle" panels
715 if ((tag and GridTagObstacle) <> 0) then
716 begin
717 // temporarily turn off this panel, so it won't interfere with collision checks
718 mapGrid.proxyEnabled[proxyId] := false;
719
720 // process players
721 for f := 0 to High(gPlayers) do
722 begin
723 plr := gPlayers[f];
724 if (plr = nil) or (not plr.alive) then continue;
725 plr.getMapBox(px, py, pw, ph);
726 if not g_Collide(px, py, pw, ph, cx0, cy0, cw, ch) then continue;
727 if tryMPlatMove(px, py, pw, ph, pdx, pdy, squash) then
728 begin
729 // set new position
730 plr.moveBy(pdx, pdy); // this will call `positionChanged()` for us
731 end;
732 // squash player, if necessary
733 if squash then plr.Damage(15000, 0, 0, 0, HIT_TRAP);
734 end;
735
736 // process gibs
737 for f := 0 to High(gGibs) do
738 begin
739 gib := @gGibs[f];
740 if not gib.alive then continue;
741 gib.getMapBox(px, py, pw, ph);
742 if not g_Collide(px, py, pw, ph, cx0, cy0, cw, ch) then continue;
743 if tryMPlatMove(px, py, pw, ph, pdx, pdy, squash, @ontop) then
744 begin
745 // set new position
746 gib.moveBy(pdx, pdy); // this will call `positionChanged()` for us
747 {
748 if ontop then
749 begin
750 gib.Obj.Vel.X += pdx;
751 gib.Obj.Vel.Y += pdy;
752 end;
753 }
754 end;
755 end;
756
757 // move and push corpses
758 for f := 0 to High(gCorpses) do
759 begin
760 cor := gCorpses[f];
761 if (cor = nil) then continue;
762 cor.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, @ontop) then
765 begin
766 // set new position
767 cor.moveBy(pdx, pdy); // this will call `positionChanged()` for us
768 {
769 if ontop then
770 begin
771 cor.ObjPtr.Vel.X += pdx;
772 cor.ObjPtr.Vel.Y += pdy;
773 end;
774 }
775 end;
776 end;
777
778 // collect monsters
779 monCheckListUsed := 0;
780 g_Mons_ForEachAt(cx0, cy0, cw, ch, monCollect);
781
782 // process collected monsters
783 if (monCheckListUsed > 0) then
784 begin
785 mpfrid := g_Mons_getNewMPlatFrameId();
786 for f := 0 to monCheckListUsed do
787 begin
788 mon := monCheckList[f];
789 if (mon = nil) or (not mon.alive) or (mon.mplatCheckFrameId = mpfrid) then continue;
790 mon.mplatCheckFrameId := mpfrid;
791 mon.getMapBox(px, py, pw, ph);
792 //if not g_Collide(px, py, pw, ph, cx0, cy0, cw, ch) then continue;
793 if tryMPlatMove(px, py, pw, ph, pdx, pdy, squash) then
794 begin
795 // set new position
796 mon.moveBy(pdx, pdy); // this will call `positionChanged()` for us
797 end;
798 // squash player, if necessary
799 if squash then mon.Damage(15000, 0, 0, 0, HIT_TRAP);
800 end;
801 end;
802
803 // restore panel state
804 mapGrid.proxyEnabled[proxyId] := true;
805 end;
806
807 // move panel
808 X := nx;
809 Y := ny;
810 FWidth += mSizeSpeed.w;
811 FHeight += mSizeSpeed.h;
812 positionChanged();
813
814 actMoveTrig := false;
815 actSizeTrig := false;
816
817 {
818 if not mSizeSpeed.isZero then
819 begin
820 e_LogWritefln('ss: size_speed=(%s,%s); size=(%s,%s); move_speed=(%s,%s); oy=%s; ny=%s; etp:%s; ets:%s', [mSizeSpeed.w, mSizeSpeed.h, FWidth, FHeight, mMovingSpeed.X, mMovingSpeed.Y, oy, ny, mEndPosTrig, mEndSizeTrig]);
821 end;
822 }
823
824 // reverse moving direction, if necessary
825 if ((mMovingSpeed.X < 0) and (nx <= mMovingStart.X)) or ((mMovingSpeed.X > 0) and (nx >= mMovingEnd.X)) then
826 begin
827 if mMoveOnce then mMovingActive := false else mMovingSpeed.X := -mMovingSpeed.X;
828 actMoveTrig := true;
829 end;
830
831 if ((mMovingSpeed.Y < 0) and (ny <= mMovingStart.Y)) or ((mMovingSpeed.Y > 0) and (ny >= mMovingEnd.Y)) then
832 begin
833 if mMoveOnce then mMovingActive := false else mMovingSpeed.Y := -mMovingSpeed.Y;
834 actMoveTrig := true;
835 end;
836
837 // check "size stop"
838 if not mSizeSpeed.isZero and (Width = mSizeEnd.w) and (Height = mSizeEnd.h) then
839 begin
840 mSizeSpeed.w := 0;
841 mSizeSpeed.h := 0;
842 actSizeTrig := true;
843 if (Width < 1) or (Height < 1) then mMovingActive := false; //HACK!
844 //e_LogWritefln('FUUUUUUUUUUUUUU', []);
845 end;
846
847
848 if actMoveTrig then
849 begin
850 g_Triggers_Press(mEndPosTrig, ACTIVATE_CUSTOM);
851 end;
852
853 if actSizeTrig then
854 begin
855 g_Triggers_Press(mEndSizeTrig, ACTIVATE_CUSTOM);
856 end;
857 end;
858 end;
859
860 procedure TPanel.SetFrame(Frame: Integer; Count: Byte);
861
862 function ClampInt(X, A, B: Integer): Integer;
863 begin
864 Result := X;
865 if X < A then Result := A else if X > B then Result := B;
866 end;
867
868 begin
869 if Enabled and (FCurTexture >= 0) and
870 (FTextureIDs[FCurTexture].Anim) and
871 (FTextureIDs[FCurTexture].AnTex <> nil) and
872 (Width > 0) and (Height > 0) and (FAlpha < 255) then
873 begin
874 FCurFrame := ClampInt(Frame, 0, FTextureIDs[FCurTexture].AnTex.TotalFrames);
875 FCurFrameCount := Count;
876 FTextureIDs[FCurTexture].AnTex.CurrentFrame := FCurFrame;
877 FTextureIDs[FCurTexture].AnTex.CurrentCounter := FCurFrameCount;
878 end;
879 end;
880
881 procedure TPanel.NextTexture(AnimLoop: Byte = 0);
882 begin
883 Assert(FCurTexture >= -1, 'FCurTexture < -1');
884
885 // Íåò òåêñòóð:
886 if Length(FTextureIDs) = 0 then
887 FCurTexture := -1
888 else
889 // Òîëüêî îäíà òåêñòóðà:
890 if Length(FTextureIDs) = 1 then
891 begin
892 if FCurTexture = 0 then
893 FCurTexture := -1
894 else
895 FCurTexture := 0;
896 end
897 else
898 // Áîëüøå îäíîé òåêñòóðû:
899 begin
900 // Ñëåäóþùàÿ:
901 Inc(FCurTexture);
902 // Ñëåäóþùåé íåò - âîçâðàò ê íà÷àëó:
903 if FCurTexture >= Length(FTextureIDs) then
904 FCurTexture := 0;
905 end;
906
907 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
908 if (FCurTexture >= 0) and FTextureIDs[FCurTexture].Anim then
909 begin
910 if (FTextureIDs[FCurTexture].AnTex = nil) then
911 begin
912 g_FatalError(_lc[I_GAME_ERROR_SWITCH_TEXTURE]);
913 Exit;
914 end;
915
916 if AnimLoop = 1 then
917 FTextureIDs[FCurTexture].AnTex.Loop := True
918 else
919 if AnimLoop = 2 then
920 FTextureIDs[FCurTexture].AnTex.Loop := False;
921
922 FTextureIDs[FCurTexture].AnTex.Reset();
923 end;
924
925 LastAnimLoop := AnimLoop;
926 end;
927
928 procedure TPanel.SetTexture(ID: Integer; AnimLoop: Byte = 0);
929 begin
930 // Íåò òåêñòóð:
931 if Length(FTextureIDs) = 0 then
932 FCurTexture := -1
933 else
934 // Òîëüêî îäíà òåêñòóðà:
935 if Length(FTextureIDs) = 1 then
936 begin
937 if (ID = 0) or (ID = -1) then
938 FCurTexture := ID;
939 end
940 else
941 // Áîëüøå îäíîé òåêñòóðû:
942 begin
943 if (ID >= -1) and (ID <= High(FTextureIDs)) then
944 FCurTexture := ID;
945 end;
946
947 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
948 if (FCurTexture >= 0) and FTextureIDs[FCurTexture].Anim then
949 begin
950 if (FTextureIDs[FCurTexture].AnTex = nil) then
951 begin
952 g_FatalError(_lc[I_GAME_ERROR_SWITCH_TEXTURE]);
953 Exit;
954 end;
955
956 if AnimLoop = 1 then
957 FTextureIDs[FCurTexture].AnTex.Loop := True
958 else
959 if AnimLoop = 2 then
960 FTextureIDs[FCurTexture].AnTex.Loop := False;
961
962 FTextureIDs[FCurTexture].AnTex.Reset();
963 end;
964
965 LastAnimLoop := AnimLoop;
966 end;
967
968 function TPanel.GetTextureID(): DWORD;
969 begin
970 Result := LongWord(TEXTURE_NONE);
971
972 if (FCurTexture >= 0) then
973 begin
974 if FTextureIDs[FCurTexture].Anim then
975 Result := FTextureIDs[FCurTexture].AnTex.FramesID
976 else
977 Result := FTextureIDs[FCurTexture].Tex;
978 end;
979 end;
980
981 function TPanel.GetTextureCount(): Integer;
982 begin
983 Result := Length(FTextureIDs);
984 if Enabled and (FCurTexture >= 0) then
985 if (FTextureIDs[FCurTexture].Anim) and
986 (FTextureIDs[FCurTexture].AnTex <> nil) and
987 (Width > 0) and (Height > 0) and (FAlpha < 255) then
988 Result := Result + 100;
989 end;
990
991 procedure TPanel.SaveState(Var Mem: TBinMemoryWriter);
992 var
993 sig: DWORD;
994 anim: Boolean;
995 begin
996 if (Mem = nil) then exit;
997 //if not SaveIt then exit;
998
999 // Ñèãíàòóðà ïàíåëè:
1000 sig := PANEL_SIGNATURE; // 'PANL'
1001 Mem.WriteDWORD(sig);
1002 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
1003 Mem.WriteBoolean(FEnabled);
1004 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
1005 Mem.WriteByte(FLiftType);
1006 // Íîìåð òåêóùåé òåêñòóðû:
1007 Mem.WriteInt(FCurTexture);
1008 // Êîîðäû
1009 Mem.WriteInt(FX);
1010 Mem.WriteInt(FY);
1011 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
1012 if (FCurTexture >= 0) and (FTextureIDs[FCurTexture].Anim) then
1013 begin
1014 Assert(FTextureIDs[FCurTexture].AnTex <> nil,
1015 'TPanel.SaveState: No animation object');
1016 anim := True;
1017 end
1018 else
1019 anim := False;
1020 Mem.WriteBoolean(anim);
1021 // Åñëè äà - ñîõðàíÿåì àíèìàöèþ:
1022 if anim then
1023 FTextureIDs[FCurTexture].AnTex.SaveState(Mem);
1024 // moving platform state
1025 Mem.WriteInt(mMovingSpeed.X);
1026 Mem.WriteInt(mMovingSpeed.Y);
1027 Mem.WriteInt(mMovingStart.X);
1028 Mem.WriteInt(mMovingStart.Y);
1029 Mem.WriteInt(mMovingEnd.X);
1030 Mem.WriteInt(mMovingEnd.Y);
1031 Mem.WriteBoolean(mMovingActive);
1032 end;
1033
1034 procedure TPanel.LoadState(var Mem: TBinMemoryReader);
1035 var
1036 sig: DWORD;
1037 anim: Boolean;
1038 //ox, oy: Integer;
1039 begin
1040 if (Mem = nil) then exit;
1041 //if not SaveIt then exit;
1042
1043 // Ñèãíàòóðà ïàíåëè:
1044 Mem.ReadDWORD(sig);
1045 if sig <> PANEL_SIGNATURE then // 'PANL'
1046 begin
1047 raise EBinSizeError.Create('TPanel.LoadState: Wrong Panel Signature');
1048 end;
1049 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
1050 Mem.ReadBoolean(FEnabled);
1051 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
1052 Mem.ReadByte(FLiftType);
1053 // Íîìåð òåêóùåé òåêñòóðû:
1054 Mem.ReadInt(FCurTexture);
1055 // Êîîðäû
1056 //ox := FX;
1057 //oy := FY;
1058 Mem.ReadInt(FX);
1059 Mem.ReadInt(FY);
1060 //e_LogWritefln('panel %s(%s): old=(%s,%s); new=(%s,%s); delta=(%s,%s)', [arrIdx, proxyId, ox, oy, FX, FY, FX-ox, FY-oy]);
1061 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
1062 Mem.ReadBoolean(anim);
1063 // Åñëè äà - çàãðóæàåì àíèìàöèþ:
1064 if anim then
1065 begin
1066 Assert((FCurTexture >= 0) and
1067 (FTextureIDs[FCurTexture].Anim) and
1068 (FTextureIDs[FCurTexture].AnTex <> nil),
1069 'TPanel.LoadState: No animation object');
1070 FTextureIDs[FCurTexture].AnTex.LoadState(Mem);
1071 end;
1072 // moving platform state
1073 Mem.ReadInt(mMovingSpeed.X);
1074 Mem.ReadInt(mMovingSpeed.Y);
1075 Mem.ReadInt(mMovingStart.X);
1076 Mem.ReadInt(mMovingStart.Y);
1077 Mem.ReadInt(mMovingEnd.X);
1078 Mem.ReadInt(mMovingEnd.Y);
1079 Mem.ReadBoolean(mMovingActive);
1080
1081 positionChanged();
1082 //mapGrid.proxyEnabled[proxyId] := FEnabled; // done in g_map.pas
1083 end;
1084
1085 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024