module DirectX9.D3D.Device
where
import Control.Monad    ( when )
import Foreign.Marshal.Alloc ( alloca, allocaBytes )
import Foreign.Marshal.Array ( withArray, peekArray0, withArray0 )
import Foreign.Marshal.Utils ( with )
import Foreign.Ptr  ( nullPtr, castPtr )
import Foreign.Storable ()

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

type Device = ComObject IDirect3DDevice9

d3dCreateDevice :: Direct3D -> UINT -> D3DDEVTYPE -> HWND -> DWORD -> D3DPRESENT_PARAMETERS -> IO (Device, D3DPRESENT_PARAMETERS)
d3dCreateDevice d3d a at window usage present' = do
    (dev, param) <- withCom d3d
        $ \d3d -> alloca
        $ \dev -> with present'
        $ \present -> do
            hrFail "IDirect3D9::CreateDevice"
                $ c_IDirect3D9_CreateDevice d3d a at window usage present dev
            d <- peek dev
            p <- peek present
            return (d,p)
    when (dev==nullPtr) $ fail "IDirect3D::CreateDevice failed (object at 0)"
    dev <- comMake dev
    return (dev,param)

devReset :: Device -> D3DPRESENT_PARAMETERS -> IO ()
devReset dev par = withCom dev $ \dev -> with par $ \par -> do
    hrFail "IDirect3DDevice9::Reset" $ c_IDirect3DDevice9_Reset dev par
    return ()

devBeginScene :: Device -> IO ()
devBeginScene dev = withCom dev $ \dev -> do
    hrFail "IDirect3DDevice9::BeginScene" $ c_IDirect3DDevice9_BeginScene dev
    return ()

devEndScene :: Device -> IO ()
devEndScene dev = withCom dev $ \dev -> do
    hrFail "IDirect3DDevice9::EndScene" $ c_IDirect3DDevice9_EndScene dev
    return ()

-- version that doesn't take RECTs or RGNDATA
devPresentMinimal :: Device -> HWND -> IO ()
devPresentMinimal dev hwnd = withCom dev $ \dev -> do
    hrFail "IDirect3DDevice9::Present" $ c_IDirect3DDevice9_Present
        dev nullPtr nullPtr hwnd nullPtr
    return ()

devClear :: Device -> [D3DRECT] -> DWORD -> D3DCOLOR -> Float -> DWORD -> IO ()
devClear dev dirty flags color z stencil =
    withCom dev $ 
        \dev -> withArray dirty $
        \dirty' -> do
            let
                count = fromIntegral $ length dirty
                prects = if count==0 then nullPtr else dirty'
            hrFail "IDirect3DDevice9::Clear" $ c_IDirect3DDevice9_Clear
                dev count prects flags color z stencil
            return ()

devSetTransform :: Device -> D3DTRANSFORMSTATETYPE -> D3DMATRIX -> IO ()
devSetTransform dev t m = withCom dev $ \dev -> alloca $ \mat -> do
    poke mat m
    hrFail "IDirect3DDevice9::SetTransform" $ c_IDirect3DDevice9_SetTransform dev t mat
    return ()

devMultiplyTransform :: Device -> D3DTRANSFORMSTATETYPE -> D3DMATRIX -> IO ()
devMultiplyTransform dev t m = withCom dev
    $ \dev -> with m
    $ \mat -> do
        hrFail "IDirect3DDevice9::MultiplyTransform" $
            c_IDirect3DDevice9_MultiplyTransform dev t mat
        return ()

devSetRenderState :: Device -> D3DRENDERSTATETYPE -> DWORD -> IO ()
devSetRenderState dev state value = withCom dev $ \dev -> do
    hrFail "IDirect3DDevice9::SetRenderState" $
        c_IDirect3DDevice9_SetRenderState dev state value
    return ()


devSetFVF :: Device -> DWORD -> IO ()
devSetFVF dev fvf = withCom dev $ \dev -> do
    hrFail "IDirect3DDevice9::SetFVF" $ c_IDirect3DDevice9_SetFVF dev fvf
    return ()


devDrawIndexedPrimitive :: Device -> D3DPRIMITIVETYPE -> Word -> Word -> Word -> Word -> Word -> IO ()
devDrawIndexedPrimitive dev t base min num start count = withCom dev $ \dev -> do
    hrFail "IDirect3DDevice9::DrawIndexedPrimitive" $
        c_IDirect3DDevice9_DrawIndexedPrimitive
            dev t (fromIntegral base) (fromIntegral min) (fromIntegral num)
            (fromIntegral start) (fromIntegral count)
    return ()


