Slightly broken placements

src/Dodge/Floor.hs

@@ -34,7 +34,8 @@ initialAnoTree = padSucWithCorridors $ treeFromTrunk
     [[StartRoom]
     ,[ChainAnos 
         [[SetLabel 0 $ return $ roomRectAutoLinks 100 100 
-                    & rmExtPmnt ?~ externalButton red (anyLnkInPS 5 & psLnkRoomEff .~ putWireStart 0) 
+                    & rmExtPmnt ?~ externalButton red 
+                        (anyLnkInPS 5 & psLnkRoomEff .~ (putWireStart 0 . extractRoomPos) )
 --                    & rmStartWires .~ IM.fromList [(0,RoomWire 0 0)]
                     & rmLinkEff .~ [putWireEndInvRmShift 0]
          ]

src/Dodge/LevelGen.hs

@@ -14,8 +14,8 @@ import Dodge.LevelGen.Pathing
 import Dodge.LevelGen.TriggerDoor
 import Dodge.LevelGen.Data
 import Dodge.Default.Wall
-import Dodge.RandomHelp
+--import Dodge.RandomHelp
-import Dodge.Placements.Spot
+--import Dodge.Placements.Spot
 import Geometry
 import Geometry.Vector3D
 import Shape
@@ -26,13 +26,14 @@ import System.Random
 import Control.Monad.State
 import Control.Lens
 import qualified Data.IntSet as IS
+import Data.Bifunctor
 
 -- when placing a placement, we update the world and the room and assign an id
 -- to the placement
 placeSpot :: (World,Room) -> Placement -> ( (World,Room), [Placement] )
 placeSpot (w,rm) plmnt = case plmnt of
     Placement{_plSpot = PSRoomRand i} -> placeSpotRoomRand rm i plmnt w
-    Placement{_plSpot = PSLnk{}}      -> placeSpotUsingLink w rm plmnt
+    Placement{_plSpot = PSLnk extract eff fallback} -> placeSpotUsingLink w rm plmnt extract eff fallback
     Placement{} ->
         let (i,w') = placeSpotID (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
             newplmnt = plmnt & plMID ?~ i
@@ -48,37 +49,33 @@ placeSpot (w,rm) plmnt = case plmnt of
   where
     shift = _rmShift rm
 
+invShiftPSBy :: (Point2,Float) -> PlacementSpot -> PlacementSpot
+invShiftPSBy (pos,rot) (PS p r) = PS (invShiftPointBy (pos,rot) p) (r - rot)
+invShiftPSBy _ ps = ps
+
+
 -- this should be tidied up
-placeSpotUsingLink :: World -> Room -> Placement -> ((World, Room), [Placement])
+placeSpotUsingLink :: World -> Room -> Placement 
-placeSpotUsingLink w rm plmnt = case lnks of
+    -> (RoomPos -> Maybe PlacementSpot)
-    ((lnki,lnk):_) -> placeSpot (w & randGen .~ g,uselnk lnki lnk) (updatePS (f lnk) plmnt)
+    -> (RoomPos -> Room -> Room)
-    [] -> case fallback of
+    -> Maybe Placement
+    -> ((World, Room), [Placement])
+placeSpotUsingLink w rm plmnt extract eff fallback = case searchedPoss (_rmPos rm) of
+    Just (ps,pos,newrmpos) -> placeSpot (w, eff pos $ rm & rmPos .~ newrmpos) (plmnt & plSpot .~ ps)
+    Nothing -> case fallback of
         Nothing -> ((w,rm),[plmnt])
         Just plmnt' -> placeSpot (w,rm) plmnt'
   where
-    uselnk lnki lnk = _psLnkRoomEff rps (f' lnk rps) rm & rmLinks %~ deletei lnki
+    searchedPoss [] = error "no correct pos type for lnk placement"
-    rps = _plSpot plmnt
+    searchedPoss (pos:poss) = case extract (invShiftPosBy (_rmShift rm) pos) of
-    fallback = _psLnkFallback rps
+        Nothing -> second (pos:) <$> searchedPoss poss
-    test = _psLnkTest rps
+        Just ps -> Just ( ps,pos, poss)
-    (lnks,g) = runState (shuffle $ filter (test . snd) $ zip [0..] 
-        $ map (invShiftLinkBy $ _rmShift rm) $ _rmLinks rm) $ _randGen w
-    f' x (PSLnk t s _ _)
-        | t x = s x
-    f' _ _ = error "wrong type of link: something is wrong"
-    f x (PSLnk t s _ _)
-        | t x = uncurry PS $ s x
-    f _ ps = ps
-    invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
-    invShiftLinkBy (pos,rot) (p,r) = (invShiftPointBy (pos,rot) p, r - rot)
 
 placeSpotRoomRand :: Room -> Int -> Placement -> World -> ((World,Room),[Placement])
 placeSpotRoomRand rm i plmnt w =
     let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w
     in placeSpot (w & randGen .~ g,rm) (plmnt & plSpot .~ uncurry PS ps)
 
-deletei :: Int -> [a] -> [a]
-deletei i xs = take i xs ++ drop (i+1) xs
-
 shiftPlacement :: (Point2,Float) -> Placement -> Placement
 shiftPlacement shift plmnt = case plmnt of
     Placement {} -> plmnt & plSpot %~ shiftPSBy shift 
@@ -138,6 +135,17 @@ shiftPointBy (pos,rot) p = pos +.+ rotateV rot p
 invShiftPointBy :: (Point2,Float) -> Point2 -> Point2
 invShiftPointBy (p1,r) p2 = rotateV (-r) $ p2 -.- p1
 
+invShiftPosBy :: (Point2,Float) -> RoomPos -> RoomPos
+invShiftPosBy s rp = case rp of
+    OutLink i p a   -> uncurry (OutLink i)  $ invShiftLinkBy s (p,a)
+    InLink  p a     -> uncurry (InLink)     $ invShiftLinkBy s (p,a)
+    UnusedLink p a  -> uncurry (UnusedLink) $ invShiftLinkBy s (p,a)
+    PosPl   p a     -> uncurry (PosPl)      $ invShiftLinkBy s (p,a)
+    LabPos  i rp'   -> LabPos i $ invShiftPosBy s rp'
+
+invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
+invShiftLinkBy (pos,rot) (p,r) = (invShiftPointBy (pos,rot) p, r - rot)
+
 shiftPoint3By :: (Point2,Float) -> Point3 -> Point3
 shiftPoint3By (pos,rot) (V3 x y z) = addZ z $ pos +.+ rotateV rot (V2 x y)
 

src/Dodge/LevelGen/Data.hs

@@ -36,9 +36,8 @@ data PSType = PutCrit {_unPutCrit :: Creature}
 data PlacementSpot 
     = PS { _psPos :: Point2 , _psRot :: Float }
     | PSLnk 
-        { _psLnkTest        :: (Point2,Float) -> Bool
+        { _psLnkShift       :: RoomPos -> Maybe PlacementSpot
-        , _psLnkShift       :: (Point2,Float) -> (Point2,Float)
+        , _psLnkRoomEff     :: RoomPos -> Room -> Room
-        , _psLnkRoomEff     :: (Point2,Float) -> Room -> Room
         , _psLnkFallback    :: Maybe Placement
         }
     | PSRoomRand { _psRoomRandPointNum :: Int }
@@ -51,62 +50,6 @@ 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 (const id) Nothing
-
-anyLnkInPS :: Float -- ^ amount to shift inward
-    -> PlacementSpot
-anyLnkInPS x = PSLnk (const True) f (const id) 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)
-
-pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement
-pContID ps pt = Placement ps pt Nothing . intPlPlPl
-
-plCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement
-plCont ps pt = Placement ps pt Nothing
-
-sPS :: Point2 -> Float -> PSType -> Placement
-sPS p a pt = Placement (PS p a) pt Nothing (const Nothing)
-
-jsps :: Point2 -> Float -> PSType -> Maybe Placement
-jsps p a pst = Just $ Placement (PS p a) pst Nothing $ const Nothing
-
-jsps0 :: PSType -> Maybe Placement
-jsps0 pst = Just $ sPS (V2 0 0) 0 pst
-
-sps0 :: PSType -> Placement
-sps0 = sPS (V2 0 0) 0
-
-jspsJ :: Point2 -> Float -> PSType -> Placement -> Maybe Placement
-jspsJ p a pst plm = Just $ Placement (PS p a) pst Nothing $ \_ -> Just plm
-
-jsps0J :: PSType -> Placement -> Maybe Placement
-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 f = f . fromJust . _plMID
-
-jps0 :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
-jps0 pst = Just . Placement (PS (V2 0 0) 0) pst Nothing . intPlPlPl
-
-ps0j :: PSType -> Placement -> Placement
-ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (const $ Just plmnt)
-
-addPlmnt :: Placement -> Placement -> Placement
-addPlmnt pl pl2 = case pl2 of
-    (PlacementUsingPos p f) -> PlacementUsingPos p (fmap (addPlmnt pl) f)
-    (RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
-    (Placement ps pt mi f) -> Placement ps pt mi (fmap g f)
-  where
-    g Nothing = Just pl
-    g (Just pl') = Just $ addPlmnt pl pl'
 
 {- 
 The '_rmPolys' list states which polygons should be cut out to form the indestructible walls of the room.
@@ -147,7 +90,92 @@ data RoomPos
     | PosPl   Point2 Float
     | LabPos  Int    RoomPos
   deriving (Eq,Ord,Show)
+
+extractRoomPos :: RoomPos -> (Point2,Float)
+extractRoomPos rp = case rp of
+    OutLink _ p a   -> (p,a)
+    InLink  p a     -> (p,a)
+    UnusedLink p a  -> (p,a)
+    PosPl   p a     -> (p,a)
+    LabPos  _ rp'   -> extractRoomPos rp'
+
 makeLenses ''Room
 makeLenses ''PSType
 makeLenses ''PlacementSpot
 makeLenses ''Placement
+
+-- TODO rename to any unused link facing out
+anyLnkOutPS :: PlacementSpot
+anyLnkOutPS = PSLnk f (const id) Nothing
+  where
+    f (UnusedLink p a) = Just $ PS p a
+    f _ = Nothing
+    
+
+anyLnkInPS :: Float -- ^ amount to shift inward
+    -> PlacementSpot
+anyLnkInPS x = PSLnk f (const id) Nothing
+  where
+    f (UnusedLink v a) = Just $ PS (v -.- x *.* unitVectorAtAngle (a + 0.5 * pi)) (a+ pi)
+    f _ = Nothing
+
+spNoID :: PlacementSpot -> PSType -> Placement
+spNoID ps pst = Placement ps pst Nothing (const Nothing)
+
+pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement
+pContID ps pt = Placement ps pt Nothing . intPlPlPl
+
+plCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement
+plCont ps pt = Placement ps pt Nothing
+
+sPS :: Point2 -> Float -> PSType -> Placement
+sPS p a pt = Placement (PS p a) pt Nothing (const Nothing)
+
+jsps :: Point2 -> Float -> PSType -> Maybe Placement
+jsps p a pst = Just $ Placement (PS p a) pst Nothing $ const Nothing
+
+jsps0 :: PSType -> Maybe Placement
+jsps0 pst = Just $ sPS (V2 0 0) 0 pst
+
+sps0 :: PSType -> Placement
+sps0 = sPS (V2 0 0) 0
+
+jspsJ :: Point2 -> Float -> PSType -> Placement -> Maybe Placement
+jspsJ p a pst plm = Just $ Placement (PS p a) pst Nothing $ \_ -> Just plm
+
+jsps0J :: PSType -> Placement -> Maybe Placement
+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
+
+pt0 :: PSType -> (Placement -> Maybe Placement) -> Placement
+pt0 pst = Placement (PS (V2 0 0) 0) pst Nothing
+
+contToIDCont :: (Int -> Maybe Placement) -> Placement -> Maybe Placement
+contToIDCont f plmnt = f $ fromJust (_plMID plmnt)
+
+intPlPlPl :: (Int -> Maybe Placement) -> Placement -> Maybe Placement
+intPlPlPl f = f . fromJust . _plMID
+
+jps0 :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
+jps0 pst = Just . Placement (PS (V2 0 0) 0) pst Nothing . intPlPlPl
+
+jps0PushPS :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
+jps0PushPS pst f = Just . Placement (PS (V2 0 0) 0) pst Nothing
+    $ \plmnt -> (f (fromJust $ _plMID plmnt) <&> plSpot .~ _plSpot plmnt)
+
+ps0j :: PSType -> Placement -> Placement
+ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (const $ Just plmnt)
+
+ps0jPushPS :: PSType -> Placement -> Placement
+ps0jPushPS pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (\p -> Just $ plmnt & plSpot .~ _plSpot p)
+
+addPlmnt :: Placement -> Placement -> Placement
+addPlmnt pl pl2 = case pl2 of
+    (PlacementUsingPos p f) -> PlacementUsingPos p (fmap (addPlmnt pl) f)
+    (RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
+    (Placement ps pt mi f) -> Placement ps pt mi (fmap g f)
+  where
+    g Nothing = Just pl
+    g (Just pl') = Just $ addPlmnt pl pl'

src/Dodge/Placements/Button.hs

@@ -10,18 +10,24 @@ import Dodge.LevelGen.Switch
 import Dodge.Placements.LightSource
 import Dodge.Placements.Spot
 
+import Data.Maybe
 import Control.Lens
 
 externalButton :: Color -> PlacementSpot -> Placement
-externalButton col ps = pContID ps (PutTrigger (const False))
+--externalButton col ps = pContID ps (PutTrigger (const False))
-    $ \trigid -> Just $ pContID ps (PutButton (makeSwitch col col (oneff trigid) (offeff trigid))) 
+--    $ \trigid -> Just $ pContID ps (PutButton (makeSwitch col col (oneff trigid) (offeff trigid))) 
+--                    (const Nothing)
+externalButton col ps = plCont ps (PutTrigger (const False))
+    $ \tp -> Just $ pContID ps (PutButton (makeSwitch col col (oneff $ trigid tp) (offeff $ trigid tp))) 
                     (const Nothing)
   where
+    trigid tp = fromJust $ _plMID tp
     oneff  tid = triggers . ix tid .~ const True
     offeff tid = triggers . ix tid .~ const False
 
 putLitButtonID :: Color -> Point2 -> Float -> (Int -> Maybe Placement) -> Placement
 putLitButtonID col p a subpl = mntLSOn aShape (Just col) ls p'' (addZ 40 p')
+    $ contToIDCont
     $ \lsid -> jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = p, _btRot = a})
     subpl
   where
@@ -30,12 +36,13 @@ putLitButtonID col p a subpl = mntLSOn aShape (Just col) ls p'' (addZ 40 p')
     changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
     ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
 
-putLitButtonID' :: Color -> ((Point2,Float) -> Bool) -> (Int -> Maybe Placement) -> Placement
+putLitButOnPos :: Color -> (RoomPos -> Maybe PlacementSpot) -> (Int -> Maybe Placement) -> Placement
-putLitButtonID' col f subpl 
+putLitButOnPos col f subpl 
-    = updatePSToLevel 3 (const thePS) $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40)
+    = updatePSToLevel 1 (const thePS) $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40)
-    $ \lsid -> jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = V2 0 (-1), _btRot = pi})
+    $ \plmnt -> let lsid = fromJust $ _plMID plmnt
-    subpl
+        in jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = V2 0 (-1), _btRot = pi})
+                subpl <&> plSpot .~ _plSpot plmnt
   where
     changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
     ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
-    thePS = PSLnk f id (const id) Nothing
+    thePS = PSLnk f (const id) Nothing

src/Dodge/Placements/LightSource.hs

@@ -17,10 +17,10 @@ import Shape
 mntLSOn
     :: (Point2 -> Point3 -> Shape) -- ^ function describing the mount shape
     -> Maybe Color  -- ^ describing a possible color override for the shape
-    -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
+    -> LightSource -> Point2 -> Point3 -> (Placement -> Maybe Placement) -> Placement
 mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _)
-    = ps0j (PutForeground . setCol $ shapeF wallp lsp)
+    = ps0jPushPS (PutForeground . setCol $ shapeF wallp lsp)
-    . ps0 (PutLS $ ls {_lsPos = lsp'})
+    . pt0 (PutLS $ ls {_lsPos = lsp'})
   where
     lsp' = lsp -.-.- V3 x y 1
     -- hack! perturb the light position
@@ -79,8 +79,8 @@ vShape wallpos (V3 x y z) =
 mntLS :: (Point2 -> Point3 -> Shape) -> Point2 -> Point3 -> Placement
 mntLS shp wallp lampp = mntLSOn shp Nothing defaultLS wallp lampp (const Nothing)
 
-mntLSCond :: (Point2 -> Point3 -> Shape) -> ((Point2,Float) -> Bool) -> Placement
+mntLSCond :: (Point2 -> Point3 -> Shape) -> (RoomPos -> Maybe PlacementSpot) -> Placement
-mntLSCond shp cond = updatePSToLevel 2 (const $ PSLnk cond id (const id) Nothing) 
+mntLSCond shp shift = updatePSToLevel 2 (const $ PSLnk shift (const id) Nothing) 
     $ mntLS shp 0 (V3 0 (-40) 90)
     -- note that this perhaps pushes the vshape light out too far
 
@@ -89,11 +89,16 @@ mntLight a b = RandomPlacement $ do
     shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
     return $ mntLS shp a (addZ 90 b)
 
-mntLightLnkCond :: ((Point2,Float) -> Bool) -> Placement
+mntLightLnkCond :: (RoomPos -> Maybe PlacementSpot) -> Placement
 mntLightLnkCond f = RandomPlacement $ do
     shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
     return $ mntLSCond shp f
 
+unusedLnkToPS :: RoomPos -> Maybe PlacementSpot
+unusedLnkToPS rp = case rp of
+    UnusedLink p a -> Just $ PS p a
+    _ -> Nothing
+
 spanColLightI :: Point3 -> Float -> Point2 -> Point2 -> Placement
 spanColLightI col h a b = ps0j (PutLS $ colorLightAt col (V3 x y (h-5)) 0)
     $ sps0 $ PutForeground $ thinHighBar h a b

src/Dodge/Room/LongDoor.hs

@@ -114,10 +114,10 @@ addButtonSlowDoor x h rm = do
     openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2)
     belowH y = (sndV2 . fst) y < h - 40
     aboveH y = (sndV2 . fst) y > h + 40
-    butDoor _ _ = putLitButtonID' col butPosCond
+    butDoor _ _ = putLitButOnPos col butPosCond
-    --butDoor bpos brot = putLitButtonID col bpos brot
         $  \btid -> Just $ putDoubleDoor False col (cond' btid) (V2 0 h) (V2 x h) 2
-    butPosCond (V2 _ y,_) = y < h
+    butPosCond (UnusedLink (V2 x' y') a') | y' < 0.5 * h = Just $ PS (V2 x' y') a'
+    butPosCond _ = Nothing
     --butPosCond _ = True -- y < h
     col = dim $ light red
     cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff

src/Dodge/Room/Procedural.hs

@@ -71,7 +71,7 @@ roomRectAutoLinks x y = (roomRect x y ((ceiling x - 40) `div` 60) ((ceiling y -
     {_rmPmnts = plmnts}
   where
     plmnts = 
-        [mntLightLnkCond (const True)
+        [mntLightLnkCond unusedLnkToPS
 --        ,sps0 $ PutForeground $ thinHighBarChain 50 $ rectNSWE y 0 0 x
         ]
 {- Combines two rooms into one room.

src/Dodge/Room/Room.hs

@@ -104,10 +104,11 @@ glassSwitchBack = do
     hgt <- state $ randomR (400,600)
     wllen <- state $ randomR (60,wth/2-40)
     let hf = hgt/5
-        con1 (V2 _ y,_) = y < 0.5*hgt 
+        con1 cond (UnusedLink (V2 x y) a) | cond y = Just $ PS (V2 x y) a 
+        con1 _ _ = Nothing
         plmnts = 
-            [ mntLightLnkCond con1
+            [ mntLightLnkCond $ con1 (< 0.5 * hgt)
-            , mntLightLnkCond (not . con1)
+            , mntLightLnkCond $ con1 (> 0.5 * hgt)
             ,windowLine (V2 (wth-60   )    hf ) (V2 wllen  hf   )
             ,windowLine (V2 (wth-wllen) (2*hf)) (V2 60    (2*hf))
             ,windowLine (V2 (wth-60   ) (3*hf)) (V2 wllen (3*hf))
@@ -199,8 +200,8 @@ roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst)
         , blockLine (V2 125 115) (V2 125 125)
         --, sPS (V2 40 120) 0 putLamp
         --, sPS (V2 200 120) 0 putLamp
-        , mntLightLnkCond (const True)
+        , mntLightLnkCond unusedLnkToPS
-        , mntLightLnkCond (const True)
+        , mntLightLnkCond unusedLnkToPS
         ]
 
 roomOctogon :: Room
@@ -249,7 +250,7 @@ weaponEmptyRoom = do
             ,sPS   (V2 20 20) (pi/2) randC1
             ,sPS (V2 (w-20) 20) (pi/2) randC1
             --,sPS (V2 (w/2) (h/2))      0 putLamp
-            ,mntLightLnkCond (const True)
+            ,mntLightLnkCond unusedLnkToPS
             ]
     (fmap connectRoom . randomiseOutLinks) =<< 
         changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPmnts plmnts $ roomRect w h 2 2)
@@ -441,10 +442,12 @@ pillarGrid = do
             y <- takeOne ys
             a <- state $ randomR (0,2*pi)
             return (V2 (x+gap) y,a)
-        cornerRestrict (V2 x y,_)
+-- the following was used to stop lights from being mounted in corners and
-             = (x > 40 && x < h - 40)
+-- potentially overlapping, might want to redo
-            || (y > 40 && y < h - 40)
+--        cornerRestrict (V2 x y,_)
-    let plmnts = replicate 8 (mntLightLnkCond cornerRestrict)
+--             = (x > 40 && x < h - 40)
+--            || (y > 40 && y < h - 40)
+    let plmnts = replicate 8 (mntLightLnkCond unusedLnkToPS)
                   ++ 
                  concat [f x y | x<-xs,y<-ys]
     return $ roomRect w h (max i 2) (max i 2)

src/Dodge/Room/Start.hs

@@ -40,6 +40,6 @@ startRoom = do
         <$> randomiseOutLinks 
             (shiftRoomBy (V2 (-20) (-20),0) 
             $ roomRectAutoLinks w h & rmPmnts %~ (plmnts ++) 
-                & rmStartWires .~ IM.fromList [(0,RoomWire (V2 0 0) 0)]
+                & rmStartWires .~ IM.fromList [(0,RoomWire (V2   0   0) 0)]
-                & rmEndWires .~ IM.fromList [(0,RoomWire (V2 (500) 500) 0)]
+                & rmEndWires   .~ IM.fromList [(0,RoomWire (V2 500 500) 0)]
             )