module Dodge.Update where
-- imports {{{
import Dodge.Data
import Dodge.Base
import Dodge.WallCreatureCollisions
import Dodge.LevelGen.Block
import Dodge.Camera
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 :: World -> World
update w 
    | _menuState w /= InGame = w
    | otherwise = 
            let w1 = updateParticles' $ updateParticles 
                     $ updateLightSources
                     $ zoneClouds
                     $ updateClouds
                     $ updateSmoke
                     $ updateCreatures 
                     $ updateBlocks -- $ zoning 
                     $ updateSeenWalls 
                     $ updateSoundQueue
                     $ updateCloseObjects
                                                     w
                w2 = -- updateWeaponCounters $
                 simpleCrSprings 
                 $ zoneCreatures $ wallEvents
                 $ set worldEvents id $ _worldEvents w1
                                 w1
                w3 = updateCamera
                           $ updateAfterParticles'
                           $ colCrsWalls 
                             w2
            in  checkEndGame $ ppEvents w3
    where -- zoning w = set wallsZone (IM.foldr wallInZone IM.empty (_walls w))
          --               w
          -- wallInZone wl | dist (_wlLine wl !! 0) (_wlLine wl !! 1) <= 2*zoneSize 
          --                   = insertIMInZone x y wlid wl
          --               | otherwise = flip (foldr (\(a,b) -> insertIMInZone a b wlid wl)) ips
          --   where (x,y) = zoneOfPoint $ (pHalf (_wlLine wl !! 0) (_wlLine wl !! 1))
          --         wlid  = _wlID wl
          --         ips = map zoneOfPoint $ divideLine (2*zoneSize) (_wlLine wl !! 0) (_wlLine wl !! 1)
          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

updateParticles w = IM.foldr' _ptUpdate w $ _particles w

updateSmoke :: World -> World
updateSmoke w = w & smoke %~ mapMaybe (\s -> _smUpdate s s)

updateParticles' :: World -> World
updateParticles' w = set particles' (catMaybes ps) w'
    where (w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles' w

updateAfterParticles' :: World -> World
updateAfterParticles' w = set afterParticles' (catMaybes ps) w'
    where (w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _afterParticles' 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


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)
    -- w --do numC <- Mix.numChannelsPlaying
--                       w' <- w
--                       let ycr = _creatures w' IM.! 0
--                       let st = _stance $ _crState ycr
--                       let vel = magV $ _crPos ycr -.- _crOldPos ycr
--                       let (x,y) = zoneOfPoint $ _crPos ycr
--                       --fmap (set testString $ show (map _wlLine $ IM.elems $ _wallsZone w' IM.! x IM.! y)) w
--                       fmap (set testString $ show $ last $ show $ pairsToIncidence' $ _pathGraph' w') w

-- update logic: creature old position set, creatures perform actions including movement, 
-- creatures collided with each other, camera updated, particles updated, creatures
-- collided with walls


checkEndGame :: World -> World
checkEndGame w | _crHP (you w) < 1 = haltSound $ w {_menuState = 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.99 *.* 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 < 5 = v +.+ 0.1 *.* (safeNormalizeV (pa -.- pb))
    | otherwise = v
    where ida = _clID a
          idb = _clID b
          pa = _clPos a
          pb = _clPos b

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