module MainGame.WorldMap where

import Affection as A

import Algebra.Graph as AG

import qualified SDL
import NanoVG hiding (V2(..))

import Control.Monad (when, void)
import Control.Monad.IO.Class (liftIO)
import Control.Concurrent.MVar
import Control.Concurrent (forkIO)

import Data.Map.Strict as Map
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Matrix as M
import Data.Ecstasy as E
import Data.Maybe
import Data.List as L (sortOn, partition, find)

import System.Random (randomRIO)

import Linear hiding (E)

import Foreign.C.Types (CFloat(..))

-- internal imports

import Interior
import Util
import Types
import Floorplan
import MindMap
import NPC

loadMap :: Affection UserData ()
loadMap = do
  ud <- getAffection
  let (Subsystems _ m k) = subsystems ud
      ctx = nano ud
  uu1 <- partSubscribe m movePlayer
  uu2 <- partSubscribe k changeMaps
  future <- liftIO $ newEmptyMVar
  progress <- liftIO $ newMVar 0
  _ <- liftIO $ forkIO $ loadMapFork ud future progress
  putAffection ud
    { stateData = None
    , uuid = [uu1, uu2]
    , stateMVar = future
    , stateProgress = progress
    }

changeMaps :: KeyboardMessage -> Affection UserData ()
changeMaps (MsgKeyboardEvent _ _ SDL.Pressed False sym)
  | SDL.keysymKeycode sym == SDL.KeycodeF1 = do
    ud <- getAffection
    putAffection ud
      { state = Main WorldMap
      }
  | SDL.keysymKeycode sym == SDL.KeycodeF2 = do
    ud <- getAffection
    putAffection ud
      { state = Main MindMap
      }
  | otherwise = return ()
changeMaps _ = return ()

loadMapFork
  :: UserData
  -> MVar (SystemState Entity IO, StateData)
  -> MVar Float
  -> IO ()
loadMapFork ud future progress = do
  let loadSteps = 18
      fc = FloorConfig
        (10, 10)
        [(5, 5), (5, 45)]
        (50, 50)
  _ <- liftIO $ swapMVar progress (1 / loadSteps)
  (mat, gr) <- buildHallFloorIO fc progress (1 / loadSteps)
  _ <- liftIO $ swapMVar progress (11 / loadSteps)
  let imgmat = convertTileToImg mat
      exits = Prelude.foldl
        (\acc coord@(r, c) -> if imgmat M.! coord == Just ImgEmpty
          then ReachPoint RoomExit (V2 r c) NE : acc
          else acc
          )
        []
        ((,) <$> [1 .. nrows mat] <*> [1 .. ncols mat])
  _ <- liftIO $ swapMVar progress (12 / loadSteps)
  (inter, rps) <- placeInteriorIO mat imgmat exits gr
  _ <- liftIO $ swapMVar progress (13 / loadSteps)
  logIO A.Debug ("number of reachpoints: " ++ show (length rps))
  let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps
  npcposs <- placeNPCs inter mat rps gr 50 -- (length nnex)
  _ <- liftIO $ swapMVar progress (14 / loadSteps)
  A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs)
  (mmintmat, mmgraph) <- buildFloorMap <$> springField <$>
    buildMindMap (length npcposs) 3
  _ <- liftIO $ swapMVar progress (15 / loadSteps)
  let mmimgmat = convertTileToImg $ manhattan mmgraph mmintmat
  _ <- liftIO $ swapMVar progress (16 / loadSteps)
  (nws, _) <- yieldSystemT (worldState ud) $ do
    let pmmpos = ((+ 0.5) . fromIntegral . floor) <$> mmPos
          (fromJust $ find (\a -> mmId a == 0) (vertexList mmgraph))
        delta = [(0, 0)] ++
          Prelude.filter (/= (0,0)) ((,) <$> [-1 .. 1] <*> [-1 .. 1]) :: [(Int, Int)]
        mmpos = Prelude.foldl (\acc (dr, dc) ->
          let (V2 pmr pmc) = floor <$> pmmpos
              seekpos = (pmr + fromIntegral dr, pmc + fromIntegral dc)
          in  if mmimgmat M.! seekpos == Nothing && mmintmat M.! seekpos == 0
              && acc == Nothing
            then Just (pmmpos + (fromIntegral <$> V2 dr dc))
            else acc
          ) Nothing delta
    void $ createEntity $ newEntity
      { pos           = Just (V2 10.5 10.5)
      , mmpos         = mmpos
      , vel           = Just (V2 0 0)
      , mmvel         = Just (V2 0 0)
      , player        = Just ()
      , rot           = Just SE
      , mmrot         = Just SE
      , anim          = Just $ AnimState (AnimId 0 "standing" SE) 0 0
      }
    void $ liftIO $ swapMVar progress (17 / loadSteps)
    void $ mapM_ (\npcpos@(V2 nr nc) -> do
      fact <- liftIO $ randomRIO (0.5, 1.5)
      future <- liftIO newEmptyMVar
      _ <- liftIO $ forkIO $ getPath (fmap floor npcpos) future nnex inter
      void $ createEntity $ newEntity
        { pos           = Just (V2 (nr + 0.5) (nc + 0.5))
        , vel           = Just (V2 0 0)
        , velFact       = Just fact
        , rot           = Just SE
        , npcMoveState  = Just (NPCStanding 0 future)
        , anim          = Just $ AnimState (AnimId 1 "standing" SE) 0 0
        }
      ) npcposs
    void $ liftIO $ swapMVar progress (18 / loadSteps)
  putMVar future (nws, MainData
      { mapMat = mat
      , imgMat = M.fromList (nrows inter) (ncols inter) $
        Prelude.map
          (\a -> if a == Just ImgEmpty then Nothing else a)
          (M.toList inter)
      , reachPoints = rps
      , mmImgMat = mmimgmat
      })

