{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Framebuffer.Middle.Internal (
	F, CreateInfo(..), create, recreate, destroy,

	fToCore ) where

import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Storable
import Foreign.Storable.PeekPoke (
	withPoked, WithPoked, withPoked', withPtrS )
import Control.Arrow
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.ParMaybe qualified as TPMaybe
import Data.Word
import Data.IORef

import Gpu.Vulkan.Exception.Middle.Internal
import Gpu.Vulkan.Exception.Enum
import Gpu.Vulkan.Framebuffer.Enum

import Gpu.Vulkan.AllocationCallbacks.Middle.Internal
	qualified as AllocationCallbacks
import qualified Gpu.Vulkan.Device.Middle.Types as Device
import {-# SOURCE #-} qualified Gpu.Vulkan.RenderPass.Middle.Internal as RenderPass
import qualified Gpu.Vulkan.ImageView.Middle.Internal as ImageView
import qualified Gpu.Vulkan.Framebuffer.Core as C

data CreateInfo mn = CreateInfo {
	forall (mn :: Maybe (*)). CreateInfo mn -> M mn
createInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags
createInfoFlags :: CreateFlags,
	forall (mn :: Maybe (*)). CreateInfo mn -> R
createInfoRenderPass :: RenderPass.R,
	forall (mn :: Maybe (*)). CreateInfo mn -> [I]
createInfoAttachments :: [ImageView.I],
	forall (mn :: Maybe (*)). CreateInfo mn -> Word32
createInfoWidth :: Word32,
	forall (mn :: Maybe (*)). CreateInfo mn -> Word32
createInfoHeight :: Word32,
	forall (mn :: Maybe (*)). CreateInfo mn -> Word32
createInfoLayers :: Word32 }

deriving instance Show (TMaybe.M mn) => Show (CreateInfo mn)

createInfoToCore :: WithPoked (TMaybe.M mn) =>
	CreateInfo mn -> (Ptr C.CreateInfo -> IO a) -> IO ()
createInfoToCore :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCore CreateInfo {
	createInfoNext :: forall (mn :: Maybe (*)). CreateInfo mn -> M mn
createInfoNext = M mn
mnxt,
	createInfoFlags :: forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags
createInfoFlags = CreateFlagBits Word32
flgs,
	createInfoRenderPass :: forall (mn :: Maybe (*)). CreateInfo mn -> R
createInfoRenderPass = RenderPass.R R
rp,
	createInfoAttachments :: forall (mn :: Maybe (*)). CreateInfo mn -> [I]
createInfoAttachments = [I] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([I] -> Int) -> ([I] -> [I]) -> [I] -> (Int, [I])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [I] -> [I]
forall a. a -> a
id -> (Int
ac, [I]
as),
	createInfoWidth :: forall (mn :: Maybe (*)). CreateInfo mn -> Word32
createInfoWidth = Word32
w,
	createInfoHeight :: forall (mn :: Maybe (*)). CreateInfo mn -> Word32
createInfoHeight = Word32
h,
	createInfoLayers :: forall (mn :: Maybe (*)). CreateInfo mn -> Word32
createInfoLayers = Word32
l } Ptr CreateInfo -> IO a
f =
	M mn -> (forall s. PtrS s (M mn) -> IO ()) -> IO ()
forall a b.
WithPoked a =>
a -> (forall s. PtrS s a -> IO b) -> IO b
forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b
withPoked' M mn
mnxt \PtrS s (M mn)
pnxt -> PtrS s (M mn) -> (Ptr (M mn) -> IO a) -> IO ()
forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO ()
withPtrS PtrS s (M mn)
pnxt \(Ptr (M mn) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr -> Ptr ()
pnxt') ->
	Int -> (Ptr I -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
ac \Ptr I
pas -> do
		Ptr I -> [I] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr I
pas ([I] -> IO ()) -> IO [I] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< I -> IO I
ImageView.iToCore (I -> IO I) -> [I] -> IO [I]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` [I]
as
		let	ci :: CreateInfo
ci = C.CreateInfo {
				createInfoSType :: ()
C.createInfoSType = (),
				createInfoPNext :: Ptr ()
C.createInfoPNext = Ptr ()
pnxt',
				createInfoFlags :: Word32
C.createInfoFlags = Word32
flgs,
				createInfoRenderPass :: R
C.createInfoRenderPass = R
rp,
				createInfoAttachmentCount :: Word32
C.createInfoAttachmentCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ac,
				createInfoPAttachments :: Ptr I
C.createInfoPAttachments = Ptr I
pas,
				createInfoWidth :: Word32
C.createInfoWidth = Word32
w,
				createInfoHeight :: Word32
C.createInfoHeight = Word32
h,
				createInfoLayers :: Word32
C.createInfoLayers = Word32
l }
		CreateInfo -> (Ptr CreateInfo -> IO a) -> IO a
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked CreateInfo
ci Ptr CreateInfo -> IO a
f

newtype F = F (IORef C.F)

fToCore :: F -> IO C.F
fToCore :: F -> IO F
fToCore (F IORef F
f) = IORef F -> IO F
forall a. IORef a -> IO a
readIORef IORef F
f

fFromCore :: C.F -> IO F
fFromCore :: F -> IO F
fFromCore F
f = IORef F -> F
F (IORef F -> F) -> IO (IORef F) -> IO F
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> F -> IO (IORef F)
forall a. a -> IO (IORef a)
newIORef F
f

create :: WithPoked (TMaybe.M mn) =>
	Device.D -> CreateInfo mn -> TPMaybe.M AllocationCallbacks.A mc -> IO F
create :: forall (mn :: Maybe (*)) (mc :: Maybe (*)).
WithPoked (M mn) =>
D -> CreateInfo mn -> M A mc -> IO F
create (Device.D D
dvc) CreateInfo mn
ci M A mc
mac = F -> IO F
fFromCore (F -> IO F) -> IO F -> IO F
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Ptr F -> IO F) -> IO F
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr F
pf -> do
	CreateInfo mn -> (Ptr CreateInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCore CreateInfo mn
ci \Ptr CreateInfo
pci ->
		M A mc -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A mc
mac \Ptr A
pac -> do
			Result -> IO ()
throwUnlessSuccess (Result -> IO ()) -> (Int32 -> Result) -> Int32 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Result
Result (Int32 -> IO ()) -> IO Int32 -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< D -> Ptr CreateInfo -> Ptr A -> Ptr F -> IO Int32
C.create D
dvc Ptr CreateInfo
pci Ptr A
pac Ptr F
pf
	Ptr F -> IO F
forall a. Storable a => Ptr a -> IO a
peek Ptr F
pf

destroy :: Device.D -> F -> TPMaybe.M AllocationCallbacks.A md -> IO ()
destroy :: forall (md :: Maybe (*)). D -> F -> M A md -> IO ()
destroy (Device.D D
dvc) F
f M A md
mac = M A md -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A md
mac \Ptr A
pac -> do
	f' <- F -> IO F
fToCore F
f; C.destroy dvc f' pac

recreate :: WithPoked (TMaybe.M mn) =>
	Device.D -> CreateInfo mn -> TPMaybe.M AllocationCallbacks.A mc ->
	TPMaybe.M AllocationCallbacks.A md -> F -> IO ()
recreate :: forall (mn :: Maybe (*)) (mc :: Maybe (*)) (md :: Maybe (*)).
WithPoked (M mn) =>
D -> CreateInfo mn -> M A mc -> M A md -> F -> IO ()
recreate (Device.D D
dvc) CreateInfo mn
ci M A mc
macc M A md
macd f :: F
f@(F IORef F
rf) =
	F -> IO F
fToCore F
f IO F -> (F -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \F
o -> (Ptr F -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr F
pf ->
	CreateInfo mn -> (Ptr CreateInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCore CreateInfo mn
ci \Ptr CreateInfo
pci ->
	M A mc -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A mc
macc \Ptr A
pacc ->
	M A md -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A md
macd \Ptr A
pacd -> do
		r <- D -> Ptr CreateInfo -> Ptr A -> Ptr F -> IO Int32
C.create D
dvc Ptr CreateInfo
pci Ptr A
pacc Ptr F
pf
		throwUnlessSuccess $ Result r
		writeIORef rf =<< peek pf
		C.destroy dvc o pacd