Add no weapon start

src/Dodge/Room/Procedural.hs

@@ -1,10 +1,11 @@
 {-
-Procedural creation of rooms.
+Procedural creation of rooms and subroom parts.
 -}
 module Dodge.Room.Procedural
     ( roomRect
     , roomRectAutoLinks
     , testRoom
+    , centerVaultRoom
     ) where
 import Dodge.Data
 import Dodge.Room.Data
@@ -18,9 +19,11 @@ import Dodge.LevelGen.Data
 import Dodge.Creature
 import Dodge.Default
 import Geometry
+import Picture
 
 import Data.List (nub,nubBy,sortBy,minimumBy)
 import Data.Function (on)
+import qualified Data.Map as M
 import Control.Lens
 import Control.Monad
 import Control.Monad.State
@@ -220,9 +223,55 @@ testRoom = do
     nCrits <- state $ randomR (1,3)
     crits <- takeN nCrits $ fmap PutCrit $ [spreadGunCrit,pistolCrit,autoCrit,armourChaseCrit]
         ++ replicate 20 chaseCrit
-    randomiseAllLinks . (fillNothingPlacements $ crits ++ itms) =<< 
+    randomiseAllLinks . fillNothingPlacements (crits ++ itms) =<< 
         ( shufflePlacements
         . foldr1 combineRooms 
         $ zipWith (\r a -> shiftRoomBy ((0,0),a) r) corners [0,pi/2,pi,3*pi/2]
         )
 
+{- | Creates room with a central vault with doors around it.
+-}
+centerVaultRoom
+    :: RandomGen g 
+    => Int      -- ^ Door id
+    -> Float    -- ^ Width
+    -> Float    -- ^ Height
+    -> Float    -- ^ Vault dimensions
+    -> State g Room
+centerVaultRoom n w h d = do
+    let northPoly = rectNSWE h d (-w) w
+        nsDoors = rectNSWE (d + 20) (negate (d +20)) (-20) 20
+        weDoors = rectNSWE 20 (-20) (d + 20) (negate (d +20)) 
+        centerPoly = rectWdthHght (d - 20) (d - 20)
+        polys = centerPoly : nsDoors : weDoors : (take 4 $ iterate (map vNormal) northPoly)
+    cr <- takeOne [miniGunCrit, autoCrit]
+    return $ Room
+        { _rmPolys  = polys
+        , _rmLinks  = 
+            [((0,h),0)
+            ,((w,0),-pi/2)
+            ,((-w,0),pi/2)
+            ,((0,-h),pi)
+            ]
+        , _rmPath   = []
+        , _rmPS     = 
+            [PS (d-25,d-25) 0 putLamp
+            ,PS (w-5,h-5) 0 putLamp
+            ,PS (w-5,5-h) 0 putLamp
+            ,PS (5-w,h-5) 0 putLamp
+            ,PS (5-w,5-h) 0 putLamp
+            ,PS (0,0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll)
+            ]
+            ++ concat (zipWith (\i r -> map (shiftPSBy ((0,0),r)) $ theDoor i) 
+                        [n, n+1, n+2, n+3] [0,pi/2,pi,3*pi/2])
+        , _rmBound  = rectNSWE h (-h) (-w) w
+        }
+  where
+    col = dim $ dim $ bright red
+    theDoor i = 
+        [ PS (0,d-10) 0 $ PutTriggerDoor col (cond i) (-19,0) (19,0)
+        , PS (35,d+4) 0 $ PutButton $ makeSwitch col 
+                           (over worldState (M.insert (DoorNumOpen i) True))
+                           (over worldState (M.insert (DoorNumOpen i) False))
+        ]
+    cond i w = or $ M.lookup (DoorNumOpen i) (_worldState w)

src/Dodge/Room/RoadBlock.hs

@@ -7,12 +7,15 @@ import Geometry
 import Dodge.Room.Data
 import Dodge.Room.Link
 import Dodge.Room.Placement
+import Dodge.Room.Corridor
 import Dodge.LevelGen.Data
 import Dodge.RandomHelp
 import Dodge.Creature
+import Dodge.Layout.Tree.Polymorphic
 
 import Data.Tree
 import Control.Monad.State
+import Control.Lens
 import System.Random
 
 armouredCorridor :: RandomGen g => State g Room
@@ -46,3 +49,30 @@ litCorridor90 = do
             ]
         , _rmBound = poly
         }
+
+noWeaponTest :: RandomGen g => State g (Tree (Either Room Room))
+noWeaponTest = do
+    undefined
+
+-- | A random length corridor with a descrutible block blocking it.
+longBlockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
+longBlockedCorridor = do
+    r <- state $ randomR (0,pi)
+    n <- state $ randomR (0,3)
+    let plmnts = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256) 
+                                          $ reverse $ rectNSWE 10 (-10) (-10) 10
+                 ,PS (20,15) 0 $ putLamp
+                 ]
+    sequence $ treeFromPost (replicate n $ fmap Left $ randomiseOutLinks corridor) 
+                        $ fmap Right $ return $ set rmPS plmnts corridor
+
+-- | A single corridor with a descrutible block blocking it.
+blockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
+blockedCorridor = do
+    r <- state $ randomR (0,pi)
+    let plmnts = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256) 
+                                          $ reverse $ rectNSWE 10 (-10) (-10) 10
+                 ,PS (20,15) 0 $ putLamp
+                 ]
+    sequence $ treeFromPost [] 
+                        $ fmap Right $ return $ set rmPS plmnts corridor

src/Dodge/Room/Teleport.hs

@@ -28,7 +28,7 @@ telRoomLev i = do
     h <- state $ randomR (200,300)
     return $ roomRectAutoLinks w h & rmPS .~ 
         [ PS (w/2,h/2) 0 $ PutPressPlate telPP 
-        , PS (w/2,h/2+ 30) 0 $ putLamp
+        , PS (w/2,h/2+ 30) 0 putLamp
         ]
   where
     telPP = PressPlate