{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
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.Word
import qualified SDL hiding (V2)
import qualified Vulkan as Vk
import qualified Vulkan.Zero as Vk

-- internal imports

import Init
import Draw (drawFrame)
import Types

main :: IO ()
main = do
  container <- STM.newEmptyTMVarIO
  runRender (ReadState container) $ do
    engineData <- initEngine

    SDL.showWindow $ engineWindow engineData

    -- create abort condition for upcoming lop
    quit <- liftIO $ STM.newTMVarIO True
    frameContainer <- liftIO $ STM.newTMVarIO 0

    -- main loop
    whileM_
      (liftIO $ STM.atomically $ STM.readTMVar quit
        )
      ( do
        frameNumber <- liftIO $ STM.atomically $ STM.takeTMVar frameContainer
        liftIO $ STM.atomically $ STM.putTMVar frameContainer (succ frameNumber)
        -- draw
        drawFrame engineData frameNumber
        -- 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
      )

    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 <$> allocate
    (Vk.createBuffer logicalDevice bufferCreateInfo Nothing)
    (\buffer -> do
      putStrLn "destroying buffer"
      Vk.destroyBuffer logicalDevice buffer Nothing
      )

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

  allocate
    (Vk.createBufferView logicalDevice bufferViewCreateInfo Nothing)
    (\bufferView -> do
      putStrLn "destroying bufferView"
      Vk.destroyBufferView logicalDevice bufferView Nothing
      )

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  = (Vk.size :: Vk.MemoryRequirements -> Word64) memoryRequirements
        , Vk.memoryTypeIndex = error ("createBuffer: TODO: populate memoryTypeIndex!" :: String)
        }

  allocate
    (Vk.allocateMemory logicalDevice memoryAllocateInfo Nothing)
    (\memory -> do
      putStrLn "Freeing memory"
      Vk.freeMemory logicalDevice memory Nothing
      )