mouseToPlayer :: V2 Int32 -> Affection UserData ()
mouseToPlayer mv2 = do
  ud <- getAffection
  (V2 rx ry) <- liftIO $ relativizeMouseCoords mv2
  let dr = (ry / sin (atan (1/2)) / 2) + rx
      dc = rx - (ry / sin (atan (1/2)) / 2)
  (nws, _) <- liftIO $ yieldSystemT (worldState ud) $
    emap allEnts $ do
      with player
      pure $ unchanged
        { vel = Set $ 4 * V2 dr dc
        }
  putAffection ud
    { worldState = nws
    }

movePlayer :: MouseMessage -> Affection UserData ()
movePlayer (MsgMouseMotion _ _ _ [SDL.ButtonLeft] m _) = mouseToPlayer m
movePlayer (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft _ m) =
  mouseToPlayer m
movePlayer (MsgMouseButton _ _ SDL.Released _ SDL.ButtonLeft _ _) = do
  ud <- getAffection
  (nws, _) <- liftIO $ yieldSystemT (worldState ud) $
    emap allEnts $ do
      with player
      pure $ unchanged
        { vel = Set $ V2 0 0
        }
  putAffection ud
    { worldState = nws
    }
movePlayer _ = return ()

drawMap :: Affection UserData ()
drawMap = do
  ud <- getAffection
  let ctx = nano ud
  case stateData ud of
    None -> liftIO $ do
      progress <- readMVar (stateProgress ud)
      drawLoadScreen ud progress
    _ -> do
      dt <- getDelta
      (_, (playerPos, posanims)) <- liftIO $ yieldSystemT (worldState ud) $ do
        pc <- fmap head $ efor allEnts $ do
          with player
          with pos
          query pos
        posanims <- efor allEnts $ do
          with anim
          with pos
          stat <- query anim
          pos' <- query pos
          return (pos', stat)
        return (pc, posanims)
      let V2 pr pc = playerPos
          mat = imgMat (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 $ mapMat $ stateData ud)
            (ncols $ mapMat $ stateData ud)
            ((reverse . fst)
              (Prelude.foldl
                (\(done, proc) coord ->
                  let (ndone, nproc) = processList proc coord
                  in  (ndone : done, nproc)
                  )
                ([], posanims)
                ((,)
                  <$> [1 .. (nrows $ mapMat $ stateData ud)]
                  <*> [1 .. (ncols $ mapMat $ stateData ud)]
                  )
                )
              )
          processList
            :: [(V2 Double, AnimState)]
            -> (Int, Int)
            -> ([(V2 Double, AnimState)], [(V2 Double, AnimState)])
          processList list coord@(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)))

drawTile
  :: UserData
  -> Context
  -> [(V2 Double, AnimState)]
  -> Double
  -> Double
  -> Int
  -> Int
  -> Maybe ImgId
  -> IO ()
