diff --git a/src/Dodge/Default/Room.hs b/src/Dodge/Default/Room.hs
index 70b57df6d..52a781a85 100644
--- a/src/Dodge/Default/Room.hs
+++ b/src/Dodge/Default/Room.hs
@@ -3,7 +3,6 @@ module Dodge.Default.Room
 import Geometry.Data
 import Dodge.Room.Data
 
-import qualified Data.IntMap.Strict as IM
 defaultRoom :: Room
 defaultRoom = Room
     { _rmPolys  = []
@@ -11,8 +10,8 @@ defaultRoom = Room
     , _rmPos    = []
     , _rmPath   = []
     , _rmPmnts  = []
-    , _rmTriggerPmnts = IM.empty
-    , _rmTriggers = IM.empty
+    , _rmPartialPmnt    = Nothing
+    , _rmExtendedPmnt   = Nothing
     , _rmBound  = []
     , _rmFloor  = []
     , _rmName   = "defaultRoom"
diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs
index 40b09c769..5cf6802f6 100644
--- a/src/Dodge/Layout.hs
+++ b/src/Dodge/Layout.hs
@@ -1,34 +1,29 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Layout 
-    where
+    ( generateLevelFromRoomList
+    , doPartialPlacements
+    , doExtendedPlacements
+    ) where
 import Dodge.Data
 import Dodge.LevelGen
-import Dodge.LevelGen.Data
 import Dodge.LevelGen.StaticWalls
 import Dodge.LevelGen.Pathing
 import Dodge.Wall.Zone
-import Dodge.Zone
 import Dodge.GameRoom
 import Dodge.Bounds
-import Dodge.Layout.Tree.Polymorphic (applyToRoot)
 import Dodge.Room.Data
 import Dodge.Room.AddTile
 import Dodge.Default.Wall
 import Geometry
 --import Geometry.Data
-import Dodge.Room.Link
 import qualified IntMapHelp as IM
 --import Dodge.Debug.LinkDecoration
-import Picture.Data
 import Tile
-import Polyhedra
-import Polyhedra.Data
 
 import Data.List (nubBy)
 --import Control.Monad.State
 import Control.Lens
 import System.Random
-import Data.Tree
 --import Data.Graph.Inductive.Graph (labNodes)
 --import qualified Data.Map as M
 import Data.Foldable
@@ -52,13 +47,29 @@ generateLevelFromRoomList gr w
     rs = zipWith addTile zs gr
     zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w
 
+doPartialPlacements :: [Room] -> (IM.IntMap Int,World) -> World
+doPartialPlacements rms (im,w) = foldr (doPartialPlacement im) w rms
+
+doPartialPlacement :: IM.IntMap Int -> Room -> World -> World
+doPartialPlacement im rm w = case _rmPartialPmnt rm of
+    Nothing -> w
+    Just fi -> case _rmTakeFrom rm of
+        Nothing -> w
+        Just i  -> fst $ placeSpot (w,rm) (fi (im IM.! i))
+
+doExtendedPlacements :: [Room] -> World -> (IM.IntMap Int, World)
+doExtendedPlacements rms w = foldr doExtendedPlacement (IM.empty,w) rms
+
+doExtendedPlacement :: Room -> (IM.IntMap Int, World) -> (IM.IntMap Int, World)
+doExtendedPlacement rm (im,w) = case _rmExtendedPmnt rm of
+    Nothing -> (im,w)
+    Just _ -> case _rmLabel rm of
+        Nothing -> (im,w)
+        Just _  -> undefined
+
 doRoomPlacements :: World -> Room -> World
 doRoomPlacements w rm = fst $ foldl' placeSpot (w,rm) $ _rmPmnts rm
 
-updatePSLnkUsing :: (Point2,Float) -> PlacementSpot -> PlacementSpot
-updatePSLnkUsing pf PSLnk{_psLinkShift=f} = uncurry PS $ f pf
-updatePSLnkUsing _ ps = ps
-
 setupWorldBounds :: World -> World
 setupWorldBounds w = w
     & worldBounds . bdMinX .~ f minx
@@ -75,8 +86,8 @@ setupWorldBounds w = w
         <*> L.premap sndV2 L.maximum
         ) ps
 
-polyhedrasToEdges :: [Polyhedra] -> [Point3]
-polyhedrasToEdges = concatMap tflat4 . concatMap polyToEdges
+--polyhedrasToEdges :: [Polyhedra] -> [Point3]
+--polyhedrasToEdges = concatMap tflat4 . concatMap polyToEdges
 
 initWallZoning :: World -> World
 initWallZoning w = foldl' (flip insertWallInZones) (w & wallsZone . znObjects .~ IM.empty) (_walls w)
