DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
some accessors to publish more properties
[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 implementation
171
172 uses
173 SysUtils, g_basic, g_map, g_game, g_gfx, e_graphics,
174 g_console, g_language, g_monsters, g_player, e_log, GL;
175
176 const
177 PANEL_SIGNATURE = $4C4E4150; // 'PANL'
178
179 { T P a n e l : }
180
181 constructor TPanel.Create(PanelRec: TDynRecord;
182 AddTextures: TAddTextureArray;
183 CurTex: Integer;
184 var Textures: TLevelTextureArray; aguid: Integer);
185 var
186 i: Integer;
187 begin
188 X := PanelRec.X;
189 Y := PanelRec.Y;
190 Width := PanelRec.Width;
191 Height := PanelRec.Height;
192 FAlpha := 0;
193 FBlending := False;
194 FCurFrame := 0;
195 FCurFrameCount := 0;
196 LastAnimLoop := 0;
197 Moved := False;
198
199 mapId := PanelRec.id;
200 mGUID := aguid;
201
202 mMovingSpeed := PanelRec.moveSpeed;
203 mMovingStart := PanelRec.moveStart;
204 mMovingEnd := PanelRec.moveEnd;
205 mMovingActive := PanelRec['move_active'].varvalue;
206
207 // Òèï ïàíåëè:
208 PanelType := PanelRec.PanelType;
209 Enabled := True;
210 Door := False;
211 LiftType := 0;
212 SaveIt := False;
213
214 case PanelType of
215 PANEL_OPENDOOR:
216 begin
217 Enabled := False;
218 Door := True;
219 SaveIt := True;
220 end;
221 PANEL_CLOSEDOOR:
222 begin
223 Door := True;
224 SaveIt := True;
225 end;
226 PANEL_LIFTUP:
227 SaveIt := True;
228 PANEL_LIFTDOWN:
229 begin
230 LiftType := 1;
231 SaveIt := True;
232 end;
233 PANEL_LIFTLEFT:
234 begin
235 LiftType := 2;
236 SaveIt := True;
237 end;
238 PANEL_LIFTRIGHT:
239 begin
240 LiftType := 3;
241 SaveIt := True;
242 end;
243 end;
244
245 // Íåâèäèìàÿ:
246 if ByteBool(PanelRec.Flags and PANEL_FLAG_HIDE) then
247 begin
248 SetLength(FTextureIDs, 0);
249 FCurTexture := -1;
250 Exit;
251 end;
252 // Ïàíåëè, íå èñïîëüçóþùèå òåêñòóðû:
253 if ByteBool(PanelType and
254 (PANEL_LIFTUP or
255 PANEL_LIFTDOWN or
256 PANEL_LIFTLEFT or
257 PANEL_LIFTRIGHT or
258 PANEL_BLOCKMON)) then
259 begin
260 SetLength(FTextureIDs, 0);
261 FCurTexture := -1;
262 Exit;
263 end;
264
265 // Åñëè ýòî æèäêîñòü áåç òåêñòóðû - ñïåöòåêñòóðó:
266 if WordBool(PanelType and (PANEL_WATER or PANEL_ACID1 or PANEL_ACID2)) and
267 (not ByteBool(PanelRec.Flags and PANEL_FLAG_WATERTEXTURES)) then
268 begin
269 SetLength(FTextureIDs, 1);
270 FTextureIDs[0].Anim := False;
271
272 case PanelRec.PanelType of
273 PANEL_WATER:
274 FTextureIDs[0].Tex := LongWord(TEXTURE_SPECIAL_WATER);
275 PANEL_ACID1:
276 FTextureIDs[0].Tex := LongWord(TEXTURE_SPECIAL_ACID1);
277 PANEL_ACID2:
278 FTextureIDs[0].Tex := LongWord(TEXTURE_SPECIAL_ACID2);
279 end;
280
281 FCurTexture := 0;
282 Exit;
283 end;
284
285 SetLength(FTextureIDs, Length(AddTextures));
286
287 if CurTex < 0 then
288 FCurTexture := -1
289 else
290 if CurTex >= Length(FTextureIDs) then
291 FCurTexture := Length(FTextureIDs) - 1
292 else
293 FCurTexture := CurTex;
294
295 for i := 0 to Length(FTextureIDs)-1 do
296 begin
297 FTextureIDs[i].Anim := AddTextures[i].Anim;
298 if FTextureIDs[i].Anim then
299 begin // Àíèìèðîâàííàÿ òåêñòóðà
300 FTextureIDs[i].AnTex :=
301 TAnimation.Create(Textures[AddTextures[i].Texture].FramesID,
302 True, Textures[AddTextures[i].Texture].Speed);
303 FTextureIDs[i].AnTex.Blending := ByteBool(PanelRec.Flags and PANEL_FLAG_BLENDING);
304 FTextureIDs[i].AnTex.Alpha := PanelRec.Alpha;
305 SaveIt := True;
306 end
307 else
308 begin // Îáû÷íàÿ òåêñòóðà
309 FTextureIDs[i].Tex := Textures[AddTextures[i].Texture].TextureID;
310 end;
311 end;
312
313 // Òåêñòóð íåñêîëüêî - íóæíî ñîõðàíÿòü òåêóùóþ:
314 if Length(FTextureIDs) > 1 then
315 SaveIt := True;
316
317 // Åñëè íå ñïåöòåêñòóðà, òî çàäàåì ðàçìåðû:
318 if PanelRec.TextureNum > High(Textures) then
319 begin
320 e_WriteLog(Format('WTF?! PanelRec.TextureNum is out of limits! (%d : %d)', [PanelRec.TextureNum, High(Textures)]), MSG_FATALERROR);
321 FTextureWidth := 2;
322 FTextureHeight := 2;
323 FAlpha := 0;
324 FBlending := ByteBool(0);
325 end
326 else if not g_Map_IsSpecialTexture(Textures[PanelRec.TextureNum].TextureName) then
327 begin
328 FTextureWidth := Textures[PanelRec.TextureNum].Width;
329 FTextureHeight := Textures[PanelRec.TextureNum].Height;
330 FAlpha := PanelRec.Alpha;
331 FBlending := ByteBool(PanelRec.Flags and PANEL_FLAG_BLENDING);
332 end;
333 end;
334
335 destructor TPanel.Destroy();
336 var
337 i: Integer;
338 begin
339 for i := 0 to High(FTextureIDs) do
340 if FTextureIDs[i].Anim then
341 FTextureIDs[i].AnTex.Free();
342 SetLength(FTextureIDs, 0);
343
344 Inherited;
345 end;
346
347 function TPanel.getx1 (): Integer; inline; begin result := X+Width-1; end;
348 function TPanel.gety1 (): Integer; inline; begin result := Y+Height-1; end;
349 function TPanel.getvisvalid (): Boolean; inline; begin result := (Width > 0) and (Height > 0); end;
350
351 function TPanel.getMovingSpeedX (): Integer; inline; begin result := mMovingSpeed.X; end;
352 procedure TPanel.setMovingSpeedX (v: Integer); inline; begin mMovingSpeed.X := v; end;
353 function TPanel.getMovingSpeedY (): Integer; inline; begin result := mMovingSpeed.Y; end;
354 procedure TPanel.setMovingSpeedY (v: Integer); inline; begin mMovingSpeed.Y := v; end;
355
356 function TPanel.getMovingStartX (): Integer; inline; begin result := mMovingStart.X; end;
357 procedure TPanel.setMovingStartX (v: Integer); inline; begin mMovingStart.X := v; end;
358 function TPanel.getMovingStartY (): Integer; inline; begin result := mMovingStart.Y; end;
359 procedure TPanel.setMovingStartY (v: Integer); inline; begin mMovingStart.Y := v; end;
360
361 function TPanel.getMovingEndX (): Integer; inline; begin result := mMovingEnd.X; end;
362 procedure TPanel.setMovingEndX (v: Integer); inline; begin mMovingEnd.X := v; end;
363 function TPanel.getMovingEndY (): Integer; inline; begin result := mMovingEnd.Y; end;
364 procedure TPanel.setMovingEndY (v: Integer); inline; begin mMovingEnd.Y := v; end;
365
366 function TPanel.getIsGBack (): Boolean; inline; begin result := ((tag and GridTagBack) <> 0); end;
367 function TPanel.getIsGStep (): Boolean; inline; begin result := ((tag and GridTagStep) <> 0); end;
368 function TPanel.getIsGWall (): Boolean; inline; begin result := ((tag and (GridTagWall or GridTagDoor)) <> 0); end;
369 function TPanel.getIsGAcid1 (): Boolean; inline; begin result := ((tag and GridTagAcid1) <> 0); end;
370 function TPanel.getIsGAcid2 (): Boolean; inline; begin result := ((tag and GridTagAcid2) <> 0); end;
371 function TPanel.getIsGWater (): Boolean; inline; begin result := ((tag and GridTagWater) <> 0); end;
372 function TPanel.getIsGFore (): Boolean; inline; begin result := ((tag and GridTagFore) <> 0); end;
373 function TPanel.getIsGLift (): Boolean; inline; begin result := ((tag and GridTagLift) <> 0); end;
374 function TPanel.getIsGBlockMon (): Boolean; inline; begin result := ((tag and GridTagBlockMon) <> 0); end;
375
376 procedure TPanel.Draw();
377 var
378 xx, yy: Integer;
379 NoTextureID: DWORD;
380 NW, NH: Word;
381 begin
382 if {Enabled and} (FCurTexture >= 0) and
383 (Width > 0) and (Height > 0) and (FAlpha < 255) and
384 ((g_dbg_scale <> 1.0) or g_Collide(X, Y, Width, Height, sX, sY, sWidth, sHeight)) then
385 begin
386 if FTextureIDs[FCurTexture].Anim then
387 begin // Àíèìèðîâàííàÿ òåêñòóðà
388 if FTextureIDs[FCurTexture].AnTex = nil then
389 Exit;
390
391 for xx := 0 to (Width div FTextureWidth)-1 do
392 for yy := 0 to (Height div FTextureHeight)-1 do
393 FTextureIDs[FCurTexture].AnTex.Draw(
394 X + xx*FTextureWidth,
395 Y + yy*FTextureHeight, M_NONE);
396 end
397 else
398 begin // Îáû÷íàÿ òåêñòóðà
399 case FTextureIDs[FCurTexture].Tex of
400 LongWord(TEXTURE_SPECIAL_WATER):
401 e_DrawFillQuad(X, Y, X+Width-1, Y+Height-1,
402 0, 0, 255, 0, B_FILTER);
403 LongWord(TEXTURE_SPECIAL_ACID1):
404 e_DrawFillQuad(X, Y, X+Width-1, Y+Height-1,
405 0, 128, 0, 0, B_FILTER);
406 LongWord(TEXTURE_SPECIAL_ACID2):
407 e_DrawFillQuad(X, Y, X+Width-1, Y+Height-1,
408 128, 0, 0, 0, B_FILTER);
409 LongWord(TEXTURE_NONE):
410 if g_Texture_Get('NOTEXTURE', NoTextureID) then
411 begin
412 e_GetTextureSize(NoTextureID, @NW, @NH);
413 e_DrawFill(NoTextureID, X, Y, Width div NW, Height div NH,
414 0, False, False);
415 end else
416 begin
417 xx := X + (Width div 2);
418 yy := Y + (Height div 2);
419 e_DrawFillQuad(X, Y, xx, yy,
420 255, 0, 255, 0);
421 e_DrawFillQuad(xx, Y, X+Width-1, yy,
422 255, 255, 0, 0);
423 e_DrawFillQuad(X, yy, xx, Y+Height-1,
424 255, 255, 0, 0);
425 e_DrawFillQuad(xx, yy, X+Width-1, Y+Height-1,
426 255, 0, 255, 0);
427 end;
428
429 else
430 e_DrawFill(FTextureIDs[FCurTexture].Tex, X, Y,
431 Width div FTextureWidth,
432 Height div FTextureHeight,
433 FAlpha, True, FBlending);
434 end;
435 end;
436 end;
437 end;
438
439 procedure TPanel.DrawShadowVolume(lightX: Integer; lightY: Integer; radius: Integer);
440 procedure extrude (x: Integer; y: Integer);
441 begin
442 glVertex2i(x+(x-lightX)*500, y+(y-lightY)*500);
443 //e_WriteLog(Format(' : (%d,%d)', [x+(x-lightX)*300, y+(y-lightY)*300]), MSG_WARNING);
444 end;
445
446 procedure drawLine (x0: Integer; y0: Integer; x1: Integer; y1: Integer);
447 begin
448 // does this side facing the light?
449 if ((x1-x0)*(lightY-y0)-(lightX-x0)*(y1-y0) >= 0) then exit;
450 //e_WriteLog(Format('lightpan: (%d,%d)-(%d,%d)', [x0, y0, x1, y1]), MSG_WARNING);
451 // this edge is facing the light, extrude and draw it
452 glVertex2i(x0, y0);
453 glVertex2i(x1, y1);
454 extrude(x1, y1);
455 extrude(x0, y0);
456 end;
457
458 begin
459 if radius < 4 then exit;
460 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
461 begin
462 if not FTextureIDs[FCurTexture].Anim then
463 begin
464 case FTextureIDs[FCurTexture].Tex of
465 LongWord(TEXTURE_SPECIAL_WATER): exit;
466 LongWord(TEXTURE_SPECIAL_ACID1): exit;
467 LongWord(TEXTURE_SPECIAL_ACID2): exit;
468 LongWord(TEXTURE_NONE): exit;
469 end;
470 end;
471 if (X+Width < lightX-radius) then exit;
472 if (Y+Height < lightY-radius) then exit;
473 if (X > lightX+radius) then exit;
474 if (Y > lightY+radius) then exit;
475 //e_DrawFill(FTextureIDs[FCurTexture].Tex, X, Y, Width div FTextureWidth, Height div FTextureHeight, FAlpha, True, FBlending);
476
477 glBegin(GL_QUADS);
478 drawLine(x, y, x+width, y); // top
479 drawLine(x+width, y, x+width, y+height); // right
480 drawLine(x+width, y+height, x, y+height); // bottom
481 drawLine(x, y+height, x, y); // left
482 glEnd();
483 end;
484 end;
485
486
487 procedure TPanel.positionChanged (); inline;
488 var
489 px, py, pw, ph: Integer;
490 begin
491 if (proxyId >= 0) then
492 begin
493 monsGrid.getBodyDims(proxyId, px, py, pw, ph);
494 if (px <> x) or (py <> y) or (pw <> Width) or (ph <> Height) then
495 begin
496 g_Mark(px, py, pw, ph, MARK_WALL, false);
497 if (pw <> Width) or (ph <> Height) then mapGrid.moveResizeBody(proxyId, X, Y, Width, Height)
498 else mapGrid.moveBody(proxyId, X, Y);
499 g_Mark(X, Y, Width, Height, MARK_WALL);
500 end;
501 end;
502 end;
503
504
505 var
506 monMoveList: array of TMonster = nil;
507 monMoveListUsed: Integer = 0;
508
509 procedure TPanel.Update();
510 var
511 nx, ny: Integer;
512 f: Integer;
513
514 function doPush (px, py, pw, ph: Integer; out dx, dy: Integer): Boolean;
515 begin
516 result := g_Collide(px, py, pw, ph, nx, ny, Width, Height);
517 if result then
518 begin
519 // need to push
520 if (mMovingSpeed.X < 0) then dx := nx-(px+pw)
521 else if (mMovingSpeed.X > 0) then dx := (nx+Width)-px
522 else dx := 0;
523 if (mMovingSpeed.Y < 0) then dy := ny-(py+ph)
524 else if (mMovingSpeed.Y > 0) then dy := (ny+Height)-py
525 else dy := 0;
526 end
527 else
528 begin
529 dx := 0;
530 dy := 0;
531 end;
532 end;
533
534 function monMove (mon: TMonster): Boolean;
535 begin
536 result := false; // don't stop
537 //mon.GameX := mon.GameX+mMovingSpeed.X;
538 //mon.GameY := mon.GameY+mMovingSpeed.Y;
539 mon.setPosition(mon.GameX+mMovingSpeed.X, mon.GameY+mMovingSpeed.Y, false); // we can't call `positionChanged()` in grid callback
540 if (monMoveListUsed >= Length(monMoveList)) then SetLength(monMoveList, monMoveListUsed+64);
541 monMoveList[monMoveListUsed] := mon;
542 Inc(monMoveListUsed);
543 end;
544
545 function monPush (mon: TMonster): Boolean;
546 var
547 px, py, pw, ph, dx, dy: Integer;
548 begin
549 result := false; // don't stop
550 mon.getMapBox(px, py, pw, ph);
551 if doPush(px, py, pw, ph, dx, dy) then
552 begin
553 //mon.GameX := mon.GameX+dx;
554 //mon.GameY := mon.GameY+dy;
555 mon.setPosition(mon.GameX+dx, mon.GameY+dy, false); // we can't call `positionChanged()` in grid callback
556 if (monMoveListUsed >= Length(monMoveList)) then SetLength(monMoveList, monMoveListUsed+64);
557 monMoveList[monMoveListUsed] := mon;
558 Inc(monMoveListUsed);
559 end;
560 end;
561
562 procedure plrMove (plr: TPlayer);
563 var
564 px, py, pw, ph, dx, dy: Integer;
565 begin
566 if (plr = nil) then exit;
567 plr.getMapBox(px, py, pw, ph);
568 if (py+ph <> Y) then
569 begin
570 // push player
571 if doPush(px, py, pw, ph, dx, dy) then
572 begin
573 plr.GameX := plr.GameX+dx;
574 plr.GameY := plr.GameY+dy;
575 plr.positionChanged();
576 end;
577 exit;
578 end;
579 if (px+pw <= X) then exit;
580 if (px >= X+Width) then exit;
581 plr.GameX := plr.GameX+mMovingSpeed.X;
582 plr.GameY := plr.GameY+mMovingSpeed.Y;
583 plr.positionChanged();
584 end;
585
586 begin
587 if Enabled and (FCurTexture >= 0) and
588 (FTextureIDs[FCurTexture].Anim) and
589 (FTextureIDs[FCurTexture].AnTex <> nil) and
590 (Width > 0) and (Height > 0) and (FAlpha < 255) then
591 begin
592 FTextureIDs[FCurTexture].AnTex.Update();
593 FCurFrame := FTextureIDs[FCurTexture].AnTex.CurrentFrame;
594 FCurFrameCount := FTextureIDs[FCurTexture].AnTex.CurrentCounter;
595 end;
596
597 if mMovingActive and (not mMovingSpeed.isZero) then
598 begin
599 monMoveListUsed := 0;
600 nx := X+mMovingSpeed.X;
601 ny := Y+mMovingSpeed.Y;
602 // move monsters on lifts
603 g_Mons_ForEachAt(X, Y-1, Width, 1, monMove);
604 // push monsters
605 g_Mons_ForEachAt(nx, ny, Width, Height, monPush);
606 // move and push players
607 for f := 0 to High(gPlayers) do plrMove(gPlayers[f]);
608 // reverse moving direction, if necessary
609 if (mMovingSpeed.X < 0) and (nx <= mMovingStart.X) then mMovingSpeed.X := -mMovingSpeed.X
610 else if (mMovingSpeed.X > 0) and (nx >= mMovingEnd.X) then mMovingSpeed.X := -mMovingSpeed.X;
611 if (mMovingSpeed.Y < 0) and (ny <= mMovingStart.Y) then mMovingSpeed.Y := -mMovingSpeed.Y
612 else if (mMovingSpeed.Y > 0) and (ny >= mMovingEnd.Y) then mMovingSpeed.Y := -mMovingSpeed.Y;
613 // awake particles
614 //g_Mark(X, Y, Width, Height, MARK_WALL, false);
615 X := nx;
616 Y := ny;
617 //g_Mark(nx, ny, Width, Height, MARK_WALL);
618 // fix grid
619 positionChanged();
620 // notify moved monsters about their movement
621 for f := 0 to monMoveListUsed-1 do monMoveList[f].positionChanged();
622 end;
623 end;
624
625 procedure TPanel.SetFrame(Frame: Integer; Count: Byte);
626
627 function ClampInt(X, A, B: Integer): Integer;
628 begin
629 Result := X;
630 if X < A then Result := A else if X > B then Result := B;
631 end;
632
633 begin
634 if Enabled and (FCurTexture >= 0) and
635 (FTextureIDs[FCurTexture].Anim) and
636 (FTextureIDs[FCurTexture].AnTex <> nil) and
637 (Width > 0) and (Height > 0) and (FAlpha < 255) then
638 begin
639 FCurFrame := ClampInt(Frame, 0, FTextureIDs[FCurTexture].AnTex.TotalFrames);
640 FCurFrameCount := Count;
641 FTextureIDs[FCurTexture].AnTex.CurrentFrame := FCurFrame;
642 FTextureIDs[FCurTexture].AnTex.CurrentCounter := FCurFrameCount;
643 end;
644 end;
645
646 procedure TPanel.NextTexture(AnimLoop: Byte = 0);
647 begin
648 Assert(FCurTexture >= -1, 'FCurTexture < -1');
649
650 // Íåò òåêñòóð:
651 if Length(FTextureIDs) = 0 then
652 FCurTexture := -1
653 else
654 // Òîëüêî îäíà òåêñòóðà:
655 if Length(FTextureIDs) = 1 then
656 begin
657 if FCurTexture = 0 then
658 FCurTexture := -1
659 else
660 FCurTexture := 0;
661 end
662 else
663 // Áîëüøå îäíîé òåêñòóðû:
664 begin
665 // Ñëåäóþùàÿ:
666 Inc(FCurTexture);
667 // Ñëåäóþùåé íåò - âîçâðàò ê íà÷àëó:
668 if FCurTexture >= Length(FTextureIDs) then
669 FCurTexture := 0;
670 end;
671
672 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
673 if (FCurTexture >= 0) and FTextureIDs[FCurTexture].Anim then
674 begin
675 if (FTextureIDs[FCurTexture].AnTex = nil) then
676 begin
677 g_FatalError(_lc[I_GAME_ERROR_SWITCH_TEXTURE]);
678 Exit;
679 end;
680
681 if AnimLoop = 1 then
682 FTextureIDs[FCurTexture].AnTex.Loop := True
683 else
684 if AnimLoop = 2 then
685 FTextureIDs[FCurTexture].AnTex.Loop := False;
686
687 FTextureIDs[FCurTexture].AnTex.Reset();
688 end;
689
690 LastAnimLoop := AnimLoop;
691 end;
692
693 procedure TPanel.SetTexture(ID: Integer; AnimLoop: Byte = 0);
694 begin
695 // Íåò òåêñòóð:
696 if Length(FTextureIDs) = 0 then
697 FCurTexture := -1
698 else
699 // Òîëüêî îäíà òåêñòóðà:
700 if Length(FTextureIDs) = 1 then
701 begin
702 if (ID = 0) or (ID = -1) then
703 FCurTexture := ID;
704 end
705 else
706 // Áîëüøå îäíîé òåêñòóðû:
707 begin
708 if (ID >= -1) and (ID <= High(FTextureIDs)) then
709 FCurTexture := ID;
710 end;
711
712 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
713 if (FCurTexture >= 0) and FTextureIDs[FCurTexture].Anim then
714 begin
715 if (FTextureIDs[FCurTexture].AnTex = nil) then
716 begin
717 g_FatalError(_lc[I_GAME_ERROR_SWITCH_TEXTURE]);
718 Exit;
719 end;
720
721 if AnimLoop = 1 then
722 FTextureIDs[FCurTexture].AnTex.Loop := True
723 else
724 if AnimLoop = 2 then
725 FTextureIDs[FCurTexture].AnTex.Loop := False;
726
727 FTextureIDs[FCurTexture].AnTex.Reset();
728 end;
729
730 LastAnimLoop := AnimLoop;
731 end;
732
733 function TPanel.GetTextureID(): DWORD;
734 begin
735 Result := LongWord(TEXTURE_NONE);
736
737 if (FCurTexture >= 0) then
738 begin
739 if FTextureIDs[FCurTexture].Anim then
740 Result := FTextureIDs[FCurTexture].AnTex.FramesID
741 else
742 Result := FTextureIDs[FCurTexture].Tex;
743 end;
744 end;
745
746 function TPanel.GetTextureCount(): Integer;
747 begin
748 Result := Length(FTextureIDs);
749 if Enabled and (FCurTexture >= 0) then
750 if (FTextureIDs[FCurTexture].Anim) and
751 (FTextureIDs[FCurTexture].AnTex <> nil) and
752 (Width > 0) and (Height > 0) and (FAlpha < 255) then
753 Result := Result + 100;
754 end;
755
756 procedure TPanel.SaveState(Var Mem: TBinMemoryWriter);
757 var
758 sig: DWORD;
759 anim: Boolean;
760 begin
761 if (Mem = nil) then exit;
762 //if not SaveIt then exit;
763
764 // Ñèãíàòóðà ïàíåëè:
765 sig := PANEL_SIGNATURE; // 'PANL'
766 Mem.WriteDWORD(sig);
767 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
768 Mem.WriteBoolean(FEnabled);
769 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
770 Mem.WriteByte(FLiftType);
771 // Íîìåð òåêóùåé òåêñòóðû:
772 Mem.WriteInt(FCurTexture);
773 // Êîîðäû
774 Mem.WriteInt(FX);
775 Mem.WriteInt(FY);
776 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
777 if (FCurTexture >= 0) and (FTextureIDs[FCurTexture].Anim) then
778 begin
779 Assert(FTextureIDs[FCurTexture].AnTex <> nil,
780 'TPanel.SaveState: No animation object');
781 anim := True;
782 end
783 else
784 anim := False;
785 Mem.WriteBoolean(anim);
786 // Åñëè äà - ñîõðàíÿåì àíèìàöèþ:
787 if anim then
788 FTextureIDs[FCurTexture].AnTex.SaveState(Mem);
789 // moving platform state
790 Mem.WriteInt(mMovingSpeed.X);
791 Mem.WriteInt(mMovingSpeed.Y);
792 Mem.WriteInt(mMovingStart.X);
793 Mem.WriteInt(mMovingStart.Y);
794 Mem.WriteInt(mMovingEnd.X);
795 Mem.WriteInt(mMovingEnd.Y);
796 Mem.WriteBoolean(mMovingActive);
797 end;
798
799 procedure TPanel.LoadState(var Mem: TBinMemoryReader);
800 var
801 sig: DWORD;
802 anim: Boolean;
803 //ox, oy: Integer;
804 begin
805 if (Mem = nil) then exit;
806 //if not SaveIt then exit;
807
808 // Ñèãíàòóðà ïàíåëè:
809 Mem.ReadDWORD(sig);
810 if sig <> PANEL_SIGNATURE then // 'PANL'
811 begin
812 raise EBinSizeError.Create('TPanel.LoadState: Wrong Panel Signature');
813 end;
814 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
815 Mem.ReadBoolean(FEnabled);
816 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
817 Mem.ReadByte(FLiftType);
818 // Íîìåð òåêóùåé òåêñòóðû:
819 Mem.ReadInt(FCurTexture);
820 // Êîîðäû
821 //ox := FX;
822 //oy := FY;
823 Mem.ReadInt(FX);
824 Mem.ReadInt(FY);
825 //e_LogWritefln('panel %s(%s): old=(%s,%s); new=(%s,%s); delta=(%s,%s)', [arrIdx, proxyId, ox, oy, FX, FY, FX-ox, FY-oy]);
826 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
827 Mem.ReadBoolean(anim);
828 // Åñëè äà - çàãðóæàåì àíèìàöèþ:
829 if anim then
830 begin
831 Assert((FCurTexture >= 0) and
832 (FTextureIDs[FCurTexture].Anim) and
833 (FTextureIDs[FCurTexture].AnTex <> nil),
834 'TPanel.LoadState: No animation object');
835 FTextureIDs[FCurTexture].AnTex.LoadState(Mem);
836 end;
837 // moving platform state
838 Mem.ReadInt(mMovingSpeed.X);
839 Mem.ReadInt(mMovingSpeed.Y);
840 Mem.ReadInt(mMovingStart.X);
841 Mem.ReadInt(mMovingStart.Y);
842 Mem.ReadInt(mMovingEnd.X);
843 Mem.ReadInt(mMovingEnd.Y);
844 Mem.ReadBoolean(mMovingActive);
845
846 positionChanged();
847 //mapGrid.proxyEnabled[proxyId] := FEnabled; // done in g_map.pas
848 end;
849
850 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024