Implement level portal

src/Dodge/Floor.hs

@@ -1,9 +1,6 @@
 module Dodge.Floor
-    ( lev1 
-    , levx
-    , generateLevel
-    )
-    where
+    ( levx
+    ) where
 import Geometry
 import Picture
 import Dodge.Data
@@ -34,29 +31,14 @@ import System.Random
 roomTreex :: RandomGen g => State g (Maybe [Room])
 roomTreex = do
     struct' <- aTreeStrut
-    let struct = Node () []
-    -- t <- randomPadCorridors $ fmap (const []) struct
-    let t' = padCorridors $ fmap (const []) struct
+    let struct = Node [EndRoom] []
+    let t' = padCorridors struct
         t = treeTrunk [[StartRoom],[Corridor],[FirstWeapon],[Corridor]] t'
---    fmap shiftExpandTree $ mapM annoToRoom t
     fmap (shiftExpandTree . expandTreeBy id) $ mapM annoToRoomTree t
 
-roomTreex' :: RandomGen g => State g (Maybe [Room])
-roomTreex' = do
-    struct <- aTreeStrut
-    let t = padCorridors $ fmap (const []) struct
-    return . shiftExpandTree $ fmap annoToRoom' t
-
-
 levx :: RandomGen g => State g [Room]
 levx = untilJust roomTreex
 
-lev1 :: RandomGen g => State g (Tree Room)
-lev1 = do
-    struct <- aTreeStrut
-    let t = padCorridors $ fmap (const []) struct
-    fmap shiftRoomTree $ mapM annoToRoom t
-
 lev1' :: RandomGen g => State g (Tree Room)
 lev1' = do
     firstWeapon <- takeOne $ [[branchRectWith weaponRoom,blockedCorridor]] ++ replicate 5 [weaponRoom]
@@ -105,34 +87,3 @@ lev1' = do
            ]
         )
         $ (fmap connectRoom . randomiseOutLinks) corridor
-
-roomToLevel2 :: RandomGen g => State g (Tree (Either Room Room))
-roomToLevel2 = join $ takeOne
-    [ portalRoom1
-    ]
-
-portalRoom1 :: RandomGen g => State g (Tree (Either Room Room))
-portalRoom1 = return $ connectRoom $ (roomRectAutoLinks 300 300) { _rmPS = plmnts}
-    where plmnts = [PS (0,0) (0-pi/2) $ PutPressPlate (levelPortalAt (200,120) 1)
-                   ,PS (60,100) pi $ PutCrit autoCrit
-                   ]
-
-generateLevel :: Int -> World -> World
-generateLevel i w = 
-    do haltSound $ ((generateFromTree $ levelTree i) w)
-
-levelTree :: Int -> State StdGen (Tree Room)
-levelTree 1 = lev1
-
-levelPortalAt :: Point2 -> Int -> PressPlate
-levelPortalAt p x 
-    = PressPlate
-        { _ppPict = onLayer PressPlateLayer $ color blue $ circle 10
-        , _ppPos = p
-        , _ppRot = 0
-        , _ppEvent = \pp w -> if dist (_crPos (you w)) (_ppPos pp) < 10
-                                then generateLevel x w
-                                else w
-        , _ppID = -1
-        , _ppText = "Portal to level "++ show x
-        }