Cleanup room moduling

src/Dodge/LevelGen/Data.hs

@@ -3,13 +3,14 @@
 module Dodge.LevelGen.Data where
 import Dodge.Data
 import Picture
-import Geometry.Data
+import Geometry
 import Shape.Data
 
 import Control.Lens
 import Control.Monad.State
 import System.Random
 import Data.Maybe
+--import Data.Bifunctor
 data PSType = PutCrit {_unPutCrit :: Creature}
     | PutMachine Color [Point2] Machine
     | PutLS LightSource
@@ -46,6 +47,15 @@ data Placement = Placement
   | PlacementUsingPos Point3 (Point3 -> Placement)  -- allows a placement to use a shifted position
   | RandomPlacement {_unRandomPlacement :: State StdGen Placement}
 
+anyLnkOutPS :: PlacementSpot
+anyLnkOutPS = PSLnk (const True) id Nothing
+
+anyLnkInPS :: Float -- ^ amount to shift inward
+    -> PlacementSpot
+anyLnkInPS x = PSLnk (const True) f Nothing
+  where
+    f (v,a) = (v -.- x *.* unitVectorAtAngle (a + 0.5 * pi), a+ pi)
+
 spNoID :: PlacementSpot -> PSType -> Placement
 spNoID ps pst = Placement ps pst Nothing (const Nothing)
 
@@ -76,7 +86,7 @@ jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0) pst Nothing $ \_ -> Just plm
 ps0 :: PSType -> (Int -> Maybe Placement) -> Placement
 ps0 pst = Placement (PS (V2 0 0) 0) pst Nothing . intPlPlPl
 
-intPlPlPl :: (Int -> Maybe Placement) -> Placement -> (Maybe Placement)
+intPlPlPl :: (Int -> Maybe Placement) -> Placement -> Maybe Placement
 intPlPlPl f = f . fromJust . _plMID
 
 jps0 :: PSType -> (Int -> Maybe Placement) -> Maybe Placement