{-# LANGUAGE TupleSections #-}

{- Rooms that contain two doors and a switch alternating both.  -}
module Dodge.Room.Airlock where

import Control.Lens
import Control.Monad
--import Dodge.Annotation.Data
import Dodge.Data.GenWorld
import Dodge.Default.Door
import Dodge.Default.Room
import Dodge.LevelGen.PlacementHelper
import Dodge.LevelGen.Switch
import Dodge.Placement.Instance
import Dodge.Placement.Instance.Analyser
import Dodge.Room.Foreground
import Dodge.RoomLink
import Geometry
import Picture
import RandomHelp

-- | 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]

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)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
                    \btid -> Just $
                        putDoubleDoorThen DoorObstacle thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
                            \_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
               , invisibleWall $ rectNSWE 60 40 (-40) (-30)
               , spanLightI (V2 (-20) 30) (V2 (-20) 70)
               ]
        & rmOutPmnt . at i ?~ 
               analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0)
        & rmInPmnt .~ [InPlacement f i]
        & rmBound .~ [rectNSWE 75 15 0 40, switchcut]
  where
    f _ (pmnt : _) = putDoubleDoor DoorObstacle (switchWallCol red) (cond pmnt) 
        (V2 (-10) 35) 
        (V2 (-10) 65) 
        2
    f _ _ = error "tried to put a door using an empty placement list"
    cond pmnt = WdTrig $ pmnt ^?! plMID . _Just
    mcpos = V2 70 50
    cutps = [rectNSWE 100 0 0 40, switchcut]
    ps = (\p -> p - mcpos) <$> orderPolygon (concat cutps)
    thewall = switchWallCol col
    switchcut = rectNSWE 65 35 (-40) 80
    lnks =
        [ (V2 20 95, 0)
        , (V2 20 5, pi)
        ]
    col = dim $ dim $ bright red

-- | 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)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
                \btid -> Just $
                    putDoubleDoorThen DoorObstacle thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
                        \_ _ -> Just $ putDoubleDoor DoorObstacle thewall (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
    thewall = switchWallCol col
    switchcut = rectNSWE 65 35 (-40) 20
    lnks =
        [ (V2 20 95, 0)
        , (V2 20 5, pi)
        ]
    col = dim $ dim $ bright red

airlockDoor :: Color -> WdBl -> [(Point2, Point2)] -> PSType
airlockDoor col = PutDoor col DoorObstacle

airlockDoubleDoor ::
    Point2 ->
    Point2 ->
    Color ->
    WdBl ->
    [(Point2, Point2)] ->
    [(Point2, Point2)] ->
    Maybe Placement
airlockDoubleDoor p1 p2 col cond outDoorps inDoorps =
    jspsJ p1 0 (airlockDoor col cond outDoorps) $
        sPS p2 0 (airlockDoor col cond inDoorps)

airlockSimple :: Room
airlockSimple =
    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 =
            [ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
                \btid -> airlockDoubleDoor 0 (V2 180 0) col (WdBlBtOn btid) outDoorps inDoorps
                --            jspsJ (V2 0 0) 0 (airlockDoor col (cond btid) outDoorps)
                --            $ sPS (V2 180 0) 0 (airlockDoor col (cond btid) inDoorps)
            ]
        , _rmBound =
            [rectNSWE 120 0 0 180]
        }
  where
    lnks =
        [ (V2 0 30, pi / 2)
        , (V2 180 30, 1.5 * pi)
        ]
    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 :: RandomGen g => State g Room
airlockZ = do
    let 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 <- takeOne [cenlight, cornlight]
    return
        defaultRoom
            { _rmPolys =
                [rectNSWE 120 0 0 180]
            , _rmLinks = muout [(V2 0 30, pi / 2)] ++ muin [(V2 180 30, 1.5 * pi)]
            , _rmPath = mempty
            , --         [(V2 0 40,V2 40 0)
              --         ,(V2 40 0,V2 0 40)
              --         ]
              _rmPmnts =
                [ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
                    \btid -> airlockDoubleDoor (V2 0 60) (V2 180 60) col (WdBlBtOn btid) outDoorps inDoorps
                , --            jspsJ (V2 0 60) 0 (airlockDoor col (cond btid) outDoorps)
                  --            $ sPS (V2 180 60) 0 (airlockDoor col (cond btid) inDoorps)
                  sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall
                , lighting
                ]
            , _rmBound =
                [rectNSWE 120 0 0 180]
            }
  where
    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)

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 = muout [(V2 0 40, pi / 2)] ++ muin [(V2 40 0, pi)]
        , _rmPath = doublePairSet (V2 0 40, V2 40 0)
        , _rmPmnts =
            [ pContID (PS (V2 120 120) (3 * pi / 4)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
                \btid -> jsps (V2 5 5) 0 $ airlockDoor col (WdBlBtOn btid) pss
            , mntLS vShape (V2 35 35) (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)
    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 = mempty
        , _rmPmnts =
            [ pContID (PS (V2 145 70) (pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
                \btid -> jsps0 $ airlockDoor col (WdBlBtOn 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)]
    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]