72 lines
2.3 KiB
Haskell
72 lines
2.3 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Room.GlassLesson where
|
|
|
|
import Dodge.Data.MTRS
|
|
import qualified Data.Set as S
|
|
import Dodge.Cleat
|
|
import Dodge.Creature
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.Default.Wall
|
|
import Dodge.LevelGen.PlacementHelper
|
|
import Dodge.Placement.Instance
|
|
import Dodge.Room.Corridor
|
|
import Dodge.Room.Door
|
|
import Dodge.Room.Link
|
|
import Dodge.Room.Procedural
|
|
import Dodge.RoomLink
|
|
import Dodge.Tree
|
|
import Geometry
|
|
import LensHelp
|
|
import RandomHelp
|
|
import Control.Monad
|
|
|
|
glassLesson :: RandomGen g => State g (Tree Room)
|
|
glassLesson = do
|
|
l1 <- takeOne
|
|
[ spanLightI (V2 160 (-20)) (V2 160 220)
|
|
, mntLS vShape (V2 180 200) (V3 160 180 50)
|
|
]
|
|
l2 <- takeOne
|
|
[ spanLightI (V2 160 (-20)) (V2 160 220)
|
|
, mntLS vShape (V2 180 200) (V3 160 180 50)
|
|
]
|
|
let botplmnts =
|
|
[ sPS (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall
|
|
, sPS (V2 50 100) 0 $ PutCrit miniGunCrit
|
|
, l1
|
|
]
|
|
topplmnts =
|
|
[ windowLine (V2 100 200) (V2 100 0)
|
|
, sPS (V2 50 100) 0 $ PutCrit miniGunCrit
|
|
, l2
|
|
]
|
|
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)
|
|
uppers = Node (door & rmConnectsTo .~ fromWest North 0) [pure topRoom]
|
|
i <- takeOne [1, 2, 3]
|
|
corridors <- replicateM i $ shuffleLinks corridor
|
|
return $
|
|
Node
|
|
botRoom
|
|
[ pure $ door & rmConnectsTo .~ fromWest North 1
|
|
, uppers
|
|
, treeFromPost
|
|
( (door & rmConnectsTo .~ S.member (OnEdge East)) :
|
|
corridors
|
|
)
|
|
$ cleatOnward door
|
|
]
|
|
where
|
|
fromWest edge i s = OnEdge edge `S.member` s && FromEdge West i `S.member` s
|
|
|
|
glassLessonRunPast :: RandomGen g => State g MTRS
|
|
glassLessonRunPast = glassLesson >>= rToOnward "glassLessonRunPast" . f
|
|
where
|
|
f (Node r rs) = Node r $ return (cleatLabel 0 $ door & rmConnectsTo .~ S.member (OnEdge West)) : rs
|