61 lines
2.1 KiB
Haskell
61 lines
2.1 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Room.GlassLesson where
|
|
import Dodge.UseAll
|
|
import Dodge.Annotation.Data
|
|
import Dodge.RoomLink
|
|
import Dodge.Creature
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.Data
|
|
import 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.Loops
|
|
glassLesson :: RandomGen g => State g (Tree Room)
|
|
glassLesson = do
|
|
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
|
|
uppers = Node (door & rmConnectsTo .~ fromWest North 0) [pure 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 MTRS
|
|
glassLessonRunPast = glassLesson >>= rToOnward "glassLessonRunPast" . f
|
|
where
|
|
f (Node r rs) = Node r $ return (cleatLabel 0 $ door & rmConnectsTo .~ S.member (OnEdge West)) : rs
|