{-# LANGUAGE LambdaCase #-}

module Dodge.Door (updateDoor) where

import Data.Foldable
import Data.Maybe
import qualified Data.Set as S
import Dodge.Data.World
import Dodge.Door.DoorLerp
import Dodge.ShiftPoint
import Dodge.SoundLogic
import Dodge.Wall.Move
import Dodge.WorldBool
import Dodge.Zoning.Base
import Dodge.Zoning.Pathing
import Geometry.Data
import LensHelp
import Linear
import Picture.Data
import Shape.Data

updateDoor :: Door -> World -> (S.Set Int2, World)
updateDoor dr w
    | DoorLerp x <- dr ^. drUpdate = doorLerp x dr w
    | otherwise =
        ( mempty
        , foldl' (doDoorMount (doDoorLerp dr (dr ^. drLerp))) w (dr ^. drMounts)
        )

doDoorMount :: Point2A -> World -> MountedObject -> World
doDoorMount pa w = \case
    MountedLight p r c ->
        w & cWorld . lWorld . lights .:~ LSParam (p & _xy %~ shiftPointBy pa) r c
    MountedSPic x ->
        w & cWorld . lWorld . tempSPic
            <>~ ( x & _1 . each . sfVs . each . _xy %~ shiftPointBy pa
                    & _2 . each . vxPos . _xy %~ shiftPointBy pa
                )

doorLerp :: Float -> Door -> World -> (S.Set Int2, World)
doorLerp speed dr w = fromMaybe (mempty, domounts (dr ^. drLerp) w) $ do
    x <- newlerp
    let ps = wlposs x
        ps' = wlposs (dr ^. drLerp)
        is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) (ps <> ps')
    -- it seems possible that this will miss some paths: we don't add zones for the
    -- old footprint. Seems unlikely, but a possible cause of pathfinding bugs
    return
        ( is
        , domounts x $
            f x
                & playSound x
                & cWorld . lWorld . doors . ix drid . drLerp .~ x
        )
  where
    domounts x w' = foldl' (doDoorMount (doDoorLerp dr x)) w' (dr ^. drMounts)
    f = ifoldl' (flip . moveWallID) w . wlposs
    wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (doDoorLerp dr x)
    clerp = dr ^. drLerp
    newlerp
        | toOpen && clerp < 1 = Just . min 1 $ clerp + speed
        | clerp > 0 && not toOpen = Just . max 0 $ clerp - speed
        | otherwise = Nothing
    toOpen = doWdBl (_drTrigger dr) w
    drid = _drID dr
    playSound x
        | _drPushedBy dr == PushesItself =
            soundContinue (WallSound drid) (fst $ doDoorLerp dr x) slideDoorS (Just 1)
        | otherwise = id