Allow to log position of placement spot
This commit is contained in:
+32
-28
@@ -61,17 +61,17 @@ randDirPS ps = do
|
||||
|
||||
isUnusedLnk :: RoomPos -> Room -> Bool
|
||||
isUnusedLnk rp _ = case _rpLinkStatus rp of
|
||||
UnusedLink{} -> _rpPlacementUse rp == 0
|
||||
UnusedLink{} -> null $ _rpPlacementUse rp
|
||||
_ -> False
|
||||
|
||||
anyUnusedSpot :: PlacementSpot
|
||||
anyUnusedSpot = rprBool $ \rp _ -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0
|
||||
anyUnusedSpot = rprBool $ \rp _ -> _rpLinkStatus rp == NotLink && null (_rpPlacementUse rp)
|
||||
|
||||
psposAddLabel :: RoomPosType -> PlacementSpot -> PlacementSpot
|
||||
psposAddLabel lab = psSelect %~ (\f rp r -> f rp r & _Just . _2 . rpType %~ S.insert lab)
|
||||
|
||||
rprBool :: (RoomPos -> Room -> Bool) -> PlacementSpot
|
||||
rprBool t = PSPos (useRoomPosRoomCond t) (const id) Nothing
|
||||
rprBool t = PSPos (useRoomPosRoomCond (S.singleton UsedPosLow) t) (const id) Nothing
|
||||
|
||||
rpIsOnPath :: RoomPos -> Bool
|
||||
rpIsOnPath = any f . _rpType
|
||||
@@ -99,34 +99,34 @@ rpOnPathFromEdge pe = any f . _rpType
|
||||
resetPLUse :: PlacementSpot -> PlacementSpot
|
||||
resetPLUse (PSPos f g fallback) = PSPos f' g fallback
|
||||
where
|
||||
f' rp = fmap (second (rpPlacementUse .~ 0)) . f rp
|
||||
f' rp = fmap (second (rpPlacementUse .~ mempty)) . f rp
|
||||
resetPLUse _ = error "Tried to reset _rpPlacementUse of non PSPos placement"
|
||||
|
||||
rprShift ::
|
||||
(RoomPos -> Room -> Maybe (Point2, Float)) ->
|
||||
(RoomPos -> Room -> Maybe ((Point2, Float), S.Set UsedPos)) ->
|
||||
PlacementSpot
|
||||
rprShift t = PSPos f (const id) Nothing
|
||||
where
|
||||
f rp r = case t rp r of
|
||||
Just (p, a) -> Just (PS p a, rp & rpPlacementUse +~ 1)
|
||||
Just ((p, a), xs) -> Just (PS p a, rp & rpPlacementUse <>~ xs)
|
||||
Nothing -> Nothing
|
||||
|
||||
rprBoolShift ::
|
||||
(RoomPos -> Room -> Bool) ->
|
||||
((Point2, Float) -> (Point2, Float)) ->
|
||||
((Point2, Float) -> ((Point2, Float), S.Set UsedPos)) ->
|
||||
PlacementSpot
|
||||
rprBoolShift t shift = PSPos f (const id) Nothing
|
||||
where
|
||||
f rp r
|
||||
| t rp r = Just (PS p a, rp & rpPlacementUse +~ 1)
|
||||
| t rp r = Just (PS p a, rp & rpPlacementUse <>~ xs)
|
||||
| otherwise = Nothing
|
||||
where
|
||||
(p, a) = shift (_rpPos rp, _rpDir rp)
|
||||
((p, a), xs) = shift (_rpPos rp, _rpDir rp)
|
||||
|
||||
unusedSpotAwayFromLink :: Float -> PlacementSpot
|
||||
unusedSpotAwayFromLink x = rprBool $ \rp r ->
|
||||
_rpLinkStatus rp == NotLink
|
||||
&& _rpPlacementUse rp == 0
|
||||
&& null (_rpPlacementUse rp)
|
||||
&& all ((> x) . dist (_rpPos rp)) (usedRoomLinkPoss r)
|
||||
|
||||
setFallback :: Placement -> Placement -> Placement
|
||||
@@ -137,14 +137,14 @@ setFallback fallback =
|
||||
|
||||
unusedOffPathAwayFromLink :: Float -> PlacementSpot
|
||||
unusedOffPathAwayFromLink x = rprBool $ \rp r ->
|
||||
_rpPlacementUse rp == 0
|
||||
null (_rpPlacementUse rp)
|
||||
&& all ((> x) . dist (_rpPos rp)) (usedRoomLinkPoss r)
|
||||
&& rpIsOffPath rp
|
||||
|
||||
unusedSpotAwayFromInLink :: Float -> PlacementSpot
|
||||
unusedSpotAwayFromInLink x = rprBool $ \rp r ->
|
||||
_rpLinkStatus rp == NotLink
|
||||
&& _rpPlacementUse rp == 0
|
||||
&& null (_rpPlacementUse rp)
|
||||
&& all ((> x) . dist (_rpPos rp)) (usedRoomInLinkPoss r)
|
||||
|
||||
--twoUnusedLinks :: (PlacementSpot -> PlacementSpot -> Placement) -> Placement
|
||||
@@ -167,12 +167,12 @@ twoRoomPoss cond1 cond2 f = Placement (rprBool cond1) PutNothing Nothing Nothing
|
||||
|
||||
isInLnk :: RoomPos -> Bool
|
||||
isInLnk rp = case _rpLinkStatus rp of
|
||||
UsedInLink{} -> _rpPlacementUse rp == 0
|
||||
UsedInLink{} -> null $ _rpPlacementUse rp
|
||||
_ -> False
|
||||
|
||||
isOutLnk :: RoomPos -> Bool
|
||||
isOutLnk rp = case _rpLinkStatus rp of
|
||||
UsedOutLink{} -> _rpPlacementUse rp == 0
|
||||
UsedOutLink{} -> null $ _rpPlacementUse rp
|
||||
_ -> False
|
||||
|
||||
useUnusedLnk :: PlacementSpot
|
||||
@@ -180,27 +180,30 @@ useUnusedLnk = rprBool isUnusedLnk
|
||||
|
||||
isUsedLnkUnplaced :: RoomPos -> Bool
|
||||
isUsedLnkUnplaced rp = case _rpLinkStatus rp of
|
||||
UsedOutLink{} -> _rpPlacementUse rp == 0
|
||||
UsedInLink{} -> _rpPlacementUse rp == 0
|
||||
UsedOutLink{} -> null (_rpPlacementUse rp)
|
||||
UsedInLink{} -> null (_rpPlacementUse rp)
|
||||
_ -> False
|
||||
|
||||
useRoomPosCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot, RoomPos)
|
||||
useRoomPosCond f = useRoomPosRoomCond $ \rp r -> f rp r
|
||||
useRoomPosCond f = useRoomPosRoomCond (S.singleton UsedPosLow) $ \rp r -> f rp r
|
||||
|
||||
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)
|
||||
useRoomPosRoomCond :: S.Set UsedPos
|
||||
-> (RoomPos -> Room -> Bool) -> RoomPos -> Room
|
||||
-> Maybe (PlacementSpot, RoomPos)
|
||||
useRoomPosRoomCond xs t rp r
|
||||
| t rp r = Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse <>~ xs)
|
||||
| otherwise = Nothing
|
||||
|
||||
isUnusedLnkType :: RoomLinkType -> RoomPos -> Room -> Bool
|
||||
isUnusedLnkType rlt rp _ = case _rpLinkStatus rp of
|
||||
UnusedLink{_rplsType = rlts} -> rlt `S.member` rlts && _rpPlacementUse rp == 0
|
||||
UnusedLink{_rplsType = rlts} -> rlt `S.member` rlts
|
||||
&& null (_rpPlacementUse rp)
|
||||
_ -> False
|
||||
|
||||
unusedSpotNearInLink :: Float -> PlacementSpot
|
||||
unusedSpotNearInLink x = rprBool $ \rp r ->
|
||||
_rpLinkStatus rp == NotLink
|
||||
&& _rpPlacementUse rp == 0
|
||||
&& null (_rpPlacementUse rp)
|
||||
&& any ((< x) . dist (_rpPos rp)) (usedRoomInLinkPoss r)
|
||||
|
||||
usedRoomInLinkPoss :: Room -> [Point2]
|
||||
@@ -224,7 +227,8 @@ atFstLnkOut = atNthLinkOut 0
|
||||
atNthLinkOut :: Int -> PlacementSpot
|
||||
atNthLinkOut n = rprBool $ \rp _ -> rp ^? rpLinkStatus . rplsChildNum == Just n
|
||||
|
||||
atNthLnkOutShiftBy :: Int -> ((Point2, Float) -> (Point2, Float)) -> PlacementSpot
|
||||
atNthLnkOutShiftBy :: Int -> ((Point2, Float) -> ((Point2, Float),S.Set UsedPos))
|
||||
-> PlacementSpot
|
||||
atNthLnkOutShiftBy n = rprBoolShift $
|
||||
\rp _ -> rp ^? rpLinkStatus . rplsChildNum == Just n
|
||||
|
||||
@@ -237,7 +241,7 @@ atNthLnkOutShiftBy n = rprBoolShift $
|
||||
-- where
|
||||
-- (p,a) = theshift (_rpPos rp,_rpDir rp)
|
||||
|
||||
atFstLnkOutShiftBy :: ((Point2, Float) -> (Point2, Float)) -> PlacementSpot
|
||||
atFstLnkOutShiftBy :: ((Point2, Float) -> ((Point2, Float), S.Set UsedPos)) -> PlacementSpot
|
||||
atFstLnkOutShiftBy = atNthLnkOutShiftBy 0
|
||||
|
||||
atFstLnkOutShiftInward :: Float -> PlacementSpot
|
||||
@@ -245,7 +249,7 @@ atFstLnkOutShiftInward = atNthLnkOutShiftInward 0
|
||||
|
||||
atNthLnkOutShiftInward :: Int -> Float -> PlacementSpot
|
||||
atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n $
|
||||
\(p, a) -> (p +.+ rotateV a (V2 0 (negate x)), a)
|
||||
\(p, a) -> ((p +.+ rotateV a (V2 0 (negate x)), a), S.singleton UsedPosLow)
|
||||
|
||||
shiftInBy :: Float -> (Point2, Float) -> (Point2, Float)
|
||||
shiftInBy x (p, a) = (p +.+ rotateV a (V2 0 (negate x)), a)
|
||||
@@ -255,9 +259,9 @@ shiftByV2 x (p, a) = (p +.+ rotateV a x, a)
|
||||
|
||||
-- this should probably check the placement use, but so should others: should
|
||||
-- unify these
|
||||
useLnkRoomPos :: RoomPos -> Room -> Maybe (PlacementSpot, RoomPos)
|
||||
useLnkRoomPos rp _ = case _rpLinkStatus rp of
|
||||
UnusedLink{} -> Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
|
||||
useLnkRoomPos :: S.Set UsedPos -> RoomPos -> Room -> Maybe (PlacementSpot, RoomPos)
|
||||
useLnkRoomPos xs rp _ = case _rpLinkStatus rp of
|
||||
UnusedLink{} -> Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse <>~ xs)
|
||||
_ -> Nothing
|
||||
|
||||
psRandRanges :: (Float, Float) -> (Float, Float) -> (Float, Float) -> State StdGen (Point2, Float)
|
||||
|
||||
Reference in New Issue
Block a user