@@ -84,22 +95,8 @@ initWallZoning w = foldl' (flip insertWallInZones) (w & wallsZone . znObjects .~
 --  where
 --    wallInZone wl = flip (foldl' (flip $ \(a,b) -> insertIMInZone a b (_wlID wl) wl)) (zoneOfWall wl)
 
-makePath :: Tree Room -> [(Point2,Point2)]
-makePath = concatMap _rmPath . flatten
-
--- consider nubbing walls after dividing them
-wallsFromTree :: Tree Room -> IM.IntMap Wall
-wallsFromTree t = 
---    createInnerWalls 
-    divideWalls 
-    . assignKeys 
-    . removeInverseWalls
-    . foldl' (flip cutWalls) [] -- map (map (g . roundPoint2)) 
---    . map (map roundPoint2)
-    $ concatMap _rmPolys (flatten t)
-  where
-    assignKeys = IM.fromList . zip [0..] . zipWith f [0..]
-    f i (x,y) = defaultWall {_wlLine = (x,y) , _wlID = i}
+--makePath :: Tree Room -> [(Point2,Point2)]
+--makePath = concatMap _rmPath . flatten
 
 wallsFromRooms :: [Room] -> IM.IntMap Wall
 wallsFromRooms =
@@ -132,40 +129,40 @@ gameRoomsFromRooms = map f
 floorsFromRooms :: [Room] -> [(Point3,Point3)]
 floorsFromRooms = concatMap (concatMap tToRender . _rmFloor)
 
-divideWall :: Wall -> [Wall]
-divideWall wl
-    = let (a,b) = _wlLine wl
-          ps = divideLine (zoneSize * 2) a b
-      in  zipWith (\ x y -> wl & wlLine .~ (x,y) ) (init ps) (tail ps)
+--divideWall :: Wall -> [Wall]
+--divideWall wl
+--    = let (a,b) = _wlLine wl
+--          ps = divideLine (zoneSize * 2) a b
+--      in  zipWith (\ x y -> wl & wlLine .~ (x,y) ) (init ps) (tail ps)
 
-divideWallIn :: Wall -> IM.IntMap Wall -> IM.IntMap Wall
-divideWallIn wl wls = 
-    let (wl':newWls) = divideWall wl
-        k = IM.newKey wls
-        newWls' = zipWith (\i w -> w {_wlID = i}) [k..] newWls
-    in  foldl' (flip $ \w -> IM.insert (_wlID w) w) wls (wl':newWls')
+--divideWallIn :: Wall -> IM.IntMap Wall -> IM.IntMap Wall
+--divideWallIn wl wls = 
+--    let (wl':newWls) = divideWall wl
+--        k = IM.newKey wls
+--        newWls' = zipWith (\i w -> w {_wlID = i}) [k..] newWls
+--    in  foldl' (flip $ \w -> IM.insert (_wlID w) w) wls (wl':newWls')
+--
+--divideWalls :: IM.IntMap Wall -> IM.IntMap Wall
+--divideWalls wls = foldl' (flip divideWallIn) wls wls
 
-divideWalls :: IM.IntMap Wall -> IM.IntMap Wall
-divideWalls wls = foldl' (flip divideWallIn) wls wls
+--insertInZone :: Int -> Int -> a -> IM.IntMap (IM.IntMap a) -> IM.IntMap (IM.IntMap a)
+--insertInZone x y obj = IM.insertWith f x $ IM.singleton y obj
+--    where f _ = IM.insert y obj
 
-insertInZone :: Int -> Int -> a -> IM.IntMap (IM.IntMap a) -> IM.IntMap (IM.IntMap a)
-insertInZone x y obj = IM.insertWith f x $ IM.singleton y obj
-    where f _ = IM.insert y obj
+--shiftRoomTree :: Tree Room -> Tree Room
+--shiftRoomTree (Node t []) = Node t []
+--shiftRoomTree (Node t ts) = Node t 
+--    $ zipWith (\l -> shiftRoomTree . applyToRoot (shiftRoomToLink l)) 
+--    (_rmLinks t) 
+--    ts
 
-shiftRoomTree :: Tree Room -> Tree Room
-shiftRoomTree (Node t []) = Node t []
-shiftRoomTree (Node t ts) = Node t 
-    $ zipWith (\l -> shiftRoomTree . applyToRoot (shiftRoomToLink l)) 
-    (_rmLinks t) 
-    ts
-
-shiftRoomTreeConstruction :: Tree Room -> [Tree Room]
-shiftRoomTreeConstruction (Node t []) = [Node t []]
-shiftRoomTreeConstruction (Node t ts) = (Node t [] :) $ concat $
-    zipWith (\l -> shiftRoomTreeConstruction . applyToRoot (shiftRoomBy l . f)) 
-    (_rmLinks t) 
-    ts
-  where 
-    f r = shiftRoomBy ( V2 0 0 -.- rotateV (pi-a) p , 0) $ shiftRoomBy (V2 0 0,pi-a)  r
-      where 
-        (p,a) = last $ _rmLinks r
+--shiftRoomTreeConstruction :: Tree Room -> [Tree Room]
+--shiftRoomTreeConstruction (Node t []) = [Node t []]
+--shiftRoomTreeConstruction (Node t ts) = (Node t [] :) $ concat $
+--    zipWith (\l -> shiftRoomTreeConstruction . applyToRoot (shiftRoomBy l . f)) 
+--    (_rmLinks t) 
+--    ts
+--  where 
+--    f r = shiftRoomBy ( V2 0 0 -.- rotateV (pi-a) p , 0) $ shiftRoomBy (V2 0 0,pi-a)  r
+--      where 
+--        (p,a) = last $ _rmLinks r
diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs
index 719e9b2b3..c2240f448 100644
--- a/src/Dodge/LevelGen.hs
+++ b/src/Dodge/LevelGen.hs
@@ -23,37 +23,15 @@ import Shape
 import qualified IntMapHelp as IM
 import Color
 
+import System.Random
 import Control.Monad.State
 import Control.Lens
 import qualified Data.IntSet as IS
 
-placeSpotRoomRand :: Room -> Int -> Placement -> World -> (World,Room)
-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)
-
 placeSpot :: (World,Room) -> Placement -> (World,Room)
 placeSpot (w,rm) plmnt = case plmnt of
     Placement{_plSpot = PSRoomRand i} -> 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)
-    Placement{_plSpot = PSLnk{}} -> case lnks of
-        ((lnki,lnk):_) -> placeSpot (w & randGen .~ g,uselnk lnki) (updatePS (f lnk) plmnt)
-        [] -> case fallback of
-            Nothing -> (w,rm)
-            Just plmnt' -> placeSpot (w,rm) plmnt'
-      where
-        uselnk lnki = rm & rmLinks %~ deletei lnki
-        rps = _plSpot plmnt
-        fallback = _psFallback rps
-        test = _psLinkTest rps
-        (lnks,g) = runState (shuffle $ filter (test . snd) $ zip [0..] 
-            $ map (invShiftLinkBy $ _rmShift rm) $ _rmLinks rm) $ _randGen w
-        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)
+    Placement{_plSpot = PSLnk{}}      -> placeSpotUsingLink w rm plmnt
     Placement{} ->
         let (i,w') = placeSpotID (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
         in maybe (w',rm) (placeSpot (w',rm)) (_plIDCont plmnt i)
