Combine Door and AutoDoor type constructors, add doorPathable field

This commit is contained in:
2021-03-21 13:33:57 +01:00
parent 8108772894
commit a34c578786
6 changed files with 8 additions and 22 deletions
+1 -3
View File
@@ -386,9 +386,7 @@ collidePointWalkable p1 p2 ws = any (isJust
. ( \(x:y:_) -> intersectSegSeg' p1 p2 x y) . ( \(x:y:_) -> intersectSegSeg' p1 p2 x y)
. _wlLine . _wlLine
) unwalkableWalls ) unwalkableWalls
where unwalkableWalls = IM.filter notDoor ws where unwalkableWalls = IM.filter (fromMaybe True . (^? doorPathable)) ws
notDoor (AutoDoor {}) = False
notDoor _ = True
furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2 furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
furthestPointWalkable p1 p2 ws = head $ (sortBy (compare `on` dist p1) $ IM.elems furthestPointWalkable p1 p2 ws = head $ (sortBy (compare `on` dist p1) $ IM.elems
+1 -8
View File
@@ -546,14 +546,6 @@ data Wall
, _blHP :: Int , _blHP :: Int
, _wlIsSeeThrough :: Bool , _wlIsSeeThrough :: Bool
} }
| AutoDoor
{ _wlLine :: [Point2] , _wlID :: Int
, _doorMech :: World -> World
, _wlColor :: Color
, _wlDraw :: Maybe (Wall -> Drawing)
, _wlSeen :: Bool
, _wlIsSeeThrough :: Bool
}
| Door | Door
{ _wlLine :: [Point2] , _wlID :: Int { _wlLine :: [Point2] , _wlID :: Int
, _doorMech :: World -> World , _doorMech :: World -> World
@@ -561,6 +553,7 @@ data Wall
, _wlDraw :: Maybe (Wall -> Drawing) , _wlDraw :: Maybe (Wall -> Drawing)
, _wlSeen :: Bool , _wlSeen :: Bool
, _wlIsSeeThrough :: Bool , _wlIsSeeThrough :: Bool
, _doorPathable :: Bool
} }
| Block | Block
{ _wlLine :: [Point2] { _wlLine :: [Point2]
+2 -8
View File
@@ -26,13 +26,6 @@ autoDoorAt a b wls = IM.union wls $ IM.fromList $ zip is $ mkAutoDoor a b is
mkAutoDoor :: Point2 -> Point2 -> [Int] -> [Wall] mkAutoDoor :: Point2 -> Point2 -> [Int] -> [Wall]
mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane [pl,pr]) mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane [pl,pr])
xs xs
-- [ True
-- , False
-- , True
-- , True
-- , False
-- , True
-- ]
[ [pld,hwd,hw,pl] [ [pld,hwd,hw,pl]
, [hwd,hwu] , [hwd,hwu]
, [hwu,plu,pl,hw] , [hwu,plu,pl,hw]
@@ -69,7 +62,7 @@ mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane [pl,pr])
where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1 where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1
autoDoorPane :: [Point2] -> Int -> [Point2] -> [Point2] -> Wall autoDoorPane :: [Point2] -> Int -> [Point2] -> [Point2] -> Wall
autoDoorPane trigL n closedPos openPos = AutoDoor autoDoorPane trigL n closedPos openPos = Door
{ _wlLine = closedPos { _wlLine = closedPos
, _wlID = n , _wlID = n
, _doorMech = dm , _doorMech = dm
@@ -77,6 +70,7 @@ autoDoorPane trigL n closedPos openPos = AutoDoor
, _wlDraw = Nothing , _wlDraw = Nothing
, _wlSeen = False , _wlSeen = False
, _wlIsSeeThrough = False , _wlIsSeeThrough = False
, _doorPathable = True
} }
where where
a = closedPos !! 0 a = closedPos !! 0
+1 -1
View File
@@ -116,7 +116,7 @@ triggerDoorPane c cond n closedPos openPos = Door
, _wlDraw = Nothing , _wlDraw = Nothing
, _wlSeen = False , _wlSeen = False
, _wlIsSeeThrough = False , _wlIsSeeThrough = False
-- , _doorLine = [a,b,a',b'] , _doorPathable = False
} }
where where
a = closedPos !! 0 a = closedPos !! 0
+3 -1
View File
@@ -28,13 +28,14 @@ basicWall = Wall { _wlLine = [(0,0),(50,0)]
, _wlSeen = False , _wlSeen = False
, _wlIsSeeThrough = False , _wlIsSeeThrough = False
} }
basicAutoDoor = AutoDoor { _wlLine = [(0,0),(50,0)] basicAutoDoor = Door { _wlLine = [(0,0),(50,0)]
, _wlID = 0 , _wlID = 0
, _doorMech = id , _doorMech = id
, _wlColor = light $ dim $ dim $ dim $ yellow , _wlColor = light $ dim $ dim $ dim $ yellow
, _wlDraw = Nothing , _wlDraw = Nothing
, _wlSeen = False , _wlSeen = False
, _wlIsSeeThrough = False , _wlIsSeeThrough = False
, _doorPathable = True
} }
basicDoor = Door { _wlLine = [(0,0),(50,0)] basicDoor = Door { _wlLine = [(0,0),(50,0)]
, _wlID = 0 , _wlID = 0
@@ -43,6 +44,7 @@ basicDoor = Door { _wlLine = [(0,0),(50,0)]
, _wlDraw = Nothing , _wlDraw = Nothing
, _wlSeen = False , _wlSeen = False
, _wlIsSeeThrough = False , _wlIsSeeThrough = False
, _doorPathable = False
} }
basicCreature :: Creature basicCreature :: Creature
basicCreature = Creature basicCreature = Creature
-1
View File
@@ -91,7 +91,6 @@ updateCreatures w = f $ set randGen newG $ set creatures (IM.mapMaybe id crs) w
wallEvents :: World -> World wallEvents :: World -> World
wallEvents w = IM.foldr (_doorMech) w ( IM.filter (\d -> case d of wallEvents w = IM.foldr (_doorMech) w ( IM.filter (\d -> case d of
Door {} -> True Door {} -> True
AutoDoor {} -> True
BlockAutoDoor {} -> True BlockAutoDoor {} -> True
_ -> False) ( _walls w)) _ -> False) ( _walls w))