Correct room link position numbering

src/Dodge/Creature.hs

@@ -163,7 +163,7 @@ startCr = defaultCreature
 {- | Items you start with.  -}
 startInvList :: [Item]
 startInvList =
-    [ lasDrones
+    [
     ]
 startInventory :: IM.IntMap Item
 startInventory = IM.fromList $ zip [0..defaultInvSize -1] $ startInvList ++ repeat NoItem
@@ -191,6 +191,7 @@ stackedInventory = IM.fromList (zip [0..25]
     ,flamer
     ,poisonSprayer
     ,launcher
+    ,lasDrones
     --,lasGun
     --,grenade
     --,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher

src/Dodge/Floor.hs

@@ -7,6 +7,7 @@ import Geometry.Data
 import Dodge.Data
 import Dodge.Creature.State.Data
 import Dodge.Room
+import Dodge.Room
 import Dodge.Placement.Instance.Button
 import Dodge.Tree
 import Dodge.Annotation
@@ -34,6 +35,7 @@ import qualified Data.IntMap.Strict as IM
 initialAnoTree :: RandomGen g => Tree [Annotation g]
 initialAnoTree = padSucWithCorridors $ treeFromTrunk 
     [[AnoApplyInt 0 startRoom]
+    , [AnoApplyInt 2 room2]
     , [AnoApplyInt 1 lasSensorTurretTest]
 --    ,[ChainAnos 
 --        [[SetLabel 0 $ return $ roomRectAutoLinks 200 200 

src/Dodge/Item/Data.hs

@@ -38,6 +38,7 @@ data ItemIdentity
     | RemoteLauncher
     | LightningGun
     | PoisonSprayer
+    | FlatShield
   deriving 
     (Eq,Show,Ord,Enum)
 data AimStance

src/Dodge/Item/Equipment.hs

@@ -54,6 +54,7 @@ flatShield = defaultEquipment
     , _itAimStance = TwoHandFlat
     , _itEffect = effectOnOffEquip createShieldWall removeShieldWall
     , _itName   = "SHIELD"
+    , _itIdentity = FlatShield
     }
 flatShieldEquipSPic :: Item -> SPic
 flatShieldEquipSPic _ = 

src/Dodge/Item/Weapon/Drone.hs

@@ -73,5 +73,5 @@ aDroneWithItemParams it cr w = over props (IM.insert i theShell) w
         , _pjVel = rotateV dir (V2 1 0)
         , _prDraw = _amPjDraw am
         , _pjID = i
-        , _pjUpdate = \_ -> id
+        , _pjUpdate = const id
         }

src/Dodge/Layout.hs

@@ -69,9 +69,10 @@ placeRoomWires rm w = IM.foldr ($) w
 
 placeWire :: Room -> RoomWire -> RoomWire -> World -> World
 placeWire rm (WallWire p _ h1) (WallWire q _ h2) = foregroundShape 
-    %~ (col ( (thinHighBarChain h2 $ map (shiftPointBy rs) doOrdering) <> 
-        (barPP 1.5 (addZ h1 p) (addZ h2 p))
-        ) <>
+    %~ (col ( thinHighBarChain h2 (map (shiftPointBy rs) doOrdering) 
+            <> barPP 1.5 (addZ h1 p) (addZ h2 p)
+            ) 
+        <>
         )
   where
     --TODO use rmWalls for non convex rooms

src/Dodge/LevelGen/Data.hs

@@ -113,6 +113,9 @@ psPt ps pt = Placement ps pt Nothing (const Nothing)
 sPS :: Point2 -> Float -> PSType -> Placement
 sPS p a pt = Placement (PS p a) pt Nothing (const Nothing)
 
+sps :: PlacementSpot -> PSType -> Placement
+sps ps pt = Placement ps pt Nothing (const Nothing)
+
 plRRpt :: Int -> PSType -> Placement
 plRRpt i pt = Placement (PSRoomRand i) pt Nothing (const Nothing)
 
@@ -153,6 +156,9 @@ jps0PushPS pst f = Just . Placement (PS (V2 0 0) 0) pst Nothing
 ps0j :: PSType -> Placement -> Placement
 ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (const $ Just plmnt)
 
+psj :: PlacementSpot -> PSType -> Placement -> Placement
+psj ps pst plmnt = Placement ps 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)
 

src/Dodge/LockAndKey.hs

@@ -0,0 +1,18 @@
+module Dodge.LockAndKey where
+import Dodge.Data
+import Dodge.Tree
+import Dodge.LevelGen.Data
+import Dodge.Room
+--import Dodge.Item.Equipment
+
+import System.Random
+import Control.Monad.State
+
+lockRoomKeyItems :: RandomGen g => [ (Int -> State g (SubCompTree Room) , [ItemIdentity] ) ]
+lockRoomKeyItems = 
+    [ (const $ return $ chainUses $ map singleUseAll [door,lasTunnel,door] , [FlatShield] )
+    , (lasCenSensEdge, [FlatShield,Launcher,TeslaGun] )
+    ]
+
+itemRooms :: [(ItemIdentity, Room)]
+itemRooms = []

src/Dodge/Placement/Instance/Sensor.hs

@@ -14,18 +14,19 @@ import Data.Either
 
 damageSensor 
     :: (DamageType -> Either Int Int) -- Left gets sensed, Right does damage
+    -> Float
     -> (Machine -> World -> World)
     -> PlacementSpot -> Placement
-damageSensor damF upf ps = pContID ps ( PutLS theLS)
+damageSensor damF wdth upf ps = pContID ps ( PutLS theLS)
     $ \lsid -> Just $ spNoID ps $ PutMachine yellow (reverse $ square wdth) defaultMachine
-        { _mcDraw = sensorSPic 
+        { _mcDraw = sensorSPic wdth
         , _mcUpdate = \mc w -> upf mc $ sensorUpdate damF mc w
         , _mcLSs = [lsid]
         }
   where
     theLS = defaultLS { _lsPos = V3 0 0 30 , _lsIntensity = 0.1 }
 
-lightSensor :: (Machine -> World -> World) -> PlacementSpot -> Placement
+lightSensor :: Float -> (Machine -> World -> World) -> PlacementSpot -> Placement
 lightSensor = damageSensor senseLasering
 
 senseLasering :: DamageType -> Either Int Int
@@ -47,9 +48,6 @@ sensorUpdate damF mc w = w & machines . ix mcid %~ upmc
     ni = fromIntegral x / 1000
     upls = lsIntensity .~ V3 ni ni ni
 
-sensorSPic :: Machine -> SPic
-sensorSPic _ = ( colorSH yellow $ upperPrismPoly 25 (square wdth)
+sensorSPic :: Float -> Machine -> SPic
+sensorSPic wdth _ = ( colorSH yellow $ upperPrismPoly 25 (square wdth)
     , mempty )
-
-wdth :: Float
-wdth = 10

src/Dodge/Placement/Instance/Wall.hs

@@ -10,6 +10,17 @@ import Color
 import Data.List
 import Control.Lens
 
+heightWallPS :: PlacementSpot -> Float -> [Point2] -> Placement
+heightWallPS spot h ps = psj spot (PutForeground . colorSH col $ upperPrismPoly h ps)
+    $ sps spot $ PutWall ps theWall
+  where
+    col = _wlColor defaultWall
+    theWall = defaultWall
+        { _wlOpacity = SeeAbove
+        , _wlDraw = False
+        , _wlHeight = h
+        }
+
 heightWall :: Float -> [Point2] -> Placement
 heightWall h ps = ps0j (PutForeground . colorSH col $ upperPrismPoly h ps)
     $ sps0 $ PutWall ps theWall

src/Dodge/Placement/PlaceSpot.hs

@@ -62,7 +62,7 @@ placeSpotUsingLink w rm plmnt extract eff fallback = case searchedPoss (_rmPos r
         Nothing -> ((w,rm),[plmnt])
         Just plmnt' -> placeSpot (w,rm) plmnt'
   where
-    searchedPoss [] = error "no correct pos type for lnk placement"
+    searchedPoss [] = Nothing
     searchedPoss (pos:poss) = case extract pos of
         Nothing -> second (pos:) <$> searchedPoss poss
         Just (ps,rmpos) -> Just ( ps,rmpos:poss)

src/Dodge/PlacementSpot.hs

@@ -18,17 +18,22 @@ atFstLnkOut = PSPos f (const id) Nothing
     f (OutLink 0 p a) = Just (PS p a, OutLink 0 p a)
     f _ = Nothing
 
-atFstLnkOutShiftBy :: ((Point2,Float) -> (Point2,Float))
-    -> PlacementSpot
-atFstLnkOutShiftBy theshift = PSPos f (const id) Nothing
+atNthLnkOutShiftBy :: Int -> ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
+atNthLnkOutShiftBy n theshift = PSPos f (const id) Nothing
   where
-    f (OutLink 0 p a) = Just (PS p' a', OutLink 0 p a)
+    f (OutLink i p a) | n == i = Just (PS p' a', OutLink n p a)
       where
         (p',a') = theshift (p,a)
     f _ = Nothing
 
+atFstLnkOutShiftBy :: ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
+atFstLnkOutShiftBy = atNthLnkOutShiftBy 0
+
 atFstLnkOutShiftInward :: Float -> PlacementSpot
-atFstLnkOutShiftInward x = atFstLnkOutShiftBy f
+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)
 

src/Dodge/Room.hs

@@ -1,8 +1,8 @@
-{- 
-Specification of individual rooms.
--}
+{- Specification of individual rooms.  -}
 module Dodge.Room
     ( module Dodge.Room.Room
+    , module Dodge.Room.RoadBlock
+    , module Dodge.Room.LasTurret
     , module Dodge.Room.Foreground
     , module Dodge.LevelGen.Data
     , module Dodge.Room.Procedural
@@ -12,17 +12,17 @@ module Dodge.Room
     , module Dodge.Room.Airlock
     , module Dodge.Room.LongDoor
     , module Dodge.Room.Branch
-    , module Dodge.Room.RoadBlock
     , module Dodge.Room.Teleport
     , module Dodge.Room.Start
     , module Dodge.Room.Boss
     , module Dodge.Room.Treasure
     ) where
 import Dodge.Room.Room
+import Dodge.Room.RoadBlock
+import Dodge.Room.LasTurret
 import Dodge.Room.Treasure
 import Dodge.Room.Boss
 import Dodge.Room.Start
-import Dodge.Room.RoadBlock
 import Dodge.Room.Teleport
 import Dodge.Room.Branch
 import Dodge.Room.Foreground

src/Dodge/Room/Corridor.hs

@@ -22,6 +22,7 @@ corridor = defaultRoom
     , _rmBound = [ rectNSWE 50 30 0 40 ]
     , _rmFloor = [makeTileFromPoly poly 2]  
     , _rmRandPSs = [psRandRanges (10,30) (30,60) (0,2*pi)]
+    , _rmName = "Corridor"
     }
   where 
     poly = rectNSWE 80 0 0 40

src/Dodge/Room/LasTurret.hs

@@ -0,0 +1,81 @@
+module Dodge.Room.LasTurret where
+import Dodge.LevelGen.Data
+import Dodge.PlacementSpot
+import Dodge.Data
+import Dodge.Tree
+import Dodge.Room.Door
+import Dodge.Room.Room
+import Dodge.Room.Corridor
+import Dodge.Room.Link
+--import Dodge.Room.Procedural
+import Dodge.Room.Foreground
+--import Dodge.Room.RoadBlock
+import Dodge.Placement.Instance
+--import Dodge.Item.Random
+--import Dodge.Item.Weapon.BulletGuns
+--import Dodge.Item.Weapon.Utility
+--import Dodge.LevelGen.Data
+--import Geometry.Data
+import Geometry
+--import Padding
+import Color
+import Shape
+
+import Data.Maybe
+import Data.Tree
+import Control.Monad.State
+import Control.Lens
+import System.Random
+
+cenLasTur :: Room
+cenLasTur = roomNgon 8 200 & rmPmnts .~
+    [ putLasTurret 0.02
+    , heightWall 30 (rectNSEW (-90) (-110) 20 (-20))
+    , mntLightLnkCond unusedLnkToPS
+    ]
+
+lightSensInsideDoor :: Room -> Room
+lightSensInsideDoor rm = rm 
+    & rmPmnts %~ ( (psPt atFstLnkOut $ PutForeground $ colorSH yellow $ 
+        thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
+        <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
+        <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)) : )
+    & rmExtPmnt ?~
+        extTrigLitPos (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
+        ( \tp -> Just $ lightSensor 10 (upf $ fromJust $ _plMID tp) (atFstLnkOutShiftInward 100)
+        )
+  where
+    upf trid mc w | _mcSensor mc > 900 = w & triggers . ix trid .~ const True
+        | otherwise = w
+
+lightSensByDoor :: Room -> Room
+lightSensByDoor rm = rm 
+    & rmPmnts %~ ( 
+        [ psPt atFstLnkOut $ PutForeground $ colorSH yellow 
+            $ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)
+        , heightWallPS (atNthLnkOutShiftInward 1 50) 30 (rectNSEW (10) (-10) 20 (-20))
+        , heightWallPS (atFstLnkOutShiftInward 100) 30 (rectNSEW (10) (-10) 20 (-20))
+        ] ++ )
+    & rmExtPmnt ?~
+        extTrigLitPos (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
+        ( \tp -> Just $ lightSensor 20 (upf $ fromJust $ _plMID tp) (atFstLnkOutShiftBy sensorshift)
+        )
+  where
+    sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a)
+    upf trid mc w | _mcSensor mc > 900 = w & triggers . ix trid .~ const True
+        | otherwise = w
+
+lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room)
+lasSensorTurretTest n = do
+    cenroom <- randomiseOutLinks $ (lightSensInsideDoor cenLasTur) {_rmLabel = Just n}
+    let doorroom = switchDoorRoom {_rmTakeFrom = Just n}
+    return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
+
+lasCenSensEdge :: RandomGen g => Int -> State g (SubCompTree Room)
+lasCenSensEdge n = do
+    cenroom <- randomiseOutLinks $ (lightSensByDoor cenLasTur) {_rmLabel = Just n}
+    let doorroom = switchDoorRoom {_rmTakeFrom = Just n}
+    return $ treeFromTrunk [PassDown door] (Node (PassDown cenroom) 
+        [treeFromPost [PassDown doorroom] (UseAll door), treeFromPost [UseNone door] (UseNone corridor)
+        ]
+        )

src/Dodge/Room/LockAndKeyList.hs

@@ -1,19 +0,0 @@
-module Dodge.Room.LockAndKeyList
-    where
-import Dodge.LevelGen.Data
-import Dodge.Room.RoadBlock
-import Dodge.Room.Boss
-
-import Control.Monad.State
-import System.Random
-import Data.Tree
-
-lockAndKeyRoomList :: RandomGen g => 
-    [   (State g (Tree (Either Room Room))
-        ,State g (Tree (Either Room Room))
-        )                                   ]
-lockAndKeyRoomList =
-    [   ( fmap (pure . Right) armouredCorridor
-        , fmap (fmap Left) armouredChasers
-        )
-    ]

src/Dodge/Room/Room.hs

@@ -181,7 +181,7 @@ rot90Around cen p = cen +.+ vNormal (p -.- cen)
 roomMiniIntro :: RandomGen g => State g (SubCompTree Room)
 roomMiniIntro = do
     midroom <- join $ takeOne [miniTree2,glassLesson]
-    return $ chainUses $ [return $ UseAll door, midroom,return $ UseAll corridor]
+    return $ chainUses [return $ UseAll door, midroom,return $ UseAll corridor]
 
 roomCenterPillar :: RandomGen g => State g Room
 roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst) 
@@ -226,6 +226,7 @@ roomNgon n x = defaultRoom
     , _rmPmnts = []
     , _rmBound = [poly]
     , _rmFloor = [makeTileFromPoly poly 9]
+    , _rmName = show n ++ "gon"
     }
   where 
     rot = 2*pi / fromIntegral n

src/Dodge/Room/Start.hs

@@ -1,8 +1,8 @@
-module Dodge.Room.Start 
-    where
+module Dodge.Room.Start where
 import Dodge.LevelGen.Data
 import Dodge.PlacementSpot
 import Dodge.Room.RunPast
+import Dodge.Room.LasTurret
 import Dodge.Data
 import Dodge.Default
 import Dodge.Tree
@@ -49,44 +49,23 @@ minigunfakeout = do
                 ,PassDown keyholeCorridor,PassDown corridor])
         `treeFromPost` UseAll door
 
