Shader.hs

module DirectX9.D3D.Shader
where
import DirectX9.Types
import DirectX9.Error
import DirectX9.D3D.Raw
import DirectX9.D3D.Device

import Foreign              ( alloca, castPtr, withArray )

type VertexShader = ComObject IDirect3DVertexShader9

---------------------------------------------------------------------------
-- VertexShader

devCreateVertexShader :: Device -> Ptr DWORD -> IO VertexShader
devCreateVertexShader dev ptr = withCom dev
    $ \dev -> alloca
    $ \ret -> do
        hrFail "IDirect3DDevice9::CreateVertexShader" $
            c_IDirect3DDevice9_CreateVertexShader dev (castPtr ptr) ret
        peek ret >>= comMake

devCreateVertexShader' :: Device -> [DWORD] -> IO VertexShader
devCreateVertexShader' dev shader
    = withArray shader $ devCreateVertexShader dev

devSetVertexShader :: Device -> Maybe VertexShader -> IO ()
devSetVertexShader dev shader = withCom dev
    $ \dev -> case shader of
        Nothing     -> set dev nullPtr
        Just x      -> withCom x $ set dev
    where set dev shader = do
            hrFail "IDirect3DDevice9::SetVertexShader" 
                (c_IDirect3DDevice9_SetVertexShader dev shader)
            return ()


---------------------------------------------------------------------------
-- PixelShader

type PixelShader = ComObject IDirect3DPixelShader9

devCreatePixelShader :: Device -> Ptr DWORD -> IO PixelShader
devCreatePixelShader dev ptr = withCom dev
    $ \dev -> alloca
    $ \ret -> do
        hrFail "IDirect3DDevice9::CreatePixelShader" $
            c_IDirect3DDevice9_CreatePixelShader dev (castPtr ptr) ret
        peek ret >>= comMake

devCreatePixelShader' :: Device -> [DWORD] -> IO PixelShader
devCreatePixelShader' dev shader =
    withArray shader $ devCreatePixelShader dev

devSetPixelShader :: Device -> Maybe PixelShader -> IO ()
devSetPixelShader dev shader = withCom dev
    $ \dev -> case shader of
        Nothing     -> set dev nullPtr
        Just x      -> withCom x $ set dev
    where set dev shader = do
            hrFail "IDirect3DDevice9::SetPixelShader" 
                (c_IDirect3DDevice9_SetPixelShader dev shader)
            return ()



---------------------------------------------------------------------------
-- Shader Constants
-- The boring, repetitive way

devSetPixelShaderConstantB :: Device -> Int -> Ptr a -> Int -> IO ()
devSetPixelShaderConstantB dev idx buf count = withCom dev
    $ \dev -> do
        hrFail "IDirect3DDevice9::SetPixelShaderConstantB" $
            c_IDirect3DDevice9_SetPixelShaderConstantB
            dev (fromIntegral idx) (castPtr buf) (fromIntegral count)
        return ()
devSetPixelShaderConstantI :: Device -> Int -> Ptr a -> Int -> IO ()
devSetPixelShaderConstantI dev idx buf count = withCom dev
    $ \dev -> do
        hrFail "IDirect3DDevice9::SetPixelShaderConstantI" $
            c_IDirect3DDevice9_SetPixelShaderConstantI
            dev (fromIntegral idx) (castPtr buf) (fromIntegral count)
        return ()
devSetPixelShaderConstantF :: Device -> Int -> Ptr a -> Int -> IO ()
devSetPixelShaderConstantF dev idx buf count = withCom dev
    $ \dev -> do
        hrFail "IDirect3DDevice9::SetPixelShaderConstantF" $
            c_IDirect3DDevice9_SetPixelShaderConstantF
            dev (fromIntegral idx) (castPtr buf) (fromIntegral count)
        return ()
devSetVertexShaderConstantB :: Device -> Int -> Ptr a -> Int -> IO ()
devSetVertexShaderConstantB dev idx buf count = withCom dev
    $ \dev -> do
        hrFail "IDirect3DDevice9::SetVertexShaderConstantB" $
            c_IDirect3DDevice9_SetVertexShaderConstantB
            dev (fromIntegral idx) (castPtr buf) (fromIntegral count)
        return ()
devSetVertexShaderConstantI :: Device -> Int -> Ptr a -> Int -> IO ()
devSetVertexShaderConstantI dev idx buf count = withCom dev
    $ \dev -> do
        hrFail "IDirect3DDevice9::SetVertexShaderConstantI" $
            c_IDirect3DDevice9_SetVertexShaderConstantI
            dev (fromIntegral idx) (castPtr buf) (fromIntegral count)
        return ()
devSetVertexShaderConstantF :: Device -> Int -> Ptr a -> Int -> IO ()
devSetVertexShaderConstantF dev idx buf count = withCom dev
    $ \dev -> do
        hrFail "IDirect3DDevice9::SetVertexShaderConstantF" $
            c_IDirect3DDevice9_SetVertexShaderConstantF
            dev (fromIntegral idx) (castPtr buf) (fromIntegral count)
        return ()