{- |
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 = 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
    (WaitMessage s i: ls) 
        | i < 1     -> w & doubleArgumentFor _worldEvents
        | otherwise -> w & menuLayers %~ ( (WaitMessage s (i-1) :) . tail )
    (GameOverMenu : _) -> updateParticles 
        . updateProjectiles 
        . updateLightSources
        . updateClouds
        $ updateSoundQueue
        w
    (_ : _) -> w
    []  -> checkEndGame 
        . updateTriggers
        . ppEvents 
        . updateCamera
        . colCrsWalls
        . simpleCrSprings 
        . zoneCreatures 
        . updateWalls
        . set worldEvents id 
        . doubleArgumentFor _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 (IM.foldr cloudInZone IM.empty (_clouds w))
    cloudInZone cr = insertIMInZone x y cid cr
      where 
        (x,y) = cloudZoneOfPoint $ _clPos cr
        cid = _clID cr
    doubleArgumentFor f x = f x x

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

updateTriggers :: World -> World
updateTriggers w 
    | ResetLevel 1 `S.member` _worldTriggers w = generateFromList 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 = 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 w = IM.foldr' _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 = IM.foldr' updateCloud w $ _clouds w 

updateCloud :: Cloud -> World -> World
updateCloud c w 
    | _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.foldr' (clClSpringVel c w) (_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 -> World -> Cloud -> Point2 -> Point2
clClSpringVel a w b v 
    | ida == idb = v
    | dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb)
    | otherwise = v
  where 
    ida = _clID a
    idb = _clID b
    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))
    takeUntil h xs = 
        let (ys,zs) = span h xs
        in ys ++ tf zs
      where 
        tf (x:_) = [x]
        tf _ = []