drawTile ud ctx posanims pr pc row col img =
  when ((realToFrac x > -tileWidth && realToFrac y > -tileHeight) &&
    ((realToFrac x :: Double) < 1280 &&
    (realToFrac (y - (74 - (realToFrac tileHeight :: CFloat))) :: Double) < 720)) $
      do
        let (bef, beh) = L.partition delimiter sorted
        save ctx
        mapM_ drawAnim beh
        when (isJust img) drawImage
        mapM_ drawAnim bef
        restore ctx
  where
    delimiter (V2 nr nc, _) =
      all delimit mb
      where
        delimit b
          | nnr > fst (matmin b) && nnr < fst (matmax b) =
            nnc < snd (matmin b)
          | nnc > snd (matmin b) && nnc < snd (matmax b) =
            nnr > fst (matmax b)
          | otherwise =
            True
        nnr = nr - fromIntegral (floor nr)
        nnc = nc - fromIntegral (floor nc)
      -- any (\m -> nr < fromIntegral (floor nr :: Int) + m) maxrs &&
      -- any (\m -> nc > fromIntegral (floor nc :: Int) + m) mincs
    ai = assetImages ud
    anims = assetAnimations ud
    tileWidth = 64 :: Double
    tileHeight = 32 :: Double
    sorted = sortOn (\(V2 sr sc, _) -> sc + sr * fromIntegral col) posanims
    minrs = Prelude.map (fst . matmin) mb
    maxrs = Prelude.map (fst . matmax) mb
    mincs = Prelude.map (snd . matmin) mb
    maxcs = Prelude.map (snd . matmax) mb
    x = realToFrac $ 640 + ((fromIntegral col - pc) +
      (fromIntegral row - pr)) * (tileWidth / 2) :: CFloat
    y = realToFrac $ 360 - (tileHeight / 2) + ((fromIntegral row - pr) -
      (fromIntegral col - pc)) * (tileHeight / 2) :: CFloat
    dist = distance (V2 (fromIntegral row) (fromIntegral col))
      (V2 (realToFrac pr - 1) (realToFrac pc)) / 4
    fact =
      if (pr <= fromIntegral row + minimum maxrs &&
         pc >= fromIntegral col + maximum mincs) &&
         isWall (fromJust img)
      then min 1 dist
      else 1
    mb = imgObstacle img
    drawAnim (V2 nr nc, as) = do
      let ax = realToFrac $ 640 + ((nc - pc) + (nr - pr)) * 32
          ay = realToFrac $ 360 + ((nr - pr) - (nc - pc)) * 16
          a = anims Map.! asId as
      beginPath ctx
      paint <- imagePattern ctx (ax - 32) (ay - 58) 64 74 0
        (animSprites a !! asCurrentFrame as) 1
      rect ctx (ax - 32) (ay - 58) 64 74
      fillPaint ctx paint
      fill ctx
    drawImage = do
      beginPath ctx
      paint <- imagePattern
        ctx x (y - (74 - realToFrac tileHeight))
        (realToFrac tileWidth) 74
        0
        (ai Map.! fromJust img)
        fact
      rect ctx x (y - (74 - realToFrac tileHeight)) (realToFrac tileWidth) 74
      fillPaint ctx paint
      fill ctx