-centralLasTurret :: Room
-centralLasTurret = roomNgon 8 200 & rmPmnts .~
-    [ putLasTurret 0.02
-    , heightWall 30 (rectNSEW (-90) (-110) 20 (-20))
-    , mntLightLnkCond unusedLnkToPS
-    --, spanColLightI 0.5 98 (V2 0 (-5)) (V2 0 5)
-    , psPt atFstLnkOut $ PutForeground $ colorSH yellow $ 
-        thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
-        <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
-        <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)
-    ]
-    & rmExtPmnt ?~
-        extTrigLitPos (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
-        ( \tp -> Just $ lightSensor (upf $ fromJust $ _plMID tp) (atFstLnkOutShiftInward 100)
-        )
-  where
-    upf trid mc w | _mcSensor mc > 900 = w & triggers . ix trid .~ const True
-        | otherwise = w
-
-lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room)
-lasSensorTurretTest n = do
-    cenroom <- randomiseOutLinks $ centralLasTurret {_rmLabel = Just n}
-    let doorroom = switchDoorRoom {_rmTakeFrom = Just n}
-    return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
 
 rezThenLasTurret :: RandomGen g => State g (SubCompTree Room)
 rezThenLasTurret = do
     rbox <- rezBoxStart
-    cenroom <- randomiseOutLinks $ centralLasTurret {_rmLabel = Just 0}
+    cenroom <- randomiseOutLinks $ (lightSensInsideDoor cenLasTur) {_rmLabel = Just 0}
     let doorroom = switchDoorRoom {_rmTakeFrom = Just 0}
         contTree = treeFromPost [PassDown cenroom,PassDown doorroom] (UseAll door)
     return $ rbox `passUntilUseAll` [contTree]
 
