{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedRecordDot #-}
module Main where

import qualified Control.Concurrent.STM as STM
import Control.Monad
import Control.Monad.Loops
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Data.Bits
import Data.ByteString.Char8
import qualified Data.Map.Strict as M
import Data.Time.Clock
import qualified Data.Vector as V
import qualified SDL hiding (V2)
import System.IO (stdout)
import System.Mem
import qualified Vulkan as Vk
import qualified Vulkan.Zero as Vk

-- internal imports

import Init
import Draw (drawFrame)
import Types

main :: IO ()
main = do
  renderablesContainer <- STM.newTMVarIO (V.empty)
  meshMap <- STM.newTMVarIO (M.empty)
  materialMap <- STM.newTMVarIO (M.empty)
  textureMap <- STM.newTMVarIO (M.empty)
  frameNumber <- STM.newTMVarIO 0
  let initState = ReadState
        { renderables     = renderablesContainer
        , meshLibrary     = meshMap
        , materialLibrary = materialMap
        , textureLibrary  = textureMap
        }
  runRender initState $ do
    engineData <- initEngine

    SDL.showWindow $ engineWindow engineData

    -- create abort condition for upcoming lop
    quit <- liftIO $ STM.newTMVarIO True
    time <- liftIO $ STM.newTMVarIO =<< getCurrentTime
    average <- liftIO $ STM.newTMVarIO 0

    -- main loop
    whileM_
      (liftIO $ STM.atomically $ STM.readTMVar quit
        )
      ( do
        liftIO performMajorGC
        now <- liftIO getCurrentTime
        before <- liftIO $ STM.atomically $ STM.swapTMVar time now
        let timeDiff = diffUTCTime now before
            fps = recip $ nominalDiffTimeToSeconds timeDiff
        liftIO $ hPutStr stdout $ pack $ "Current FPS: " <> show (floor fps) <> "  \r"
        number <- liftIO $ STM.atomically $ do
          number <- STM.readTMVar frameNumber
          if number == 0 then
            void $ STM.swapTMVar average fps
          else do
            oldAverage <- STM.readTMVar average
            let newAverage = (oldAverage * fromIntegral number + fps) / frameCount
                frameCount = fromIntegral number + 1
            void $ STM.swapTMVar average newAverage
          void $ STM.swapTMVar frameNumber (succ number)
          return number
        -- draw
        -- liftIO $ putStr $ show (recip $ nominalDiffTimeToSeconds timeDiff) <> "\r"
        drawFrame engineData number
        -- poll events
        evs <- liftIO SDL.pollEvents
        -- flip abort condition on window close
        mapM_
          (\e -> case SDL.eventPayload e of
            SDL.WindowClosedEvent _ ->
              void $ liftIO $ STM.atomically $ STM.swapTMVar quit False
            _ -> return ()
            )
          evs
      )

    fps <- liftIO $ STM.atomically $ STM.readTMVar average

    liftIO $ hPutStr stdout $
      "\n" <>
      "Average FPS: " <> pack (show fps) <> "\n"

    Vk.deviceWaitIdle $ engineLogicalDevice engineData

createBufferView
  :: (MonadResource m)
  => Vk.Device
  -> m (ReleaseKey, Vk.BufferView)
createBufferView logicalDevice = do
  let bufferCreateInfo = Vk.zero
        { Vk.size        = 1024
        , Vk.usage       =
          Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT .|.
          Vk.BUFFER_USAGE_UNIFORM_TEXEL_BUFFER_BIT
        , Vk.sharingMode = Vk.SHARING_MODE_EXCLUSIVE
        }
  buffer <- snd <$> 
    (Vk.withBuffer logicalDevice bufferCreateInfo Nothing allocate)

  let bufferViewCreateInfo = Vk.zero
        { Vk.buffer = buffer
        , Vk.format = Vk.FORMAT_R32G32B32_SFLOAT
        , Vk.offset = 0
        , Vk.range  = Vk.WHOLE_SIZE
        }

  Vk.withBufferView logicalDevice bufferViewCreateInfo Nothing allocate

allocateMemory
  :: (MonadResource m)
  => Vk.Device
  -> Vk.Buffer
  -> m (ReleaseKey, Vk.DeviceMemory)
allocateMemory logicalDevice buffer = do
  memoryRequirements <- Vk.getBufferMemoryRequirements logicalDevice buffer

  let memoryAllocateInfo = Vk.zero
        { Vk.allocationSize  = memoryRequirements.size
        , Vk.memoryTypeIndex = error ("createBuffer: TODO: populate memoryTypeIndex!" :: String)
        }

  Vk.withMemory logicalDevice memoryAllocateInfo Nothing allocate