devDrawPrimitiveUP :: Device -> D3DPRIMITIVETYPE -> Word -> Ptr a -> Int -> IO ()
devDrawPrimitiveUP dev t count buf stride = withCom dev $ \dev -> do
    hrFail "IDirect3DDevice9::DrawPrimitiveUP" $ c_IDirect3DDevice9_DrawPrimitiveUP
        dev t (fromIntegral count) (castPtr buf) (fromIntegral stride)
    return ()

devDrawIndexedPrimitiveUP :: 
    Device -> D3DPRIMITIVETYPE -> Word -> Word -> Word -> Ptr a
    -> D3DFORMAT -> Ptr b -> Word -> IO ()
devDrawIndexedPrimitiveUP dev t minv numv count vtx it idx stride =
    withCom dev $ \dev -> do
        hrFail "IDirect3DDevice9::DrawIndexedPrimitiveUP"
            $ c_IDirect3DDevice9_DrawIndexedPrimitiveUP dev
                t (fromIntegral minv) (fromIntegral numv) (fromIntegral count)
                (castPtr vtx) it (castPtr idx) (fromIntegral stride)
        return   ()

devDrawPrimitive :: Device -> D3DPRIMITIVETYPE -> Word -> Word -> IO ()
devDrawPrimitive dev t start count = withCom dev $ \dev -> do
    hrFail "IDirect3DDevice9::DrawPrimitive" $ c_IDirect3DDevice9_DrawPrimitive
        dev t (fromIntegral start) (fromIntegral count)
    return ()

devDrawRectPatch :: Device -> Word -> [Float] -> D3DRECTPATCH_INFO -> IO ()
devDrawRectPatch dev handle segs patch =
    withCom dev $ \dev ->
    withArray segs $ \segs ->
    with patch $ \patch -> do
        hrFail "IDirect3DDevice9::DrawRectPatch" $
            c_IDirect3DDevice9_DrawRectPatch dev (fromIntegral handle) segs patch
        return ()

devDrawTriPatch :: Device -> Word -> [Float] -> D3DTRIPATCH_INFO -> IO ()
devDrawTriPatch dev handle segs patch =
    withCom dev $ \dev ->
    withArray segs $ \segs ->
    with patch $ \patch -> do
        hrFail "IDirect3DDevice9::DrawTriPatch" $
            c_IDirect3DDevice9_DrawTriPatch dev (fromIntegral handle) segs patch
        return ()

devDeletePatch :: Device -> UINT -> IO ()
devDeletePatch dev handle = withCom dev $ \dev -> do
    hrFail "IDirect3DDevice9::DeletePatch" $ c_IDirect3DDevice9_DeletePatch dev handle
    return ()

devGetDeviceCaps :: Device -> IO D3DCAPS9
devGetDeviceCaps dev = withCom dev
    $ \dev -> alloca
    $ \buf -> do
        hrFail "IDirect3DDevice9::GetDeviceCaps" $
            c_IDirect3DDevice9_GetDeviceCaps dev buf
        peek buf

devSetLight :: Device -> Int -> D3DLIGHT9 -> IO ()
devSetLight dev idx light = withCom dev
    $ \dev -> with light
    $ \light -> do
        hrFail "IDirect3DDevice9::SetLight" $ c_IDirect3DDevice9_SetLight
            dev (fromIntegral idx) light
        return ()

devLightEnable :: Device -> Int -> Bool -> IO ()
devLightEnable dev li e = withCom dev $ \dev -> do
    hrFail "IDirect3DDevice9::LightEnable" $
        c_IDirect3DDevice9_LightEnable dev (fromIntegral li) e
    return ()

devSetMaterial :: Device -> D3DMATERIAL9 -> IO ()
devSetMaterial dev mat = withCom dev
    $ \dev -> with mat
    $ \mat -> do
        hrFail "IDirect3DDevice9::SetMaterial" $
            c_IDirect3DDevice9_SetMaterial dev mat
        return ()

devSetNPatchMode :: Device -> Float -> IO ()
devSetNPatchMode dev segs = withCom dev $ \dev -> do
    hrFail "IDirect3DDevice9::SetNPatchMode"
        $ c_IDirect3DDevice9_SetNPatchMode dev segs
    return ()


devSetTextureStageState :: Device -> Int -> D3DTEXTURESTAGESTATETYPE -> DWORD -> IO ()
devSetTextureStageState dev stage t v = withCom dev $ \dev -> do
    hrFail "IDirect3DDevice9::SetTextureStageState" $
        c_IDirect3DDevice9_SetTextureStageState dev (fromIntegral stage) t v
    return ()


