Commit before making out and in placements have ids
This commit is contained in:
+80
-107
@@ -1,5 +1,26 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
module Dodge.PlacementSpot where
|
||||
--{-# LANGUAGE LambdaCase #-}
|
||||
module Dodge.PlacementSpot
|
||||
( atFstLnkOut
|
||||
, useUnusedLnk
|
||||
, psRandRanges
|
||||
, useRoomPosCond
|
||||
, isUsedLnkUnplaced
|
||||
, anyUnusedSpot
|
||||
, unusedSpotAwayFromLink
|
||||
, isUnusedLnk
|
||||
, unusedLnkToPS
|
||||
, unusedSpotNearInLink
|
||||
, randDirPS
|
||||
, unusedSpotAwayFromInLink
|
||||
, useLnkRoomPos
|
||||
, atFstLnkOutShiftInward
|
||||
, atFstLnkOutShiftBy
|
||||
, atNthLnkOutShiftInward
|
||||
, unusedOffPathAwayFromLink
|
||||
, setFallback
|
||||
, twoRoomPoss
|
||||
, isUnusedLinkType
|
||||
) where
|
||||
import Dodge.LevelGen.Data
|
||||
import Geometry
|
||||
|
||||
@@ -22,88 +43,61 @@ 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
|
||||
|
||||
anyUnusedSpot :: PlacementSpot
|
||||
anyUnusedSpot = PSPos f (const id) Nothing
|
||||
where
|
||||
f rp _
|
||||
| _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0
|
||||
= Just $ (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
|
||||
| otherwise = Nothing
|
||||
anyUnusedSpot = roomPosBool $ \rp -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0
|
||||
|
||||
roomPosRoomBool :: (RoomPos -> Room -> Bool) -> PlacementSpot
|
||||
roomPosRoomBool t = PSPos (useRoomPosRoomCond t) (const id) Nothing
|
||||
|
||||
unusedSpotAwayFromLink :: Float -> PlacementSpot
|
||||
unusedSpotAwayFromLink x = PSPos f (const id) Nothing
|
||||
where
|
||||
f rp r
|
||||
| _rpLinkStatus rp == NotLink
|
||||
&& _rpPlacementUse rp == 0
|
||||
&& all ( (>x) . dist p ) (usedRoomLinkPoss r)
|
||||
= Just $ (PS p (_rpDir rp), rp & rpPlacementUse +~ 1)
|
||||
| otherwise = Nothing
|
||||
where
|
||||
p = _rpPos rp
|
||||
unusedSpotAwayFromLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink
|
||||
&& _rpPlacementUse rp == 0
|
||||
&& all ( (>x) . dist (_rpPos rp) ) (usedRoomLinkPoss r)
|
||||
|
||||
setFallback :: Placement -> Placement -> Placement
|
||||
setFallback fallback plmnt = plmnt
|
||||
& 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 = PSPos f (const id) Nothing
|
||||
where
|
||||
f rp r
|
||||
| _rpLinkStatus rp == NotLink
|
||||
&& _rpPlacementUse rp == 0
|
||||
&& all ( (>x) . dist p ) (usedRoomLinkPoss r)
|
||||
&& RoomPosOffPath `S.member` _rpType rp
|
||||
= Just $ (PS p (_rpDir rp), rp & rpPlacementUse +~ 1)
|
||||
| otherwise = Nothing
|
||||
where
|
||||
p = _rpPos rp
|
||||
unusedOffPathAwayFromLink x = roomPosRoomBool $ \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 = PSPos f (const id) Nothing
|
||||
where
|
||||
f rp r
|
||||
| _rpLinkStatus rp == NotLink
|
||||
&& _rpPlacementUse rp == 0
|
||||
&& all ( (>x) . dist p ) (usedRoomInLinkPoss r)
|
||||
= Just $ (PS p (_rpDir rp), rp & rpPlacementUse +~ 1)
|
||||
| otherwise = Nothing
|
||||
where
|
||||
p = _rpPos rp
|
||||
unusedSpotAwayFromInLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink
|
||||
&& _rpPlacementUse rp == 0
|
||||
&& all ( (>x) . dist (_rpPos rp) ) (usedRoomInLinkPoss r)
|
||||
|
||||
twoUnusedLinks :: (PlacementSpot -> PlacementSpot -> Placement)
|
||||
-> Placement
|
||||
twoUnusedLinks f = Placement useUnusedLink PutNothing Nothing
|
||||
$ \pl1 -> Just $ Placement useUnusedLink PutNothing Nothing
|
||||
$ \pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2)
|
||||
--twoUnusedLinks :: (PlacementSpot -> PlacementSpot -> Placement) -> Placement
|
||||
--twoUnusedLinks = twoRoomPoss isUnusedLnk isUnusedLnk
|
||||
|
||||
twoRoomPoss :: (RoomPos -> Bool)
|
||||
-> (RoomPos -> Bool)
|
||||
-> (PlacementSpot -> PlacementSpot -> Placement)
|
||||
-> Placement
|
||||
twoRoomPoss cond1 cond2 f = Placement (useRoomPos cond1) PutNothing Nothing
|
||||
$ \pl1 -> Just $ Placement (useRoomPos cond2) PutNothing Nothing
|
||||
twoRoomPoss cond1 cond2 f = Placement (roomPosBool cond1) PutNothing Nothing
|
||||
$ \pl1 -> Just $ Placement (roomPosBool cond2) PutNothing Nothing
|
||||
$ \pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2)
|
||||
|
||||
useUnusedLink :: PlacementSpot
|
||||
useUnusedLink = PSPos unusedLnkToPS (const id) Nothing
|
||||
|
||||
useRoomPos :: (RoomPos -> Bool) -> PlacementSpot
|
||||
useRoomPos cond = PSPos (useRoomPosCond cond) (const id) Nothing
|
||||
|
||||
isUnusedLnk :: RoomPos -> Bool
|
||||
isUnusedLnk rp = case _rpLinkStatus rp of
|
||||
UnusedLink {} -> _rpPlacementUse rp == 0
|
||||
_ -> False
|
||||
|
||||
useUnusedLnk :: PlacementSpot
|
||||
useUnusedLnk = roomPosBool isUnusedLnk
|
||||
|
||||
isUsedLnkUnplaced :: RoomPos -> Bool
|
||||
isUsedLnkUnplaced rp = case _rpLinkStatus rp of
|
||||
UsedOutLink {} -> _rpPlacementUse rp == 0
|
||||
UsedInLink {} -> _rpPlacementUse rp == 0
|
||||
UsedInLink {} -> _rpPlacementUse rp == 0
|
||||
_ -> False
|
||||
|
||||
useRoomPosCond :: (RoomPos -> Bool)
|
||||
-> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
|
||||
useRoomPosCond :: (RoomPos -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
|
||||
useRoomPosCond t rp _
|
||||
| t rp = Just (PS p a, rp & rpPlacementUse +~ 1)
|
||||
| otherwise = Nothing
|
||||
@@ -111,33 +105,33 @@ useRoomPosCond t rp _
|
||||
p = _rpPos rp
|
||||
a = _rpDir rp
|
||||
|
||||
useRoomPosRoomCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
|
||||
useRoomPosRoomCond t rp r
|
||||
| t rp r = Just (PS p a, rp & rpPlacementUse +~ 1)
|
||||
| otherwise = Nothing
|
||||
where
|
||||
p = _rpPos rp
|
||||
a = _rpDir rp
|
||||
|
||||
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
|
||||
--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
|
||||
|
||||
-- TODO unify this with other xSpotNear/FarLink
|
||||
unusedSpotNearInLink :: Float -> PlacementSpot
|
||||
unusedSpotNearInLink x = PSPos f (const id) Nothing
|
||||
where
|
||||
f rp r
|
||||
| _rpLinkStatus rp == NotLink
|
||||
&& _rpPlacementUse rp == 0
|
||||
&& any ( (<x) . dist p ) (usedRoomInLinkPoss r)
|
||||
= Just $ (PS p (_rpDir rp), rp & rpPlacementUse +~ 1)
|
||||
| otherwise = Nothing
|
||||
where
|
||||
p = _rpPos rp
|
||||
unusedSpotNearInLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink
|
||||
&& _rpPlacementUse rp == 0
|
||||
&& any ( (<x) . dist (_rpPos rp) ) (usedRoomInLinkPoss r)
|
||||
|
||||
usedRoomInLinkPoss :: Room -> [Point2]
|
||||
usedRoomInLinkPoss r = mapMaybe f $ _rmPos r
|
||||
@@ -154,21 +148,8 @@ usedRoomLinkPoss r = mapMaybe f $ _rmPos r
|
||||
UsedOutLink {} -> Just $ _rpPos rp
|
||||
_ -> Nothing
|
||||
|
||||
-- TODO rename to any unused link facing out
|
||||
-- note this can REUSE unused links
|
||||
anyLnkOutPS :: PlacementSpot
|
||||
anyLnkOutPS = PSPos f (const id) Nothing
|
||||
where
|
||||
f rp _ = case _rpLinkStatus rp of
|
||||
UnusedLink {} -> Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
|
||||
_ -> Nothing
|
||||
|
||||
atFstLnkOut :: PlacementSpot
|
||||
atFstLnkOut = PSPos f (const id) Nothing
|
||||
where
|
||||
f rp _ = case _rpLinkStatus rp of
|
||||
UsedOutLink {_rplsChildNum = 0} -> Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
|
||||
_ -> Nothing
|
||||
atFstLnkOut = roomPosBool $ \rp -> rp ^? rpLinkStatus . rplsChildNum == Just 0
|
||||
|
||||
atNthLnkOutShiftBy :: Int -> ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
|
||||
atNthLnkOutShiftBy n theshift = PSPos f (const id) Nothing
|
||||
@@ -186,30 +167,22 @@ atFstLnkOutShiftBy = atNthLnkOutShiftBy 0
|
||||
atFstLnkOutShiftInward :: Float -> PlacementSpot
|
||||
atFstLnkOutShiftInward = atNthLnkOutShiftInward 0
|
||||
|
||||
atNthLnkOutShiftInward ::Int -> Float -> PlacementSpot
|
||||
atNthLnkOutShiftInward :: Int -> Float -> PlacementSpot
|
||||
atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n f
|
||||
where
|
||||
f (p,a) = (p +.+ rotateV a (V2 0 (negate x)),a)
|
||||
|
||||
-- does not change the placement use count
|
||||
overFstLnkOut :: PlacementSpot
|
||||
overFstLnkOut = PSPos f (const id) Nothing
|
||||
where
|
||||
f rp _ = case _rpLinkStatus rp of
|
||||
UsedOutLink {_rplsChildNum = 0} -> Just (PS (_rpPos rp) (_rpDir rp), rp)
|
||||
_ -> Nothing
|
||||
|
||||
anyLnkInPS :: Float -- ^ amount to shift inward
|
||||
-> PlacementSpot
|
||||
anyLnkInPS x = PSPos f (const id) Nothing
|
||||
where
|
||||
f rp _ = case _rpLinkStatus rp of
|
||||
UnusedLink {} -> Just (PS v' a', rp & rpPlacementUse +~ 1)
|
||||
_ -> Nothing
|
||||
where
|
||||
a = _rpDir rp
|
||||
v' = _rpPos rp -.- x *.* unitVectorAtAngle (a + 0.5 * pi)
|
||||
a' = a + pi
|
||||
--anyLnkInPS :: Float -- ^ amount to shift inward
|
||||
-- -> PlacementSpot
|
||||
--anyLnkInPS x = PSPos f (const id) Nothing
|
||||
-- where
|
||||
-- f rp _ = case _rpLinkStatus rp of
|
||||
-- UnusedLink {} -> Just (PS v' a', rp & rpPlacementUse +~ 1)
|
||||
-- _ -> Nothing
|
||||
-- where
|
||||
-- a = _rpDir rp
|
||||
-- v' = _rpPos rp -.- x *.* unitVectorAtAngle (a + 0.5 * pi)
|
||||
-- a' = a + pi
|
||||
|
||||
-- this should probably check the placement use, but so should others: should
|
||||
-- unify these
|
||||
|
||||
Reference in New Issue
Block a user