{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

module Play.Engine.Runner where

import qualified Data.Map as M
import Control.Monad.IO.Class (MonadIO)
import Control.Monad
import qualified SDL
import SDL.Vect (V2(..), V4(..))
import Control.Lens hiding (sets)
import Control.DeepSeq
import Control.Concurrent.STM.TQueue

import qualified Play.Engine.MySDL.MySDL as MySDL
import Play.Engine.Input
import Play.Engine.Types
import Play.Engine.Utils
import Play.Engine.Settings
import Play.Engine.Scene

-----------
-- Logic --
-----------

runGame :: Settings -> Stack Scene -> IO ()
runGame sets w = do
  putStrLn "Hello Game!"
  _ <- run sets w
  putStrLn "Goodbye."

run :: Settings -> Stack Scene -> IO ()
run settings stack = do
  responsesQueue <- newTQueueIO
  resources <- MySDL.initResources
  void $ MySDL.withWindow "Game" (MySDL.myWindowConfig (V2 (winSize x) (winSize y))) $
    flip MySDL.withRenderer
      (\(window, ren) ->
          MySDL.apploop
            resources
            responsesQueue
            ren
            (settings, stack)
            update
            (render (window, ren) . snd)
      )
  where
    winSize l = fromIntegral $ settings ^. windowSize . l

update
  :: [MySDL.Response]
  -> [SDL.EventPayload]
  -> (SDL.Scancode -> Bool)
  -> (Settings, Stack Scene)
  -> IO (Either [String] ([MySDL.Request], (Settings, Stack Scene)))
update responses payload isKeyPressed (settings, stack) =
  let
    (keys, joykeys) = makeEvents (_keyStats settings) (_joyKeyStats settings) payload isKeyPressed (_keyMap settings)

    toggleMuteFlag
      | keyClicked' KeyM keys = not
      | otherwise = id

    settings' = settings
      & over muteMusic toggleMuteFlag
      & set keyStats keys
      & set joyKeyStats joykeys

    toggleMuteCmd
      | settings' ^. muteMusic = (:) MySDL.MuteMusic
      | not (settings' ^. muteMusic) = (:) MySDL.UnmuteMusic
      | otherwise = id

  in pure
    . fmap (\(setts, (reqs, states)) -> (toggleMuteCmd reqs, (setts, states)))
    . (joykeys `deepseq` keys `deepseq` runResult $! settings')
    $ updateScenes (Input (M.unionWith max keys joykeys) responses) stack


render :: (SDL.Window, SDL.Renderer) -> Stack Scene -> IO ()
render (_, renderer) stack = do
  SDL.rendererDrawBlendMode renderer SDL.$= SDL.BlendAlphaBlend
  renderTopScene renderer stack
  SDL.present renderer

setBGColorBlack :: MonadIO m => (SDL.Window, SDL.Renderer) -> m (SDL.Window, SDL.Renderer)
setBGColorBlack sdlStuff@(_, renderer) = do
  void $ MySDL.setBGColor (V4 0 0 0 255) renderer
  pure sdlStuff