Base.hs

module DirectX9.D3D.Base
where
import Control.Monad    ( when )
import Foreign          ( alloca )

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

type Direct3D = ComObject IDirect3D9

createDirect3D :: IO Direct3D
createDirect3D = do
    d3d <- c_Direct3DCreate9 32 -- dx9.0c sdk
    when (d3d==nullPtr) $ fail "Direct3DCreate9 failed (returned 0)"
    comMake d3d

-- enumModes combines GetAdapterCount, GetAdapterModeCount and EnumAdapterModes
d3dEnumModes :: Direct3D -> IO [(UINT, [(UINT,Int,Int,Int,D3DFORMAT)])]
d3dEnumModes d3d = withCom d3d $ \d3d -> do
    adapters <- c_IDirect3D9_GetAdapterCount d3d
    mapM (mode d3d) [0..adapters]
    where
        mode d3d a = do
            modes <- mapM (mode' d3d a) validSurfaceFormats
            return (a, concat modes)
        mode' d3d a f = do
            modes <- c_IDirect3D9_GetAdapterModeCount d3d a f
            if modes==0
                then return []
                else mapM (mode'' d3d a f) [0..modes-1]
        mode'' d3d a f m = alloca $ \mode -> do
            hrFail "IDirect3D9::EnumAdapterModes" $ c_IDirect3D9_EnumAdapterModes d3d a f m mode
            (D3DDISPLAYMODE x y hz format) <- peek mode
            return (m, fromIntegral x, fromIntegral y, fromIntegral hz, format)

d3dCheckAvail_ :: Direct3D -> String -> (Ptr IDirect3D9 -> IO HRESULT) -> IO Bool
d3dCheckAvail_ d3d err act = do
    ret <- hrSuccess [d3D_OK, d3DERR_NOTAVAILABLE] err $ withCom d3d act
    return $ ret==d3D_OK

d3dCheckFormatConversion :: Direct3D -> UINT -> D3DDEVTYPE -> D3DFORMAT -> D3DFORMAT -> IO Bool
d3dCheckFormatConversion d3d a d f t =
    d3dCheckAvail_ d3d "IDirect3D9::CheckDeviceFormatConversion"
        $ \d3d -> c_IDirect3D9_CheckDeviceFormatConversion d3d a d f t

d3dCheckMultisample :: Direct3D -> UINT -> D3DDEVTYPE -> D3DFORMAT -> Bool -> D3DMULTISAMPLE_TYPE -> IO Bool
d3dCheckMultisample d3d a dt sf win mst =
    d3dCheckAvail_ d3d  "IDirect3D9::CheckDeviceMultiSampleType"
        $ \d3d -> c_IDirect3D9_CheckDeviceMultiSampleType d3d a dt sf win mst nullPtr

d3dCheckDevice :: Direct3D -> UINT -> D3DDEVTYPE -> D3DFORMAT -> D3DFORMAT -> Bool -> IO Bool
d3dCheckDevice d3d a dt df sf win =
    d3dCheckAvail_ d3d  "IDirect3D9::CheckDeviceType"
        $ \d3d -> c_IDirect3D9_CheckDeviceType d3d a dt df sf win

d3dCheckDepthStencil :: Direct3D -> UINT -> D3DDEVTYPE -> D3DFORMAT -> D3DFORMAT -> D3DFORMAT -> IO Bool
d3dCheckDepthStencil d3d a dt af sf dsf =
    d3dCheckAvail_ d3d "IDirect3D9::CheckDepthStencilMatch"
        $ \d3d -> c_IDirect3D9_CheckDepthStencilMatch d3d a dt af sf dsf

d3dCheckFormat :: Direct3D -> UINT -> D3DDEVTYPE -> D3DFORMAT -> DWORD -> D3DRESOURCETYPE -> D3DFORMAT -> IO Bool
d3dCheckFormat d3d a dt af usage rt f =
    d3dCheckAvail_ d3d "IDirect3D9::CheckDeviceFormat"
        $ \d3d -> c_IDirect3D9_CheckDeviceFormat d3d a dt af usage rt f


d3dGetAdapterDisplayMode :: Direct3D -> UINT -> IO D3DDISPLAYMODE
d3dGetAdapterDisplayMode d3d a =
    withCom d3d $ \d3d -> alloca $ \mode -> do
        hrFail "IDirect3D9::GetAdapterDisplayMode"
            $ c_IDirect3D9_GetAdapterDisplayMode d3d a mode
        peek mode

d3dGetDeviceCaps :: Direct3D -> UINT -> D3DDEVTYPE -> IO D3DCAPS9
d3dGetDeviceCaps d3d a at = withCom d3d $ \d3d -> alloca $ \caps -> do
    hrFail "IDirect3D9::GetDeviceCaps" $ c_IDirect3D9_GetDeviceCaps d3d a at caps
    peek caps