module MainGame.MindMap where

import Affection as A

import Linear hiding (E(..))

import qualified Data.Map.Strict as Map
import Data.Matrix as M
import qualified Data.Set as S
import qualified Data.Text as T
import Data.List as L
import Data.Ecstasy as E
import Data.Maybe

import NanoVG hiding (V2(..))

-- internal imports

import Types

import MainGame.WorldMap (checkBoundsCollision2, drawTile)

import Util

updateMind :: Double -> Affection UserData ()
updateMind dt = do
 ud <- getAffection
 (nws, _) <- yieldSystemT (worldState ud) $ do
   emap allEnts $ do
     with player
     with xyvel
     with mmvel
     V2 rx ry <- query xyvel
     -- let dr = (ry / sin (atan (1/2)) / 2) + rx
     --     dc = rx - (ry / sin (atan (1/2)) / 2)
     let V2 dr dc = fmap (* 1.5) (V2 rx ry `rotVec` 45)
     return $ unchanged
       { mmvel = Set $ 2 * V2 dr dc
       }
   emap allEnts $ do
     with anim
     with mmpos
     stat <- query anim
     let an = assetAnimations ud Map.! asId stat
         ntime = asElapsedTime stat + dt
         nstate = if ntime > fromIntegral (asCurrentFrame stat) *
           (animDuration an / fromIntegral (length $ animSprites an))
           then
             let nframe = asCurrentFrame stat + 1
             in  case animPlay an of
                   APLoop ->
                     let (nnframe, nntime) =
                           if nframe >= length (animSprites an)
                           then (0, 0)
                           else (nframe, ntime)
                     in  stat
                           { asCurrentFrame = nnframe
                           , asElapsedTime  = nntime
                           }
                   APOnce ->
                     let nnframe = if nframe >= length (animSprites an)
                           then nframe - 1
                           else nframe
                     in  stat
                           { asCurrentFrame = nnframe
                           , asElapsedTime  = ntime
                           }
           else
             stat
               { asElapsedTime = ntime
               }
     return $ unchanged
       { anim = Set nstate
       }
   emap allEnts $ do
     with player
     with mmvel
     with mmpos
     with rot
     with anim
     pos'@(V2 pr pc) <- query mmpos
     vel' <- query mmvel
     rot' <- query rot
     stat <- query anim
     let npos = pos' + fmap (* dt) vel'
         dpos@(V2 dpr dpc) = npos - pos'
         aId = asId stat
         nstat = case aiName aId of
           "walking"
             | sqrt (colldpos `dot` colldpos) > 0 ->
               stat
                 { asId = aId
                   { aiDirection = fromMaybe rot' (direction vel')
                   }
                 }
             | otherwise ->
               stat
                 { asId = aId
                   { aiDirection = fromMaybe rot' (direction vel')
                   , aiName = "standing"
                   }
                 , asCurrentFrame = 0
                 }
           "standing"
             | sqrt (colldpos `dot` colldpos) > 0 ->
               stat
                 { asId = aId
                   { aiDirection = fromMaybe rot' (direction vel')
                   , aiName = "walking"
                   }
                 , asCurrentFrame = 0
                 }
             | otherwise ->
               stat
                 { asId = aId
                   { aiDirection = fromMaybe rot' (direction vel')
                   }
                 }
           x -> error ("unknown animation name" ++ x)
         lll = (,)
           <$> (
             if dpr < 0
             then [(floor dpr :: Int) .. 0]
             else [0 .. (ceiling dpr :: Int)])
           <*> (
             if dpc < 0
             then [(floor dpc :: Int) .. 0]
             else [0 .. (ceiling dpc :: Int)])
         colldpos = dpos * Prelude.foldl
           (\acc a -> let ret = checkBoundsCollision2 pos' npos dt acc a
             in A.log A.Verbose (show ret) ret)
           (V2 1 1)
           (
             concatMap
             (\(dr, dc) ->
               let bs = maybe [] collisionObstacle (fromMaybe Nothing $ M.safeGet
                     (fromIntegral $ floor pr + dr)
                     (fromIntegral $ floor pc + dc)
                     (mmImgMat (stateData ud)))
               in  Prelude.map (\(Boundaries (minr, minc) (maxr, maxc))->
                     Boundaries
                       (minr + fromIntegral dr, minc + fromIntegral dc)
                       (maxr + fromIntegral dr, maxc + fromIntegral dc)
                     ) bs
               )
             lll -- (A.log A.Verbose (show lll ++ " " ++ show len) lll)
             )
         ent = unchanged
           { mmpos = Set $ pos' + colldpos
           , rot = Set (fromMaybe rot' $ direction vel')
           , anim = Set nstat
           }
     return ent
 putAffection ud
   { worldState = nws
   }

