Rethink damage data type, work on damage sensors
This commit is contained in:
+41
-43
@@ -9,7 +9,6 @@ module Dodge.PlacementSpot
|
||||
, unusedSpotAwayFromLink
|
||||
, isUnusedLnk
|
||||
, isInLnk
|
||||
, unusedLnkToPS
|
||||
, unusedSpotNearInLink
|
||||
, randDirPS
|
||||
, unusedSpotAwayFromInLink
|
||||
@@ -21,8 +20,10 @@ module Dodge.PlacementSpot
|
||||
, setFallback
|
||||
, twoRoomPoss
|
||||
, isUnusedLinkType
|
||||
, roomPosRoomBoolShift
|
||||
, rprBoolShift
|
||||
, rpBool
|
||||
, shiftInBy
|
||||
, resetPLUse
|
||||
) where
|
||||
import Dodge.LevelGen.Data
|
||||
import Geometry
|
||||
@@ -46,19 +47,25 @@ randDirPS ps = do
|
||||
a <- state $ randomR (0,pi*2)
|
||||
return $ setDirPS a ps
|
||||
|
||||
roomPosBool :: (RoomPos -> Bool) -> PlacementSpot
|
||||
roomPosBool t = PSPos (useRoomPosCond t) (const id) Nothing
|
||||
rpBool :: (RoomPos -> Bool) -> PlacementSpot
|
||||
rpBool t = PSPos (useRoomPosCond t) (const id) Nothing
|
||||
|
||||
anyUnusedSpot :: PlacementSpot
|
||||
anyUnusedSpot = roomPosBool $ \rp -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0
|
||||
anyUnusedSpot = rpBool $ \rp -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0
|
||||
|
||||
roomPosRoomBool :: (RoomPos -> Room -> Bool) -> PlacementSpot
|
||||
roomPosRoomBool t = PSPos (useRoomPosRoomCond t) (const id) Nothing
|
||||
rprBool :: (RoomPos -> Room -> Bool) -> PlacementSpot
|
||||
rprBool t = PSPos (useRoomPosRoomCond t) (const id) Nothing
|
||||
|
||||
roomPosRoomBoolShift :: (RoomPos -> Room -> Bool)
|
||||
resetPLUse :: PlacementSpot -> PlacementSpot
|
||||
resetPLUse (PSPos f g fallback) = PSPos f' g fallback
|
||||
where
|
||||
f' rp = fmap (second (rpPlacementUse .~ 0)) . f rp
|
||||
resetPLUse _ = error "Tried to reset _rpPlacementUse of non PSPos placement"
|
||||
|
||||
rprBoolShift :: (RoomPos -> Room -> Bool)
|
||||
-> ((Point2,Float) -> (Point2,Float))
|
||||
-> PlacementSpot
|
||||
roomPosRoomBoolShift t shift = PSPos f (const id) Nothing
|
||||
rprBoolShift t shift = PSPos f (const id) Nothing
|
||||
where
|
||||
f rp r
|
||||
| t rp r = Just (PS p a, rp & rpPlacementUse +~ 1)
|
||||
@@ -67,22 +74,24 @@ roomPosRoomBoolShift t shift = PSPos f (const id) Nothing
|
||||
(p,a) = shift (_rpPos rp, _rpDir rp)
|
||||
|
||||
unusedSpotAwayFromLink :: Float -> PlacementSpot
|
||||
unusedSpotAwayFromLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink
|
||||
unusedSpotAwayFromLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink
|
||||
&& _rpPlacementUse rp == 0
|
||||
&& all ( (>x) . dist (_rpPos rp) ) (usedRoomLinkPoss r)
|
||||
|
||||
setFallback :: Placement -> Placement -> Placement
|
||||
setFallback fallback = (plSpot . psFallback %~ maybe (Just fallback) Just)
|
||||
. (plIDCont %~ fmap (fmap $ setFallback fallback))
|
||||
setFallback fallback
|
||||
= (plSpot . psFallback %~ maybe (Just fallback) Just)
|
||||
. (plIDCont %~ fmap (fmap $ setFallback fallback)
|
||||
)
|
||||
|
||||
unusedOffPathAwayFromLink :: Float -> PlacementSpot
|
||||
unusedOffPathAwayFromLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink
|
||||
unusedOffPathAwayFromLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink
|
||||
&& _rpPlacementUse rp == 0
|
||||
&& all ( (>x) . dist (_rpPos rp) ) (usedRoomLinkPoss r)
|
||||
&& RoomPosOffPath `S.member` _rpType rp
|
||||
|
||||
unusedSpotAwayFromInLink :: Float -> PlacementSpot
|
||||
unusedSpotAwayFromInLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink
|
||||
unusedSpotAwayFromInLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink
|
||||
&& _rpPlacementUse rp == 0
|
||||
&& all ( (>x) . dist (_rpPos rp) ) (usedRoomInLinkPoss r)
|
||||
|
||||
@@ -93,8 +102,8 @@ twoRoomPoss :: (RoomPos -> Bool)
|
||||
-> (RoomPos -> Bool)
|
||||
-> (PlacementSpot -> PlacementSpot -> Placement)
|
||||
-> Placement
|
||||
twoRoomPoss cond1 cond2 f = Placement (roomPosBool cond1) PutNothing Nothing
|
||||
$ \pl1 -> Just $ Placement (roomPosBool cond2) PutNothing Nothing
|
||||
twoRoomPoss cond1 cond2 f = Placement (rpBool cond1) PutNothing Nothing
|
||||
$ \pl1 -> Just $ Placement (rpBool cond2) PutNothing Nothing
|
||||
$ \pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2)
|
||||
|
||||
isUnusedLnk :: RoomPos -> Bool
|
||||
@@ -108,7 +117,7 @@ isInLnk rp = case _rpLinkStatus rp of
|
||||
_ -> False
|
||||
|
||||
useUnusedLnk :: PlacementSpot
|
||||
useUnusedLnk = roomPosBool isUnusedLnk
|
||||
useUnusedLnk = rpBool isUnusedLnk
|
||||
|
||||
isUsedLnkUnplaced :: RoomPos -> Bool
|
||||
isUsedLnkUnplaced rp = case _rpLinkStatus rp of
|
||||
@@ -117,32 +126,20 @@ isUsedLnkUnplaced rp = case _rpLinkStatus rp of
|
||||
_ -> False
|
||||
|
||||
useRoomPosCond :: (RoomPos -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
|
||||
useRoomPosCond t rp _
|
||||
| t rp = Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
|
||||
| otherwise = Nothing
|
||||
useRoomPosCond f = useRoomPosRoomCond $ \rp _ -> f rp
|
||||
|
||||
useRoomPosRoomCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
|
||||
useRoomPosRoomCond t rp r
|
||||
| t rp r = Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
|
||||
| otherwise = Nothing
|
||||
|
||||
unusedLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
|
||||
unusedLnkToPS = useRoomPosCond $ \rp -> case _rpLinkStatus rp of
|
||||
UnusedLink {} -> True
|
||||
_ -> False
|
||||
|
||||
--usedInLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
|
||||
--usedInLnkToPS = useRoomPosCond $ \rp -> case _rpLinkStatus rp of
|
||||
-- UsedInLink {} -> True
|
||||
-- _ -> False
|
||||
|
||||
isUnusedLinkType :: RoomLinkType -> RoomPos -> Bool
|
||||
isUnusedLinkType rlt rp = case _rpLinkStatus rp of
|
||||
UnusedLink{_rplsType = rlts} -> rlt `S.member` rlts
|
||||
_ -> False
|
||||
|
||||
unusedSpotNearInLink :: Float -> PlacementSpot
|
||||
unusedSpotNearInLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink
|
||||
unusedSpotNearInLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink
|
||||
&& _rpPlacementUse rp == 0
|
||||
&& any ( (<x) . dist (_rpPos rp) ) (usedRoomInLinkPoss r)
|
||||
|
||||
@@ -162,17 +159,19 @@ usedRoomLinkPoss r = mapMaybe f $ _rmPos r
|
||||
_ -> Nothing
|
||||
|
||||
atFstLnkOut :: PlacementSpot
|
||||
atFstLnkOut = roomPosBool $ \rp -> rp ^? rpLinkStatus . rplsChildNum == Just 0
|
||||
atFstLnkOut = rpBool $ \rp -> rp ^? rpLinkStatus . rplsChildNum == Just 0
|
||||
|
||||
atNthLnkOutShiftBy :: Int -> ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
|
||||
atNthLnkOutShiftBy n theshift = PSPos f (const id) Nothing
|
||||
where
|
||||
f rp _ = case _rpLinkStatus rp of
|
||||
UsedOutLink {_rplsChildNum = i} | i == n
|
||||
-> Just (PS p a, rp & rpPlacementUse +~ 1)
|
||||
_ -> Nothing
|
||||
where
|
||||
(p,a) = theshift (_rpPos rp,_rpDir rp)
|
||||
atNthLnkOutShiftBy n = rprBoolShift
|
||||
$ \ rp _ -> rp ^? rpLinkStatus . rplsChildNum == Just n
|
||||
--atNthLnkOutShiftBy n theshift = PSPos f (const id) Nothing
|
||||
-- where
|
||||
-- f rp _ = case _rpLinkStatus rp of
|
||||
-- UsedOutLink {_rplsChildNum = i} | i == n
|
||||
-- -> Just (PS p a, rp & rpPlacementUse +~ 1)
|
||||
-- _ -> Nothing
|
||||
-- where
|
||||
-- (p,a) = theshift (_rpPos rp,_rpDir rp)
|
||||
|
||||
atFstLnkOutShiftBy :: ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
|
||||
atFstLnkOutShiftBy = atNthLnkOutShiftBy 0
|
||||
@@ -181,9 +180,8 @@ atFstLnkOutShiftInward :: Float -> PlacementSpot
|
||||
atFstLnkOutShiftInward = atNthLnkOutShiftInward 0
|
||||
|
||||
atNthLnkOutShiftInward :: Int -> Float -> PlacementSpot
|
||||
atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n f
|
||||
where
|
||||
f (p,a) = (p +.+ rotateV a (V2 0 (negate x)),a)
|
||||
atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n
|
||||
$ \ (p,a) -> (p +.+ rotateV a (V2 0 (negate x)),a)
|
||||
|
||||
shiftInBy :: Float -> (Point2,Float) -> (Point2,Float)
|
||||
shiftInBy x (p,a) = (p +.+ rotateV a (V2 0 (negate x)),a)
|
||||
|
||||
Reference in New Issue
Block a user