Resource.hs

{-#  LANGUAGE FlexibleContexts #-}
module DirectX9.D3D.Resource
where
import Control.Exception ( bracket )
import Foreign.Marshal.Alloc ( alloca )
import Foreign.Marshal.Utils ( with )
import Foreign.Ptr  ( castPtr, nullPtr )
import Foreign.Storable ()

import DirectX9.Types
import DirectX9.Error
import DirectX9.D3D.Format
import DirectX9.D3D.Raw
import DirectX9.D3D.Device


resSetPriority :: (ComCast IDirect3DResource9 a) => ComObject a -> DWORD -> IO DWORD
resSetPriority obj p = withCastedCom obj $ \res ->
    c_IDirect3DResource9_SetPriority res p


resGetPriority :: (ComCast IDirect3DResource9 a) => ComObject a -> IO DWORD
resGetPriority res = withCastedCom res $ \res ->
    c_IDirect3DResource9_GetPriority res

resGetType :: (ComCast IDirect3DResource9 a) => ComObject a -> IO D3DRESOURCETYPE
resGetType res = withCastedCom res $ \res -> c_IDirect3DResource9_GetType res

resPreLoad :: (ComCast IDirect3DResource9 a) => ComObject a -> IO ()
resPreLoad res = withCastedCom res $ \res -> c_IDirect3DResource9_PreLoad res

resSetPrivateData :: (ComCast IDirect3DResource9 a) => ComObject a -> GUID -> Ptr () -> Int -> DWORD -> IO ()
resSetPrivateData res guid d size flags = withCastedCom res $
    \res -> with guid $
    \guid -> do
        hrFail "IDirect3DResource9::SetPrivateData" $
            c_IDirect3DResource9_SetPrivateData res guid d (fromIntegral size) flags
        return ()

resGetPrivateData :: (ComCast IDirect3DResource9 a) => ComObject a -> GUID -> Ptr () -> Int ->  IO DWORD
resGetPrivateData res guid d size = withCastedCom res $
    \res -> with guid $
    \guid -> with (fromIntegral size) $
    \size -> do
        ret <- hrSuccess [d3D_OK, d3DERR_MOREDATA] "IDirect3DResource9::GetPrivateData" $
            c_IDirect3DResource9_GetPrivateData res guid d size
        if ret==d3D_OK
            then return 0
            else peek size

resFreePrivateData :: (ComCast IDirect3DResource9 a) => ComObject a -> GUID -> IO Bool
resFreePrivateData res guid = withCastedCom res $
    \res -> with guid $
    \guid -> do
        ret <- hrSuccess
            [d3D_OK, d3DERR_NOTFOUND]
            "IDirect3DResource9::FreePrivateData"
            $ c_IDirect3DResource9_FreePrivateData res guid
        return $ ret==d3D_OK

---------------------------------------------------------------------------
-- VertexBuffer

type VertexBuffer = ComObject IDirect3DVertexBuffer9

devCreateVertexBuffer :: Device -> Int -> DWORD -> D3DFORMAT -> D3DPOOL -> IO VertexBuffer
devCreateVertexBuffer dev bytes usage format pool = withCom dev
    $ \dev -> alloca
    $ \ret -> do
        hrFail "IDirect3DDevice9::CreateVertexBuffer" $
            c_IDirect3DDevice9_CreateVertexBuffer
                dev (fromIntegral bytes) usage format pool ret nullPtr
        peek ret >>= comMake

vbGetDesc :: VertexBuffer -> IO D3DVERTEXBUFFER_DESC
vbGetDesc vb = withCom vb
    $ \vb -> alloca
    $ \ret -> do
        hrFail "IDirect3DVertexBuffer9::GetDesc" $
            c_IDirect3DVertexBuffer9_GetDesc vb ret
        peek ret

withLockedVertexBuffer :: VertexBuffer -> Int -> Int -> DWORD -> (Ptr a -> IO b) -> IO b
withLockedVertexBuffer vb offset size flags act =
    withCom vb $ \vb -> bracket
        (alloca $ \buf -> do
            hrFail "IDirect3DVertexBuffer9::Lock" $ c_IDirect3DVertexBuffer9_Lock
                vb (fromIntegral offset) (fromIntegral size) buf flags
            peek buf)
        (const $
            hrFail "IDirect3DVertexBuffer9::Unlock" $
                c_IDirect3DVertexBuffer9_Unlock vb)
        (act.castPtr)

devSetStreamSource :: Device -> Word -> VertexBuffer -> Word -> Word -> IO ()
devSetStreamSource dev s vb offset stride = withCom vb
    $ \vb -> withCom dev
    $ \dev -> do
        hrFail "IDirect3DDevice9::SetStreamSource" $
            c_IDirect3DDevice9_SetStreamSource
                dev (fromIntegral s) vb (fromIntegral offset) (fromIntegral stride)
        return ()


---------------------------------------------------------------------------
-- IndexBuffer

type IndexBuffer = ComObject IDirect3DIndexBuffer9

devCreateIndexBuffer :: Device -> Int -> DWORD -> D3DFORMAT -> D3DPOOL -> IO IndexBuffer
devCreateIndexBuffer dev bytes usage format pool = withCom dev
    $ \dev -> alloca
    $ \ret -> do
        hrFail "IDirect3DDevice9::CreateIndexBuffer" $
            c_IDirect3DDevice9_CreateIndexBuffer
                dev (fromIntegral bytes) usage format pool ret nullPtr
        peek ret >>= comMake

ibGetDesc :: IndexBuffer -> IO D3DINDEXBUFFER_DESC
ibGetDesc ib = withCom ib
    $ \ib -> alloca
    $ \ret -> do
        hrFail "IDirect3DIndexBuffer9::GetDesc" $
            c_IDirect3DIndexBuffer9_GetDesc ib ret
        peek ret

withLockedIndexBuffer :: IndexBuffer -> Int -> Int -> DWORD -> (Ptr a -> IO b) -> IO b
withLockedIndexBuffer ib offset size flags act =
    withCom ib $ \ib -> bracket
        (alloca $ \buf -> do
            hrFail "IDirect3DIndexBuffer9::Lock" $ c_IDirect3DIndexBuffer9_Lock
                ib (fromIntegral offset) (fromIntegral size) buf flags
            peek buf)
        (const $
            hrFail "IDirect3DIndexBuffer9::Unlock" $
                c_IDirect3DIndexBuffer9_Unlock ib)
        (act.castPtr)

devSetIndices :: Device -> IndexBuffer -> IO ()
devSetIndices dev ib = withCom dev
    $ \dev -> withCom ib
    $ \ib -> do
        hrFail "IDirect3DDevice9::SetIndices" $
            c_IDirect3DDevice9_SetIndices dev ib
        return ()