61 lines
2.1 KiB
Haskell
61 lines
2.1 KiB
Haskell
module Dodge.Room.GlassLesson where
|
|
import Dodge.RoomLink
|
|
import Dodge.Creature
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.RandomHelp
|
|
import Dodge.Default.Wall
|
|
import Dodge.Tree
|
|
import Dodge.Placement.Instance
|
|
--import Dodge.LevelGen.Data
|
|
import Dodge.Room.Procedural
|
|
import Dodge.Room.Corridor
|
|
import Dodge.Room.Link
|
|
import Dodge.Room.Door
|
|
import Geometry
|
|
import LensHelp
|
|
|
|
import qualified Data.Set as S
|
|
import Control.Monad.State
|
|
--import Control.Monad.Loops
|
|
import System.Random
|
|
import Data.Tree
|
|
glassLesson :: RandomGen g => State g (SubCompTree Room)
|
|
glassLesson = do
|
|
i <- takeOne [1,2,3]
|
|
corridors <- replicateM i $ PassDown <$> shuffleLinks corridor
|
|
return $ Node (PassDown botRoom)
|
|
[ singleUseNone $ door & rmConnectsTo .~ fromWest North 1
|
|
, uppers
|
|
, treeFromPost (PassDown (door & rmConnectsTo .~ S.member (OnEdge East))
|
|
: corridors) $ UseAll door]
|
|
where
|
|
fromWest edge i s = S.member (OnEdge edge) s && S.member (FromWest i) s
|
|
uppers = Node (PassDown $ door & rmConnectsTo .~ fromWest North 0)
|
|
[singleUseNone topRoom]
|
|
botRoom = roomRect 200 200 1 1
|
|
& rmPmnts .~ botplmnts
|
|
& rmLinks %~ setInLinksByType (OnEdge West)
|
|
topRoom = roomRect 200 200 1 1
|
|
& rmPmnts .~ topplmnts
|
|
& rmLinks %~ setInLinks (fromWest South 0 . _rlType)
|
|
botplmnts =
|
|
[sPS (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall
|
|
,sPS (V2 50 100) 0 $ PutCrit miniGunCrit
|
|
,RandomPlacement $ takeOne
|
|
[ spanLightI (V2 160 (-20)) (V2 160 220)
|
|
, mntLS vShape (V2 180 200) (V3 160 180 50)
|
|
]
|
|
]
|
|
topplmnts =
|
|
[windowLine (V2 100 200) (V2 100 0)
|
|
,sPS (V2 50 100) 0 $ PutCrit miniGunCrit
|
|
,RandomPlacement $ takeOne
|
|
[ spanLightI (V2 160 (-20)) (V2 160 220)
|
|
, mntLS vShape (V2 180 200) (V3 160 180 50)
|
|
]
|
|
]
|
|
glassLessonRunPast :: RandomGen g => State g (SubCompTree Room)
|
|
glassLessonRunPast = f <$> glassLesson
|
|
where
|
|
f (Node r rs) = Node r $ return (UseLabel 0 $ door & rmConnectsTo .~ S.member (OnEdge West)) : rs
|