updateMap :: Double -> Affection UserData ()
updateMap dt = do
  ud <- getAffection
  isFut <- liftIO $ isEmptyMVar (stateMVar ud)
  if not isFut && stateData ud == None
  then do
    liftIO $ logIO A.Debug "Loaded game data"
    Just (nws, mendat) <- liftIO $ tryTakeMVar (stateMVar ud)
    putAffection ud
      { worldState = nws
      , stateData = mendat
      }
  else do
    let direction :: V2 Double -> Direction -> Direction
        direction vel'@(V2 vr _) rot' = if sqrt (vel' `dot` vel') > 0
          then
            let xuu =
                  acos ((vel' `dot` V2 0 1) /
                    sqrt (vel' `dot` vel')) / pi * 180
                xu = if vr < 0 then 360 - xuu else xuu
                d
                  |               xu < 22.5  = NE
                  | xu > 22.5  && xu < 67.5  = E
                  | xu > 67.5  && xu < 112.5 = SE
                  | xu > 112.5 && xu < 157.5 = S
                  | xu > 157.5 && xu < 202.5 = SW
                  | xu > 202.5 && xu < 247.5 = W
                  | xu > 247.5 && xu < 292.5 = NW
                  | xu > 292.5 && xu < 337.5 = N
                  | xu > 337.5               = NE
                  | otherwise                = NE
            in d
          else rot'
    (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do
      emap allEnts $ do
        with anim
        with pos
        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
        without player
        with vel
        with velFact
        with pos
        with rot
        with anim
        pos' <- query pos
        vel' <- query vel
        rot' <- query rot
        fact' <- query velFact
        stat <- query anim
        let npos = pos' + fmap (* (dt * fact')) vel'
            aId = asId stat
            nstat = case aiName aId of
              "walking"
                | sqrt (vel' `dot` vel') > 0 ->
                  stat
                    { asId = aId
                      { aiDirection = direction vel' rot'
                      }
                    }
                | otherwise ->
                  stat
                    { asId = aId
                      { aiDirection = direction vel' rot'
                      , aiName = "standing"
                      }
                    , asCurrentFrame = 0
                    }
              "standing"
                | sqrt (vel' `dot` vel') > 0 ->
                  stat
                    { asId = aId
                      { aiDirection = direction vel' rot'
                      , aiName = "walking"
                      }
                    , asCurrentFrame = 0
                    }
                | otherwise ->
                  stat
                    { asId = aId
                      { aiDirection = direction vel' rot'
                      }
                    }
              x -> error ("unknown animation name" ++ x)
            ent = unchanged
              { pos = Set npos
              , rot = Set $ direction vel' rot'
              , anim = Set nstat
              }
        return ent
      emap allEnts $ do
        with player
        with vel
        with pos
        with rot
        with anim
        pos'@(V2 pr pc) <- query pos
        vel' <- query vel
        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 = direction vel' rot'
                      }
                    }
                | otherwise ->
                  stat
                    { asId = aId
                      { aiDirection = direction vel' rot'
                      , aiName = "standing"
                      }
                    , asCurrentFrame = 0
                    }
              "standing"
                | sqrt (colldpos `dot` colldpos) > 0 ->
                  stat
                    { asId = aId
                      { aiDirection = direction vel' rot'
                      , aiName = "walking"
                      }
                    , asCurrentFrame = 0
                    }
                | otherwise ->
                  stat
                    { asId = aId
                      { aiDirection = direction vel' rot'
                      }
                    }
              x -> error ("unknown animation name" ++ x)
            len = sqrt (dpos `dot` dpos)
            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 = fromMaybe [] (imgObstacle <$> M.safeGet
                        (fromIntegral $ floor pr + dr)
                        (fromIntegral $ floor pc + dc)
                        (imgMat (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
              { pos = Set $ pos' + colldpos
              , rot = Set (direction vel' rot')
              , anim = Set nstat
              }
        return ent
      updateNPCs
        (imgMat $ stateData ud)
        (Prelude.filter
          (\p -> pointType p /= RoomExit)
          (reachPoints $ stateData ud)
          )
        dt
    putAffection ud
      { worldState = nws
      }

checkBoundsCollision2
  :: V2 Double
  -> V2 Double
  -> Double
  -> V2 Double
  -> Boundaries Double
  -> V2 Double
checkBoundsCollision2
  pre@(V2 pr pc) nex dt acc (Boundaries (minr, minc) (maxr, maxc))
    | colltr < dt && colltc < dt = V2 0 0
    | colltr < dt && incol       = V2 0 1 * acc
    | colltc < dt && inrow       = V2 1 0 * acc
    | otherwise                  = acc
    where
      V2 vr vc = fmap (/ dt) (nex - pre)
      colltr
        | vr > 0 && prr <= maxr =
          ((fromIntegral (floor pr :: Int) + minr - 0.15) - pr) / vr
        | vr < 0 && prr >= minr =
          ((fromIntegral (floor pr :: Int) + maxr + 0.15) - pr) / vr
        | otherwise = dt
      colltc
        | vc > 0 && prc <= maxc =
          ((fromIntegral (floor pc :: Int) + minc - 0.15) - pc) / vc
        | vc < 0 && prc >= minc =
          ((fromIntegral (floor pc :: Int) + maxc + 0.15) - pc) / vc
        | otherwise = dt
      inrow = pr > minr && pr < maxr
      incol = pc > minc && pc < maxc
      prr = pr - fromIntegral (floor pr :: Int)
      prc = pc - fromIntegral (floor pc :: Int)