vulkan-tutorial/src/Main.hs
2022-10-26 16:52:55 +02:00

113 lines
3.1 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
module Main where
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 Control.Concurrent.STM as STM
import qualified Vulkan as Vk
import qualified Vulkan.Zero as Vk
-- internal imports
import Init
import Draw (drawFrame)
import Types
main :: IO ()
main = runResourceT $ do
engineData <- initEngine
SDL.showWindow $ engineWindow engineData
-- create abort condition for upcoming lop
quit <- liftIO $ STM.newTMVarIO True
secondPipeline <- liftIO $ STM.newTMVarIO False
-- main loop
whileM_
(liftIO $ STM.atomically $ STM.readTMVar quit
)
( do
-- draw
drawFrame engineData secondPipeline
-- 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
SDL.KeyboardEvent dat ->
case dat of
SDL.KeyboardEventData _ SDL.Released _ (SDL.Keysym _ SDL.KeycodeSpace _) ->
liftIO $ STM.atomically $ do
state <- STM.readTMVar secondPipeline
void $ STM.swapTMVar secondPipeline (not state)
_ -> return ()
_ -> 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
)