95 lines
3.0 KiB
Haskell
95 lines
3.0 KiB
Haskell
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
|
|
]
|
|
++[roomMiniIntro]
|
|
++ [longRoom >>= randomiseLinks]
|
|
++ [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
|
|
}
|