+room2 :: RandomGen g => Int -> State g (SubCompTree Room)
+room2 = lasCenSensEdge    
+
 startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
 startRoom i = join $ takeOne 
     [-- roomMiniIntro
-    minigunfakeout
-    , rezBoxesWp
+    --minigunfakeout
+     rezBoxesWp
     , rezBoxesThenWeaponRoom
     , rezBoxThenWeaponRoom
     , rezBoxesWpCrit
@@ -220,7 +199,7 @@ startRoom' = do
             , tankSquareEmboss4 (dim orange) 50 (h-60)
             , tankSquare (dim orange) 50 50
             , tankSquare (dim orange) 50 120
-            , lightSensor (const id) (PS (V2 (0.8*w) (0.25*h)) 0)
+            , lightSensor 10 (const id) (PS (V2 (0.8*w) (0.25*h)) 0)
             , putLasTurret 0.005 & plSpot .~ PS (V2 (0.8*w) (0.8*h)) 0
             , sps0 $ PutForeground $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
             ]

src/Dodge/RoomComplex.hs

@@ -0,0 +1 @@
+module Dodge.RoomComplex where

src/Dodge/Tree/Compose.hs

@@ -14,9 +14,9 @@ import Data.Tree
 expandTree :: CompTree a -> Tree a
 expandTree (Node root extChildren) = case root of
     Node (UseAll x)     _   -> Node x (map expandTree extChildren)