@@ -64,15 +42,40 @@ placeSpot (w,rm) plmnt = case plmnt of
   where
     shift = _rmShift rm
 
+placeSpotUsingLink :: World -> Room -> Placement -> (World, Room)
+placeSpotUsingLink w rm plmnt = case lnks of
+    ((lnki,lnk):_) -> placeSpot (w & randGen .~ g,uselnk lnki) (updatePS (f lnk) plmnt)
+    [] -> case fallback of
+        Nothing -> (w,rm)
+        Just plmnt' -> placeSpot (w,rm) plmnt'
+  where
+    uselnk lnki = rm & rmLinks %~ deletei lnki
+    rps = _plSpot plmnt
+    fallback = _psFallback rps
+    test = _psLinkTest rps
+    (lnks,g) = runState (shuffle $ filter (test . snd) $ zip [0..] 
+        $ map (invShiftLinkBy $ _rmShift rm) $ _rmLinks rm) $ _randGen w
+    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)
+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 (Placement ps pt f) = Placement (shiftPSBy shift ps) pt
-     (fmap (fmap $ shiftPlacement shift) f)
-shiftPlacement shift (PlacementUsingPos p f) = PlacementUsingPos (shiftPoint3By shift p)
-     (fmap (shiftPlacement shift) f)
-shiftPlacement shift (RandomPlacement rpl) = RandomPlacement $ fmap (shiftPlacement shift) rpl
+shiftPlacement shift plmnt = case plmnt of
+    Placement {} -> plmnt & plSpot %~ shiftPSBy shift 
+        & plIDCont %~ fmap (fmap $ shiftPlacement shift)
+    PlacementUsingPos p f -> PlacementUsingPos (shiftPoint3By shift p)
+        (fmap (shiftPlacement shift) f)
+    RandomPlacement rpl -> RandomPlacement $ fmap (shiftPlacement shift) rpl
 
 shiftPSBy :: (Point2,Float) -> PlacementSpot -> PlacementSpot
 shiftPSBy (pos,rot) ps = ps
