{- |
Module      : Dodge.Update
Description : Simulation update
-}
module Dodge.Update 
    ( update
    ) where
import Dodge.Data
import Dodge.Data.Menu
import Dodge.World.Trigger.Data
--import Dodge.Config.Data
import Dodge.Base
import Dodge.WallCreatureCollisions
import Dodge.LevelGen.Block
import Dodge.Update.Camera
--import Dodge.Update.UsingInput
import Dodge.SoundLogic
import Dodge.Inventory
import Dodge.Initialisation
import Dodge.Layout
import Dodge.Floor
import Geometry

import Data.List
import Data.Maybe
import Data.Function
import qualified Data.Set as S
import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M
import Control.Lens

update :: World -> World
update = update' . pushSideEffects

pushSideEffects :: World -> World
pushSideEffects w = w 
    & sideEffects .~ []
    & doneSideEffects .~ _sideEffects w
{- | 
 The update step.
For most menus the only way to change the world is using event handling.  -}
update' :: World -> World
update' w = case _menuLayers w of
    (TerminalMessage t xs:mls) -> w & menuLayers .~ (TerminalMessage (max (t-1) 0) xs:mls)
    (WaitMessage s i: _) 
        | i < 1     -> w & dbArg _worldEvents
        | otherwise -> w & menuLayers %~ ( (WaitMessage s (i-1) :) . tail )
    (GameOverMenu : _) -> updateParticles 
        . updateProjectiles 
        . updateLightSources
        . updateClouds
        $ updateSoundQueue
        w
    (_ : _) -> w
    []  -> checkEndGame 
        . updateRadialDistortions
        . updateTriggers
        . ppEvents 
        . updateCamera
        . colCrsWalls
        . simpleCrSprings 
        . zoneCreatures 
        . updateWalls
        . set worldEvents id 
        . dbArg _worldEvents
        . updateParticles 
        . updateProjectiles 
        . updateLightSources
        . zoneClouds
        . updateClouds
        . updateCreatures 
        . updateCreatureGroups
        . updateBlocks
        . updateSeenWalls 
        . updateSoundQueue
        $ updateCloseObjects w
  where 
    zoneCreatures = set creaturesZone (IM.foldr creatureInZone IM.empty (_creatures w))
    creatureInZone cr = insertIMInZone x y cid cr
      where 
        (x,y) = crZoneOfPoint $ _crPos cr
        cid = _crID cr
    zoneClouds = set cloudsZone (foldl' (flip cloudInZone) IM.empty (_clouds w))
    cloudInZone cl = insertInZoneWith x y (++) [cl]
      where 
        (x,y) = cloudZoneOfPoint $ _clPos cl

updateCreatureGroups :: World -> World
updateCreatureGroups w = w & creatureGroups %~ 
    IM.mapMaybe (\cgp -> _crGroupUpdate cgp w cgp)

updateRadialDistortions :: World -> World
updateRadialDistortions = radDistortion %~ mapMaybe decreaseBulge

decreaseBulge 
    :: (Point2,Point2,Point2,Float) 
    -> Maybe (Point2,Point2,Point2,Float)
decreaseBulge (a,b,c,v)
    | v > 1 = Just (a,b,c,max 1 (v - 0.05) )
    | v < 1 = Just (a,b,c,min 1 (v + 0.05) )
    | otherwise = Nothing

updateTriggers :: World -> World
updateTriggers w 
    | ResetLevel 1 `S.member` _worldTriggers w = generateLevelFromRoomList levx $ initialWorld 
        & randGen       .~ _randGen w
        & config        .~ _config w
        & menuLayers    .~ []
        & creatures . ix 0 .~ cr
    | otherwise = w
  where
    cr = _creatures w IM.! 0 & crPos .~ (0,0)

updateSoundQueue :: World -> World
updateSoundQueue = set soundQueue [] . set sounds M.empty

updateLightSources :: World -> World
updateLightSources w = set tempLightSources (catMaybes tlss) w'
  where 
    (w',tlss) = mapAccumR (\a b -> _tlsUpdate b a b) w $ _tempLightSources w

updateProjectiles :: World -> World
updateProjectiles w = IM.foldr' (dbArg _pjUpdate) w $ _projectiles w
{-
Apply internal particle updates, delete 'Nothing's.  -}
updateParticles :: World -> World
updateParticles w = set particles (catMaybes ps) w'
  where 
    (w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles w

updateCreatures :: World -> World
updateCreatures w = f $ set randGen newG $ set creatures (IM.mapMaybe id crs) w
  where 
    ((f,newG),crs) = 
        IM.mapAccum (\g' cr -> _crUpdate cr w g' cr) (id,_randGen w) $ _creatures w

{- |
Apply door mechanisms.  -}
updateWalls :: World -> World
updateWalls w = IM.foldr (fromMaybe id . (^? doorMech)) w (_walls w)

ppEvents :: World -> World
ppEvents w = IM.foldr (\pp w' -> _ppEvent pp pp w') w $ _pressPlates w

updateSeenWalls :: World -> World
updateSeenWalls w = foldr markSeen w wallsToUpdate
  where 
    vPos = _cameraViewFrom w
    wallsToUpdate = concatMap (\p -> visibleWalls vPos (vPos +.+p) $ wallsAlongLine vPos (vPos +.+ p) w)
                             $ nRays 20
    markSeen i = set (walls . ix i . wlSeen) True

--setTestStringIO :: IO World -> IO World
--setTestStringIO = fmap (\ w -> set testString (show $ s w) w)
--  where 
--    s w = (-.-) <$> (w ^? creatures . ix 0 . crPos) <*> (w ^? creatures . ix 0 . crOldPos)

checkEndGame :: World -> World
checkEndGame w 
    | _crHP (you w) < 1 = haltSound $ w {_menuLayers = [GameOverMenu]}
    | otherwise         = w

updateClouds :: World -> World
updateClouds w = w & clouds %~ mapMaybe (updateCloud w)
--updateClouds w = IM.foldl' updateCloud w $ _clouds w 

updateCloud :: World -> Cloud -> Maybe Cloud
updateCloud w c
    | _clTimer c < 1 = Nothing
    | otherwise = Just $ c 
        & clPos %~ (+.+ newVel)
        & clVel .~ newVel
        & clTimer -~ 1
  where
    newVel = 0.90 *.* springVels
    springVels = foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w)
    oldPos = _clPos c

--updateCloud :: World -> Cloud -> World
--updateCloud w c
--    | _clTimer c < 1 = w & clouds %~ IM.delete (_clID c)
--    | otherwise = moveCloud c w
--
--moveCloud :: Cloud -> World -> World
--moveCloud c w = _clEffect c c . theUpdate $ w
--  where 
--    newVel = 0.95 *.* springVels
--    springVels = IM.foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w)
--    oldPos = _clPos c
--    newPos = oldPos +.+ newVel
--    hitWl = collideCircWalls' oldPos newPos 5 $ wallsNearPoint newPos w
--    finalPos = maybe newPos fst hitWl
--    finalVel = maybe newVel snd hitWl
--    theUpdate w' = w' 
--        & clouds . ix (_clID c) . clTimer %~ (\t -> t - 1)
--        & clouds . ix (_clID c) . clVel .~ finalVel
--        & clouds . ix (_clID c) . clPos .~ finalPos
--
clClSpringVel :: Cloud -> Point2 -> Cloud -> Point2
clClSpringVel a v b
    | dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb)
    | otherwise = v
  where 
    pa = _clPos a
    pb = _clPos b
    radDist = (_clRad a + _clRad b) / 2