-    Node (UseSome is x) _   -> Node x (map expandTree $ map (\i -> extChildren !! i) is)
+    Node (UseSome is x) _   -> Node x (map (expandTree . \i -> extChildren !! i) is)
     Node (UseNone _)    _   -> fmap _unCompose root
-    Node (PassDown x)   xs  -> Node x $ map (expandTree . (\ct -> Node ct extChildren)) xs
+    Node (PassDown x)   xs  -> Node x $ map (expandTree . (`Node` extChildren)) xs
     Node (SplitDown x)  xs  -> Node x $ map expandTree $ zipWith Node xs 
             $ map (:[]) extChildren ++ repeat []
 

src/Dodge/Tree/Shift.hs

@@ -9,6 +9,7 @@ import Dodge.Room.Link
 import Dodge.Tree.Polymorphic
 import Geometry.ConvexPoly
 import Geometry.Data
+import Padding
 
 import Data.Tree
 import Data.Sequence hiding (zipWith)
@@ -19,35 +20,40 @@ import Control.Lens hiding (Empty, (<|) , (|>))
 type RoomInt = (Room,Int)
 
 positionRoomsFromTree :: Tree RoomInt -> IO (Maybe [Room])
-positionRoomsFromTree (Node (r,i) ts) = posRms (map pointsToPoly $ _rmBound r) (r,i) ts Empty
+positionRoomsFromTree (Node (r,i) ts) = posRms (map pointsToPoly $ _rmBound r) (r,i) 0 ts Empty
 
 posRms :: [ConvexPoly]
     -> RoomInt
