justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Implement (partially) updating pathing grid when opening doors

Browse Source
This commit is contained in:
justin
2022-07-02 21:39:33 +01:00
parent 8a612be5fe
commit 46bc135e69
11 changed files with 48 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block.hs
+1 -1
View File
@@ -49,7 +49,7 @@ destroyBlock bl w = w
& flip (foldr unshadowBlock) (_blShadows bl)
& _blDeath bl bl
& deleteWallIDs wlids
& maybeClearPaths (_blPaths bl) -- must happen after the walls are deleted
& maybeClearPaths (_blObstructs bl) -- must happen after the walls are deleted
& blocks %~ IM.delete (_blID bl)
-- & matDesSound (_blMaterial bl) pos
& flip (foldr (wlDustAt awl)) (map (pos +.+) ps)
src/Dodge/Config/Data.hs
+6
View File
@@ -1,3 +1,5 @@
--{-# LANGUAGE FlexibleInstances #-}
--{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
@@ -6,6 +8,7 @@ import Data.Aeson
import qualified Data.Set as S
import GHC.Generics
import Control.Lens
--import Data.Enum.Set.Base
{-# ANN module "HLint: ignore Use camelCase" #-}
data Configuration = Configuration
{ _volume_master :: Float
@@ -70,6 +73,9 @@ instance ToJSON DebugBool where
instance ToJSON Configuration where
toEncoding = genericToEncoding defaultOptions
--deriving instance Generic a => Generic (EnumSet Word a)
--instance FromJSON (EnumSet Word a)
instance FromJSON DebugBool
instance FromJSON Configuration
src/Dodge/Creature/Action.hs
+2 -9
View File
@@ -75,8 +75,8 @@ performPathTo cr w p
Just q -> ([MvTurnToward q
,MvForward
,RandomTurn jit
,ArbitraryImpulseEffect . const
$ debugPicture .~ drawPathList cpos p w
-- ,ArbitraryImpulseEffect . const
-- $ debugPicture .~ drawPathList cpos p w
]
, Just (PathTo p))
_ -> ([],Nothing)
@@ -84,13 +84,6 @@ performPathTo cr w p
cpos = _crPos cr
jit = _mvTurnJit $ _crMvType cr
drawPathList :: Point2 -> Point2 -> World -> Picture
drawPathList x y w = case makePathBetweenPs x y w of
Nothing -> setLayer DebugLayer $ color red $ line [x,y]
Just [] -> setLayer DebugLayer $ color green $ line [x,y]
Just as -> setLayer DebugLayer $ color orange (line as)
<> color blue (line [head as,x]) <> color yellow (line [last as, y])
performTurnToA :: Creature -> Point2 -> OutAction
performTurnToA cr p
| angleVV cdirv dirv < 0.1 = ([], Nothing)
src/Dodge/Data.hs
+3 -3
View File
@@ -135,7 +135,6 @@ data World = World
, _floorTiles :: [(Point3,Point3)]
, _randGen :: StdGen
, _testString :: Configuration -> World -> [String]
, _debugPicture :: Picture
, _modifications :: IM.IntMap Modification
, _yourID :: Int
, _worldEvents :: World -> World
@@ -947,12 +946,11 @@ data Block = Block
, _blHP :: Int
, _blShadows :: [Int] -- a list of blocks/walls? that are not shown when this block exists
, _blFootprint :: [Point2]
, _blObstructs :: [(Point2,Point2)]
, _blPos :: Point2
, _blDir :: Float
, _blDraw :: Block -> SPic
, _blDeath :: Block -> World -> World
, _blPaths :: [(Int,Int,PathEdge)]
, _blObstructs :: [(Int,Int,PathEdge)]
}
data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady
deriving (Eq,Ord,Show)
@@ -1043,6 +1041,8 @@ data Door = Door
, _drPushedBy :: PushSource
, _drPushes :: Maybe Int
, _drMounts :: [MountedObject]
, _drObstructs :: [(Int,Int,PathEdge)]
, _drObstacleType :: EdgeObstacle
}
data MountedObject
= MountedLS Int
src/Dodge/Default/Block.hs
-1
View File
@@ -15,7 +15,6 @@ defaultBlock = Block
, _blDraw = const mempty
, _blDeath = makeBlockDebris
, _blObstructs = []
, _blPaths = []
}
defaultDirtBlock :: Block
defaultDirtBlock = defaultBlock & blHP .~ 50
src/Dodge/Default/Door.hs
+2
View File
@@ -37,5 +37,7 @@ defaultDoor = Door
, _drPushedBy = PushesItself
, _drPushes = Nothing
, _drMounts = mempty
, _drObstructs = mempty
, _drObstacleType = DoorObstacle
}
src/Dodge/Default/World.hs
-1
View File
@@ -61,7 +61,6 @@ defaultWorld = World
, _randGen = mkStdGen 2
, _mousePos = V2 0 0
, _testString = const . const []
, _debugPicture = mempty
, _yourID = 0
, _worldEvents = id
, _delayedEvents = []
src/Dodge/Path.hs
+3 -3
View File
@@ -118,8 +118,8 @@ addEdges nodemap gr = runIdentity . S.fold_ f (mempty,gr) id
theedge = (g a,g b,PathEdge a b (dist a b) mempty)
g a = nodemap M.! a
obstructPathsCrossing :: Point2 -> Point2 -> World -> ( World, [(Int,Int,PathEdge)])
obstructPathsCrossing sp' ep w =
obstructPathsCrossing :: EdgeObstacle -> Point2 -> Point2 -> World -> ( World, [(Int,Int,PathEdge)])
obstructPathsCrossing obstacletype sp' ep w =
( w & pathGraph %~ updateedges
, runIdentity $ S.toList_ es
)
@@ -128,4 +128,4 @@ obstructPathsCrossing sp' ep w =
edgecrosses (_,_,pe) = isJust $ intersectSegSeg sp' ep (_peStart pe) (_peEnd pe)
updateedges gr = runIdentity $ S.fold_ updateedge gr id es
updateedge gr (x,y,pe)
= insEdge (x,y,pe & peObstacles . at BlockObstacle ?~ ()) $ delEdge (x,y) gr
= insEdge (x,y,pe & peObstacles . at obstacletype ?~ ()) $ delEdge (x,y) gr
src/Dodge/Placement/PlaceSpot/Block.hs
+2 -3
View File
@@ -74,7 +74,6 @@ plLineBlock basePane blwidth a b gw = ( 0
, _blDir = 0 -- THIS IS NOT SENSIBLE. TODO rethink block positioning
, _blFootprint = cornersAt p -- TODO check winding (clockwise, anticlockwise)
, _blObstructs = []
, _blPaths = []
, _blPos = p, _blDraw = const mempty , _blDeath = makeBlockDebris}
)
insertBlocks = flip (foldr insertBlock) $ zip is blockCenPs
@@ -97,10 +96,10 @@ plLineBlock basePane blwidth a b gw = ( 0
-- | Must be done after inserting the block
insertWalls :: Int -> [Wall] -> World -> World
insertWalls blid wls w = w' & blocks . ix blid . blPaths .~ concat paths
insertWalls blid wls w = w' & blocks . ix blid . blObstructs .~ concat paths
where
(w',paths) = mapAccumR (flip insertWall) w wls
insertWall :: Wall -> World -> (World,[(Int,Int,PathEdge)])
insertWall wl = uncurry obstructPathsCrossing (_wlLine wl)
insertWall wl = uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl)
. (walls . at (_wlID wl) ?~ wl)
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+29 -11
View File
@@ -4,7 +4,9 @@ module Dodge.Placement.PlaceSpot.TriggerDoor
, plSlideDoor
) where
import Dodge.Data
import Dodge.Zone
import Dodge.Base
import Dodge.Path
import Dodge.Default.Door
import Dodge.Wall.Move
import Dodge.LevelGen.DoorPane
@@ -17,15 +19,16 @@ import Dodge.SoundLogic
--import Data.Maybe
import Data.List
import Control.Lens
--import Data.Graph.Inductive hiding ((&))
import qualified Data.IntSet as IS
plDoor :: Color
import qualified Data.Graph.Inductive as FGL
import qualified Streaming.Prelude as S
plDoor :: Color
-> (World -> Bool) -- ^ Opening condition
-> [(Point2,Point2)] -- ^ Door positions, closed to open.
-- Bumped out up and down by 9, not widened
-> World
-> World
-> (Int,World)
plDoor col cond pss gw = (drid, addWalls gw & doors %~ addDoor)
plDoor col cond pss gw = (drid, addWalls $ gw & doors %~ addDoor) -- carefull with the ordering of addWalls
where
drid = IM.newKey $ _doors gw
addDoor = IM.insert drid $ defaultDoor
@@ -44,11 +47,15 @@ plDoor col cond pss gw = (drid, addWalls gw & doors %~ addDoor)
addWalls w' = foldl' (addDoorWall drid $ switchWallCol col) w' $ zip wlids wlps'
addDoorWall :: Int -> Wall -> World -> (Int,(Point2,Point2)) -> World
addDoorWall drid wl w (wlid,wlps) = w & walls %~ IM.insert wlid wl
{ _wlLine = wlps
, _wlID = wlid
, _wlStructure = DoorPart drid
}
addDoorWall drid wl w (wlid,wlps) = w'
& walls %~ IM.insert wlid wl
{ _wlLine = wlps
, _wlID = wlid
, _wlStructure = DoorPart drid
}
& doors . ix drid . drObstructs .~ es
where
(w',es) = uncurry (obstructPathsCrossing DoorObstacle) wlps w
-- TODO use vector instead of list, perhaps also memoisation of rectanglePairs
-- TODO update _drPos
-- perhaps also remove use of DoorInt in favour of DoorOpen/DoorClosed
@@ -80,6 +87,7 @@ doorMechanism dr w = case mvDir of
& flip (IS.foldl' (flip (`translateWallID` d))) (_drWallIDs dr)
& moveUpdate
& doors . ix drid . drPos . each %~ (+.+ d)
& maybeClearDoorPaths (_drObstacleType dr) (_drObstructs dr)
Nothing -> w
where
toOpen = _drTrigger dr w
@@ -100,7 +108,16 @@ doorMechanism dr w = case mvDir of
| dist dpos dcp < 1 = doors . ix drid . drStatus .~ DoorClosed
| otherwise = doors . ix drid . drStatus .~ DoorHalfway
-- TODO cut pathing if not pathable, reset when opened
maybeClearDoorPaths :: EdgeObstacle -> [(Int,Int,PathEdge)] -> World -> World
maybeClearDoorPaths eo es w = foldl' (maybeClearDoorPath eo) w es
maybeClearDoorPath :: EdgeObstacle -> World -> (Int,Int,PathEdge) -> World
maybeClearDoorPath eo w (x,y,pe)
| runIdentity . S.any_ (const True) $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w
= w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x,y)
| otherwise
= w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x,y)
plSlideDoor
:: Door
-> Wall
@@ -110,7 +127,7 @@ plSlideDoor
-> World
-> (Int, World)
plSlideDoor dr wl shiftOffset a b gw
= (drid, addDoorWalls gw & doors %~ addDoor)
= (drid, addDoorWalls $ gw & doors %~ addDoor)
where
drid = IM.newKey $ _doors gw
addDoor = IM.insert drid $ dr
@@ -121,6 +138,7 @@ plSlideDoor dr wl shiftOffset a b gw
, _drPos = (a,b)
, _drOpenPos = (shiftLeft a,shiftLeft b)
, _drClosePos = (a,b)
, _drObstacleType = DoorObstacle
}
addDoorWalls w' = foldl' (addDoorWall drid wl) w' $ zip wlids pairs
pairs = rectanglePairs 9 a b
src/Dodge/Render/ShapePicture.hs
-3
View File
@@ -69,7 +69,6 @@ cullPoint cfig w p
| debugOn Close_shape_culling cfig = pointInPolygon p (_boundBox w)
| otherwise = dist (_cameraCenter w) p < _viewDistance w
-- TODO filter out pictures not in the frame
extraPics :: Configuration -> World -> Picture
extraPics cfig w = pictures (_decorations w)
<> concatMapPic (dbArg _ptDraw) (_particles w)
@@ -77,8 +76,6 @@ extraPics cfig w = pictures (_decorations w)
<> concatMapPic (dbArg _bmDraw) (_electronBeams $ _beams w)
<> concatMapPic (dbArg _lsPict) (_lightSources w)
<> testPic cfig w
<> _debugPicture w
-- <> runIdentity (S.foldMap_ clDraw (_clouds w))
<> concatMapPic clDraw (_clouds w )
<> concatMapPic ppDraw (_pressPlates w )
<> viewClipBounds cfig w