{- |
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 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.
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 
                    . triggerUpdate
                    . 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

triggerUpdate :: World -> World
triggerUpdate w 
    | ResetLevel 1 `S.member` _worldTriggers w
        = generateFromList levx
            $ initialWorld 
                & randGen .~ _randGen w
                & windowX .~ _windowX w
                & windowY .~ _windowY w
                & menuLayers .~ []
                & creatures . ix 0 .~ (_creatures w IM.! 0 & crPos .~ (0,0))
    | otherwise = w

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 _ = []