Allow for more complex placement positioning

src/Dodge/PlacementSpot.hs

@@ -2,29 +2,49 @@ module Dodge.PlacementSpot where
 import Dodge.LevelGen.Data
 import Geometry
 
+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 -> undefined
+    _ -> error "TODO write this in"
+
+randDirPS :: RandomGen g => PlacementSpot -> State g PlacementSpot
+randDirPS (PSPos f ef fb) = do
+    a <- state $ randomR (0,pi*2)
+    return $ PSPos (g a) ef fb 
+  where
+    g a rp r = fmap (first (setDirPS a)) $ f rp r
+
+--unusedSpotAwayFromInLinkRD :: RandomGen g => Float -> State g PlacementSpot
+--unusedSpotAwayFromInLinkRD x = do
+--    a <- state $ randomR (0.2*pi)
+--    return PSPos (f a) (const id) Nothing
+--  where
+
 -- 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, PosPl p a)
-    f _ = Nothing
+    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
+    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)
+    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
+    f _ _ = Nothing
 
 atFstLnkOutShiftBy :: ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
 atFstLnkOutShiftBy = atNthLnkOutShiftBy 0
@@ -40,22 +60,22 @@ atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n f
 overFstLnkOut :: PlacementSpot
 overFstLnkOut = PSPos f (const id) Nothing
   where
-    f (UsedOutLink 0 _ p a) = Just (PS p a, PosPl p a)
-    f _ = Nothing
+    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' ,PosPl v' a')
+    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
+    f _ _ = Nothing
 
-useLnkRoomPos :: RoomPos -> Maybe (PlacementSpot,RoomPos)
-useLnkRoomPos rp = case rp of
-    (UnusedLink (V2 x y) a) -> Just (PS (V2 x y) a , PosPl (V2 x y) a)
+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)