simpleCrSprings :: World -> World
simpleCrSprings w = IM.foldr' crSpring w $ _creatures w

crSpring :: Creature -> World -> World
crSpring c w = IM.foldr' (crCrSpring c) w cs
  where 
    cs = creaturesNearPoint (_crPos c) w

crCrSpring :: Creature -> Creature -> World -> World
crCrSpring c1 c2 w 
    | id1 == id2 = w
    | vec == (0,0) = w
    | diff >= comRad = w
    | otherwise = over (creatures . ix id1 . crPos) (+.+ overlap1)
                        $ over (creatures . ix id2 . crPos) (-.- overlap2) w
  where 
    id1  = _crID c1
    id2  = _crID c2
    vec  = _crPos c1 -.- _crPos c2
    diff = magV vec
    comRad  = _crRad c1 + _crRad c2
    overlap1 = ((comRad - diff) * _crMass c2 * 0.5 / massT) *.* errorNormalizeV 55 vec
    overlap2 = ((comRad - diff) * _crMass c1 * 0.5 / massT) *.* errorNormalizeV 56 vec
    massT    = _crMass c1 + _crMass c2
{-
Finds the IDs of visible walls from a point to another point.  -}
visibleWalls :: Point2 -> Point2 -> IM.IntMap Wall -> [Int]
visibleWalls p1 p2 ws 
    = map fst 
    . takeUntil (_wlIsSeeThrough . snd) 
    . map snd 
    . sortOn (dist p1 . fromJust . fst) 
    . filter ((/=) Nothing . fst) 
    . map f 
    $ IM.toList ws
  where 
    f (i,wl) = (uncurry intersectSegSeg' (_wlLine wl) p1 p2, (i,wl))