Refactor level/room generation modules

src/Dodge/Floor.hs

@@ -0,0 +1,92 @@
+module Dodge.Floor
+    ( lev1 
+    , generateLevel
+    )
+    where
+import Geometry
+import Picture
+
+import Dodge.Data
+import Dodge.Rooms
+import Dodge.Base
+import Dodge.Layout
+import Dodge.Critters
+import Dodge.SoundLogic
+import Dodge.RandomHelp
+import Dodge.LightSources
+
+import Data.Tree
+
+import Control.Lens
+import Control.Monad.State
+
+import Control.Monad.Loops
+
+import System.Random
+
+lev1 :: RandomGen g => State g (Tree Room)
+lev1 = do
+    firstWeapon <- takeOne $ [[branchRectWith weaponRoom,blockedCorridor]] ++ replicate 5 [weaponRoom]
+    iterateWhile boundClip $ fmap (shiftRoomTree . expandTreeBy id) 
+            $ sequence $ treePost 
+            (
+            [return $ return $ Right deadEndRoom
+            ]
+            ++ [return $ connectRoom corridor
+               ,return $ connectRoom door]
+            ++ firstWeapon
+            ++ [return $ connectRoom corridor
+               ,return $ connectRoom door]
+            ++ [randomiseLinks =<< pistolerRoom]
+            ++ [return $ connectRoom door]
+             ++ [randomiseLinks =<< shooterRoom]
+             ++ (replicate 3 $ randomiseLinks corridor)
+            ++ [return $ connectRoom (set rmPS [PS (20,40) 0 basicLS] corridor)]
+            ++ [return $ connectRoom corridor]
+             ++ (replicate 3 $ randomiseLinks corridor)
+            ++ [return $ connectRoom corridor]
+            ++[return $ connectRoom corridor,return $ connectRoom door]
+            ++ [shootingRange]
+               ++ (replicate 3 $ randomiseLinks corridor)
+              ++[roomMiniIntro]
+               ++ (replicate 3 $ randomiseLinks corridor)
+              ++ [return $ connectRoom corridor
+                 ,return $ connectRoom door
+                 ,slowDoorRoom]
+            ++ [return $ connectRoom corridor
+               ,spawnerRoom
+               ,return $ connectRoom corridor
+               ]
+            )
+            $ randomiseLinks 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 $ (roomRect 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
+        }