vulkan-tutorial/src/Main.hs

{-# 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 qualified Data.Map.Strict as M
import qualified Data.Vector as V
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
  renderablesContainer <- STM.newTMVarIO (V.empty)
  meshMap <- STM.newTMVarIO (M.empty)
  materialMap <- STM.newTMVarIO (M.empty)
  let initState = ReadState
        { renderables = renderablesContainer
        , meshLibrary = meshMap
        , materialLibrary = materialMap
        }
  runRender initState $ 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
      )