packages feed

dx9d3d-0.1: DirectX9/D3D/Surface.hs

module DirectX9.D3D.Surface
where
import Control.Exception    ( bracket )
import Foreign  ( alloca, with, castPtr, nullPtr, maybeWith )

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

type Surface = ComObject IDirect3DSurface9

surfGetDC :: Surface -> IO HDC
surfGetDC surf = withCom surf
    $ \surf -> alloca
    $ \ret -> do
        hrFail "IDirect3DSurface9::GetDC" $ c_IDirect3DSurface9_GetDC surf ret
        peek ret


surfGetDesc :: Surface -> IO D3DSURFACE_DESC
surfGetDesc surf = withCom surf
    $ \surf -> alloca
    $ \ret -> do
        hrFail "IDirect3DSurface9::GetDesc" $ c_IDirect3DSurface9_GetDesc surf ret
        peek ret

surfReleaseDC :: Surface -> HDC -> IO ()
surfReleaseDC surf hdc = withCom surf $ \surf -> do
    hrFail "IDirect3DSurface9::ReleaseDC" $ c_IDirect3DSurface9_ReleaseDC surf hdc
    return ()

withLockedSurface :: Surface -> Maybe RECT -> DWORD -> (D3DLOCKED_RECT -> IO b) -> IO b
withLockedSurface surf rect flags act = withCom surf $ \surf -> bracket
    (alloca
        $ \lock -> maybeWith with rect
        $ \rect -> do
            hrFail "IDirect3DSurface9::LockRect" $
                c_IDirect3DSurface9_LockRect surf lock (castPtr rect) flags
            peek lock)
    (const $ hrFail "IDirect3DSurface9::UnlockRect" $
        c_IDirect3DSurface9_UnlockRect surf)
    act


devCreateDepthStencilSurface :: Device -> Int -> Int -> D3DFORMAT -> D3DMULTISAMPLE_TYPE -> DWORD -> Bool -> IO Surface
devCreateDepthStencilSurface dev width height format multisample msq discard =
    withCom dev $ \dev -> alloca $ \ret -> do
        hrFail "IDirect3DDevice9::CreateDepthStencilSurface" $ c_IDirect3DDevice9_CreateDepthStencilSurface
            dev (fromIntegral width) (fromIntegral height) format multisample msq discard ret nullPtr
        peek ret >>= comMake

devGetDepthStencilSurface :: Device -> IO (Maybe Surface)
devGetDepthStencilSurface dev = withCom dev $ \dev -> alloca $ \ret -> do
    err <- hrSuccess [d3D_OK,d3DERR_NOTFOUND]
        "IDirect3DDevice9::GetDepthStencilSurface" $
        c_IDirect3DDevice9_GetDepthStencilSurface dev ret
    if err==d3D_OK
        then do
            s <- comMake =<< peek ret
            return $ Just s
        else return Nothing

devSetDepthStencilSurface :: Device -> Maybe Surface -> IO  ()
devSetDepthStencilSurface dev surf = withCom dev
    $ \dev -> maybeWith withCom surf
    $ \surf -> do
        hrFail "IDirect3DDevice9::SetDepthStencilSurface" $
            c_IDirect3DDevice9_SetDepthStencilSurface dev surf
        return ()


textureGetSurfaceLevel :: Texture -> Int -> IO Surface
textureGetSurfaceLevel tex lvl = withCom tex
    $ \tex -> alloca
    $ \ret -> do
        hrFail "IDirect3DTexture9::GetSurfaceLevel"
            $ c_IDirect3DTexture9_GetSurfaceLevel tex (fromIntegral lvl) ret
        peek ret >>= comMake