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 RandomHelp
import Geometry
import Picture

import qualified Data.IntMap.Strict as IM
{- | 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 [airlockCrystal]
{- | 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 , switchcutout ]
    , _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 = [ rectNSWE 120 20 0 40 , switchcutout ]
    }
  where 
    switchcutout = orderPolygon $ map toV2 [ (39,20) , (150,60) , (150,80) , (39,120) ]
    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]