@@ -84,17 +87,14 @@ shiftPSBy (pos,rot) ps = ps
 placeSpotID :: PlacementSpot -> PSType -> World -> (Int, World)
 placeSpotID ps pt w = case pt of
     PutTrigger cond -> placeNewInto triggers cond w
-    PutProp prop -> placeProp prop p rot w
-    --PutButton bt -> placeBt bt p rot w
-    PutButton bt -> placeNewUpdateID buttons btID (mvButton bt p rot) w
-    PutFlIt itm -> placeFlIt itm p rot w
-    PutCrit cr -> placeCr cr p rot 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 -> placeLS ls p' rot w
-    PutPressPlate pp -> placePressPlate pp p rot w
-    RandPS rgen -> placeSpotID ps evaluatedType (set randGen g w)
-      where 
-        (evaluatedType, g) = runState rgen (_randGen 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
@@ -112,6 +112,11 @@ placeSpotID ps pt w = case pt of
     rot = _psRot ps
     doShift = shiftPointBy (p,rot)
 
+evaluateRandPS :: State StdGen PSType -> PlacementSpot -> World -> (Int,World)
+evaluateRandPS rgen ps w = placeSpotID ps evaluatedType (set randGen g w)
+  where 
+    (evaluatedType, g) = runState rgen (_randGen w)
+
 placeWallPoly :: [Point2] -> Wall -> World -> World
 placeWallPoly ps wl = rmCrossPaths . over walls (addWalls ps wl)
   where
@@ -148,71 +153,30 @@ placeNewInto l x w = (i,w & l #%~ IM.insert i x)
     i = IM.newKey $ w ^# l
 
 -- | place an new object into an intmap and update its id
-placeNewUpdateID :: ALens' World (IM.IntMap a)
+plNewUpID :: ALens' World (IM.IntMap a)
     -> ALens' a Int
     -> a
     -> World
     -> (Int,World)
-placeNewUpdateID l li x w = (i,w & l #%~ IM.insert i (x & li #~ i))
+plNewUpID l li x w = (i,w & l #%~ IM.insert i (x & li #~ i))
   where
     i = IM.newKey $ w ^# l
 
-placeProp 
-    :: Prop
-    -> Point2
-    -> Float -- ^ Rotation
-    -> World
-    -> (Int, World)
-placeProp pr p a w = (i, w & props %~ addProp)
-  where 
-    i = IM.newKey $ _props w
-    addProp prs = IM.insert i (f pr) prs
-    f = (pjRot +~ a) . (pjPos %~ ( (p +.+) . rotateV a )) . (pjID .~ i)
+mvProp :: Point2 -> Float -> Prop -> Prop
+mvProp p a = (pjRot +~ a) . (pjPos %~ ( (p +.+) . rotateV a ))
 
-placeBt 
-    :: Button
-    -> Point2
-    -> Float -- ^ Rotation
-    -> World
-    -> (Int, World)
-placeBt bt p a w = (i , over buttons addBT w)
-  where 
-    i = IM.newKey $ _buttons w
-    addBT = IM.insert i (f bt)
-    f = (btRot +~ a) . (btPos %~ ( (p +.+) . rotateV a )) . (btID .~ i)
+mvButton :: Point2 -> Float -> Button -> Button
+mvButton p a = (btRot +~ a) . (btPos %~ ( (p +.+) . rotateV a ))
 
-mvButton bt p a = bt & btRot +~ a & btPos %~ ( (p +.+) . rotateV a )
+{- Creates a floor item at a given point.-}
+createFlIt :: Point2 -> Float -> Item -> FloorItem
+createFlIt p rot itm = FlIt { _flItPos = p , _flItRot = rot , _flItID = 0 , _flIt = itm }
 
-{- Creates a floor item at a given point.
-Assigns an id correctly.  -}
-placeFlIt
-    :: Item
-    -> Point2   -- ^ Position
-    -> Float    -- ^ Rotation
-    -> World
-    -> (Int, World)
-placeFlIt itm p rot w = (i
-    , w & floorItems %~ IM.insert i FlIt { _flItPos = p , _flItRot = rot , _flItID = i , _flIt = itm }
-    )
-  where
-    i = IM.newKey $ _floorItems w
+mvPP :: Point2 -> Float -> PressPlate -> PressPlate
+mvPP p rot pp = pp {_ppPos = p,_ppRot = rot}
 
-placePressPlate
-    :: PressPlate
-    -> Point2
-    -> Float -- ^ Rotation
-    -> World
-    -> (Int, World)
-placePressPlate pp p rot w = (i , over pressPlates addPP w)
-  where 
-    i = IM.newKey $ _pressPlates w
-    addPP pps = IM.insert (IM.newKey pps) (pp {_ppPos = p,_ppRot = rot}) pps
-
-placeCr :: Creature -> Point2 -> Float -> World -> (Int,World)
-placeCr crF p rot w = (cid, over creatures addCr w)
-  where 
-    cid = IM.newKey $ _creatures w
-    addCr crs = IM.insert cid (crF {_crPos = p,_crOldPos = p,_crDir = rot,_crID = cid}) crs
+mvCr :: Point2 -> Float -> Creature -> Creature
+mvCr p rot cr = cr {_crPos = p,_crOldPos = p,_crDir = rot}
 
 placeMachine :: Color -> [Point2] -> Machine -> Point2 -> Float -> World -> (Int,World)
 placeMachine color wallpoly mc p rot w = (mcid
@@ -224,6 +188,7 @@ placeMachine color wallpoly mc p rot w = (mcid
     wlid = IM.newKey $ _walls w
     wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
     addMc mcs = IM.insert mcid (mc {_mcPos = p,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids}) mcs
+
 -- TODO correctly remove/shift pathfinding lines (removePathsCrossing)
 placeMachineWalls :: Color -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
 placeMachineWalls col poly mcid wlid = flip (foldr f) $ zip [wlid..] $ loopPairs poly
@@ -233,9 +198,7 @@ placeMachineWalls col poly mcid wlid = flip (foldr f) $ zip [wlid..] $ loopPairs
         & wlColor .~ col
         & wlStructure . wlStMachine .~ mcid
 
-placeLS :: LightSource -> Point3 -> Float -> World -> (Int,World)
-placeLS ls (V3 x y z) rot w = (i, over lightSources addLS w)
-  where 
-    i = IM.newKey $ _lightSources w
+mvLS :: Point3 -> Float -> LightSource -> LightSource
+mvLS (V3 x y z) rot ls = ls {_lsPos = V3 x y z +.+.+ startPos,_lsDir = rot}
+  where
     startPos = onXY (rotateV rot) $ _lsPos ls
-    addLS = IM.insert i (ls {_lsPos = V3 x y z +.+.+ startPos,_lsDir = rot,_lsID = i})
diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs
index 782494146..5459e32c4 100644
--- a/src/Dodge/LevelGen/Data.hs
+++ b/src/Dodge/LevelGen/Data.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.LevelGen.Data
-    where
+module Dodge.LevelGen.Data where
 import Dodge.Data
 import Picture
 import Geometry.Data
@@ -40,16 +39,20 @@ data PlacementSpot
 data Placement = Placement 
     { _plSpot   :: PlacementSpot
     , _plType   :: PSType
+    , _plID     :: Maybe Int
     , _plIDCont :: Int -> Maybe Placement 
     }
   | PlacementUsingPos Point3 (Point3 -> Placement)  -- allows a placement to use a shifted position
   | RandomPlacement {_unRandomPlacement :: State StdGen Placement}
 
+spNoID :: PlacementSpot -> PSType -> Placement
+spNoID ps pst = Placement ps pst Nothing (const Nothing)
+
 sPS :: Point2 -> Float -> PSType -> Placement
-sPS p a pt = Placement (PS p a) pt (const Nothing)
+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 $ const Nothing
+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
@@ -58,25 +61,25 @@ 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 $ \_ -> Just plm
+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 $ \_ -> Just plm
+jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0) pst Nothing $ \_ -> Just plm
 
 ps0 :: PSType -> (Int -> Maybe Placement) -> Placement
-ps0 = Placement (PS (V2 0 0) 0)
+ps0 pst = Placement (PS (V2 0 0) 0) pst Nothing
 
 jps0 :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
-jps0 pst = Just . Placement (PS (V2 0 0) 0) pst
+jps0 pst = Just . Placement (PS (V2 0 0) 0) pst Nothing
 
 ps0j :: PSType -> Placement -> Placement
-ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst (const $ Just plmnt)
+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 f) -> Placement ps pt (fmap g f)
+    (Placement ps pt mi f) -> Placement ps pt mi (fmap g f)
   where
     g Nothing = Just pl
     g (Just pl') = Just $ addPlmnt pl pl'
diff --git a/src/Dodge/Placements/Door.hs b/src/Dodge/Placements/Door.hs
index 2c685c994..eb1d7a1c7 100644
--- a/src/Dodge/Placements/Door.hs
+++ b/src/Dodge/Placements/Door.hs
@@ -17,7 +17,7 @@ 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) $ const mayp
+    $ Placement (PS (V2 0 0) 0) ( PutSlideDoor pathing col cond b half speed) Nothing $ const mayp
   where
     half = 0.5 *.* (a +.+ b)
 
@@ -31,7 +31,7 @@ putAutoDoor a b = PlacementUsingPos (addZ 0 a)
     cond az bz = any (crNearSeg 40 (stripZ az) (stripZ bz)) . IM.filter isAnimate . _creatures
 
 switchDoor :: Point2 -> Float -> Point2 -> Point2 -> Color -> Placement
-switchDoor btpos btrot dra drb col = Placement (PS btpos btrot) (PutButton $ makeSwitch col red id id)
+switchDoor btpos btrot dra drb col = Placement (PS btpos btrot) (PutButton $ makeSwitch col red id id) Nothing
     $ \btid -> jsps0J (PutSlideDoor False col (cond btid) dra drc 2)
     $          sps0   (PutSlideDoor False col (cond btid) drb drc 2)
   where
diff --git a/src/Dodge/Placements/Sensor.hs b/src/Dodge/Placements/Sensor.hs
index 6b072ce02..c6dc41503 100644
--- a/src/Dodge/Placements/Sensor.hs
+++ b/src/Dodge/Placements/Sensor.hs
@@ -15,7 +15,7 @@ import Data.Either
 damageSensor 
     :: (DamageType -> Either Int Int) -- Left gets sensed, Right does damage
     -> Point2 -> Float -> Placement
-damageSensor damF p r = Placement (PS p r) ( PutLS theLS)
+damageSensor damF p r = Placement (PS p r) ( PutLS theLS) Nothing
     $ \lsid -> jsps p r $ PutMachine yellow (reverse $ square wdth) defaultMachine
         { _mcDraw = sensorSPic 
         , _mcUpdate = sensorUpdate damF
diff --git a/src/Dodge/Placements/Spot.hs b/src/Dodge/Placements/Spot.hs
index ebf3e3816..8a99cefb5 100644
--- a/src/Dodge/Placements/Spot.hs
+++ b/src/Dodge/Placements/Spot.hs
@@ -13,16 +13,16 @@ updatePSToLevel :: Int -> (PlacementSpot -> PlacementSpot) -> Placement -> Place
 updatePSToLevel 0 _ plmnt = plmnt
 updatePSToLevel i f plmnt = case plmnt of
     PlacementUsingPos p pl  -> PlacementUsingPos p (fmap (updatePSToLevel i f) pl)
-    Placement ps pt pl      -> Placement (f ps) pt (fmap (fmap (updatePSToLevel (i-1) f)) pl)
+    Placement ps pt mi pl   -> Placement (f ps) pt mi (fmap (fmap (updatePSToLevel (i-1) f)) pl)
     RandomPlacement rplmnt  -> RandomPlacement $ fmap (updatePSToLevel i f) rplmnt
 
 setLocalPS :: PlacementSpot -> Placement -> Placement
-setLocalPS ps (Placement _ pt f) = Placement ps pt f
+setLocalPS ps (Placement _ pt mi f) = Placement ps pt mi f
 setLocalPS ps (RandomPlacement rplmnt) = RandomPlacement (fmap (setLocalPS ps) rplmnt)
 setLocalPS _ plmnt = plmnt
 
 updatePS :: (PlacementSpot -> PlacementSpot) -> Placement -> Placement
 updatePS f pl' = case pl' of
-    Placement ps pt ipl     -> Placement (f ps) pt $ (fmap . fmap $ updatePS f) ipl
+    Placement ps pt mi ipl  -> Placement (f ps) pt mi $ (fmap . fmap $ updatePS f) ipl
     PlacementUsingPos p pl  -> PlacementUsingPos p (fmap (updatePS f) pl)
     RandomPlacement rpl     -> RandomPlacement (fmap (updatePS f) rpl)
diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs
index 84fca57b3..bff3cb4c4 100644
--- a/src/Dodge/Room.hs
+++ b/src/Dodge/Room.hs
@@ -137,8 +137,8 @@ glassSwitchBack = do
 
 glassSwitchBackCrits :: RandomGen g => State g Room
 glassSwitchBackCrits = glassSwitchBack 
-    <&> rmPmnts %~ ([Placement (PSRoomRand 0) (PutCrit miniGunCrit) (const Nothing)
-                , Placement (PSRoomRand 1) randC1 (const Nothing)
+    <&> rmPmnts %~ ([spNoID (PSRoomRand 0) (PutCrit miniGunCrit)
+                , spNoID (PSRoomRand 1) randC1
                 ] ++)
 
 miniTree2 :: RandomGen g => State g (Tree (Either Room Room))
@@ -351,7 +351,7 @@ weaponRoom = join $ takeOne
 
 roomCCrits :: RandomGen g => State g Room
 roomCCrits = roomC 200 200
-    <&> rmPmnts %~ (replicate 20 (Placement (PSRoomRand 0) randC1 (const Nothing)) ++ )
+    <&> rmPmnts %~ (replicate 20 (spNoID (PSRoomRand 0) randC1) ++ )
 
 longRoom :: RandomGen g => State g Room
 longRoom = do
@@ -418,13 +418,13 @@ shootersRoom' = do
 shootersRoom1 :: RandomGen g => State g Room
 shootersRoom1 = shootersRoom' <&> rmPmnts %~ 
     ( (
-    RandomPlacement $ takeOne $ map (\i -> Placement (PSRoomRand i) (PutCrit autoCrit) (const Nothing))
+    RandomPlacement $ takeOne $ map (\i -> spNoID (PSRoomRand i) (PutCrit autoCrit))
                     [0,1,2]
     ) :)
 
 shootersRoom :: RandomGen g => State g Room
 shootersRoom = shootersRoom' <&> rmPmnts %~
-    ( map (\i -> Placement (PSRoomRand i) (PutCrit autoCrit) (const Nothing))
+    ( map (\i -> spNoID (PSRoomRand i) (PutCrit autoCrit))
                     [0,1,2]
     ++ )
 
@@ -461,9 +461,9 @@ pillarGrid = do
 pistolerRoom :: RandomGen g => State g Room
 pistolerRoom = pillarGrid
     <&> rmPmnts %~ (
-        [Placement (PSRoomRand 0) (PutCrit pistolCrit) (const Nothing)
-        ,Placement (PSRoomRand 0) (PutCrit pistolCrit) (const Nothing)
-        ,Placement (PSRoomRand 0) (PutCrit pistolCrit) (const Nothing)
+        [spNoID (PSRoomRand 0) (PutCrit pistolCrit)
+        ,spNoID (PSRoomRand 0) (PutCrit pistolCrit)
+        ,spNoID (PSRoomRand 0) (PutCrit pistolCrit)
         ]
             ++)
 
@@ -490,6 +490,6 @@ spawnerRoom = do
     x <- state $ randomR (250,300)
     y <- state $ randomR (300,400)
     roomWithSpawner <- roomC x y <&> 
-        rmPmnts %~ (Placement (PSRoomRand 0) (PutCrit spawnerCrit) (const Nothing) :)
+        rmPmnts %~ (spNoID (PSRoomRand 0) (PutCrit spawnerCrit) :)
     aRoom <- airlock
     return $ treeFromTrunk [Left aRoom,Left corridor] $ connectRoom roomWithSpawner
diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs
index 8f09047ac..efe12ee4a 100644
--- a/src/Dodge/Room/Airlock.hs
+++ b/src/Dodge/Room/Airlock.hs
@@ -27,7 +27,7 @@ airlock0 = defaultRoom
     , _rmLinks = lnks
     , _rmPath  = [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20  5) ]
     , _rmPmnts    = 
-        [Placement (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id)
+        [Placement (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id) Nothing
             $ \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)
@@ -49,7 +49,7 @@ airlockSimple = defaultRoom
     , _rmLinks = lnks
     , _rmPath  = concatMap (doublePair. (V2 90 30,) . fst) lnks
     , _rmPmnts = 
-        [ Placement (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id)
+        [ Placement (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id) Nothing
             $ \btid -> jspsJ (V2 0 0) 0 (PutDoor col (cond btid) outDoorps)
             $ sPS (V2 180 0) 0 (PutDoor col (cond btid) inDoorps)
         ]
@@ -78,7 +78,7 @@ airlockZ = defaultRoom
 --         ,(V2 40 0,V2 0 40)
 --         ]
     , _rmPmnts = 
-        [ Placement (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id)
+        [ Placement (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id) Nothing
             $ \btid -> jspsJ (V2 0 60) 0 (PutDoor col (cond btid) outDoorps)
             $ sPS (V2 180 60) 0 (PutDoor col (cond btid) inDoorps)
         , sps0 $ PutWall (rectNSEW 70 50 120 60) defaultWall
@@ -118,7 +118,7 @@ airlock90 = defaultRoom
          ,(V2 40 0,V2 0 40)
          ]
     , _rmPmnts    = 
-        [ Placement (PS (V2 120 120) (3 * pi/4)) (PutButton $ makeSwitch col red id id)
+        [ Placement (PS (V2 120 120) (3 * pi/4)) (PutButton $ makeSwitch col red id id) Nothing
             $ \btid -> jsps (V2 5 5) 0 $ PutDoor col (cond btid) pss
         ,mountLightV (V2 20 20) (V3 70 70 50)
         ]
@@ -146,7 +146,7 @@ airlockCrystal = defaultRoom
     , _rmLinks = [(V2 20 130,0) ,(V2 20  0 ,pi) ]
     , _rmPath  = [ ]
     , _rmPmnts    = 
-        [ Placement (PS (V2 145 70) (pi/2)) ( PutButton $ makeSwitch col red id id)
+        [ Placement (PS (V2 145 70) (pi/2)) ( PutButton $ makeSwitch col red id id) Nothing
             $ \btid -> jsps0 $ PutDoor col (cond btid) pss
         , crystalLine (V2 0 70) (V2 40 70)
         , mountLightV (V2 150 70) (V3 110 70 70)
diff --git a/src/Dodge/Room/Data.hs b/src/Dodge/Room/Data.hs
index 063cc9fb7..96faae584 100644
--- a/src/Dodge/Room/Data.hs
+++ b/src/Dodge/Room/Data.hs
@@ -5,12 +5,11 @@ module Dodge.Room.Data
 import Dodge.LevelGen.Data
 import Geometry.Data
 import Data.Tile
-import Dodge.Data
 
 import Control.Monad.State
 import System.Random
 import Control.Lens
-import qualified Data.IntMap.Strict as IM
+--import qualified Data.IntMap.Strict as IM
 {- 
 The '_rmPolys' list states 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;
@@ -26,16 +25,16 @@ data Room = Room
     , _rmPos    :: [RoomPos]
     , _rmPath   :: [(Point2, Point2)]
     , _rmPmnts  :: [Placement]
-    , _rmTriggers :: IM.IntMap (World -> Bool)
-    , _rmTriggerPmnts :: IM.IntMap ((World -> Bool) -> Placement)
+    , _rmPartialPmnt    :: Maybe (Int -> Placement)
+    , _rmExtendedPmnt   :: Maybe Placement
     , _rmBound  :: [ [Point2] ]
     , _rmFloor  :: [Tile]
     , _rmName   :: String
     , _rmShift  :: (Point2, Float)
     , _rmViewpoints :: [Point2]
     , _rmRandPSs :: [State StdGen (Point2,Float)]
-    , _rmLabel    :: Maybe Int
-    , _rmTakeFrom :: Maybe Int
+    , _rmLabel      :: Maybe Int
+    , _rmTakeFrom   :: Maybe Int
     }
 data RoomPos 
     = OutLink Int Point2 Float
diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs
index a73c41320..4629d0efa 100644
--- a/src/Dodge/Room/Door.hs
+++ b/src/Dodge/Room/Door.hs
@@ -5,9 +5,9 @@ import Geometry
 import Dodge.Room.Data
 import Dodge.Default.Room
 import Dodge.Placements
-import Color
+--import Color
 
-import qualified Data.IntMap.Strict as IM
+--import qualified Data.IntMap.Strict as IM
 
 door :: Room
 door = defaultRoom
@@ -30,8 +30,6 @@ switchDoor = defaultRoom
     , _rmLinks = lnks
     , _rmPath  = [(V2 20 35,V2 20 5)]
 -- door extends into side walls (for shadows as rendered 12/03)
-    , _rmTriggerPmnts = IM.fromList 
-        [(0,\cond -> putDoubleDoor False red cond (V2 0 20) (V2 40 20) 2)]
 -- note no bounds
     }
   where 
diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs
index 23b6c0401..122a9f4fc 100644
--- a/src/Dodge/Room/LongDoor.hs
+++ b/src/Dodge/Room/LongDoor.hs
@@ -39,7 +39,7 @@ twinSlowDoorRoom w h x = defaultRoom
         ]
     , _rmPath   = []
     , _rmPmnts     = 
-        [ Placement (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col id)
+        [ Placement (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col id) Nothing
             $ \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)
             $ \did -> jps0 (PutLS (colorLightAt (V3 0.75 0 0) (V3 0 (h-1) lampHeight) 0))
diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs
index 633659b05..6e14dafe3 100644
--- a/src/Dodge/Room/Procedural.hs
+++ b/src/Dodge/Room/Procedural.hs
@@ -175,7 +175,7 @@ fillNothingPlacement :: PSType -> Room -> Room
 fillNothingPlacement pst r =
     r & rmPmnts %~ replaceNothingWith pst
   where
-    replaceNothingWith x (Placement (PS p rot) PutNothing _: pss) = sPS p rot x : pss
+    replaceNothingWith x (Placement (PS p rot) PutNothing _ _: pss) = sPS p rot x : pss
     replaceNothingWith x (ps:pss) = ps : replaceNothingWith x pss
     replaceNothingWith _ [] = []
 {- | Successively fill 'PutNothing' placements with a list of given 'PSType's.
@@ -237,7 +237,7 @@ centerVaultRoom w h d = do
   where
     col = dim $ dim $ bright red
     theDoor = 
-        [ Placement (PS (V2 35 (d+4)) 0) (PutButton $ makeSwitch col red id id)
+        [ Placement (PS (V2 35 (d+4)) 0) (PutButton $ makeSwitch col red id id) Nothing
             $ \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)
         ]