diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs
index c78456b18..bf46e500a 100644
--- a/src/Dodge/Data.hs
+++ b/src/Dodge/Data.hs
@@ -110,7 +110,7 @@ data World = World
     , _lClickHammer         :: HammerPosition
     , _distortions          :: [Distortion]
     , _worldBounds          :: Bounds
-    , _gameRooms            :: [GameRoom]
+    , _gameRooms            :: [GameRoom] -- consider using and IntMap
     , _keyConfig            :: KeyConfigSDL
     , _config               :: Configuration
     , _preloadData          :: PreloadData
diff --git a/src/Dodge/Default/Room.hs b/src/Dodge/Default/Room.hs
index 0bfb3365b..5e5776631 100644
--- a/src/Dodge/Default/Room.hs
+++ b/src/Dodge/Default/Room.hs
@@ -26,4 +26,7 @@ defaultRoom = Room
     , _rmStartWires = IM.empty
     , _rmEndWires   = IM.empty
     , _rmConnectsTo = S.singleton OutLink
+    , _rmMID        = Nothing
+    , _rmMParent    = Nothing
+    , _rmChildren   = []
     }
diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs
index 3137941fc..2f3eb43da 100644
--- a/src/Dodge/Floor.hs
+++ b/src/Dodge/Floor.hs
@@ -1,36 +1,35 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
+--{-# OPTIONS_GHC -Wno-unused-imports #-}
 {- | The tree of rooms that make up a level. -}
 module Dodge.Floor
-    ( layoutLevelFromSeed
+    ( initialRoomTree
     ) where
-import Geometry.Data
-import Dodge.Data
+--import Geometry.Data
+--import Dodge.Data
 import Dodge.LockAndKey
-import Dodge.Creature.State.Data
+--import Dodge.Creature.State.Data
 import Dodge.Room
-import Dodge.Placement.Instance.Button
+--import Dodge.Placement.Instance.Button
 import Dodge.Tree
 import Dodge.Annotation
-import Dodge.Creature
-import Dodge.LevelGen.Data
-import Dodge.LevelGen.Switch
-import Dodge.Item.Weapon.Launcher
-import Dodge.PlacementSpot
-import Dodge.RoomPos
-import Dodge.Room.RunPast
-import MonadHelp
+--import Dodge.Creature
+--import Dodge.LevelGen.Data
+--import Dodge.LevelGen.Switch
+--import Dodge.Item.Weapon.Launcher
+--import Dodge.PlacementSpot
+--import Dodge.RoomPos
+--import Dodge.Room.RunPast
+--import MonadHelp
 import Data.Tree
-import Color
-import Dodge.Wire
+--import Color
+--import Dodge.Wire
 
-import Control.Lens
+--import Control.Lens
 import Control.Monad.State
-import Control.Monad.Loops
+--import Control.Monad.Loops
 import System.Random
-import Data.Sequence hiding (zipWith)
-import Data.Maybe
-import qualified Data.IntMap.Strict as IM
-
+--import Data.Sequence hiding (zipWith)
+--import Data.Maybe
+--import qualified Data.IntMap.Strict as IM
 
 initialAnoTree :: RandomGen g => Tree [Annotation g]
 initialAnoTree = padSucWithCorridors $ treeFromTrunk 
@@ -98,38 +97,4 @@ initialRoomTree :: RandomGen g => State g (Tree Room)
 initialRoomTree = do
     expandTree <$> mapM anoToRoomTree initialAnoTree
 
-layoutLevelFromSeed :: Int -> Int -> IO [Room]
-layoutLevelFromSeed i seed = do
-    let i' = i + 1
-    putStrLn $ "Generating level with seed " ++ show seed
-    let g = mkStdGen seed
-    let rmtree = inorderNumberTree $ evalState initialRoomTree g
-    putStrLn "Abstract layout: "
-    putStrLn $ compactDrawTree $ fmap (show . snd) rmtree
-    mrs <- positionRoomsFromTree rmtree
-    case mrs of
-        Just rs -> do
-            putStrLn $ "After " ++ show i' 
-                ++ " attempt(s), Successful generation of level with seed " 
-                ++ show seed
-            --return (fmap setLastLinkToUsed rs)
-            putStrLn $ show (Prelude.length rs) ++ " rooms in total"
-            return rs
-        Nothing -> do
-            putStr $ "Level generation with seed " ++ show seed ++ " failed: "
-            let (seed',_) = random g
-            layoutLevelFromSeed i' seed'
 
-compactDrawTree :: Tree String -> String
-compactDrawTree = unlines . compactDraw
-
-compactDraw :: Tree String -> [String]
-compactDraw (Node x [Node y ts]) = compactDraw (Node (x++","++y) ts)
-compactDraw (Node x ts0) = lines x ++ drawSubTrees ts0
-  where
-    drawSubTrees [] = []
-    drawSubTrees [t] =
-        "|" : compactDraw t
-    drawSubTrees (t:ts) =
-        "|" : shift "+- " "|  " (compactDraw t) ++ drawSubTrees ts
-    shift first other = zipWith (++) (first : repeat other)
diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs
index 7cc61eca5..35062b675 100644
--- a/src/Dodge/Layout.hs
+++ b/src/Dodge/Layout.hs
@@ -15,6 +15,7 @@ import Dodge.GameRoom
 import Dodge.Bounds
 import Dodge.Default.Wall
 import Dodge.Room.Link
+import Dodge.Randify
 import Geometry
 import Geometry.Vector3D
 import Geometry.ConvexPoly
@@ -35,35 +36,41 @@ import Data.Maybe
 import Data.Function
 import Control.Monad.State
 
-generateLevelFromRoomList :: [Room] -> World -> World
+generateLevelFromRoomList :: IM.IntMap Room -> World -> World
 generateLevelFromRoomList gr' w 
     = initWallZoning 
     . setupWorldBounds
     . placeWires
+    . doAfterPlacements
     . doPartialPlacements
     . doExtendedPlacements
-    . flip (mapAccumR doRoomPlacements) rs'
-    . worldToGenWorld
+    . doIndividualPlacements
+--    . flip (mapAccumR doRoomPlacements) (IM.elems rs')
+    . worldToGenWorld rs'
     $ w { _walls        = wallsFromRooms rs
         , _floorTiles   = floorsFromRooms rs
-        , _gameRooms    = gameRoomsFromRooms rs'
+        , _gameRooms    = gameRoomsFromRooms (IM.elems rs')
         , _pathGraph    = path
         , _pathGraphP   = pairPath
         }
   where
     path = pairsToGraph dist pairPath
     pairPath = concatMap _rmPath rs
-    zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w
-    rs = map doRoomShift rs'
-    rs' = mapM shuffleRoomPos (zipWith addTile zs gr') & evalState $ _randGen w
+    rs = map doRoomShift $ IM.elems rs'
+    rs'= mapM (shuffleRoomPos >=> addRandomTile) gr' & evalState $ _randGen w
+
+addRandomTile :: RandomGen g => Room -> State g Room
+addRandomTile r = do
+    z <- state $ randomR (0,63)
+    return $ addTile z r
 
 shuffleRoomPos :: RandomGen g => Room -> State g Room
 shuffleRoomPos rm = do
     newPos <- shuffle $ _rmPos rm
     return $ rm & rmPos .~ newPos
 
-placeWires :: (GenWorld,[Room])-> World
-placeWires (w,rms) = foldr placeRoomWires (_gWorld w) rms
+placeWires :: GenWorld -> World
+placeWires w = foldr placeRoomWires (_gWorld w) $ _gRooms w
 
 placeRoomWires :: Room -> World -> World
 placeRoomWires rm w = IM.foldr ($) w 
@@ -91,8 +98,18 @@ placeWire rm (WallWire p _ h1) (WallWire q _ h2) = foregroundShape
     rightpleftq x = isRHS rmcen p x && isLHS rmcen q x
     rs = _rmShift rm
 
-doPartialPlacements :: ( (IM.IntMap [Placement],GenWorld) , [Room] ) -> (GenWorld,[Room])
-doPartialPlacements ((im,w),rms) = mapAccumR (doPartialPlacement im) w rms
+doAfterPlacements :: GenWorld -> GenWorld
+doAfterPlacements gw = foldr doAfterPlacement gw (_gPlacements gw)
+
+doAfterPlacement :: [(Placement,Int)] -> GenWorld -> GenWorld
+doAfterPlacement pmntis gw = gRandify gw $ do
+    (pmnt,i) <- takeOne pmntis
+    let (newgw,rm) = fst $ placeSpot (gw,_gRooms gw IM.! i) pmnt
+    return $ newgw & gRooms . ix i .~ rm
+
+doPartialPlacements :: ( IM.IntMap [Placement],GenWorld) -> GenWorld
+doPartialPlacements (im,w) = let (gw,rms) = mapAccumR (doPartialPlacement im) w (_gRooms w)
+    in gw {_gRooms = rms}
 
 doPartialPlacement :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room)
 doPartialPlacement im w rm = case _rmPartPmnt rm of
@@ -101,8 +118,9 @@ doPartialPlacement im w rm = case _rmPartPmnt rm of
         Nothing -> (w, rm)
         Just i  -> fst $ placeSpot (w,rm) (fi (im IM.! i))
 
-doExtendedPlacements :: (GenWorld,[Room]) -> ( (IM.IntMap [Placement], GenWorld) , [Room] )
-doExtendedPlacements (w,rms) = mapAccumR doExtendedPlacement (IM.empty,w) rms
+doExtendedPlacements :: GenWorld -> ( IM.IntMap [Placement], GenWorld)
+doExtendedPlacements w = let ((pmnts,gw),rms) = mapAccumR doExtendedPlacement (IM.empty,w) (_gRooms w)
+    in (pmnts,gw{_gRooms = rms})
 
 doExtendedPlacement :: (IM.IntMap [Placement], GenWorld) -> Room 
     -> ( (IM.IntMap [Placement], GenWorld) , Room )
@@ -113,6 +131,10 @@ doExtendedPlacement (im,w) rm = case _rmExtPmnt rm of
         Just i  -> let ((neww,newrm),plmnts) = placeSpot (w,rm) plmnt
             in ( (IM.insert i plmnts im, neww) , newrm )
 
+doIndividualPlacements :: GenWorld -> GenWorld
+doIndividualPlacements gw = let (gw', rms) = mapAccumR doRoomPlacements gw (_gRooms gw)
+    in gw' {_gRooms = rms}
+
 doRoomPlacements :: GenWorld -> Room -> (GenWorld, Room)
 doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm
 
@@ -142,16 +164,18 @@ initWallZoning w = foldl' (flip insertWallInZones) (w & wallsZone . znObjects .~
 --makePath = concatMap _rmPath . flatten
 
 wallsFromRooms :: [Room] -> IM.IntMap Wall
-wallsFromRooms =
---    divideWalls .
-    IM.fromList . zipWith f [0..] . removeInverseWalls 
-        . foldl' (flip cutWalls) [] . concatMap _rmPolys
+wallsFromRooms = --    divideWalls .
+    IM.fromAscList 
+    . zipWith f [0..] 
+    . removeInverseWalls 
+    . foldl' (flip cutWalls) [] 
+    . concatMap _rmPolys
   where
     f i (x,y) = (i, defaultWall {_wlLine = (x,y) , _wlID = i})
 
 -- TODO sort out shifting before or after etc
 gameRoomsFromRooms :: [Room] -> [GameRoom]
-gameRoomsFromRooms = map gameRoomFromRoom
+gameRoomsFromRooms = fmap gameRoomFromRoom
 
 gameRoomFromRoom :: Room -> GameRoom
 gameRoomFromRoom rm = GameRoom
diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs
index 91cca547a..7c80f49c0 100644
--- a/src/Dodge/LevelGen.hs
+++ b/src/Dodge/LevelGen.hs
@@ -8,10 +8,14 @@ import Dodge.Floor
 import Dodge.Layout
 import Dodge.Initialisation
 import Dodge.RandomHelp
+import Dodge.LevelGen.Data
+import Dodge.Tree
 
+import Data.Tree
 import System.Random
 import Control.Lens
 import Control.Monad.State
+import qualified Data.IntMap.Strict as IM
 
 generateWorldFromSeed :: Int -> IO World
 generateWorldFromSeed i = do
@@ -21,3 +25,42 @@ generateWorldFromSeed i = do
 
 randomCompass :: World -> World
 randomCompass w = w & cameraRot .~ (takeOne [0,0.5*pi,pi,1.5*pi] & evalState $ _randGen w)
+
+layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room)
+layoutLevelFromSeed i seed = do
+    let i' = i + 1
+    putStrLn $ "Generating level with seed " ++ show seed
+    let g = mkStdGen seed
+    let rmtree = inorderNumberTree $ evalState initialRoomTree g
+    putStrLn "Abstract layout: "
+    putStrLn $ compactDrawTree $ fmap (show . snd) rmtree
+    mrs <- positionRoomsFromTree rmtree
+    case mrs of
+        Just rs -> do
+            putStrLn $ "After " ++ show i' 
+                ++ " attempt(s), Successful generation of level with seed " 
+                ++ show seed
+            --return (fmap setLastLinkToUsed rs)
+            putStrLn $ show (Prelude.length rs) ++ " rooms in total"
+            return . IM.fromList $ map reversePair rs
+        Nothing -> do
+            putStr $ "Level generation with seed " ++ show seed ++ " failed: "
+            let (seed',_) = random g
+            layoutLevelFromSeed i' seed'
+
+reversePair :: (a,b) -> (b,a)
+reversePair (a,b) = (b,a)
+
+compactDrawTree :: Tree String -> String
+compactDrawTree = unlines . compactDraw
+
+compactDraw :: Tree String -> [String]
+compactDraw (Node x [Node y ts]) = compactDraw (Node (x++","++y) ts)
+compactDraw (Node x ts0) = lines x ++ drawSubTrees ts0
+  where
+    drawSubTrees [] = []
+    drawSubTrees [t] =
+        "|" : compactDraw t
+    drawSubTrees (t:ts) =
+        "|" : shift "+- " "|  " (compactDraw t) ++ drawSubTrees ts
+    shift first other = zipWith (++) (first : repeat other)
diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs
index 7a57f9031..e8ad5fa7d 100644
--- a/src/Dodge/LevelGen/Data.hs
+++ b/src/Dodge/LevelGen/Data.hs
@@ -21,19 +21,18 @@ data PSType = PutCrit {_unPutCrit :: Creature}
     | PutButton Button
     | PutProp Prop
     | PutFlIt Item
-    | PutPressPlate PressPlate
-    | PutBlock BlockMaterial [Int] Wall [Point2]
-    | PutCoordinate Point2
+    | PutPPlate PressPlate
+    | PutBlock BlockMaterial Int [Int] Wall [Point2]
+    | PutCoord Point2
     | PutMod Modification
     | PutTrigger (World -> Bool)
     | PutLineBlock Wall BlockMaterial Float Float Point2 Point2
     | PutWall { _pwPoly :: [Point2] , _pwWall :: Wall }
-    | PutSlideDoor Bool Color (World -> Bool) Point2 Point2 Float
+    | PutSlideDr Bool Color (World -> Bool) Point2 Point2 Float
     | PutDoor Color (World -> Bool) [(Point2,Point2)]
     | RandPS (State StdGen PSType)
-    | PutForeground Shape
+    | PutShape Shape
     | PutWorldUpdate (PlacementSpot -> World -> World)
-    | AddToPList Int PSType
     | PutNothing
     | PutID { _putID :: Int}
 -- maybe there is a monadic implementation of this?
@@ -49,15 +48,16 @@ data PlacementSpot
         { _psRoomRandPointNum :: Int 
         , _psRandShift :: (Point2,Float) -> PlacementSpot
         }
-data Placement = Placement 
-    { _plSpot   :: PlacementSpot
-    , _plType   :: PSType
-    , _plMID    :: Maybe Int
-    , _plIDCont :: Placement -> Maybe Placement 
-    }
-  | PlacementUsingPos Point3 (Point3 -> Placement)  -- allows a placement to use a shifted position
-  | RandomPlacement {_unRandomPlacement :: State StdGen Placement}
-
+data Placement 
+    = Placement 
+        { _plSpot   :: PlacementSpot
+        , _plType   :: PSType
+        , _plMID    :: Maybe Int
+        , _plIDCont :: Placement -> Maybe Placement 
+        }
+    | PlacementUsingPos Point3 (Point3 -> Placement)  -- allows a placement to use a shifted position
+    | RandomPlacement {_unRandomPlacement :: State StdGen Placement}
+    | PickOnePlacement Int Placement
 
 {- The '_rmPolys' lists which polygons should be cut out to form the indestructible walls of the room.
 Link pairs contain a position and rotation to attach to another room;
@@ -89,6 +89,9 @@ data Room = Room
     , _rmStartWires :: IM.IntMap RoomWire
     , _rmEndWires   :: IM.IntMap RoomWire
     , _rmConnectsTo :: S.Set RoomLinkType
+    , _rmMID        :: Maybe Int
+    , _rmMParent    :: Maybe Int
+    , _rmChildren   :: [Int]
     }
 data RoomLink = RoomLink
     { _rlType   :: S.Set RoomLinkType
@@ -212,6 +215,7 @@ 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)
+    PickOnePlacement {} -> error "not written how to combine PickOnePlacement with others yet"
   where
     g Nothing = Just pl
     g (Just pl') = Just $ addPlmnt pl pl'
diff --git a/src/Dodge/LevelGen/LevelStructure.hs b/src/Dodge/LevelGen/LevelStructure.hs
index d542e4a11..1678387b3 100644
--- a/src/Dodge/LevelGen/LevelStructure.hs
+++ b/src/Dodge/LevelGen/LevelStructure.hs
@@ -12,7 +12,13 @@ import Control.Lens
 
 data GenWorld = GenWorld
     { _gWorld       :: World
-    , _gPlacements  :: IM.IntMap [Placement]
+    , _gPlacements  :: IM.IntMap [(Placement,Int)]
+    , _gRooms       :: IM.IntMap Room
+    }
+worldToGenWorld :: IM.IntMap Room -> World -> GenWorld
+worldToGenWorld rms w = GenWorld 
+    { _gWorld = w
+    , _gPlacements = IM.empty
+    , _gRooms = rms
     }
-worldToGenWorld w = GenWorld w IM.empty
 makeLenses ''GenWorld
diff --git a/src/Dodge/Placement/Instance/Door.hs b/src/Dodge/Placement/Instance/Door.hs
index 1316114d2..2013caae2 100644
--- a/src/Dodge/Placement/Instance/Door.hs
+++ b/src/Dodge/Placement/Instance/Door.hs
@@ -15,8 +15,8 @@ putDoubleDoor pathing col cond a b speed = putDoubleDoorThen pathing col cond a
 
 putDoubleDoorThen :: Bool -> Color -> (World -> Bool) 
     -> Point2 -> Point2 -> Float -> Maybe Placement -> Placement
-putDoubleDoorThen pathing col cond a b speed mayp = ps0j (PutSlideDoor pathing col cond a half speed)
-    $ Placement (PS (V2 0 0) 0) ( PutSlideDoor pathing col cond b half speed) Nothing $ const mayp
+putDoubleDoorThen pathing col cond a b speed mayp = ps0j (PutSlideDr pathing col cond a half speed)
+    $ Placement (PS (V2 0 0) 0) ( PutSlideDr pathing col cond b half speed) Nothing $ const mayp
   where
     half = 0.5 *.* (a +.+ b)
 
@@ -33,8 +33,8 @@ putAutoDoor a b = PlacementUsingPos (addZ 0 a)
 
 switchDoor :: Point2 -> Float -> Point2 -> Point2 -> Color -> Placement
 switchDoor btpos btrot dra drb col = pContID (PS btpos btrot) (PutButton $ makeSwitch col red id id)
-    $ \btid -> jsps0J (PutSlideDoor False col (cond btid) dra drc 2)
-    $          sps0   (PutSlideDoor False col (cond btid) drb drc 2)
+    $ \btid -> jsps0J (PutSlideDr False col (cond btid) dra drc 2)
+    $          sps0   (PutSlideDr False col (cond btid) drb drc 2)
   where
     drc = 0.5 *.* (dra +.+ drb)
     cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
diff --git a/src/Dodge/Placement/Instance/LightSource.hs b/src/Dodge/Placement/Instance/LightSource.hs
index e58e6d258..0f3479800 100644
--- a/src/Dodge/Placement/Instance/LightSource.hs
+++ b/src/Dodge/Placement/Instance/LightSource.hs
@@ -20,7 +20,7 @@ mntLSOn
     -> Maybe Color  -- ^ describing a possible color override for the shape
     -> LightSource -> Point2 -> Point3 -> (Placement -> Maybe Placement) -> Placement
 mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _)
-    = ps0jPushPS (PutForeground . setCol $ shapeF wallp lsp)
+    = ps0jPushPS (PutShape . setCol $ shapeF wallp lsp)
     . pt0 (PutLS $ ls {_lsPos = lsp'})
   where
     lsp' = lsp -.-.- V3 x y 1
@@ -106,20 +106,20 @@ unusedLnkToPS rp _ = case rp of
 
 spanLSLightI :: LightSource -> Float -> Point2 -> Point2 -> Placement
 spanLSLightI ls h a b = ps0j (PutLS ls {_lsPos = V3 x y h})
-    $ sps0 $ PutForeground $ thinHighBar h a b
+    $ sps0 $ PutShape $ thinHighBar h a b
   where
     V2 x y = 0.5 *.* (a +.+ b)
 
 spanLS :: LightSource -> Point2 -> Point2 -> Placement
 spanLS ls a b = Placement (PS (V2 x y) 0) (PutLS ls) Nothing
-    $ const $ Just $ sps0 $ PutForeground $ thinHighBar h a b
+    $ const $ Just $ sps0 $ PutShape $ thinHighBar h a b
   where
     V3 _ _ h = _lsPos ls + 5
     V2 x y = 0.5 *.* (a +.+ b)
 
 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
+    $ sps0 $ PutShape $ thinHighBar h a b
   where
     V2 x y = 0.5 *.* (a +.+ b)
 
diff --git a/src/Dodge/Placement/Instance/Tank.hs b/src/Dodge/Placement/Instance/Tank.hs
index ae4141568..d9b1f1cca 100644
--- a/src/Dodge/Placement/Instance/Tank.hs
+++ b/src/Dodge/Placement/Instance/Tank.hs
@@ -12,7 +12,7 @@ import Color
 
 roundTank :: Color -> Float -> Float -> Placement
 roundTank col x y = shiftPlacement (V2 x y,0) $ ps0j 
-    (PutForeground $ colorSH col $ 
+    (PutShape $ colorSH col $ 
         upperPrismPoly 31 thecircle
         <> foldMap toprail ( take 8 [0,pi/4..]) 
     )
@@ -23,7 +23,7 @@ roundTank col x y = shiftPlacement (V2 x y,0) $ ps0j
 
 roundTankCross :: Color -> Float -> Float -> Placement
 roundTankCross col x y = shiftPlacement (V2 x y,0) $ ps0j 
-    (PutForeground $ colorSH col $ 
+    (PutShape $ colorSH col $ 
         upperPrismPoly 31 thecircle
         <> thinHighBar 31 (V2 20 0) (V2 (-20) 0)
         <> thinHighBar 31 (V2 0 20) (V2 0 (-20))
@@ -34,7 +34,7 @@ roundTankCross col x y = shiftPlacement (V2 x y,0) $ ps0j
 
 tankRectCross :: Float -> Float -> Color -> Float -> Float -> Placement
 tankRectCross w h col x y = shiftPlacement (V2 x y,0) $ ps0j
-    (PutForeground $ colorSH col $
+    (PutShape $ colorSH col $
         upperPrismPoly 31 therect
         <> thinHighBar 31 (V2 w 0) (V2 (-w) 0)
         <> thinHighBar 31 (V2 0 h) (V2 0 (-h))
@@ -49,7 +49,7 @@ tankSquareCross = tankRectCross 20 20
 
 tankRect :: Float -> Float -> Color -> Float -> Float -> Placement
 tankRect w h col x y = shiftPlacement (V2 x y,0) $ ps0j
-    (PutForeground $ colorSH col
+    (PutShape $ colorSH col
         $ upperPrismPoly 31 therect
         <> foldMap f [(w',-w',h',h'),(w',-w',-h',-h'),(w',w',h',-h'),(-w',-w',h',-h')]
     )
@@ -65,7 +65,7 @@ tankSquare = tankRect 20 20
 
 tankRectEmboss :: Float -> Float -> Color -> Float -> Float -> Placement
 tankRectEmboss w h col x y = shiftPlacement (V2 x y,0) $ ps0j
-    (PutForeground $ colorSH col $
+    (PutShape $ colorSH col $
         upperPrismPoly 31 therect
         <> embossingR
         <> rotateSH pi embossingR
@@ -84,7 +84,7 @@ tankSquareEmboss = tankRectEmboss 20 20
 
 tankRectEmboss4 :: Float -> Float -> Color -> Float -> Float -> Placement
 tankRectEmboss4 w h col x y = shiftPlacement (V2 x y,0) $ ps0j
-    (PutForeground $ colorSH col $
+    (PutShape $ colorSH col $
         upperPrismPoly 31 therect
         <> foldMap f [(w,h),(-w,h),(w,-h),(-w,-h)]
     )
diff --git a/src/Dodge/Placement/Instance/Wall.hs b/src/Dodge/Placement/Instance/Wall.hs
index 71db3d0ef..217f18dc5 100644
--- a/src/Dodge/Placement/Instance/Wall.hs
+++ b/src/Dodge/Placement/Instance/Wall.hs
@@ -11,7 +11,7 @@ import Data.List
 import Control.Lens
 
 heightWallPS :: PlacementSpot -> Float -> [Point2] -> Placement
-heightWallPS spot h ps = psj spot (PutForeground . colorSH col $ upperPrismPoly h ps)
+heightWallPS spot h ps = psj spot (PutShape . colorSH col $ upperPrismPoly h ps)
     $ sps spot $ PutWall ps theWall
   where
     col = _wlColor defaultWall
@@ -22,7 +22,7 @@ heightWallPS spot h ps = psj spot (PutForeground . colorSH col $ upperPrismPoly
         }
 
 heightWall :: Float -> [Point2] -> Placement
-heightWall h ps = ps0j (PutForeground . colorSH col $ upperPrismPoly h ps)
+heightWall h ps = ps0j (PutShape . colorSH col $ upperPrismPoly h ps)
     $ sps0 $ PutWall ps theWall
   where
     col = _wlColor defaultWall
@@ -33,7 +33,7 @@ heightWall h ps = ps0j (PutForeground . colorSH col $ upperPrismPoly h ps)
         }
 
 midWall :: [Point2] -> Placement
-midWall ps = ps0j (PutForeground . colorSH col $ upperPrismPoly 50 ps)
+midWall ps = ps0j (PutShape . colorSH col $ upperPrismPoly 50 ps)
     $ sps0 $ PutWall ps theWall
   where
     col = _wlColor defaultWall
@@ -47,7 +47,7 @@ midWall ps = ps0j (PutForeground . colorSH col $ upperPrismPoly 50 ps)
 singleBlock :: Point2 -> [Placement]
 singleBlock a = 
     [sPS a 0 
-        $ PutBlock StoneBlock [5,20,20] baseBlockPane
+        $ PutBlock StoneBlock 5 [20,20] baseBlockPane
         $ reverse 
         $ square 10
     ]
diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs
index f05393774..d9d578729 100644
--- a/src/Dodge/Placement/PlaceSpot.hs
+++ b/src/Dodge/Placement/PlaceSpot.hs
@@ -22,6 +22,7 @@ import Shape
 import qualified IntMapHelp as IM
 import Color
 
+import Data.Maybe
 import System.Random
 import Control.Monad.State
 import Control.Lens
@@ -34,23 +35,34 @@ placeSpot :: (GenWorld,Room) -> Placement -> ( (GenWorld,Room), [Placement] )
 placeSpot (w,rm) plmnt = case plmnt of
     Placement{_plSpot = PSRoomRand i f} -> placeSpotRoomRand rm i f plmnt w
     Placement{_plSpot = PSPos 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
-        in maybe ((w',rm),[newplmnt]) (recrPlace newplmnt w') (_plIDCont plmnt newplmnt)
-      where
-        recrPlace newplmnt w' pl = let (wr,newplmnts) = placeSpot (w',rm) pl
-                        in (wr,newplmnt:newplmnts)
-            -- (placeSpot (w',rm)) (_plIDCont plmnt i)
+    Placement{} -> placePlainPSSpot w rm plmnt shift
     PlacementUsingPos p subpl -> placeSpot (w,rm) (subpl (shiftPoint3By shift p))
-    RandomPlacement rplmnt -> placeSpot (w & gWorld . randGen .~ g,rm) plmnt'
-      where
-        (plmnt', g) = runState rplmnt (_randGen $ _gWorld w)
+    RandomPlacement rplmnt -> placeRandomPlacement rplmnt w rm
+    PickOnePlacement i pl -> ((placePickOne i pl rm w, rm), [])
   where
     shift = _rmShift rm
 
+placePickOne :: Int -> Placement -> Room -> GenWorld -> GenWorld
+placePickOne i pl rm w = w & gPlacements %~ IM.insertWith (++) i [(pl, fromJust (_rmMID rm))]
+
+placeRandomPlacement :: State StdGen Placement -> GenWorld -> Room -> ((GenWorld,Room),[Placement])
+placeRandomPlacement rplmnt w rm = placeSpot (w & gWorld . randGen .~ g,rm) plmnt'
+  where
+    (plmnt', g) = runState rplmnt (_randGen $ _gWorld w)
+
+placePlainPSSpot :: GenWorld -> Room -> Placement -> DPoint2 -> ((GenWorld,Room),[Placement])
+placePlainPSSpot w rm plmnt shift = 
+    let (i,w') = placeSpotID (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
+        newplmnt = plmnt & plMID ?~ i
+    in maybe ((w',rm),[newplmnt]) (recrPlace newplmnt w') (_plIDCont plmnt newplmnt)
+  where
+    recrPlace newplmnt w' pl = let (wr,newplmnts) = placeSpot (w',rm) pl
+                    in (wr,newplmnt:newplmnts)
+
 -- this should be tidied up
-placeSpotUsingLink :: GenWorld -> Room -> Placement 
+placeSpotUsingLink :: GenWorld 
+    -> Room 
+    -> Placement 
     -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
     -> (RoomPos -> Room -> Room)
     -> Maybe Placement
@@ -66,44 +78,47 @@ placeSpotUsingLink w rm plmnt extract eff fallback = case searchedPoss (_rmPos r
         Nothing -> second (pos:) <$> searchedPoss poss
         Just (ps,rmpos) -> Just ( ps,rmpos:poss)
 
-placeSpotRoomRand :: Room -> Int -> ((Point2,Float) -> PlacementSpot) 
+placeSpotRoomRand :: Room -> Int -> (DPoint2 -> PlacementSpot) 
     -> Placement -> GenWorld -> ((GenWorld,Room),[Placement])
 placeSpotRoomRand rm i f plmnt w =
     let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen (_gWorld w)
     in placeSpot (w & gWorld . randGen .~ g,rm) (plmnt & plSpot .~ f ps)
 
-
-
 -- the Int here is some id that is assigned when the placement is placed
 placeSpotID :: PlacementSpot -> PSType -> GenWorld -> (Int, GenWorld)
 placeSpotID ps pt w = case pt of
-    PutTrigger cond -> placeNewInto triggers cond w
-    PutMod     modi -> plNewUpID modifications mdID modi w
-    PutProp prop    -> plNewUpID props pjID (mvProp p rot prop) w
-    PutButton bt    -> plNewUpID buttons btID (mvButton p rot bt) w
-    PutFlIt itm     -> plNewUpID floorItems flItID (createFlIt p rot itm) w
-    PutCrit cr      -> plNewUpID creatures crID (mvCr p rot cr) w
-    PutMachine col wallpoly mc -> placeMachine col (map doShift wallpoly) mc p rot w
-    PutLS ls        -> plNewUpID lightSources lsID (mvLS p' rot ls) w
-    PutPressPlate pp -> plNewUpID pressPlates ppID (mvPP p rot pp) w
-    RandPS rgen -> evaluateRandPS rgen ps w
-    PutDoor col f pss -> placeDoor col f (map (bimap doShift doShift) pss) w
-    PutCoordinate coordp -> placeNewInto coordinates (doShift coordp) w
-    PutSlideDoor pathing col f a b spd -> placeSlideDoor pathing col f (doShift a) (doShift b) spd w
-    PutBlock bm (hp:hps) wl ps' -> placeBlock (map doShift ps') hp wl hps bm w
-    PutBlock{} -> error "messed up block placement somehow"
+    PutTrigger  cnd         -> placeNewInto triggers cnd w
+    PutMod      mdi         -> plNewUpID modifications mdID mdi w
+    PutProp     prp         -> plNewUpID props pjID (mvProp p rot prp) w
+    PutButton   bt          -> plNewUpID buttons btID (mvButton p rot bt) w
+    PutFlIt     itm         -> plNewUpID floorItems flItID (createFlIt p rot itm) w
+    PutCrit     cr          -> plNewUpID creatures crID (mvCr p rot cr) w
+    PutMachine  col pps mc  -> placeMachine col (map doShift pps) mc p rot w
+    PutLS       ls          -> plNewUpID lightSources lsID (mvLS p' rot ls) w
+    PutPPlate   pp          -> plNewUpID pressPlates ppID (mvPP p rot pp) w
+    RandPS      rgn         -> evaluateRandPS rgn ps w
+    PutDoor     col f   pss -> placeDoor col f (map (bimap doShift doShift) pss) w
+    PutCoord    cp          -> placeNewInto coordinates (doShift cp) w
+    PutSlideDr  pth col f  a   b spd 
+                            -> placeSlideDoor pth col f (doShift a) (doShift b) spd w
+    PutBlock    bm  hp  hps wl  ps' 
+                            -> placeBlock (map doShift ps') hp wl hps bm w
     PutLineBlock wl bm wdth dpth a b -> placeLineBlock wl bm wdth dpth (doShift a) (doShift b) w
-    PutWall { _pwPoly = ps', _pwWall = wl } -> (0,placeWallPoly (map doShift ps') wl w)
-    PutForeground sh -> (0,w & gWorld . foregroundShape %~ ((uncurryV translateSHf p . rotateSH rot) sh <>))
-    PutNothing -> (0,w)
-    PutID i -> (i, w)
-    PutWorldUpdate f -> (0,w & gWorld %~ f ps)
+    PutWall     qs  wl      -> (0,placeWallPoly (map doShift qs) wl w)
+    PutShape    sh          -> placeShape sh p rot w
+    PutNothing              -> (0,w)
+    PutID i                 -> (i, w)
+    PutWorldUpdate f        -> (0,w & gWorld %~ f ps)
   where 
     p@(V2 px py) = _psPos ps
     p' = V3 px py 0
     rot = _psRot ps
     doShift = shiftPointBy (p,rot)
 
+placeShape :: Shape -> Point2 -> Float -> GenWorld -> (Int, GenWorld)
+placeShape sh p rot w = 
+    (0, w & gWorld . foregroundShape %~ ((uncurryV translateSHf p . rotateSH rot) sh <>))
+
 evaluateRandPS :: State StdGen PSType -> PlacementSpot -> GenWorld -> (Int,GenWorld)
 evaluateRandPS rgen ps w = placeSpotID ps evaluatedType (set (gWorld . randGen) g w)
   where 
@@ -114,7 +129,6 @@ placeWallPoly ps wl = gWorld %~ (rmCrossPaths . over walls (addWalls ps wl))
   where
     rmCrossPaths w = foldr (uncurry removePathsCrossing) w $ loopPairs ps
 
-
 addWalls :: [Point2] -> Wall -> IM.IntMap Wall -> IM.IntMap Wall
 addWalls qs wl wls = foldr (addPane wl) wls pairs
   where 
@@ -134,7 +148,7 @@ placeNewInto :: ALens' World (IM.IntMap a)
     -> (Int,GenWorld)
 placeNewInto l x w = (i,w & gWorld . l #%~ IM.insert i x)
   where
-    i = IM.newKey $ (_gWorld w) ^# l
+    i = IM.newKey $ _gWorld w ^# l
 
 -- | place an new object into an intmap and update its id
 plNewUpID :: ALens' World (IM.IntMap a)
@@ -144,7 +158,7 @@ plNewUpID :: ALens' World (IM.IntMap a)
     -> (Int,GenWorld)
 plNewUpID l li x w = (i,w & gWorld . l #%~ IM.insert i (x & li #~ i))
   where
-    i = IM.newKey $ (_gWorld w) ^# l
+    i = IM.newKey $ _gWorld w ^# l
 
 mvProp :: Point2 -> Float -> Prop -> Prop
 mvProp p a = (pjRot +~ a) . (pjPos %~ ( (p +.+) . rotateV a ))
diff --git a/src/Dodge/Placement/PlaceSpot/Block.hs b/src/Dodge/Placement/PlaceSpot/Block.hs
index 88a34978e..348160177 100644
--- a/src/Dodge/Placement/PlaceSpot/Block.hs
+++ b/src/Dodge/Placement/PlaceSpot/Block.hs
@@ -73,7 +73,7 @@ placeLineBlock
     -> GenWorld 
     -> (Int, GenWorld)
 placeLineBlock basePane bm blockWidth depth a b gw = ( 0 
-    , gw & gWorld .~ (removePathsCrossing a b $ foldr insertWall (insertBlocks w) listWalls)
+    , gw & gWorld .~ removePathsCrossing a b (foldr insertWall (insertBlocks w) listWalls)
     )
   where 
     w = _gWorld gw
diff --git a/src/Dodge/Placement/Shift.hs b/src/Dodge/Placement/Shift.hs
index cd7e0b767..36f821a8b 100644
--- a/src/Dodge/Placement/Shift.hs
+++ b/src/Dodge/Placement/Shift.hs
@@ -17,3 +17,4 @@ shiftPlacement shift plmnt = case plmnt of
     PlacementUsingPos p f -> PlacementUsingPos (shiftPoint3By shift p)
         (fmap (shiftPlacement shift) f)
     RandomPlacement rpl -> RandomPlacement $ fmap (shiftPlacement shift) rpl
+    PickOnePlacement i pl -> PickOnePlacement i (shiftPlacement shift pl)
diff --git a/src/Dodge/Randify.hs b/src/Dodge/Randify.hs
new file mode 100644
index 000000000..a0496a525
--- /dev/null
+++ b/src/Dodge/Randify.hs
@@ -0,0 +1,11 @@
+module Dodge.Randify where
+import Dodge.Data
+import Dodge.LevelGen.LevelStructure
+
+import System.Random
+import Control.Monad.State
+import Control.Lens
+
+gRandify :: GenWorld -> State StdGen GenWorld -> GenWorld
+gRandify gw mw = let (gw',g) = runState mw (_randGen $ _gWorld gw)
+    in gw' & gWorld . randGen .~ g
diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs
index 4deb19320..0364d53ce 100644
--- a/src/Dodge/Room/Airlock.hs
+++ b/src/Dodge/Room/Airlock.hs
@@ -31,7 +31,7 @@ airlock0 = defaultRoom
             $ \btid -> Just $ putDoubleDoorThen False col (not . cond' btid) (V2 (-1) 20) (V2 41 20) 2
                 $ Just $ putDoubleDoorThen False col (cond' btid) (V2 (-1) 80) (V2 41 80) 2 Nothing
         ,spanLightI (V2 (-2) 30) (V2 (-2) 70)
-        ,sps0 $ PutForeground $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
+        ,sps0 $ PutShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
         ]
     , _rmBound = [rectNSWE 75 15 0 40]
     }
@@ -91,7 +91,7 @@ airlockZ = defaultRoom
     inDoorps  = (V2 0 0 ,) <$> arcStepwise 3 (pi/2) (V2 0 0) (V2 (-61) 0)
     cenlight  = mntLS vShape (V2 90 60) (V3 90 40 50) `addPlmnt` mntLS vShape (V2 90 60) (V3 90 80 50)
     cornlight = mntLS vShape (V2 0 120) (V3 30 90 50) `addPlmnt` mntLS vShape (V2 180 120) (V3 150 90 50)
-        `addPlmnt` sps0 (PutForeground (thinHighBar 50 (V2 30 90) (V2 150 90)))
+        `addPlmnt` sps0 (PutShape (thinHighBar 50 (V2 30 90) (V2 150 90)))
     lighting = RandomPlacement $ takeOne [cenlight,cornlight]
 
 airlock90 :: Room
diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs
index 77550e1ab..4657d8635 100644
--- a/src/Dodge/Room/LasTurret.hs
+++ b/src/Dodge/Room/LasTurret.hs
@@ -36,7 +36,7 @@ cenLasTur = roomNgon 8 200 & rmPmnts .~
 
 lightSensInsideDoor :: Room -> Room
 lightSensInsideDoor rm = rm 
-    & rmPmnts %~ ( (psPt atFstLnkOut $ PutForeground $ colorSH yellow $ 
+    & rmPmnts %~ ( (psPt atFstLnkOut $ PutShape $ 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)) : )
@@ -51,7 +51,7 @@ lightSensInsideDoor rm = rm
 lightSensByDoor :: Room -> Room
 lightSensByDoor rm = rm 
     & rmPmnts %~ ( 
-        [ psPt atFstLnkOut $ PutForeground $ colorSH yellow 
+        [ psPt atFstLnkOut $ PutShape $ colorSH yellow 
             $ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)
         , heightWallPS (atNthLnkOutShiftInward 1 100) 30 (rectNSEW 10 (-10) 20 (-20))
         , heightWallPS (atFstLnkOutShiftInward 100) 30 (rectNSEW 10 (-10) 20 (-20))
diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs
index 0879f94da..ef4642967 100644
--- a/src/Dodge/Room/Link.hs
+++ b/src/Dodge/Room/Link.hs
@@ -20,7 +20,7 @@ module Dodge.Room.Link
     , restrictRMInLinksPD
     ) where
 import Dodge.ShiftPoint
-import Dodge.Placement.PlaceSpot
+--import Dodge.Placement.PlaceSpot
 import Dodge.LevelGen.Data
 import Dodge.RandomHelp
 import Geometry
diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs
index 93b272c1b..719022649 100644
--- a/src/Dodge/Room/LongDoor.hs
+++ b/src/Dodge/Room/LongDoor.hs
@@ -44,8 +44,8 @@ twinSlowDoorRoom w h x = defaultRoom
     , _rmPath   = []
     , _rmPmnts     = 
         [ pContID (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col id)
-            $ \btid -> jsps0J (PutSlideDoor False col (cond' btid) (V2 x 1) (V2 x h) wlSpeed)
-            $ ps0 (PutSlideDoor False col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed)
+            $ \btid -> jsps0J (PutSlideDr False col (cond' btid) (V2 x 1) (V2 x h) wlSpeed)
+            $ ps0 (PutSlideDr False col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed)
             $ \did -> jps0 (PutLS (colorLightAt (V3 0.75 0 0) (V3 0 (h-1) lampHeight) 0))
             $ \lsid -> jsps0 $ PutProp $ addColorChange lsid did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight
         ]
diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs
index 85d547588..a14e1b678 100644
--- a/src/Dodge/Room/Procedural.hs
+++ b/src/Dodge/Room/Procedural.hs
@@ -49,7 +49,7 @@ roomRect x y xn yn = defaultRoom
     { _rmPolys = [rectNSWE  y 0 0 x ]
     , _rmLinks = lnks
     , _rmPath  = concatMap doublePair pth
-    , _rmPos   = map (\p -> UnusedSpot p 0) posps
+    , _rmPos   = map (`UnusedSpot` 0) posps
     , _rmPmnts    = []
     , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
     , _rmFloor = [Tile 
@@ -232,7 +232,7 @@ centerVaultRoom w h d = do
             ,sps0 $ PutWall (rectNSEW   d  (d - 30) (-d) (30 - d)) defaultWall
             ,sps0 $ PutWall (rectNSEW (-d) (30 - d)   d  (d - 30)) defaultWall
             ,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
-            ,sps0 $ PutForeground $ girder 70 10 10 (V2 (d-11) (-d)) (V2 (d-11) (-h))
+            ,sps0 $ PutShape $ girder 70 10 10 (V2 (d-11) (-d)) (V2 (d-11) (-h))
             ]
             ++ map (\a -> mntLS vShape (rotateV a $ V2 0  d) (rotate3z a $ V3 0 (d+30) 70))
                 [0,0.5*pi,pi,1.5*pi]
@@ -244,7 +244,7 @@ centerVaultRoom w h d = do
     col = dim $ dim $ bright red
     theDoor = 
         [ pContID (PS (V2 35 (d+4)) 0) (PutButton $ makeSwitch col red id id)
-            $ \btid -> jspsJ (V2 0 (d-10)) 0 (PutSlideDoor False col (cond' btid) (V2 (-21) 0) (V2 0 0) 2)
-            $          sPS   (V2 0 (d-10)) 0 (PutSlideDoor False col (cond' btid) (V2   21  0) (V2 0 0) 2)
+            $ \btid -> jspsJ (V2 0 (d-10)) 0 (PutSlideDr False col (cond' btid) (V2 (-21) 0) (V2 0 0) 2)
+            $          sPS   (V2 0 (d-10)) 0 (PutSlideDr False col (cond' btid) (V2   21  0) (V2 0 0) 2)
         ]
     cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn
diff --git a/src/Dodge/Room/RezBox.hs b/src/Dodge/Room/RezBox.hs
index c581eb3a9..c1066e9bf 100644
--- a/src/Dodge/Room/RezBox.hs
+++ b/src/Dodge/Room/RezBox.hs
@@ -49,7 +49,7 @@ rezBoxesWp = do
     let aroom = rezInvBox thecol -- & rmConnectsTo .~ S.singleton (OnEdge North)
     let isnorth = S.member (OnEdge North) . _rlType
     centralRoom <- shuffleLinks $(roomRectAutoLinks w h) {_rmPmnts = []} 
-        & rmLinks %~ (setLinkType InLink isnorth)
+        & rmLinks %~ setLinkType InLink isnorth
     onwardpassage <- maybeBlockedPassage
     let n = length $ getLinksOfType (OnEdge North) $  _rmLinks centralRoom
     let rezrooms = map adddoor 
@@ -71,8 +71,8 @@ rezBoxesWpCrit = do
     theweapon <- randBlockBreakWeapon
     --horedge <- takeOne [OnEdge North,OnEdge South]
     let centralRoom = (roomRectAutoLinks w h) {_rmPmnts = []}
-    onwardpassage <- fmap 
-        (applyToCompRoot (rmConnectsTo .~ S.singleton (OnEdge West))) $ maybeBlockedPassage
+    onwardpassage <- 
+        (applyToCompRoot (rmConnectsTo .~ S.singleton (OnEdge West))) <$> maybeBlockedPassage
     let bottomEdgeTest (V2 _ y,_) = y < 1
         aroom = rezInvBox thecol
     let n = length $ filter bottomEdgeTest $ map lnkPosDir $ _rmLinks centralRoom
@@ -123,7 +123,6 @@ rezBoxes = do
         , PassDown door
         ] 
         (Node (PassDown centralRoom') (replicate (n-1) dbox ++ [Node (UseAll door) []]))
-  where
     
 
 rezColor :: RandomGen g => State g LightSource
diff --git a/src/Dodge/Room/RoadBlock.hs b/src/Dodge/Room/RoadBlock.hs
index 364ccb0b9..9df3fcfa3 100644
--- a/src/Dodge/Room/RoadBlock.hs
+++ b/src/Dodge/Room/RoadBlock.hs
@@ -74,7 +74,7 @@ blockedCorridor = do
     sequence $ treeFromPost [] $ return $ UseAll $ set rmPmnts plmnts corridor
 
 dirtPoly :: [Point2] -> PSType
-dirtPoly = PutBlock DirtBlock [1] dirtWall . reverse
+dirtPoly = PutBlock DirtBlock 1 [] dirtWall . reverse
 
 -- | A single corridor with a destructible block blocking it.
 blockedCorridorCloseBlocks :: RandomGen g => State g Room
diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs
index 859e23189..0b2e61fb7 100644
--- a/src/Dodge/Room/Room.hs
+++ b/src/Dodge/Room/Room.hs
@@ -60,8 +60,8 @@ roomPillars = roomRect 240 240 2 2
     plmnts = spanLightI (V2 120 24) (V2 120 216) 
         : mntLS vShape (V2 12 12) (V3 25 25 70)
         : mntLS vShape (V2 228 228) (V3 215 215 70)
-        : sps0 (PutForeground $ thinHighBar 75 (V2 26 25) (V2 120 25))
-        : sps0 (PutForeground $ thinHighBar 75 (V2 214 215) (V2 120 215))
+        : sps0 (PutShape $ thinHighBar 75 (V2 26 25) (V2 120 25))
+        : sps0 (PutShape $ thinHighBar 75 (V2 214 215) (V2 120 215))
         : g 180 150 90 60
     f a x b y = putBlockRect a x b y
     g a b c d = f a b a b ++ f a b c d ++ f c d a b ++ f c d c d
@@ -150,7 +150,7 @@ miniRoom3 = do
         w <- state $ randomR (300,400)
         h <- state $ randomR (300,400)
         let cp = V2 0 (h/2+40)
-        let b = PutBlock StoneBlock [5,20,20] baseBlockPane $ map toV2 [(-10,-60) 
+        let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ map toV2 [(-10,-60) 
                                                ,( 10,-60) 
                                                ,( 10,-80) 
                                                ,(-10,-80) 
@@ -273,15 +273,18 @@ weaponEmptyRoom = do
 weaponUnderCrits :: RandomGen g => State g (SubCompTree Room)
 weaponUnderCrits = do
     let plmnts = 
-            [sPS (V2 20 0)   0 $ RandPS randFirstWeapon
-            ,sPS (V2 20 0)  (negate $ pi/2) randC1
+            [--sPS (V2 20 0)   0 $ RandPS randFirstWeapon
+            sPS (V2 20 0)  (negate $ pi/2) randC1
             ,sPS (V2 20 20) (negate $ pi/2) randC1
             ]
+        addwpat p = rmPmnts %~ ((PickOnePlacement 0 $ sPS p 0 $ RandPS randFirstWeapon) :)
     let continuationRoom = treeFromTrunk 
-            [PassDown corridorN,PassDown corridorN] 
+            [PassDown $ addwpat (V2 20 0) corridorN,PassDown $ addwpat (V2 20 0) corridorN] 
             (singleUseAll (set rmPmnts plmnts corridorN))
     rcp <- roomCenterPillar
-    deadEndRoom' <- takeOne [roomPillars,rcp]
+    deadEndRoom' <- takeOne 
+        [ addwpat (V2 120 20) roomPillars
+        , addwpat (V2 120 20) rcp]
     junctionRoom <- takeOne [PassDown tEast,PassDown tWest]
     return $ treeFromTrunk [PassDown corridorN,PassDown corridorN] 
                        $ Node junctionRoom
@@ -313,7 +316,7 @@ weaponBetweenPillars = do
     critPlacementSpots <- replicateM 2 $ randDirPS $ unusedSpotAwayFromInLink 100
     let plmnts = 
             sPS wpPos 0 (RandPS randFirstWeapon) :
-            map (\ps -> sps ps randC1) critPlacementSpots
+            map (`sps` randC1) critPlacementSpots
         theRoom = roomPillars & rmPmnts %~ (++ plmnts)
     (fmap singleUseAll . randomiseOutLinks) =<< filterLinks f theRoom
   where 
diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs
index b6ccd4f2c..68888ddaa 100644
--- a/src/Dodge/Room/Start.hs
+++ b/src/Dodge/Room/Start.hs
@@ -106,14 +106,14 @@ startRoom' = do
     w <- state $ randomR (100,400)
     h <- state $ randomR (200,400)
     let plmnts = 
-            [ sPS (V2 0 0) 0 $ PutForeground $ girderV 40 20 10 (V2 0 (h/2)) (V2 w (h/2))
+            [ sPS (V2 0 0) 0 $ PutShape $ girderV 40 20 10 (V2 0 (h/2)) (V2 w (h/2))
             --, mntLS jShape (V2 0 (h/3)) (V3 40 (h/3) 70)
             , tankSquareEmboss4 (dim orange) 50 (h-60)
             , tankSquare (dim orange) 50 50
             , tankSquare (dim orange) 50 120
             , 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)
+            , sps0 $ PutShape $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
             ]
     thecol <- rezColor
     treeFromPost [PassDown $ rezBox thecol, PassDown door] . UseAll 
diff --git a/src/Dodge/Room/Teleport.hs b/src/Dodge/Room/Teleport.hs
index 94b55e03a..9efacaed6 100644
--- a/src/Dodge/Room/Teleport.hs
+++ b/src/Dodge/Room/Teleport.hs
@@ -23,7 +23,7 @@ telRoomLev _ = do
     w <- state $ randomR (200,300)
     h <- state $ randomR (200,300)
     return $ roomRectAutoLinks w h & rmPmnts .~ 
-        [ sPS (V2 (w/2) (h/2)) 0 $ PutPressPlate telPP 
+        [ sPS (V2 (w/2) (h/2)) 0 $ PutPPlate telPP 
         , sPS (V2 (w/2) (h/2+ 30)) 0 putLamp
         ]
   where
diff --git a/src/Dodge/Tree/Shift.hs b/src/Dodge/Tree/Shift.hs
index 3b108ee3a..37568a833 100644
--- a/src/Dodge/Tree/Shift.hs
+++ b/src/Dodge/Tree/Shift.hs
@@ -21,7 +21,7 @@ import Control.Lens hiding (Empty, (<|) , (|>))
 
 type RoomInt = (Room,Int)
 
-positionRoomsFromTree :: Tree RoomInt -> IO (Maybe [Room])
+positionRoomsFromTree :: Tree RoomInt -> IO (Maybe [RoomInt])
 positionRoomsFromTree (Node (r,i) ts) = printHeader 
     >> posRms (map pointsToPoly $ _rmBound r) (r,i) (zipCount ts) Empty
 
@@ -29,10 +29,10 @@ posRms :: [ConvexPoly]
     -> RoomInt
     -> [(Int,Tree RoomInt)]     -- the list of children, with indices
     -> Seq (Tree RoomInt)
-    -> IO (Maybe [Room])
-posRms bounds (parent,_) [] st = case st of
-    Empty                   -> return $ Just [parent]
-    Node childi ts :<| tseq -> fmap (parent:) <$> posRms bounds childi (zipCount ts) tseq
+    -> IO (Maybe [RoomInt])
+posRms bounds (parent,i) [] st = case st of
+    Empty                   -> return $ Just [(parent,i)]
+    Node childi ts :<| tseq -> fmap ((parent,i):) <$> posRms bounds childi (zipCount ts) tseq
 posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
     printInfoCheckNum parenti numChild childi
     tryParentLinks outlinks
@@ -61,9 +61,12 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
             updateparent rm = doLnkEff (lnkPosDir outlnk) $ rm 
                 & rmLinks %~ delete outlnk 
                 & rmPos %~ (uncurry (UsedOutLink numChild (snd childi)) (lnkPosDir outlnk) :)
+                & rmChildren %~ (snd childi :)
             shiftedoutlink = shiftLinkBy (_rmShift parent) outlnk
             r' = doRoomShift . fst $ rootLabel shiftedt
             updatechild rm = rm 
+                & rmMParent ?~ snd parenti
+                & rmMID     ?~ snd childi
                 & rmLinks %~ delete il 
                 & rmPos %~ ( (uncurry (UsedInLink 0) (lnkPosDir il):)
                     . (map (uncurry UnusedLink . lnkPosDir) (delete il (_rmLinks rm)) ++) )
diff --git a/src/Geometry/Data.hs b/src/Geometry/Data.hs
index a657021a6..6320a4c74 100644
--- a/src/Geometry/Data.hs
+++ b/src/Geometry/Data.hs
@@ -1,17 +1,8 @@
 module Geometry.Data
-    ( Point2 
-    , Point3 
-    , Point4 
+    ( module Geometry.Data
     , V2 (..)
     , V3 (..)
     , V4 (..)
-    , toV2
-    , toV3
-    , toV4
-    , fromV3
-    , uncurryV
-    , fstV2
-    , sndV2
     )
     where
 import Linear.V2
@@ -21,6 +12,8 @@ type Point2 = V2 Float
 type Point3 = V3 Float
 type Point4 = V4 Float
 
+type DPoint2 = (Point2,Float)
+
 toV2 :: (a,a) -> V2 a
 toV2 (a,b)      = V2 a b
 toV3 :: (a,a,a) -> V3 a