(* Copyright (C) DooM 2D:Forever Developers * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program. If not, see . *) {$INCLUDE ../shared/a_modes.inc} {$M+} unit g_panel; interface uses MAPDEF, BinEditor, g_textures, xdynrec; type TAddTextureArray = Array of record Texture: Cardinal; Anim: Boolean; end; TPanel = Class (TObject) private const private mGUID: Integer; // will be assigned in "g_map.pas" FTextureWidth: Word; FTextureHeight: Word; FAlpha: Byte; FBlending: Boolean; FTextureIDs: Array of record case Anim: Boolean of False: (Tex: Cardinal); True: (AnTex: TAnimation); end; mMovingSpeed: TDFPoint; mMovingStart: TDFPoint; mMovingEnd: TDFPoint; mMovingActive: Boolean; private function getx1 (): Integer; inline; function gety1 (): Integer; inline; function getvisvalid (): Boolean; inline; function getMovingSpeedX (): Integer; inline; procedure setMovingSpeedX (v: Integer); inline; function getMovingSpeedY (): Integer; inline; procedure setMovingSpeedY (v: Integer); inline; function getMovingStartX (): Integer; inline; procedure setMovingStartX (v: Integer); inline; function getMovingStartY (): Integer; inline; procedure setMovingStartY (v: Integer); inline; function getMovingEndX (): Integer; inline; procedure setMovingEndX (v: Integer); inline; function getMovingEndY (): Integer; inline; procedure setMovingEndY (v: Integer); inline; public FCurTexture: Integer; // Номер текущей текстуры FCurFrame: Integer; FCurFrameCount: Byte; FX, FY: Integer; FWidth, FHeight: Word; FPanelType: Word; FSaveIt: Boolean; // Сохранять при SaveState? FEnabled: Boolean; FDoor: Boolean; FMoved: Boolean; FLiftType: Byte; FLastAnimLoop: Byte; // sorry, there fields are public to allow setting 'em in g_map; this should be fixed later // for now, PLEASE, don't modify 'em, or all hell will break loose arrIdx: Integer; // index in one of internal arrays; sorry tag: Integer; // used in coldets and such; sorry; see g_map.GridTagXXX proxyId: Integer; // proxy id in map grid (DO NOT USE!) mapId: AnsiString; // taken directly from map file; dunno why it is here constructor Create(PanelRec: TDynRecord; AddTextures: TAddTextureArray; CurTex: Integer; var Textures: TLevelTextureArray; aguid: Integer); destructor Destroy(); override; procedure Draw(); procedure DrawShadowVolume(lightX: Integer; lightY: Integer; radius: Integer); procedure Update(); procedure SetFrame(Frame: Integer; Count: Byte); procedure NextTexture(AnimLoop: Byte = 0); procedure SetTexture(ID: Integer; AnimLoop: Byte = 0); function GetTextureID(): Cardinal; function GetTextureCount(): Integer; procedure SaveState(var Mem: TBinMemoryWriter); procedure LoadState(var Mem: TBinMemoryReader); procedure positionChanged (); inline; function getIsGBack (): Boolean; inline; // gRenderBackgrounds function getIsGStep (): Boolean; inline; // gSteps function getIsGWall (): Boolean; inline; // gWalls function getIsGAcid1 (): Boolean; inline; // gAcid1 function getIsGAcid2 (): Boolean; inline; // gAcid2 function getIsGWater (): Boolean; inline; // gWater function getIsGFore (): Boolean; inline; // gRenderForegrounds function getIsGLift (): Boolean; inline; // gLifts function getIsGBlockMon (): Boolean; inline; // gBlockMon public property visvalid: Boolean read getvisvalid; // panel is "visvalid" when it's width and height are positive published property guid: Integer read mGUID; // will be assigned in "g_map.pas" property x0: Integer read FX; property y0: Integer read FY; property x1: Integer read getx1; // inclusive! property y1: Integer read gety1; // inclusive! property x: Integer read FX write FX; property y: Integer read FY write FY; property width: Word read FWidth write FWidth; property height: Word read FHeight write FHeight; property panelType: Word read FPanelType write FPanelType; property saveIt: Boolean read FSaveIt write FSaveIt; // Сохранять при SaveState? property enabled: Boolean read FEnabled write FEnabled; // Сохранять при SaveState? property door: Boolean read FDoor write FDoor; // Сохранять при SaveState? property moved: Boolean read FMoved write FMoved; // Сохранять при SaveState? property liftType: Byte read FLiftType write FLiftType; // Сохранять при SaveState? property lastAnimLoop: Byte read FLastAnimLoop write FLastAnimLoop; // Сохранять при SaveState? property movingSpeedX: Integer read getMovingSpeedX write setMovingSpeedX; property movingSpeedY: Integer read getMovingSpeedY write setMovingSpeedY; property movingStartX: Integer read getMovingStartX write setMovingStartX; property movingStartY: Integer read getMovingStartY write setMovingStartY; property movingEndX: Integer read getMovingEndX write setMovingEndX; property movingEndY: Integer read getMovingEndY write setMovingEndY; property movingActive: Boolean read mMovingActive write mMovingActive; property isGBack: Boolean read getIsGBack; property isGStep: Boolean read getIsGStep; property isGWall: Boolean read getIsGWall; property isGAcid1: Boolean read getIsGAcid1; property isGAcid2: Boolean read getIsGAcid2; property isGWater: Boolean read getIsGWater; property isGFore: Boolean read getIsGFore; property isGLift: Boolean read getIsGLift; property isGBlockMon: Boolean read getIsGBlockMon; public property movingSpeed: TDFPoint read mMovingSpeed write mMovingSpeed; property movingStart: TDFPoint read mMovingStart write mMovingStart; property movingEnd: TDFPoint read mMovingEnd write mMovingEnd; end; TPanelArray = Array of TPanel; var g_dbgpan_mplat_active: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}true{$ENDIF}; g_dbgpan_mplat_step: Boolean = false; // one step, and stop implementation uses SysUtils, g_basic, g_map, g_game, g_gfx, e_graphics, g_weapons, g_console, g_language, g_monsters, g_player, g_grid, e_log, GL, utils; const PANEL_SIGNATURE = $4C4E4150; // 'PANL' { T P a n e l : } constructor TPanel.Create(PanelRec: TDynRecord; AddTextures: TAddTextureArray; CurTex: Integer; var Textures: TLevelTextureArray; aguid: Integer); var i: Integer; begin X := PanelRec.X; Y := PanelRec.Y; Width := PanelRec.Width; Height := PanelRec.Height; FAlpha := 0; FBlending := False; FCurFrame := 0; FCurFrameCount := 0; LastAnimLoop := 0; Moved := False; mapId := PanelRec.id; mGUID := aguid; mMovingSpeed := PanelRec.moveSpeed; mMovingStart := PanelRec.moveStart; mMovingEnd := PanelRec.moveEnd; mMovingActive := PanelRec['move_active'].varvalue; // Тип панели: PanelType := PanelRec.PanelType; Enabled := True; Door := False; LiftType := 0; SaveIt := False; case PanelType of PANEL_OPENDOOR: begin Enabled := False; Door := True; SaveIt := True; end; PANEL_CLOSEDOOR: begin Door := True; SaveIt := True; end; PANEL_LIFTUP: SaveIt := True; PANEL_LIFTDOWN: begin LiftType := 1; SaveIt := True; end; PANEL_LIFTLEFT: begin LiftType := 2; SaveIt := True; end; PANEL_LIFTRIGHT: begin LiftType := 3; SaveIt := True; end; end; // Невидимая: if ByteBool(PanelRec.Flags and PANEL_FLAG_HIDE) then begin SetLength(FTextureIDs, 0); FCurTexture := -1; Exit; end; // Панели, не использующие текстуры: if ByteBool(PanelType and (PANEL_LIFTUP or PANEL_LIFTDOWN or PANEL_LIFTLEFT or PANEL_LIFTRIGHT or PANEL_BLOCKMON)) then begin SetLength(FTextureIDs, 0); FCurTexture := -1; Exit; end; // Если это жидкость без текстуры - спецтекстуру: if WordBool(PanelType and (PANEL_WATER or PANEL_ACID1 or PANEL_ACID2)) and (not ByteBool(PanelRec.Flags and PANEL_FLAG_WATERTEXTURES)) then begin SetLength(FTextureIDs, 1); FTextureIDs[0].Anim := False; case PanelRec.PanelType of PANEL_WATER: FTextureIDs[0].Tex := LongWord(TEXTURE_SPECIAL_WATER); PANEL_ACID1: FTextureIDs[0].Tex := LongWord(TEXTURE_SPECIAL_ACID1); PANEL_ACID2: FTextureIDs[0].Tex := LongWord(TEXTURE_SPECIAL_ACID2); end; FCurTexture := 0; Exit; end; SetLength(FTextureIDs, Length(AddTextures)); if CurTex < 0 then FCurTexture := -1 else if CurTex >= Length(FTextureIDs) then FCurTexture := Length(FTextureIDs) - 1 else FCurTexture := CurTex; for i := 0 to Length(FTextureIDs)-1 do begin FTextureIDs[i].Anim := AddTextures[i].Anim; if FTextureIDs[i].Anim then begin // Анимированная текстура FTextureIDs[i].AnTex := TAnimation.Create(Textures[AddTextures[i].Texture].FramesID, True, Textures[AddTextures[i].Texture].Speed); FTextureIDs[i].AnTex.Blending := ByteBool(PanelRec.Flags and PANEL_FLAG_BLENDING); FTextureIDs[i].AnTex.Alpha := PanelRec.Alpha; SaveIt := True; end else begin // Обычная текстура FTextureIDs[i].Tex := Textures[AddTextures[i].Texture].TextureID; end; end; // Текстур несколько - нужно сохранять текущую: if Length(FTextureIDs) > 1 then SaveIt := True; // Если не спецтекстура, то задаем размеры: if PanelRec.TextureNum > High(Textures) then begin e_WriteLog(Format('WTF?! PanelRec.TextureNum is out of limits! (%d : %d)', [PanelRec.TextureNum, High(Textures)]), MSG_FATALERROR); FTextureWidth := 2; FTextureHeight := 2; FAlpha := 0; FBlending := ByteBool(0); end else if not g_Map_IsSpecialTexture(Textures[PanelRec.TextureNum].TextureName) then begin FTextureWidth := Textures[PanelRec.TextureNum].Width; FTextureHeight := Textures[PanelRec.TextureNum].Height; FAlpha := PanelRec.Alpha; FBlending := ByteBool(PanelRec.Flags and PANEL_FLAG_BLENDING); end; end; destructor TPanel.Destroy(); var i: Integer; begin for i := 0 to High(FTextureIDs) do if FTextureIDs[i].Anim then FTextureIDs[i].AnTex.Free(); SetLength(FTextureIDs, 0); Inherited; end; function TPanel.getx1 (): Integer; inline; begin result := X+Width-1; end; function TPanel.gety1 (): Integer; inline; begin result := Y+Height-1; end; function TPanel.getvisvalid (): Boolean; inline; begin result := (Width > 0) and (Height > 0); end; function TPanel.getMovingSpeedX (): Integer; inline; begin result := mMovingSpeed.X; end; procedure TPanel.setMovingSpeedX (v: Integer); inline; begin mMovingSpeed.X := v; end; function TPanel.getMovingSpeedY (): Integer; inline; begin result := mMovingSpeed.Y; end; procedure TPanel.setMovingSpeedY (v: Integer); inline; begin mMovingSpeed.Y := v; end; function TPanel.getMovingStartX (): Integer; inline; begin result := mMovingStart.X; end; procedure TPanel.setMovingStartX (v: Integer); inline; begin mMovingStart.X := v; end; function TPanel.getMovingStartY (): Integer; inline; begin result := mMovingStart.Y; end; procedure TPanel.setMovingStartY (v: Integer); inline; begin mMovingStart.Y := v; end; function TPanel.getMovingEndX (): Integer; inline; begin result := mMovingEnd.X; end; procedure TPanel.setMovingEndX (v: Integer); inline; begin mMovingEnd.X := v; end; function TPanel.getMovingEndY (): Integer; inline; begin result := mMovingEnd.Y; end; procedure TPanel.setMovingEndY (v: Integer); inline; begin mMovingEnd.Y := v; end; function TPanel.getIsGBack (): Boolean; inline; begin result := ((tag and GridTagBack) <> 0); end; function TPanel.getIsGStep (): Boolean; inline; begin result := ((tag and GridTagStep) <> 0); end; function TPanel.getIsGWall (): Boolean; inline; begin result := ((tag and (GridTagWall or GridTagDoor)) <> 0); end; function TPanel.getIsGAcid1 (): Boolean; inline; begin result := ((tag and GridTagAcid1) <> 0); end; function TPanel.getIsGAcid2 (): Boolean; inline; begin result := ((tag and GridTagAcid2) <> 0); end; function TPanel.getIsGWater (): Boolean; inline; begin result := ((tag and GridTagWater) <> 0); end; function TPanel.getIsGFore (): Boolean; inline; begin result := ((tag and GridTagFore) <> 0); end; function TPanel.getIsGLift (): Boolean; inline; begin result := ((tag and GridTagLift) <> 0); end; function TPanel.getIsGBlockMon (): Boolean; inline; begin result := ((tag and GridTagBlockMon) <> 0); end; procedure TPanel.Draw(); var xx, yy: Integer; NoTextureID: DWORD; NW, NH: Word; begin if {Enabled and} (FCurTexture >= 0) and (Width > 0) and (Height > 0) and (FAlpha < 255) and ((g_dbg_scale <> 1.0) or g_Collide(X, Y, Width, Height, sX, sY, sWidth, sHeight)) then begin if FTextureIDs[FCurTexture].Anim then begin // Анимированная текстура if FTextureIDs[FCurTexture].AnTex = nil then Exit; for xx := 0 to (Width div FTextureWidth)-1 do for yy := 0 to (Height div FTextureHeight)-1 do FTextureIDs[FCurTexture].AnTex.Draw( X + xx*FTextureWidth, Y + yy*FTextureHeight, M_NONE); end else begin // Обычная текстура case FTextureIDs[FCurTexture].Tex of LongWord(TEXTURE_SPECIAL_WATER): e_DrawFillQuad(X, Y, X+Width-1, Y+Height-1, 0, 0, 255, 0, B_FILTER); LongWord(TEXTURE_SPECIAL_ACID1): e_DrawFillQuad(X, Y, X+Width-1, Y+Height-1, 0, 128, 0, 0, B_FILTER); LongWord(TEXTURE_SPECIAL_ACID2): e_DrawFillQuad(X, Y, X+Width-1, Y+Height-1, 128, 0, 0, 0, B_FILTER); LongWord(TEXTURE_NONE): if g_Texture_Get('NOTEXTURE', NoTextureID) then begin e_GetTextureSize(NoTextureID, @NW, @NH); e_DrawFill(NoTextureID, X, Y, Width div NW, Height div NH, 0, False, False); end else begin xx := X + (Width div 2); yy := Y + (Height div 2); e_DrawFillQuad(X, Y, xx, yy, 255, 0, 255, 0); e_DrawFillQuad(xx, Y, X+Width-1, yy, 255, 255, 0, 0); e_DrawFillQuad(X, yy, xx, Y+Height-1, 255, 255, 0, 0); e_DrawFillQuad(xx, yy, X+Width-1, Y+Height-1, 255, 0, 255, 0); end; else e_DrawFill(FTextureIDs[FCurTexture].Tex, X, Y, Width div FTextureWidth, Height div FTextureHeight, FAlpha, True, FBlending); end; end; end; end; procedure TPanel.DrawShadowVolume(lightX: Integer; lightY: Integer; radius: Integer); procedure extrude (x: Integer; y: Integer); begin glVertex2i(x+(x-lightX)*500, y+(y-lightY)*500); //e_WriteLog(Format(' : (%d,%d)', [x+(x-lightX)*300, y+(y-lightY)*300]), MSG_WARNING); end; procedure drawLine (x0: Integer; y0: Integer; x1: Integer; y1: Integer); begin // does this side facing the light? if ((x1-x0)*(lightY-y0)-(lightX-x0)*(y1-y0) >= 0) then exit; //e_WriteLog(Format('lightpan: (%d,%d)-(%d,%d)', [x0, y0, x1, y1]), MSG_WARNING); // this edge is facing the light, extrude and draw it glVertex2i(x0, y0); glVertex2i(x1, y1); extrude(x1, y1); extrude(x0, y0); end; begin if radius < 4 then exit; 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 begin if not FTextureIDs[FCurTexture].Anim then begin case FTextureIDs[FCurTexture].Tex of LongWord(TEXTURE_SPECIAL_WATER): exit; LongWord(TEXTURE_SPECIAL_ACID1): exit; LongWord(TEXTURE_SPECIAL_ACID2): exit; LongWord(TEXTURE_NONE): exit; end; end; if (X+Width < lightX-radius) then exit; if (Y+Height < lightY-radius) then exit; if (X > lightX+radius) then exit; if (Y > lightY+radius) then exit; //e_DrawFill(FTextureIDs[FCurTexture].Tex, X, Y, Width div FTextureWidth, Height div FTextureHeight, FAlpha, True, FBlending); glBegin(GL_QUADS); drawLine(x, y, x+width, y); // top drawLine(x+width, y, x+width, y+height); // right drawLine(x+width, y+height, x, y+height); // bottom drawLine(x, y+height, x, y); // left glEnd(); end; end; procedure TPanel.positionChanged (); inline; var px, py, pw, ph: Integer; begin if (proxyId >= 0) then begin mapGrid.getBodyDims(proxyId, px, py, pw, ph); if (px <> x) or (py <> y) or (pw <> Width) or (ph <> Height) then begin { e_LogWritefln('panel moved: arridx=%s; guid=%s; proxyid=%s; old:(%s,%s)-(%sx%s); new:(%s,%s)-(%sx%s)', [arrIdx, mGUID, proxyId, px, py, pw, ph, x, y, width, height]); } g_Mark(px, py, pw, ph, MARK_WALL, false); if (pw <> Width) or (ph <> Height) then mapGrid.moveResizeBody(proxyId, X, Y, Width, Height) else mapGrid.moveBody(proxyId, X, Y); g_Mark(X, Y, Width, Height, MARK_WALL); end; end; end; { var monMoveList: array of TMonster = nil; monMoveListUsed: Integer = 0; } procedure TPanel.Update(); var ox, oy: Integer; nx, ny: Integer; ex, ey, nex, ney: Integer; cx0, cy0, cx1, cy1: Integer; // return `true` if we should move by dx,dy function tryMPlatMove (px, py, pw, ph: Integer; out dx, dy: Integer; out squash: Boolean): Boolean; var u0, u1: Single; tex, tey: Integer; pdx, pdy: Integer; begin squash := false; dx := 0; dy := 0; pdx := mMovingSpeed.X; pdy := mMovingSpeed.Y; // standing on the platform? if (py+ph = oy) then begin // yes, move with it mapGrid.traceBox(tex, tey, px, py, pw, ph, pdx, pdy, nil, GridTagObstacle); //e_LogWritefln('entity on the platform; tracing=(%s,%s); endpoint=(%s,%s); mustbe=(%s,%s)', [px, py, tex, tey, px+pdx, py+pdy]); // still in platform? squash := g_Collide(tex, tey, pw, ph, nx, ny, Width, Height); dx := tex-px; dy := tey-py; end else begin // not standing on the platform: trace platform to see if it hits the entity // hitedge (for `it`): 0: top; 1: right; 2: bottom; 3: left { if g_Collide(px, py, pw, ph, ox, oy, Width, Height) then begin 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+Width-1, oy+Height-1]); end; } if sweepAABB(ox, oy, Width, Height, pdx, pdy, px, py, pw, ph, @u0, nil, @u1) then begin //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, Width, Height, pdx, pdy, px-1, py-1, pw+2, ph+2]); // yes, platform hits the entity, push the entity in the direction of the platform u0 := 1.0-u0; // how much path left? pdx := trunc(pdx*u0); pdy := trunc(pdy*u0); //e_LogWritefln(' platsweep; uleft=%s; pd=(%s,%s)', [u0, pdx, pdy]); if (pdx <> 0) or (pdy <> 0) then begin // has some path to go, trace the entity mapGrid.traceBox(tex, tey, px, py, pw, ph, pdx, pdy, nil, GridTagObstacle); //e_LogWritefln(' tracebox: te=(%s,%s)', [tex, tey]); end else begin // no movement tex := px; tey := py; end; // free to push along the whole path, or path was corrected // still in platform? squash := g_Collide(tex, tey, pw, ph, nx, ny, Width, Height); dx := tex-px; dy := tey-py; end else begin // no collistion, but may be embedded //e_LogWritefln('F: platsweep; u0=%s; u1=%s; sweepAABB(%s, %s, %s, %s, %s, %s, %s, %s, %s, %s)', [u0, u1, ox, oy, Width, Height, pdx, pdy, px-1, py-1, pw+2, ph+2]); squash := (u1 >= 0.0); end; end; result := (dx <> 0) or (dy <> 0); end; (* function monCollect (mon: TMonster): Boolean; begin result := false; // don't stop monMoveList[monMoveListUsed] := mon; Inc(monMoveListUsed); end; function doPush (px, py, pw, ph: Integer; out dx, dy: Integer): Boolean; begin result := g_Collide(px, py, pw, ph, nx, ny, Width, Height); if result then begin // need to push if (mMovingSpeed.X < 0) then dx := nx-(px+pw) else if (mMovingSpeed.X > 0) then dx := (nx+Width)-px else dx := 0; if (mMovingSpeed.Y < 0) then dy := ny-(py+ph) else if (mMovingSpeed.Y > 0) then dy := (ny+Height)-py else dy := 0; end else begin dx := 0; dy := 0; end; end; function monMove (mon: TMonster): Boolean; begin result := false; // don't stop //mon.GameX := mon.GameX+mMovingSpeed.X; //mon.GameY := mon.GameY+mMovingSpeed.Y; mon.setPosition(mon.GameX+mMovingSpeed.X, mon.GameY+mMovingSpeed.Y, false); // we can't call `positionChanged()` in grid callback if (monMoveListUsed >= Length(monMoveList)) then SetLength(monMoveList, monMoveListUsed+64); monMoveList[monMoveListUsed] := mon; Inc(monMoveListUsed); end; function monPush (mon: TMonster): Boolean; var px, py, pw, ph, dx, dy: Integer; begin result := false; // don't stop mon.getMapBox(px, py, pw, ph); if doPush(px, py, pw, ph, dx, dy) then begin //mon.GameX := mon.GameX+dx; //mon.GameY := mon.GameY+dy; mon.setPosition(mon.GameX+dx, mon.GameY+dy, false); // we can't call `positionChanged()` in grid callback if (monMoveListUsed >= Length(monMoveList)) then SetLength(monMoveList, monMoveListUsed+64); monMoveList[monMoveListUsed] := mon; Inc(monMoveListUsed); end; end; procedure plrMove (plr: TPlayer); var px, py, pw, ph, dx, dy: Integer; begin // dead players leaves separate body entities, so don't move 'em if (plr = nil) or not plr.alive then exit; plr.getMapBox(px, py, pw, ph); if (py+ph <> oy) then begin // push player if doPush(px, py, pw, ph, dx, dy) then begin plr.GameX := plr.GameX+dx; plr.GameY := plr.GameY+dy; plr.positionChanged(); // check if we're squashed if plr.alive then begin plr.getMapBox(px, py, pw, ph); if g_Map_CollidePanel(px, py, pw, ph, (PANEL_WALL or PANEL_OPENDOOR or PANEL_CLOSEDOOR)) then begin plr.Damage(15000, 0, 0, 0, HIT_TRAP); end; end; end; exit; end; if (px+pw <= ox) then exit; if (px >= ox+Width) then exit; plr.GameX := plr.GameX+mMovingSpeed.X; plr.GameY := plr.GameY+mMovingSpeed.Y; plr.positionChanged(); end; procedure gibMove (gib: PGib); var px, py, pw, ph, dx, dy: Integer; begin if (gib = nil) or not gib.alive then exit; gib.getMapBox(px, py, pw, ph); { writeln('gib: p=(', px, ',', py, '); obj=(', gib.Obj.X, ',', gib.Obj.Y, ')'); px := gib.Obj.X; py := gib.Obj.Y; } if (py+ph <> oy) then begin // push gib if doPush(px, py, pw, ph, dx, dy) then begin gib.Obj.X += dx; gib.Obj.Y += dy; gib.positionChanged(); end; exit; end; if (px+pw <= ox) then exit; if (px >= ox+Width) then exit; gib.Obj.X += mMovingSpeed.X; gib.Obj.Y += mMovingSpeed.Y; gib.positionChanged(); end; procedure corpseMove (cor: TCorpse); var px, py, pw, ph, dx, dy: Integer; begin if (cor = nil) then exit; cor.getMapBox(px, py, pw, ph); if (py+ph <> oy) then begin // push gib if doPush(px, py, pw, ph, dx, dy) then begin cor.moveBy(dx, dy); // will call `positionChanged()` for us end; exit; end; if (px+pw <= ox) then exit; if (px >= ox+Width) then exit; cor.moveBy(mMovingSpeed.X, mMovingSpeed.Y); // will call `positionChanged()` for us end; *) var f: Integer; plr: TPlayer; px, py, pw, ph, pdx, pdy: Integer; squash: Boolean; { mon: TMonster; sdx, sdy, he: Integer; u0, u1: Single; } begin if (not Enabled) or (Width < 1) or (Height < 1) then exit; if (FCurTexture >= 0) and (FTextureIDs[FCurTexture].Anim) and (FTextureIDs[FCurTexture].AnTex <> nil) and (FAlpha < 255) then begin FTextureIDs[FCurTexture].AnTex.Update(); FCurFrame := FTextureIDs[FCurTexture].AnTex.CurrentFrame; FCurFrameCount := FTextureIDs[FCurTexture].AnTex.CurrentCounter; end; // moving platform? if mMovingActive and (not mMovingSpeed.isZero) and g_dbgpan_mplat_active then begin (* * collect all monsters and players (aka entities) along the possible platform path * if entity is standing on a platform: * try to move it along the platform path, checking wall collisions * if entity is NOT standing on a platform, but hit with sweeped platform aabb: * try to push entity * if we can't push entity all the way, squash it *) // old rect ox := X; oy := Y; ex := ox+Width-1; ey := ox+Height-1; // new rect nx := ox+mMovingSpeed.X; ny := oy+mMovingSpeed.Y; nex := nx+Width-1; ney := ny+Height-1; // full rect cx0 := nmin(ox, nx); cy0 := nmin(oy, ny); cx1 := nmax(ex, nex); cy1 := nmax(ey, ney); // temporarily turn off this panel, so it won't interfere with collision checks mapGrid.proxyEnabled[proxyId] := false; for f := 0 to High(gPlayers) do begin plr := gPlayers[f]; if (plr = nil) or (not plr.alive) then continue; plr.getMapBox(px, py, pw, ph); if tryMPlatMove(px, py, pw, ph, pdx, pdy, squash) then begin // set new position plr.moveBy(pdx, pdy); // this will call `positionChanged()` for us // squash player, if necessary if squash then plr.Damage(15000, 0, 0, 0, HIT_TRAP); end; end; // restore panel state mapGrid.proxyEnabled[proxyId] := true; // and really move it X := nx; Y := ny; positionChanged(); // reverse moving direction, if necessary if (mMovingSpeed.X < 0) and (nx <= mMovingStart.X) then mMovingSpeed.X := -mMovingSpeed.X else if (mMovingSpeed.X > 0) and (nx >= mMovingEnd.X) then mMovingSpeed.X := -mMovingSpeed.X; if (mMovingSpeed.Y < 0) and (ny <= mMovingStart.Y) then mMovingSpeed.Y := -mMovingSpeed.Y else if (mMovingSpeed.Y > 0) and (ny >= mMovingEnd.Y) then mMovingSpeed.Y := -mMovingSpeed.Y; (* // collect monsters monMoveListUsed := 0; g_Mons_ForEachAt(cx0, cy0, cx1-cx0+1, cy1-cy0+1, monCollect); // process collected monsters // move monsters on lifts g_Mons_ForEachAt(ox, oy-1, Width, 1, monMove); X := nx; Y := ny; // fix grid positionChanged(); // push monsters g_Mons_ForEachAt(nx, ny, Width, Height, monPush); // move and push players for f := 0 to High(gPlayers) do begin gPlayers[f].getMapBox(px, py, pw, ph); //if sweepAABB(ox, oy, Width, Height, mMovingSpeed.X, mMovingSpeed.Y, px, py, pw, ph, @u0, @u1) then //if sweepAABB(ox, oy, Width, Height, mMovingSpeed.X, mMovingSpeed.Y, px, py, pw, ph, @u0, @u1) then sdx := -mMovingSpeed.X; sdy := -mMovingSpeed.Y; if sweepAABB(ox, oy, Width, Height, mMovingSpeed.X, mMovingSpeed.Y, px, py, pw, ph, @u0, @he, @u1) then begin e_LogWritefln('player #%s sweep with platform %s: u0=%s; u1=%s; phe=%s', [f, mGUID, u0, u1, he]); if (u1 > 0.0) then begin e_LogWritefln(' collide: %s', [g_Collide(px, py, pw, ph, nx, ny, Width, Height)]); //gPlayers[f].GameX := gPlayers[f].GameX+trunc(sdx*(1.0-u0)); //gPlayers[f].GameY := gPlayers[f].GameY+trunc(mMovingSpeed.Y*(1.0-u0)); //gPlayers[f].positionChanged(); end; end; //plrMove(gPlayers[f]); end; // move and push gibs for f := 0 to High(gGibs) do gibMove(@gGibs[f]); // move and push corpses for f := 0 to High(gCorpses) do corpseMove(gCorpses[f]); // notify moved monsters about their movement for f := 0 to monMoveListUsed-1 do begin monMoveList[f].positionChanged(); end; for f := 0 to monMoveListUsed-1 do begin mon := monMoveList[f]; // check if it is squashed if mon.alive then begin mon.getMapBox(px, py, pw, ph); if g_Map_CollidePanel(px, py, pw, ph, (PANEL_WALL or PANEL_OPENDOOR or PANEL_CLOSEDOOR)) then begin mon.Damage(15000, 0, 0, 0, HIT_TRAP); end; end; end; *) end; end; procedure TPanel.SetFrame(Frame: Integer; Count: Byte); function ClampInt(X, A, B: Integer): Integer; begin Result := X; if X < A then Result := A else if X > B then Result := B; end; begin if Enabled and (FCurTexture >= 0) and (FTextureIDs[FCurTexture].Anim) and (FTextureIDs[FCurTexture].AnTex <> nil) and (Width > 0) and (Height > 0) and (FAlpha < 255) then begin FCurFrame := ClampInt(Frame, 0, FTextureIDs[FCurTexture].AnTex.TotalFrames); FCurFrameCount := Count; FTextureIDs[FCurTexture].AnTex.CurrentFrame := FCurFrame; FTextureIDs[FCurTexture].AnTex.CurrentCounter := FCurFrameCount; end; end; procedure TPanel.NextTexture(AnimLoop: Byte = 0); begin Assert(FCurTexture >= -1, 'FCurTexture < -1'); // Нет текстур: if Length(FTextureIDs) = 0 then FCurTexture := -1 else // Только одна текстура: if Length(FTextureIDs) = 1 then begin if FCurTexture = 0 then FCurTexture := -1 else FCurTexture := 0; end else // Больше одной текстуры: begin // Следующая: Inc(FCurTexture); // Следующей нет - возврат к началу: if FCurTexture >= Length(FTextureIDs) then FCurTexture := 0; end; // Переключились на видимую аним. текстуру: if (FCurTexture >= 0) and FTextureIDs[FCurTexture].Anim then begin if (FTextureIDs[FCurTexture].AnTex = nil) then begin g_FatalError(_lc[I_GAME_ERROR_SWITCH_TEXTURE]); Exit; end; if AnimLoop = 1 then FTextureIDs[FCurTexture].AnTex.Loop := True else if AnimLoop = 2 then FTextureIDs[FCurTexture].AnTex.Loop := False; FTextureIDs[FCurTexture].AnTex.Reset(); end; LastAnimLoop := AnimLoop; end; procedure TPanel.SetTexture(ID: Integer; AnimLoop: Byte = 0); begin // Нет текстур: if Length(FTextureIDs) = 0 then FCurTexture := -1 else // Только одна текстура: if Length(FTextureIDs) = 1 then begin if (ID = 0) or (ID = -1) then FCurTexture := ID; end else // Больше одной текстуры: begin if (ID >= -1) and (ID <= High(FTextureIDs)) then FCurTexture := ID; end; // Переключились на видимую аним. текстуру: if (FCurTexture >= 0) and FTextureIDs[FCurTexture].Anim then begin if (FTextureIDs[FCurTexture].AnTex = nil) then begin g_FatalError(_lc[I_GAME_ERROR_SWITCH_TEXTURE]); Exit; end; if AnimLoop = 1 then FTextureIDs[FCurTexture].AnTex.Loop := True else if AnimLoop = 2 then FTextureIDs[FCurTexture].AnTex.Loop := False; FTextureIDs[FCurTexture].AnTex.Reset(); end; LastAnimLoop := AnimLoop; end; function TPanel.GetTextureID(): DWORD; begin Result := LongWord(TEXTURE_NONE); if (FCurTexture >= 0) then begin if FTextureIDs[FCurTexture].Anim then Result := FTextureIDs[FCurTexture].AnTex.FramesID else Result := FTextureIDs[FCurTexture].Tex; end; end; function TPanel.GetTextureCount(): Integer; begin Result := Length(FTextureIDs); if Enabled and (FCurTexture >= 0) then if (FTextureIDs[FCurTexture].Anim) and (FTextureIDs[FCurTexture].AnTex <> nil) and (Width > 0) and (Height > 0) and (FAlpha < 255) then Result := Result + 100; end; procedure TPanel.SaveState(Var Mem: TBinMemoryWriter); var sig: DWORD; anim: Boolean; begin if (Mem = nil) then exit; //if not SaveIt then exit; // Сигнатура панели: sig := PANEL_SIGNATURE; // 'PANL' Mem.WriteDWORD(sig); // Открыта/закрыта, если дверь: Mem.WriteBoolean(FEnabled); // Направление лифта, если лифт: Mem.WriteByte(FLiftType); // Номер текущей текстуры: Mem.WriteInt(FCurTexture); // Коорды Mem.WriteInt(FX); Mem.WriteInt(FY); // Анимированная ли текущая текстура: if (FCurTexture >= 0) and (FTextureIDs[FCurTexture].Anim) then begin Assert(FTextureIDs[FCurTexture].AnTex <> nil, 'TPanel.SaveState: No animation object'); anim := True; end else anim := False; Mem.WriteBoolean(anim); // Если да - сохраняем анимацию: if anim then FTextureIDs[FCurTexture].AnTex.SaveState(Mem); // moving platform state Mem.WriteInt(mMovingSpeed.X); Mem.WriteInt(mMovingSpeed.Y); Mem.WriteInt(mMovingStart.X); Mem.WriteInt(mMovingStart.Y); Mem.WriteInt(mMovingEnd.X); Mem.WriteInt(mMovingEnd.Y); Mem.WriteBoolean(mMovingActive); end; procedure TPanel.LoadState(var Mem: TBinMemoryReader); var sig: DWORD; anim: Boolean; //ox, oy: Integer; begin if (Mem = nil) then exit; //if not SaveIt then exit; // Сигнатура панели: Mem.ReadDWORD(sig); if sig <> PANEL_SIGNATURE then // 'PANL' begin raise EBinSizeError.Create('TPanel.LoadState: Wrong Panel Signature'); end; // Открыта/закрыта, если дверь: Mem.ReadBoolean(FEnabled); // Направление лифта, если лифт: Mem.ReadByte(FLiftType); // Номер текущей текстуры: Mem.ReadInt(FCurTexture); // Коорды //ox := FX; //oy := FY; Mem.ReadInt(FX); Mem.ReadInt(FY); //e_LogWritefln('panel %s(%s): old=(%s,%s); new=(%s,%s); delta=(%s,%s)', [arrIdx, proxyId, ox, oy, FX, FY, FX-ox, FY-oy]); // Анимированная ли текущая текстура: Mem.ReadBoolean(anim); // Если да - загружаем анимацию: if anim then begin Assert((FCurTexture >= 0) and (FTextureIDs[FCurTexture].Anim) and (FTextureIDs[FCurTexture].AnTex <> nil), 'TPanel.LoadState: No animation object'); FTextureIDs[FCurTexture].AnTex.LoadState(Mem); end; // moving platform state Mem.ReadInt(mMovingSpeed.X); Mem.ReadInt(mMovingSpeed.Y); Mem.ReadInt(mMovingStart.X); Mem.ReadInt(mMovingStart.Y); Mem.ReadInt(mMovingEnd.X); Mem.ReadInt(mMovingEnd.Y); Mem.ReadBoolean(mMovingActive); positionChanged(); //mapGrid.proxyEnabled[proxyId] := FEnabled; // done in g_map.pas end; end.