Refactoring, add screen when generating level

2021-05-03 14:44:27 +02:00
parent 2bf23db935
commit 6e6757499c
19 changed files with 342 additions and 118 deletions
@@ -0,0 +1,112 @@
+{-# LANGUAGE TupleSections #-}
+{- | Rooms containing long doors, probably with a big reveal behind them.
+ -}
+module Dodge.Room.LongDoor
+    where
+import Dodge.Data
+import Dodge.Room.Data
+import Dodge.Room.Placement
+import Dodge.Room.Link
+import Dodge.Room.Procedural
+import Dodge.Layout.Tree.Either
+import Dodge.LevelGen.Data
+import Dodge.LevelGen.Switch
+import Dodge.RandomHelp
+import Dodge.Creature.Inanimate
+import Dodge.Creature
+import Picture
+import Geometry
+
+import System.Random
+import Control.Lens
+import Control.Monad.State
+import Data.Tree
+import qualified Data.Map as M
+
+twinSlowDoorRoom 
+    :: Int      -- ^ Door id
+    -> Float    -- ^ Half width
+    -> Float    -- ^ Half height
+    -> Float    -- ^ Inner width
+    -> Room
+twinSlowDoorRoom drID w h x = Room
+    { _rmPolys  = ps
+    , _rmLinks  =
+        [ ((w,h/2) , negate $ pi/2)
+        , ((-w,h/2) , pi/2)
+        , ((0,-h), pi)
+        ]
+    , _rmPath   = []
+    , _rmPS     = 
+        [ PS (0,h/2) 0 putLamp
+        , PS (25,5) 0 putLamp
+        , PS (negate $ 25,5) 0 putLamp
+        , PS (0,0) 0 $ PutDoor col (not . cond) drL
+        , PS (0,0) 0 $ PutDoor col (not . cond) drR
+        , PS (0,h-5) pi $ PutButton $ makeButton col 
+            (over worldState (M.insert (DoorNumOpen drID) True))
+        ]
+    , _rmBound  = ps
+    }
+  where
+    ps = 
+        [rectNSWE h (-2) (-w) w
+        ,rectNSWE 20 (-h) (negate x) x
+        ]
+    drL = fmap ((\h' -> ((x,-h'),(x,h-h'))) . (* h) . (/ fromIntegral nDrp) . fromIntegral) 
+        [0..nDrp]
+    drR = fmap ((\h' -> ((-x,-h'),(-x,h-h'))) . (* h) . (/ fromIntegral nDrp) . fromIntegral) 
+        [0..nDrp]
+    nDrp = ceiling $ h
+    cond w = or $ M.lookup (DoorNumOpen drID) (_worldState w)
+    col = dim $ dim $ bright red
+
+twinSlowDoorChasers 
+    :: RandomGen g 
+    => Int  -- ^ Door id
+    -> State g Room
+twinSlowDoorChasers drid = do
+    let lps = (-65 ,) <$> [20,40 .. 180]
+        rps = (65 ,) <$> [20,40 .. 180]
+    ps <- takeN 4 $ lps ++ rps
+    let plmnts = map (\p -> PS p 0 $ PutCrit chaseCrit) ps
+    return $ twinSlowDoorRoom drid 80 200 40 & rmPS %~ (plmnts ++)
+
+slowDoorRoom :: RandomGen g => State g (Tree (Either Room Room))
+slowDoorRoom = do
+     x <- state $ randomR (400,800)
+     y <- state $ randomR (400,800)
+     h <- state $ randomR (200,min (y-100) 500)
+     (butPos,butRot) <- takeOne 
+        [( (x/2-50,5),0)
+        ,( (x/2+50,5),0)
+        ]
+     let n = 25
+     xs <- sequence $ replicate n $ state $ randomR (10,x-10)
+     ys <- sequence $ replicate n $ state $ randomR (h+20,y)
+     rs <- sequence $ replicate n $ state $ randomR (0,2*pi)
+     let ps = zip xs ys
+     xs' <- sequence $ replicate 5 $ state $ randomR (10,x-10)
+     ys' <- sequence $ replicate 5 $ state $ randomR (h+20,y)
+     let crits = zipWith (\p r -> PS p r randC1) ps rs
+         lsources = [PS (x/2,30) 0 putLamp, PS (x/2,y-30) 0 putLamp]
+     let barrels = zipWith (\x y -> PS (x,y) 0 $ PutCrit explosiveBarrel) xs' ys'
+     let pillarsa = []
+     let pillarsb = putBlockRect (x/5-20) (x/5+20) (h/2-20) (h/2+20)
+                   ++ putBlockRect (2*x/5-20) (2*x/5+20) (h/2-20) (h/2+20)
+                   ++ putBlockRect (3*x/5-20) (3*x/5+20) (h/2-20) (h/2+20)
+                   ++ putBlockRect (4*x/5-20) (4*x/5+20) (h/2-20) (h/2+20)
+     let pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20)
+                   ++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20)
+     pillars <- takeOne [pillarsa, pillarsb, pillarsc]
+     let cond x = (snd . fst) x > h + 40
+     let cond2 x = (snd . fst) x < h - 40
+     but <- takeOne [PutBtDoor (dim $ light red) butPos butRot (0,h) (x,h)
+                  --  ,PutSwitchDoor (dim $ light red) butPos butRot (0,h) (x,h)
+                    ]
+     fmap connectRoom (filterLinks cond =<< (changeLinkTo cond2
+                                             $ set rmPS ([PS (0,0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources) 
+                                             $ roomRectAutoLinks x y
+                                             ))
+
+randC1 = RandPS $ takeOne $ map PutCrit $ (armourChaseCrit : replicate 50 chaseCrit)