{-# 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 showPipeline <- liftIO $ STM.newTMVarIO Rainbow -- main loop whileM_ (liftIO $ STM.atomically $ STM.readTMVar quit ) ( do -- draw drawFrame engineData showPipeline -- 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 showPipeline void $ STM.swapTMVar showPipeline (if state /= maxBound then succ state else state) SDL.KeyboardEventData _ SDL.Released _ (SDL.Keysym _ SDL.KeycodeTab _) -> liftIO $ STM.atomically $ do state <- STM.readTMVar showPipeline void $ STM.swapTMVar showPipeline (if state /= minBound then pred state else 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 )