+    -> Int -- ^ the number of children already placed
     -> [Tree RoomInt]
     -> Seq (Tree RoomInt)
     -> IO (Maybe [Room])
-posRms bounds (parent,_) [] st = case st of
+posRms bounds (parent,_) _ [] st = case st of
     Empty -> return $ Just []
     Node childi ts :<| tseq 
-        -> fmap (finalLinksUpdate parent:) <$> posRms bounds childi ts tseq
-posRms bounds parenti (t@(Node (_,i') _):ts) tseq = do
-    putStr $ "Trying to place room " ++ show i' ++ ": "
-    tryLinks 0 (_rmLinks parent)
+        -> fmap (finalLinksUpdate parent:) <$> posRms bounds childi 0 ts tseq
+posRms bounds parenti@(pr,i) numChild (t@(Node (cr,i') _):ts) tseq = do
+    putStr $ (rpns 20 (_rmName cr ++ "-" ++ show i')) 
+          ++ (rpns 9 (" child " ++ show numChild ))
+          ++ (rpns 25 (" of " ++ _rmName pr ++ "-" ++ show i ))
+    tryLinks (0::Int) (_rmLinks parent)
   where
+    rpns x s = rightPadNoSquash x ' ' s
     parent = fst parenti
     tryLinks _ [] = putStrLn "all links tried" >> return Nothing
     tryLinks j (l:ls) 
         | clipping  = tryLinks (j+1) ls
         | otherwise = do
-            putStrLn $ "placing at link " ++ show j
-            mayrs <- posRms (convexBounds ++ bounds) (first upr parenti) ts (tseq |> shiftedt)
+            putStrLn $ "placed at link " ++ show j
+            mayrs <- posRms (convexBounds ++ bounds) 
+                (first upr parenti) (numChild + 1) ts (tseq |> shiftedt)
             case mayrs of
                 Nothing -> putStr ("Backtracking to room " ++ show i' ++ ": ") >> tryLinks (j+1) ls
                 Just rs -> return (Just rs)
       where
         convexBounds = map pointsToPoly $ _rmBound r'
         clipping = or (convexPolysOverlap <$> convexBounds <*> bounds)
-        upr rm = doLnkEff l $ rm & rmLinks %~ delete l & rmPos %~ (uncurry (OutLink j) l :)
+        upr rm = doLnkEff l $ rm & rmLinks %~ delete l & rmPos %~ (uncurry (OutLink numChild) l :)
         l' = shiftLinkBy (_rmShift parent) l
         r' = doRoomShift . fst $ rootLabel shiftedt
         shiftedt = applyToRoot (first $ shiftRoomShiftToLink l') t

src/Padding.hs

@@ -2,6 +2,7 @@
 module Padding
     ( leftPad
     , rightPad
+    , rightPadNoSquash
     , midPad
     , midPadL
     , rotU
@@ -18,6 +19,10 @@ rightPad :: Int -> a -> [a] -> [a]
 {-# INLINE rightPad #-}
 rightPad i x xs = take i $ xs ++ repeat x
 
+rightPadNoSquash :: Int -> a -> [a] -> [a]
+{-# INLINE rightPadNoSquash #-}
+rightPadNoSquash i x xs = take (max i $ length xs) $ xs ++ repeat x
+
 midPad :: Int -> a -> [a] -> [a] -> [a]
 {-# INLINE midPad #-}
 midPad i x xs ys = xs ++ replicate j x ++ ys