{- |
Module      : Dodge.Update
Description : Simulation update
-}
module Dodge.Update 
    ( update
    ) where
import Dodge.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 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.
If '_menuLayers' is not empty, or the saving screen, this is the identity.
In such menus, the only way to change the world is using event handling.
 -}
update' :: World -> World
update' w = case _menuLayers w of
    (ConfigSaveScreen : ls) -> w & menuLayers .~ ls
    (_ : _) -> w    
    []  ->  let w1 = updateParticles' . updateProjectiles 
                                      . updateLightSources
                                      . zoneClouds
                                      . updateClouds
                                      . updateCreatures 
                                      . updateBlocks -- . zoning 
                                      . updateSeenWalls 
                                      . updateSoundQueue
                                      $ updateCloseObjects w
            in  checkEndGame . ppEvents 
                             . updateCamera
                             . colCrsWalls
                             . simpleCrSprings 
                             . zoneCreatures 
                             . wallEvents
                             . set worldEvents id 
                             $ _worldEvents w1 w1
  where 
    zoneCreatures = set creaturesZone (IM.foldr creatureInZone IM.empty (_creatures w))
    creatureInZone cr = insertIMInZone x y cid cr
      where (x,y) = zoneOfPoint $ _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) = zoneOfPoint $ _clPos cr
            cid = _clID cr

updateSoundQueue = set soundQueue []
                    . set sounds M.empty

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

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' (setOldPos cr)) (id,_randGen w) 
                        $ _creatures w
    setOldPos cr = cr & crOldPos .~ _crPos cr


wallEvents :: World -> World
wallEvents w = IM.foldr (_doorMech) w ( IM.filter (\d -> case d of 
                                                                Door {} -> True
                                                                BlockAutoDoor {} -> True
                                                                _       -> False) ( _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 yPos = _crPos $ _creatures w IM.! 0
--          wallsToUpdate = map _wlID $ IM.elems $ wallsNearPoint yPos w
          wallsToUpdate = concatMap (\p -> collidePointFindWalls yPos (yPos +.+p) $ wallsAlongLine yPos (yPos +.+ p) w)
                                   $ nRays 60
          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 = fromMaybe newPos (fmap fst hitWl)
          finalVel = fromMaybe newVel (fmap 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 = over (creatures . ix id1 . crPos) (+.+ overlap1)
                         $ over (creatures . ix id2 . crPos) (-.- overlap2) w
     | otherwise = 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

collidePointFindWall :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Int
collidePointFindWall p1 p2 ws = fmap fst $ listToMaybe $ sortBy f 
                                            $ IM.toList 
                                            $ IM.mapMaybe ((\(x:y:_) -> intersectSegSeg' p1 p2 x y) . _wlLine) ws
    where f (_,a) (_,b) = compare (magV (p1 -.- a)) (magV (p1 -.- b))

collidePointFindWalls :: Point2 -> Point2 -> IM.IntMap Wall -> [Int]
collidePointFindWalls p1 p2 ws 
    -- = map fst . takeWhileAnd g . map snd . sortBy (compare `on` (dist p1 . fst . fromJust)) . filter ((/=) Nothing . fst) . map f $ IM.toList ws
    = map fst . takeWhileAnd g . map snd . sortBy (compare `on` (dist p1 . fromJust . fst)) . filter ((/=) Nothing . fst) . map f $ IM.toList ws
    where f (i,wl) = (intersectSegSeg' (_wlLine wl !! 0) (_wlLine wl !! 1) p1 p2, (i,wl))
          g (_,wl) = _wlIsSeeThrough wl
          takeWhileAnd h xs = let (ys,zs) = span h xs
                              in  ys ++ tf zs
                where tf (x:_) = [x]
                      tf _ = []