loop/src/Dodge/Room/Airlock.hs

{-# LANGUAGE TupleSections #-}
{- Rooms that contain two doors and a switch alternating both.  -}
module Dodge.Room.Airlock where
import Dodge.Placement.Instance
import Dodge.Room.Foreground
import Dodge.RoomLink
import Dodge.Default.Room
import Dodge.Default.Wall
import Dodge.Data
import Dodge.LevelGen.Data
import Dodge.LevelGen.Switch
import Dodge.RandomHelp
import Geometry
import Picture

import qualified Data.IntMap.Strict as IM
import System.Random
import Control.Monad.State
{- | A passage with a switch that opens forward access while closing backwards access. -}
airlock :: RandomGen g => State g Room
airlock = takeOne [airlock0,airlock90,airlockCrystal,airlockZ]
--airlock = takeOne [airlockZ]
{- | Straight airlock -}
airlock0 :: Room
airlock0 = defaultRoom
    { _rmPolys = [ rectNSWE 100 0 0 40 , rectNSWE 65 35 (-40) 20 ]
    , _rmLinks = muout lnks ++ muin [last lnks]
    , _rmPath  = [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20  5) ]
    , _rmPmnts    = 
        [pContID (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id)
            $ \btid -> Just $ putDoubleDoorThen False col (not . cond' btid) 1 (V2 (-1) 20) (V2 41 20) 2
                $ \_ _ -> Just $ putDoubleDoor False col (cond' btid) (V2 (-1) 80) (V2 41 80) 2
        ,spanLightI (V2 (-2) 30) (V2 (-2) 70)
        ,sps0 $ PutShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
        ]
    , _rmBound = [rectNSWE 75 15 0 40]
    }
  where 
    lnks = [(V2 20 95,0)
           ,(V2 20  5,pi)
           ]
    cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn
    col = dim $ dim $ bright red

airlockSimple :: Room
airlockSimple = defaultRoom
    { _rmPolys =
        [ rectNSWE 120 0 0 180 ]
    , _rmLinks = map (uncurry outLink) (init lnks) ++ [uncurry inLink $ last lnks]
    , _rmPath  = concatMap (doublePair. (V2 90 30,) . fst) lnks
    , _rmPmnts = 
        [pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id)
            $ \btid -> jspsJ (V2 0 0) 0 (PutDoor col (cond btid) outDoorps)
            $ sPS (V2 180 0) 0 (PutDoor col (cond btid) inDoorps)
        ]
    , _rmBound = 
        [ rectNSWE 120 0 0 180 ]
    }
  where 
    lnks = 
         [(V2 0 30,pi/2)
         ,(V2 180 30,1.5*pi)
         ]
    cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
    col = dim $ dim $ bright red
    outDoorps = (V2 0 0 ,) <$> arcStepwise 3 (negate $ pi/2) (V2 0 0) (V2 0 55)
    inDoorps  = (V2 0 0 ,) <$> arcStepwise 3 (negate $ pi/2) (V2 0 0) (V2 (-55) 0)
airlockZ :: Room
airlockZ = defaultRoom
    { _rmPolys =
        [ rectNSWE 120 0 0 180 ]
    , _rmLinks = muout[(V2 0 30,pi/2)] ++ muin[(V2 180 30,1.5*pi) ]
    , _rmPath  = []
--         [(V2 0 40,V2 40 0)
--         ,(V2 40 0,V2 0 40)
--         ]
    , _rmPmnts = 
        [pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id)
            $ \btid -> jspsJ (V2 0 60) 0 (PutDoor col (cond btid) outDoorps)
            $ sPS (V2 180 60) 0 (PutDoor col (cond btid) inDoorps)
        , sps0 $ PutWall (rectNSEW 70 50 120 60) defaultWall
        , lighting
        ]
    , _rmBound = 
        [ rectNSWE 120 0 0 180 ]
    }
  where 
    cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
    col = dim $ dim $ bright red
    outDoorps = (V2 0 0 ,) <$> arcStepwise 3 (pi/2) (V2 0 0) (V2 0 (-61))
    inDoorps  = (V2 0 0 ,) <$> arcStepwise 3 (pi/2) (V2 0 0) (V2 (-61) 0)
    cenlight  = mntLS vShape (V2 90 60) (V3 90 40 50) `addPlmnt` mntLS vShape (V2 90 60) (V3 90 80 50)
    cornlight = mntLS vShape (V2 0 120) (V3 30 90 50) `addPlmnt` mntLS vShape (V2 180 120) (V3 150 90 50)
        `addPlmnt` sps0 (PutShape (thinHighBar 50 (V2 30 90) (V2 150 90)))
    lighting = RandomPlacement $ takeOne [cenlight,cornlight]

airlock90 :: Room
airlock90 = defaultRoom
    { _rmPolys =
        [ rectNSWE 100 10 10 100
        , rectNSWE 20  0  20 60
        , rectNSWE 20  60 20 0
        ,   map toV2 [ (10,100)
            , (100,150)
            , (150,100)
            , (100,10)
            ]
        ]
    , _rmLinks = muout[(V2 0 40,pi/2)] ++ muin[(V2 40 0,pi) ]
    , _rmPath  = 
         [(V2 0 40,V2 40 0)
         ,(V2 40 0,V2 0 40)
         ]
    , _rmPmnts    = 
        [pContID (PS (V2 120 120) (3 * pi/4)) (PutButton $ makeSwitch col red id id)
            $ \btid -> jsps (V2 5 5) 0 $ PutDoor col (cond btid) pss
        ,mntLS vShape (V2 20 20) (V3 70 70 50)
        ]
    , _rmBound = 
        [map toV2 [ (10,10)
        , (10,100)
        , (100,150)
        , (150,100)
        , (100,10)
        ]]
    , _rmName = "airlock90"
    }
  where 
    --cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
    cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
    col = dim $ dim $ bright red
    pss = (V2 0 0 ,) <$> arcStepwise 3 (negate $ pi/2) (V2 0 0) (V2 0 55)

airlockCrystal
    :: Room
airlockCrystal = defaultRoom
    { _rmPolys =
        [ rectNSWE 140 0 0 40
        , orderPolygon $ map toV2 [ (39,20) , (150,60) , (150,80) , (39,120) ]
        ]
    , _rmLinks = muout[(V2 20 130,0) ] ++ muin[(V2 20  0 ,pi) ]
    , _rmPath  = [ ]
    , _rmPmnts    = 
        [pContID (PS (V2 145 70) (pi/2)) ( PutButton $ makeSwitch col red id id)
            $ \btid -> jsps0 $ PutDoor col (cond btid) pss
        , crystalLine (V2 0 70) (V2 40 70)
        , mntLS vShape (V2 150 70) (V3 110 70 70)
        ]
    , _rmBound = 
        [         ]
    }
  where 
    --cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
    cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
    col = dim $ dim $ bright red
    pss :: [(Point2,Point2)]
    pss = reverse $ fmap ( (\x -> (V2 50 (x - 10),V2 50 (x+60)) ) . fromIntegral)
            [20::Int,22..70]