drawMind :: Affection UserData ()
drawMind = do
  ud <- getAffection
  let ctx = nano ud
  dt <- getDelta
  (_, (playerPos, posanims)) <- yieldSystemT (worldState ud) $ do
    pc <- fmap head $ efor allEnts $ do
      with player
      with mmpos
      query mmpos
    posanims <- efor allEnts $ do
      with anim
      with mmpos
      stat <- query anim
      pos' <- query mmpos
      mbnds <- queryMaybe obstacle
      return (pos', stat, mbnds)
    return (pc, posanims)
  let V2 pr pc = playerPos
      mat = mmImgMat (stateData ud)
      cols = fromIntegral (ncols mat)
      rows = fromIntegral (nrows mat)
      tileWidth = 64 :: Double
      tileHeight = 32 :: Double
      x = realToFrac $ 640 + ((1 - pc) + (1 - pr)) * (tileWidth / 2)
      y = realToFrac $ 360 + ((1 - pr) - (1 - pc)) * (tileHeight / 2)
      partposanims = M.fromList
        (nrows $ mmImgMat $ stateData ud)
        (ncols $ mmImgMat $ stateData ud)
        ((reverse . fst)
          (Prelude.foldl
            (\(done, proc) coord ->
              let (ndone, nproc) = processList proc coord
              in  (ndone : done, nproc)
              )
            ([], posanims)
            ((,)
              <$> [1 .. (nrows $ mmImgMat $ stateData ud)]
              <*> [1 .. (ncols $ mmImgMat $ stateData ud)]
              )
            )
          )
      processList
        :: [(V2 Double, AnimState, Maybe (Boundaries Double))]
        -> (Int, Int)
        -> ( [(V2 Double, AnimState, Maybe (Boundaries Double))]
           , [(V2 Double, AnimState, Maybe (Boundaries Double))]
           )
      processList list (r, c) =
        let delimiter (V2 nr nc, _, _) =
              floor nr == r && floor nc == c
        in  L.partition delimiter list
  liftIO $ do -- draw floor
    beginPath ctx
    moveTo ctx (x + realToFrac tileWidth / 2) y
    lineTo ctx
      (x + cols * (realToFrac tileWidth / 2))
      (y - (realToFrac tileHeight / 2) * (cols - 1))
    lineTo ctx
      (x + (realToFrac tileWidth / 2) * (cols + rows - 1))
      (y + (rows - cols) * (realToFrac tileHeight / 2))
    lineTo ctx
      (x + (realToFrac tileWidth / 2) * rows)
      (y + (realToFrac tileHeight / 2) * (rows - 1))
    closePath ctx
    fillColor ctx (rgb 255 255 255)
    fill ctx
    mapM_ (\(i, ls) -> mapM_
        (\(j, t) -> drawTile ud ctx (partposanims M.! (i, j)) pr pc i j t)
        (reverse $ zip [1..] ls))
      (zip [1..] (toLists mat))
    fontSize ctx 20
    fontFace ctx (assetFonts ud Map.! FontBedstead)
    textAlign ctx (S.fromList [AlignCenter,AlignTop])
    fillColor ctx (rgb 255 128 0)
    textBox ctx 0 0 200 ("FPS: " `T.append` T.pack (Prelude.take 5 $ show (1/dt)))