devSetClipPlane :: Device -> Int -> (Float,Float,Float,Float) -> IO ()
devSetClipPlane dev idx (v1,v2,v3,v4) = withCom dev
    $ \dev -> withArray [v1,v2,v3,v4]
    $ \buf -> do
        hrFail "IDirect3DDevice9::SetClipPlane" $
            c_IDirect3DDevice9_SetClipPlane dev (fromIntegral idx) buf
        return ()   

devSetClipStatus :: Device -> D3DCLIPSTATUS9 -> IO ()
devSetClipStatus dev cs = withCom dev
    $ \dev -> with cs
    $ \cs -> do
        hrFail "IDirect3DDevice9::SetClipStatus" $
            c_IDirect3DDevice9_SetClipStatus dev cs
        return ()

devValidate :: Device -> IO (Either DWORD HRESULT)
devValidate dev = withCom dev
    $ \dev -> alloca
    $ \passes -> do
        ret <- hrSuccess success "IDirect3DDevice9::ValidateDevice" $
            c_IDirect3DDevice9_ValidateDevice dev passes
        if ret==d3D_OK
            then peek passes >>= return.Left
            else return $ Right ret
    where
        success = 
            [ d3DERR_CONFLICTINGRENDERSTATE, d3DERR_CONFLICTINGTEXTUREFILTER
            , d3DERR_DEVICELOST, d3DERR_DRIVERINTERNALERROR, d3DERR_TOOMANYOPERATIONS
            , d3DERR_UNSUPPORTEDALPHAARG, d3DERR_UNSUPPORTEDALPHAOPERATION
            , d3DERR_UNSUPPORTEDCOLORARG, d3DERR_UNSUPPORTEDCOLOROPERATION
            , d3DERR_UNSUPPORTEDFACTORVALUE, d3DERR_UNSUPPORTEDTEXTUREFILTER
            , d3DERR_WRONGTEXTUREFORMAT, d3D_OK ]

devSetViewport :: Device -> Int -> Int -> Int -> Int -> Float -> Float -> IO ()
devSetViewport dev x y width height minz maxz = withCom dev
    $ \dev -> with viewport
    $ \vp -> do
        hrFail "IDirect3DDevice9::SetViewport" $
            c_IDirect3DDevice9_SetViewport dev vp
        return ()
    where
        viewport = (D3DVIEWPORT9
            (fromIntegral x) (fromIntegral y)
            (fromIntegral width) (fromIntegral height)
            minz maxz)


devTestCooperativeLevel :: Device -> IO HRESULT
devTestCooperativeLevel dev = withCom dev $ \dev ->
    hrSuccess [d3D_OK, d3DERR_DEVICELOST, d3DERR_DEVICENOTRESET]
        "IDirect3DDevice9::TestCooperativeLevel" $
        c_IDirect3DDevice9_TestCooperativeLevel dev

---------------------------------------------------------------------------
-- VertexDeclaration

type VertexDeclaration = ComObject IDirect3DVertexDeclaration9

d3DDECL_END :: D3DVERTEXELEMENT9
d3DDECL_END = D3DVERTEXELEMENT9 0xFF 0 d3DDECLTYPE_UNUSED 0 0 0

devCreateVertexDeclaration :: Device -> [D3DVERTEXELEMENT9] -> IO VertexDeclaration
devCreateVertexDeclaration dev decl = withCom dev
    $ \dev -> withArray0 d3DDECL_END decl
    $ \decl -> alloca
    $ \ret -> do
        hrFail "IDirect3DDevice9::CreateVertexDeclaration" $
            c_IDirect3DDevice9_CreateVertexDeclaration dev decl ret
        peek ret >>= comMake


devSetVertexDeclaration :: Device -> VertexDeclaration -> IO ()
devSetVertexDeclaration dev vd = withCom dev
    $ \dev -> withCom vd
    $ \vd -> do
        hrFail "IDirect3DDevice9::SetVertexDeclaration" $
            c_IDirect3DDevice9_SetVertexDeclaration dev vd
        return ()

vertexDeclGetDeclaration :: VertexDeclaration -> IO [D3DVERTEXELEMENT9]
vertexDeclGetDeclaration vd = withCom vd
    $ \vd -> alloca
    $ \count -> allocaBytes (1024*(sizeOf (undefined::D3DVERTEXELEMENT9)))
    $ \buf -> do
        poke count 1024
        hrFail "IDirect3DVertexDeclaration9::GetDeclaration" $
            c_IDirect3DVertexDeclaration9_GetDeclaration vd buf count
        peekArray0 d3DDECL_END buf