96 lines
2.9 KiB
Haskell
96 lines
2.9 KiB
Haskell
module Dodge.PlacementSpot where
|
|
import Dodge.LevelGen.Data
|
|
import Geometry
|
|
|
|
import Data.Maybe
|
|
import Data.Bifunctor
|
|
import Control.Monad.State
|
|
import System.Random
|
|
|
|
setDirPS :: Float -> PlacementSpot -> PlacementSpot
|
|
setDirPS a ps = case ps of
|
|
PS p _ -> PS p a
|
|
PSPos f re fb -> PSPos (\rp r -> fmap (first (setDirPS a)) (f rp r)) re fb
|
|
PSRoomRand i f -> PSRoomRand i (fmap (setDirPS a) f)
|
|
|
|
randDirPS :: RandomGen g => PlacementSpot -> State g PlacementSpot
|
|
randDirPS ps = do
|
|
a <- state $ randomR (0,pi*2)
|
|
return $ setDirPS a ps
|
|
|
|
unusedSpotAwayFromInLink :: Float -> PlacementSpot
|
|
unusedSpotAwayFromInLink x = PSPos f (const id) Nothing
|
|
where
|
|
f rp r = case rp of
|
|
UnusedSpot p a | all ( (>x) . dist p ) inlinkposs -> Just (PS p a,UsedSpot p a)
|
|
_ -> Nothing
|
|
where
|
|
inlinkposs = usedRoomInLinkPoss r
|
|
|
|
usedRoomInLinkPoss :: Room -> [Point2]
|
|
usedRoomInLinkPoss r = mapMaybe f $ _rmPos r
|
|
where
|
|
f rp = case rp of
|
|
UsedInLink {} -> Just $ _rpPos rp
|
|
_ -> Nothing
|
|
|
|
-- TODO rename to any unused link facing out
|
|
anyLnkOutPS :: PlacementSpot
|
|
anyLnkOutPS = PSPos f (const id) Nothing
|
|
where
|
|
f (UnusedLink p a) _ = Just (PS p a, UsedSpot p a)
|
|
f _ _ = Nothing
|
|
|
|
atFstLnkOut :: PlacementSpot
|
|
atFstLnkOut = PSPos f (const id) Nothing
|
|
where
|
|
f (UsedOutLink 0 i p a) _ = Just (PS p a, UsedOutLink 0 i p a)
|
|
f _ _ = Nothing
|
|
|
|
atNthLnkOutShiftBy :: Int -> ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
|
|
atNthLnkOutShiftBy n theshift = PSPos f (const id) Nothing
|
|
where
|
|
f (UsedOutLink i rmid p a) _ | n == i = Just (PS p' a', UsedOutLink n rmid p a)
|
|
where
|
|
(p',a') = theshift (p,a)
|
|
f _ _ = Nothing
|
|
|
|
atFstLnkOutShiftBy :: ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
|
|
atFstLnkOutShiftBy = atNthLnkOutShiftBy 0
|
|
|
|
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)
|
|
|
|
overFstLnkOut :: PlacementSpot
|
|
overFstLnkOut = PSPos f (const id) Nothing
|
|
where
|
|
f (UsedOutLink 0 _ p a) _ = Just (PS p a, UsedSpot p a)
|
|
f _ _ = Nothing
|
|
|
|
anyLnkInPS :: Float -- ^ amount to shift inward
|
|
-> PlacementSpot
|
|
anyLnkInPS x = PSPos f (const id) Nothing
|
|
where
|
|
f (UnusedLink v a) _ = Just (PS v' a' ,UsedSpot v' a')
|
|
where
|
|
v' = v -.- x *.* unitVectorAtAngle (a + 0.5 * pi)
|
|
a' = a + pi
|
|
f _ _ = Nothing
|
|
|
|
useLnkRoomPos :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
|
|
useLnkRoomPos rp _ = case rp of
|
|
(UnusedLink (V2 x y) a) -> Just (PS (V2 x y) a , UsedSpot (V2 x y) a)
|
|
_ -> Nothing
|
|
|
|
psRandRanges :: (Float,Float) -> (Float,Float) -> (Float,Float) -> State StdGen (Point2,Float)
|
|
psRandRanges xranges yranges aranges = do
|
|
x <- state $ randomR xranges
|
|
y <- state $ randomR yranges
|
|
a <- state $ randomR aranges
|
|
return (V2 x y,a)
|