Work towards using room positions rather than room links in placements

src/Dodge/Floor.hs

@@ -34,9 +34,9 @@ initialAnoTree = padSucWithCorridors $ treeFromTrunk
     [[StartRoom]
     ,[ChainAnos 
         [[SetLabel 0 $ return $ roomRectAutoLinks 100 100 
-                    & rmExtPmnt ?~ externalButton red (anyLnkInPS 5) 
-                    & rmStartWires .~ IM.fromList [(0,RoomWire 0 0)]
-                    & rmLinkEff .~ [putWireEnd 0]
+                    & rmExtPmnt ?~ externalButton red (anyLnkInPS 5 & psLnkRoomEff .~ putWireStart 0) 
+--                    & rmStartWires .~ IM.fromList [(0,RoomWire 0 0)]
+                    & rmLinkEff .~ [putWireEndInvRmShift 0]
          ]
         ,[UseLabel 0 $ return switchDoorRoom]
         ]
@@ -107,7 +107,8 @@ layoutLevelFromSeed i seed = do
             putStrLn $ "After " ++ show i' 
                 ++ " attempt(s), Successful generation of level with seed " 
                 ++ show seed
-            return (fmap setLastLinkToUsed rs)
+            --return (fmap setLastLinkToUsed rs)
+            return rs
         Nothing -> do
             putStr $ "Level generation with seed " ++ show seed ++ " failed: "
             let (seed',_) = random g

src/Dodge/Layout.hs

@@ -53,7 +53,7 @@ placeRoomWires rm w = IM.foldr ($) w
     $ IM.intersectionWith (placeWire rm) (_rmStartWires rm) (_rmEndWires rm)
 
 placeWire :: Room -> RoomWire -> RoomWire -> World -> World
-placeWire rm (RoomWire p' _) (RoomWire q' _) w = w & foregroundShape %~ (thinHighBar 40 p q <>)
+placeWire rm (RoomWire p' _) (RoomWire q' _) w = w & foregroundShape %~ (thinHighBar 80 p q <>)
   where
     rs = _rmShift rm
     p = shiftPointBy rs p'

src/Dodge/Layout/Tree/Shift.hs

@@ -29,7 +29,7 @@ posRms
     -> IO (Maybe [Room])
 posRms _ _ [] Empty = return $ Just []
 posRms bounds (rtoadd,_) [] (Node (r,i) ts :<| tseq) 
-    = fmap (setLastLinkToUsed rtoadd:) <$> posRms bounds (r,i) ts tseq
+    = fmap (finalLinksUpdate rtoadd:) <$> posRms bounds (r,i) ts tseq
 posRms bounds (r,i) (t@(Node (_,i') _):ts) tseq = do
     putStr $ "Trying to place room " ++ show i' ++ ": "
     tryLinks (0::Int) (_rmLinks r)

src/Dodge/LevelGen/Data.hs

@@ -119,7 +119,8 @@ assigning no bounds will allow rooms to overlap.
  -}
 data Room = Room
     { _rmPolys  :: [ [Point2] ]
-    , _rmLinks  :: [(Point2,Float)]
+    , _rmLinks  :: [(Point2,Float)] 
+        -- update the room when assigning the next link to an adjacent room with the head of of this list, return the tail
     , _rmLinkEff :: [(Point2,Float) -> Room -> Room]
     , _rmPos    :: [RoomPos]
     , _rmPath   :: [(Point2, Point2)]
@@ -142,6 +143,7 @@ data RoomWire
 data RoomPos 
     = OutLink Int    Point2  Float
     | InLink  Point2 Float
+    | UnusedLink Point2 Float
     | PosPl   Point2 Float
     | LabPos  Int    RoomPos
   deriving (Eq,Ord,Show)

src/Dodge/Placements/LightSource.hs

@@ -81,13 +81,13 @@ mntLS shp wallp lampp = mntLSOn shp Nothing defaultLS wallp lampp (const Nothing
 
 mntLSCond :: (Point2 -> Point3 -> Shape) -> ((Point2,Float) -> Bool) -> Placement
 mntLSCond shp cond = updatePSToLevel 2 (const $ PSLnk cond id (const id) Nothing) 
-    $ mntLS shp 0 (V3 0 (-40) 40)
+    $ mntLS shp 0 (V3 0 (-40) 90)
     -- note that this perhaps pushes the vshape light out too far
 
 mntLight :: Point2 -> Point2 -> Placement
 mntLight a b = RandomPlacement $ do
     shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
-    return $ mntLS shp a (addZ 50 b)
+    return $ mntLS shp a (addZ 90 b)
 
 mntLightLnkCond :: ((Point2,Float) -> Bool) -> Placement
 mntLightLnkCond f = RandomPlacement $ do

src/Dodge/Room/Link.hs

@@ -13,7 +13,7 @@ module Dodge.Room.Link
     , randomiseOutLinks
     , randomiseLinksBy
     , invShiftLinkBy
-    , setLastLinkToUsed
+    , finalLinksUpdate
     ) where
 import Dodge.LevelGen
 import Dodge.LevelGen.Data
@@ -78,7 +78,7 @@ shiftRoomToLink l r
     r
   where 
     (p,a) = last $ _rmLinks r
--- NOTE placements are shifted by the room shift
+-- NOTE placements, when placed, will be shifted by the value _rmShift
 shiftRoomBy :: (Point2,Float) -> Room -> Room
 shiftRoomBy shift r = r
     & rmPolys %~ fmap (map (shiftPointBy shift))
@@ -105,9 +105,11 @@ shiftPathBy
     -> (Point2,Point2) 
 shiftPathBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2)
 
-setLastLinkToUsed :: Room -> Room
-setLastLinkToUsed rm = case _rmLinks rm of
+finalLinksUpdate :: Room -> Room
+finalLinksUpdate rm = case _rmLinks rm of
     (_:_) -> rm
         & rmLinks %~ init
-        & rmPos %~ (uncurry InLink (last (_rmLinks rm)) :)
+        & rmPos %~ ( (uncurry InLink (last thelnks) :) . (map (uncurry UnusedLink) (init thelnks) ++) )
     _ -> rm
+  where
+    thelnks = _rmLinks rm

src/Dodge/Wire.hs

@@ -6,5 +6,12 @@ import Geometry
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 
-putWireEnd :: Int -> (Point2,Float) -> Room -> Room
-putWireEnd i pos rm = rm  & rmEndWires %~ IM.insert i (uncurry RoomWire $ invShiftLinkBy (_rmShift rm) pos)
+putWireEndInvRmShift :: Int -> (Point2,Float) -> Room -> Room
+putWireEndInvRmShift i pos rm = 
+    rm & rmEndWires %~ IM.insert i (uncurry RoomWire $ invShiftLinkBy (_rmShift rm) pos)
+
+putWireStart :: Int -> (Point2,Float) -> Room -> Room
+putWireStart i pos rm = rm 
+    & rmStartWires %~ IM.insert i (uncurry RoomWire pos)
+
+