{-# LANGUAGE TupleSections #-} {- Rooms that contain two doors and a switch alternating both. -} module Dodge.Room.Airlock where import Control.Lens import Control.Monad import qualified Data.IntMap.Strict as IM import Data.Maybe import Dodge.Data.GenWorld import Dodge.Default.Door import Dodge.Default.Room import Dodge.Default.Wall import Dodge.LevelGen.DoorPane import Dodge.LevelGen.PlacementHelper import Dodge.LevelGen.Switch import Dodge.Placement.Instance import Dodge.Placement.Instance.Analyser import Dodge.Room.Foreground import Dodge.Room.Path import Dodge.RoomLink import Geometry import Picture import RandomHelp import ShapePicture -- | A passage with a switch that opens forward access while closing backwards access. airlock :: RandomGen g => State g Room airlock = join $ takeOne [return airlock0, return airlock90, return airlockCrystal, airlockZ] xSwitch :: PSType xSwitch = PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect where col = dim $ dim $ bright red decontamRoom :: Int -> Room decontamRoom i = defaultRoom & rmPolys .~ cutps & rmLinks .~ muout lnks ++ muin [last lnks] & rmPath .~ foldMap doublePairSet [(V2 20 95, V2 20 45), (V2 20 45, V2 20 5)] & rmPmnts .~ [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) xSwitch $ \btid -> Just $ putDoubleDoorThen defaultDoorWall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $ \_ _ -> Just $ putDoubleDoor defaultDoorWall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2 , invisibleWall $ rectNSWE 60 40 (-40) (-30) , spanLightI (V2 (-20) 30) (V2 (-20) 70) , analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0) & plExternalID ?~ i ] -- & rmOutPmnt . at i ?~ -- analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0) & rmInPmnt .~ [(0, return . f)] & rmBound .~ [rectNSWE 75 15 0 40, switchcut] where f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do pmnt <- gw ^? genPmnt . ix i return $ putDoubleDoor defaultDoorWall (cond pmnt) (V2 (-10) 35) (V2 (-10) 65) 2 cond pmnt = WdTrig $ pmnt ^?! plMID . _Just mcpos = V2 70 50 cutps = [rectNSWE 100 0 0 40, switchcut] ps = (\p -> p - mcpos) <$> orderPolygon (concat cutps) switchcut = rectNSWE 65 35 (-40) 80 lnks = [ (V2 20 95, 0) , (V2 20 5, pi) ] -- | Straight airlock airlock0 :: Room airlock0 = defaultRoom { _rmPolys = [rectNSWE 100 0 0 40, switchcut] , _rmLinks = muout lnks ++ muin [last lnks] , _rmPath = foldMap doublePairSet [(V2 20 95, V2 20 45), (V2 20 45, V2 20 5)] , _rmPmnts = [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) xSwitch $ \btid -> Just $ putDoubleDoorThen defaultDoorWall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $ \_ _ -> Just $ putDoubleDoor defaultDoorWall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2 , invisibleWall $ rectNSWE 60 40 (-40) (-30) , spanLightI (V2 (-2) 30) (V2 (-2) 70) , sps0 $ putShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50) ] , _rmBound = [rectNSWE 75 15 0 40, switchcut] } where switchcut = rectNSWE 65 35 (-40) 20 lnks = [ (V2 20 95, 0) , (V2 20 5, pi) ] airlockDoubleDoor :: WdBl -> Float -> Point2A -> Point2A -> Point2A -> Point2A -> Maybe Placement airlockDoubleDoor cond l x1 y1 x2 y2 = jsps0J (pd x1 y1) $ sps0 (pd x2 y2) where pd = putDoor cond l putDoor :: WdBl -> Float -> Point2A -> Point2A -> PSType putDoor cond l p1 p2 = PutDoor dr defaultDoorWall where dr = defaultDoor & drTrigger .~ cond & drUpdate .~ DoorLerp 0.01 & drZeroPos .~ p1 & drOnePos .~ p2 & drFootPrint .~ IM.fromDistinctAscList (zip [0 ..] (loopPairs $ mkRectangle 9 (V2 l 0))) airlockSimple :: RandomGen g => State g Room airlockSimple = do light1 <- join $ takeOne [ mntLightLnkCond $ PS (V2 90 120) 0 , mntLightLnkCond $ PS (V2 90 0) pi , return $ spanLightI (V2 90 0) (V2 90 120) , return $ spanLightI (V2 0 60) (V2 180 60) , takeOne [30, 60, 90] <&> \x -> spanLightY (V2 90 (120 - x)) (V2 (90 - x) 120) (V2 (90 + x) 120) (V2 90 0) ] return $ defaultRoom { _rmPolys = [rectNSWE 120 0 0 180] , _rmLinks = map (uncurry outLink) (init lnks) ++ [uncurry inLink $ last lnks] , _rmPath = foldMap (doublePairSet . (V2 90 30,) . fst) lnks , _rmPmnts = [ light1 , pContID (PS (V2 90 115) pi) xSwitch $ \btid -> airlockDoubleDoor (WdBlBtOn btid) 55 (0, pi / 2) (0, 0) (V2 180 0, pi) (V2 180 0, pi / 2) ] , _rmBound = [rectNSWE 120 0 0 180] } where lnks = [ (V2 0 30, pi / 2) , (V2 180 30, 1.5 * pi) ] airlockZ :: RandomGen g => State g Room airlockZ = do let cenlight = [ mntLS vShape (V2 90 60) (V3 90 40 50) , mntLS vShape (V2 90 60) (V3 90 80 50) ] cornlight = [ mntLS vShape (V2 0 120) (V3 30 90 50) , mntLS vShape (V2 180 120) (V3 150 90 50) , sps0 (putShape (thinHighBar 50 (V2 30 90) (V2 150 90))) ] lighting <- takeOne [cenlight, cornlight] return defaultRoom { _rmPolys = [rectNSWE 120 0 0 180] , _rmLinks = lnks , _rmPath = linksDAGToPath lnks $ loopPairs $ rectNSWE 100 40 40 140 , _rmPmnts = [ pContID (PS (V2 90 115) pi) xSwitch $ \btid -> airlockDoubleDoor (WdBlBtOn btid) 61 (V2 0 60, - pi / 2) (V2 0 60, 0) (V2 180 60, - pi) (V2 180 60, - pi / 2) , sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall ] <> lighting , _rmBound = [rectNSWE 120 0 0 180] } where lnks = muout [(V2 0 30, pi / 2)] ++ muin [(V2 180 30, 1.5 * pi)] airlock90 :: Room airlock90 = defaultRoom { _rmPolys = [ rectNSWE 100 10 10 100 , rectNSWE 20 (-0.1) 20 60 , rectNSWE 20 60 20 0 , map toV2 [ (10, 100) , (100, 150) , (150, 100) , (100, 10) ] ] , _rmLinks = lnks , _rmPath = linksDAGToPath lnks [(40,80)] , _rmPmnts = [ pContID (PS (V2 120 120) (3 * pi / 4)) xSwitch $ \btid -> jsps (V2 5 5) 0 $ putDoor (WdBlBtOn btid) l1 x1 y1 & putDoorDoor . drMounts .~ themounts -- , mntLS vShape (V2 35 35) (V3 70 70 50) ] , _rmBound = pure [ V2 10 10 , V2 10 100 , V2 100 150 , V2 150 100 , V2 100 10 ] , _rmName = "airlock90" } where themounts = [ MountedLight (V3 hl hl 50) 150 0.5 , MountedLight (V3 hl (- hl) 50) 150 0.5 , MountedSPic . noPic $ thinHighBar 55 (V2 hl (- hl')) (V2 hl hl') ] lnks = muout [(V2 0 40, pi / 2)] ++ muin [(V2 40 0, pi)] hl = 27.5 hl' = 30 l1 = 55 y1 = (0, 0) x1 = (0, pi / 2) airlockCrystal :: Room airlockCrystal = defaultRoom { _rmPolys = [rectNSWE 140 0 0 40, switchcutout] , _rmLinks = lnks , _rmPath = linksDAGToPath lnks $ loopPairs [V2 20 40, V2 100 70, V2 20 110] , _rmPmnts = [ pContID (PS (V2 145 70) (pi / 2)) xSwitch $ \btid -> jsps (V2 40 70) 0 $ putDoor (WdBlBtOn btid) l1 x1 y1 , crystalLine (V2 5 70) (V2 25.5 70) , mntLS vShape (V2 150 70) (V3 110 70 70) ] , _rmBound = [rectNSWE 120 20 0 40, switchcutout] } where lnks = muout [(V2 20 130, 0)] ++ muin [(V2 20 0, pi)] switchcutout = orderPolygon $ map toV2 [(39, 20), (150, 60), (150, 80), (39, 120)] l1 = 55 x1 = (0, pi / 2) y1 = (V2 0 (-55), pi / 2)