d3d11binding 0.0.0.1 → 0.0.0.2

raw patch · 19 files changed

+779/−19 lines, 19 files

Files

csource/wrapper.c +101/−0
d3d11binding.cabal +15/−1
examples/HelloWorld.hs +88/−7
src/Graphics/D3D11Binding.hs +4/−0
src/Graphics/D3D11Binding/Enums.hs +110/−1
src/Graphics/D3D11Binding/Interface.hs +12/−2
src/Graphics/D3D11Binding/Interface/D3D11Buffer.hs +9/−0
src/Graphics/D3D11Binding/Interface/D3D11ClassLinkage.hs +3/−0
src/Graphics/D3D11Binding/Interface/D3D11Device.hs +61/−7
src/Graphics/D3D11Binding/Interface/D3D11DeviceContext.hs +55/−0
src/Graphics/D3D11Binding/Interface/D3D11InputLayout.hs +3/−0
src/Graphics/D3D11Binding/Interface/D3DBlob.hs +24/−0
src/Graphics/D3D11Binding/Interface/D3DInclude.hs +3/−0
src/Graphics/D3D11Binding/Shader.hs +15/−0
src/Graphics/D3D11Binding/Shader/Compile.hs +88/−0
src/Graphics/D3D11Binding/Shader/D3D11PixelShader.hs +7/−0
src/Graphics/D3D11Binding/Shader/D3D11VertexShader.hs +7/−0
src/Graphics/D3D11Binding/Shader/Flags.hs +76/−0
src/Graphics/D3D11Binding/Types.hs +98/−1

csource/wrapper.c view

@@ -59,4 +59,105 @@ void ClearState(ID3D11DeviceContext* This)
 {
   This->lpVtbl->ClearState(This);
+}
+
+void* GetBufferPointer(ID3DBlob* This)
+{
+  return This->lpVtbl->GetBufferPointer(This);
+}
+
+void GetBufferSize(ID3DBlob* This)
+{
+  This->lpVtbl->GetBufferSize(This);
+}
+
+HRESULT CreateVertexShader(
+  ID3D11Device* This,
+  const void *pShaderBytecode,
+  SIZE_T BytecodeLength,
+  ID3D11ClassLinkage *pClassLinkage,
+  ID3D11VertexShader **ppVertexShader)
+{
+    return This->lpVtbl->CreateVertexShader(This, pShaderBytecode, BytecodeLength, pClassLinkage, ppVertexShader);
+}
+
+HRESULT CreatePixelShader( 
+  ID3D11Device* This,
+  const void *pShaderBytecode,
+  SIZE_T BytecodeLength,
+  ID3D11ClassLinkage *pClassLinkage,
+  ID3D11PixelShader **ppPixelShader)
+{
+    return This->lpVtbl->CreatePixelShader(This, pShaderBytecode, BytecodeLength, pClassLinkage, ppPixelShader);
+}
+
+HRESULT CreateInputLayout( 
+  ID3D11Device* This,
+  const D3D11_INPUT_ELEMENT_DESC* pInputElementDescs,
+  UINT NumElements,
+  const void* pShaderBytecodeWithInputSignature,
+  SIZE_T BytecodeLength,
+  ID3D11InputLayout** ppInputLayout)
+{
+  return This->lpVtbl->CreateInputLayout(This, pInputElementDescs, NumElements, pShaderBytecodeWithInputSignature, BytecodeLength, ppInputLayout);
+}
+
+void IASetInputLayout( 
+  ID3D11DeviceContext* This,
+  ID3D11InputLayout *pInputLayout)
+{
+  return This->lpVtbl->IASetInputLayout(This, pInputLayout);
+}
+
+HRESULT CreateBuffer( 
+  ID3D11Device* This,
+  const D3D11_BUFFER_DESC *pDesc,
+  const D3D11_SUBRESOURCE_DATA *pInitialData,
+  ID3D11Buffer **ppBuffer)
+{
+  return This->lpVtbl->CreateBuffer(This, pDesc, pInitialData, ppBuffer);
+}
+
+void IASetVertexBuffers( 
+  ID3D11DeviceContext* This,
+  UINT StartSlot,
+  UINT NumBuffers,
+  ID3D11Buffer *const *ppVertexBuffers,
+  const UINT *pStrides,
+  const UINT *pOffsets)
+{
+  This->lpVtbl->IASetVertexBuffers(This, StartSlot, NumBuffers, ppVertexBuffers, pStrides, pOffsets);
+}
+
+void IASetPrimitiveTopology( 
+  ID3D11DeviceContext* This,
+  D3D11_PRIMITIVE_TOPOLOGY Topology)
+{
+  This->lpVtbl->IASetPrimitiveTopology(This, Topology);
+}
+
+void VSSetShader(
+  ID3D11DeviceContext* This,
+  ID3D11VertexShader *pVertexShader,
+  ID3D11ClassInstance *const *ppClassInstances,
+  UINT NumClassInstances)
+{
+  return This->lpVtbl->VSSetShader(This, pVertexShader, ppClassInstances, NumClassInstances);
+}
+
+void PSSetShader(
+  ID3D11DeviceContext* This,
+  ID3D11PixelShader *pPixelShader,
+  ID3D11ClassInstance *const *ppClassInstances,
+  UINT NumClassInstances)
+{
+  return This->lpVtbl->PSSetShader(This, pPixelShader, ppClassInstances, NumClassInstances);
+}
+
+void Draw( 
+  ID3D11DeviceContext* This,
+  UINT VertexCount,
+  UINT StartVertexLocation)
+{
+  This->lpVtbl->Draw(This, VertexCount, StartVertexLocation); 
 }

d3d11binding.cabal view

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                d3d11binding
-version:             0.0.0.1
+version:             0.0.0.2
 synopsis:            A raw binding for the directX 11
 description:         A raw binding for the directX 11   
 homepage:            https://github.com/jwvg0425/d3d11binding
@@ -28,17 +28,31 @@     Graphics.D3D11Binding.Types
     Graphics.D3D11Binding.Interface
     
+    Graphics.D3D11Binding.Interface.D3D11Buffer
+    Graphics.D3D11Binding.Interface.D3D11ClassLinkage
     Graphics.D3D11Binding.Interface.D3D11DepthStencilView
     Graphics.D3D11Binding.Interface.D3D11Device
     Graphics.D3D11Binding.Interface.D3D11DeviceContext
+    Graphics.D3D11Binding.Interface.D3D11InputLayout
     Graphics.D3D11Binding.Interface.D3D11RenderTargetView
     Graphics.D3D11Binding.Interface.D3D11Resource
+    Graphics.D3D11Binding.Interface.D3DBlob
+    Graphics.D3D11Binding.Interface.D3DInclude
     
     Graphics.D3D11Binding.Interface.DxgiAdapter
     Graphics.D3D11Binding.Interface.DxgiSwapChain
     
     Graphics.D3D11Binding.Interface.Texture2D
     Graphics.D3D11Binding.Interface.Unknown
+    
+    Graphics.D3D11Binding.Shader
+    
+    Graphics.D3D11Binding.Shader.Compile
+    
+    Graphics.D3D11Binding.Shader.D3D11PixelShader
+    Graphics.D3D11Binding.Shader.D3D11VertexShader
+    
+    Graphics.D3D11Binding.Shader.Flags
     
     Graphics.D3D11Binding.GUID
   -- other-modules:

examples/HelloWorld.hs view

@@ -8,6 +8,7 @@ import Control.Monad
 
 import Foreign (peekByteOff)
+import Foreign.Storable
 import Foreign.Ptr
 
 import Graphics.Win32
@@ -20,9 +21,66 @@ main :: IO ()
 main = do
   hWnd <- createDefaultWindow 800 600 wndProc
+  useDevice hWnd $ \swapChain device deviceContext renderTargetView -> do
+    vb <- compileShaderFromFile "fx/HelloWorld.fx" "VS" "vs_4_0"
+    vs <- use vb $ \vsBlob -> do
+      pointer <- getBufferPointer vsBlob
+      size <- getBufferSize vsBlob
+      Right vertexShader <- createVertexShader 
+                              device
+                              pointer
+                              size
+                              nullPtr
+      
+      Right inputLayout <- createInputLayout
+                              device
+                              [D3D11InputElementDesc 
+                                  "POSITION" 
+                                  (fromIntegral 0)
+                                  DxgiFormatR32G32B32Float
+                                  (fromIntegral 0)
+                                  (fromIntegral 0)
+                                  D3D11InputPerVertexData
+                                  (fromIntegral 0)]
+                              pointer
+                              size
+      iaSetInputLayout deviceContext inputLayout
+      return vertexShader
+    
+    pb <- compileShaderFromFile "fx/HelloWorld.fx" "PS" "ps_4_0"
+    ps <- use pb $ \psBlob -> do
+      pointer <- getBufferPointer psBlob
+      size <- getBufferSize psBlob
+      Right pixelShader <- createPixelShader
+                            device
+                            pointer
+                            size
+                            nullPtr
+      
+      let bd = D3D11BufferDesc
+                { byteWidth = fromIntegral $ 3 * sizeOf (undefined :: Vertex3)
+                , usage = D3D11UsageDefault
+                , bindFlags = d3d11BindFlags [D3D11BindVertexBuffer]
+                , cpuAccessFlags = 0
+                , miscFlags = 0
+                , structureByteStride = 0 }
+      Right buffer <- createBuffer
+                        device
+                        bd
+                        [ Vertex3 0.0 0.5 0.5
+                        , Vertex3 0.5 (-0.5) 0.5
+                        , Vertex3 (-0.5) (-0.5) 0.5 ]
+      iaSetVertexBuffers deviceContext 0 [(buffer, fromIntegral $ sizeOf (undefined :: Vertex3), 0)]
+      iaSetPrimitiveTopology deviceContext D3D11PrimitiveTopologyTrianglelist
+      return pixelShader
+    
+    use vs $ \vertexShader -> use ps $ \pixelShader -> do
+      messagePump hWnd deviceContext swapChain renderTargetView vertexShader pixelShader
+
+useDevice hWnd proc = do
   (s, d, dc, r) <- initDevice hWnd
-  use s $ \swapChain -> use d $ \device -> use dc $ \deviceContext -> use r $ \renderTargetView -> do
-    messagePump hWnd deviceContext swapChain renderTargetView
+  use s $ \swapChain -> use d $ \device -> use dc $ \deviceContext -> use r $ \renderTargetView ->
+    proc swapChain device deviceContext renderTargetView
   
 wndProc :: WindowClosure
 wndProc hWnd msg wParam lParam
@@ -65,6 +123,19 @@   
   return (swapChain, device, deviceContext, renderTargetView)
 
+compileShaderFromFile :: String -> String -> String -> IO (Ptr ID3DBlob)
+compileShaderFromFile fileName entryPoint shaderModel = do
+  Right res <- d3dCompileFromFile 
+      fileName
+      Nothing
+      Nothing
+      nullPtr
+      (Just entryPoint)
+      shaderModel
+      [d3dCompileEnableStrictness]
+      []
+  return res
+
 createDefaultWindow :: Int -> Int -> WindowClosure -> IO HWND
 createDefaultWindow width height wndProc = do
   let winClass = mkClassName "HelloWorld"
@@ -101,8 +172,11 @@ pM_REMOVE = 0x0001
 pM_NOYIELD = 0x0002
 
-messagePump :: HWND -> Ptr ID3D11DeviceContext -> Ptr IDxgiSwapChain -> Ptr ID3D11RenderTargetView -> IO ()
-messagePump hwnd deviceContext swapChain renderTargetView = Graphics.Win32.allocaMessage $ \ msg ->
+messagePump 
+  :: HWND -> Ptr ID3D11DeviceContext -> 
+     Ptr IDxgiSwapChain -> Ptr ID3D11RenderTargetView ->
+     Ptr ID3D11VertexShader -> Ptr ID3D11PixelShader -> IO ()
+messagePump hwnd deviceContext swapChain renderTargetView vs ps = Graphics.Win32.allocaMessage $ \ msg ->
   let pump = do
         m <- peekByteOff msg 4 :: IO WindowMessage
         when (m /= wM_QUIT) $ do
@@ -113,12 +187,19 @@             dispatchMessage msg
             return ()
           else do
-            render deviceContext swapChain renderTargetView
+            render deviceContext swapChain renderTargetView vs ps
           pump
   in pump
   
-render :: Ptr ID3D11DeviceContext -> Ptr IDxgiSwapChain -> Ptr ID3D11RenderTargetView -> IO ()
-render deviceContext swapChain renderTargetView = do
+render 
+  :: Ptr ID3D11DeviceContext -> Ptr IDxgiSwapChain -> Ptr ID3D11RenderTargetView ->
+     Ptr ID3D11VertexShader -> Ptr ID3D11PixelShader -> IO ()
+render deviceContext swapChain renderTargetView vs ps= do
   clearRenderTargetView deviceContext renderTargetView $ Color 0.0 0.125 0.3 1.0
+  
+  vsSetShader deviceContext vs []
+  psSetShader deviceContext ps []
+  draw deviceContext 3 0
+  
   present swapChain 0 0
   return ()

src/Graphics/D3D11Binding.hs view

@@ -2,7 +2,9 @@ ( module Graphics.D3D11Binding.Enums
 , module Graphics.D3D11Binding.Types
 , module Graphics.D3D11Binding.Interface
+, module Graphics.D3D11Binding.Shader
 , module Graphics.D3D11Binding.GUID
+, module Graphics.D3D11Binding.Utils
 , d3d11CreateDeviceAndSwapChain
 ) where
 
@@ -15,7 +17,9 @@ import Graphics.D3D11Binding.Enums
 import Graphics.D3D11Binding.Types
 import Graphics.D3D11Binding.Interface
+import Graphics.D3D11Binding.Shader
 import Graphics.D3D11Binding.GUID
+import Graphics.D3D11Binding.Utils
 
 import Foreign.Marshal.Array
 import Foreign.Marshal.Alloc

src/Graphics/D3D11Binding/Enums.hs view

@@ -134,8 +134,10 @@ 
 instance Enum DxgiFormat where
   fromEnum DxgiFormatUnknown = 0
+  fromEnum DxgiFormatR32G32B32Float = 6
   fromEnum DxgiFormatR8G8B8A8Unorm = 28
   toEnum 0 = DxgiFormatUnknown
+  toEnum 6 = DxgiFormatR32G32B32Float
   toEnum 28 = DxgiFormatR8G8B8A8Unorm
   toEnum unmatched = error ("DxgiFormat.toEnum: cannot match " ++ show unmatched)
 
@@ -305,4 +307,111 @@   cSizeOf = sizeOf
   cAlignment = alignment
   cPeek = peek
-  cPoke = poke+  cPoke = poke
+  
+data D3D11InputClassification = D3D11InputPerVertexData
+                              | D3D11InputPerInstanceData
+                              deriving (Eq, Show)
+
+instance Enum D3D11InputClassification where
+  fromEnum D3D11InputPerVertexData = 0
+  fromEnum D3D11InputPerInstanceData = 1
+  toEnum 0 = D3D11InputPerVertexData
+  toEnum 1 = D3D11InputPerInstanceData
+  toEnum unmatched = error ("D3D11InputClassification.toEnum: cannot match " ++ show unmatched)
+  
+instance Storable D3D11InputClassification where
+  sizeOf e = sizeOf ((fromIntegral $ fromEnum e) :: Int32)
+  alignment e = alignment ((fromIntegral $ fromEnum e) :: Int32)
+  peek ptr = peekByteOff (castPtr ptr :: Ptr Int32) 0 >>= (return . toEnum)
+  poke ptr val = pokeByteOff (castPtr ptr :: Ptr Int32) 0 (fromEnum val)
+  
+instance CStorable D3D11InputClassification where
+  cSizeOf = sizeOf
+  cAlignment = alignment
+  cPeek = peek
+  cPoke = poke
+  
+data D3D11Usage = D3D11UsageDefault
+                | D3D11UsageImmutable
+                | D3D11UsageDynamic
+                | D3D11UsageStaging
+                deriving (Eq, Show)
+
+instance Enum D3D11Usage where
+  fromEnum D3D11UsageDefault = 0
+  fromEnum D3D11UsageImmutable = 1
+  fromEnum D3D11UsageDynamic = 2
+  fromEnum D3D11UsageStaging = 3
+  toEnum 0 = D3D11UsageDefault
+  toEnum 1 = D3D11UsageImmutable
+  toEnum 2 = D3D11UsageDynamic
+  toEnum 3 = D3D11UsageStaging
+  toEnum unmatched = error ("D3D11Usage.toEnum: cannot match " ++ show unmatched)
+
+instance Storable D3D11Usage where
+  sizeOf e = sizeOf ((fromIntegral $ fromEnum e) :: Int32)
+  alignment e = alignment ((fromIntegral $ fromEnum e) :: Int32)
+  peek ptr = peekByteOff (castPtr ptr :: Ptr Int32) 0 >>= (return . toEnum)
+  poke ptr val = pokeByteOff (castPtr ptr :: Ptr Int32) 0 (fromEnum val)
+  
+instance CStorable D3D11Usage where
+  cSizeOf = sizeOf
+  cAlignment = alignment
+  cPeek = peek
+  cPoke = poke
+
+data D3D11BindFlag = D3D11BindVertexBuffer
+                   | D3D11BindIndexBuffer
+                   | D3D11BindConstantBuffer
+                   | D3D11BindShaderResource
+                   | D3D11BindStreamOutput
+                   | D3D11BindRenderTarget
+                   | D3D11BindDepthStencil
+                   | D3D11BindUnorderedAccess
+                   deriving (Eq, Show)
+                   
+instance Enum D3D11BindFlag where
+  fromEnum D3D11BindVertexBuffer = 0x1
+  fromEnum D3D11BindIndexBuffer = 0x2
+  fromEnum D3D11BindConstantBuffer = 0x4
+  fromEnum D3D11BindShaderResource = 0x8
+  fromEnum D3D11BindStreamOutput = 0x10
+  fromEnum D3D11BindRenderTarget = 0x20
+  fromEnum D3D11BindDepthStencil = 0x40
+  fromEnum D3D11BindUnorderedAccess = 0x80
+  toEnum 0x1 = D3D11BindVertexBuffer
+  toEnum 0x2 = D3D11BindIndexBuffer
+  toEnum 0x4 = D3D11BindConstantBuffer
+  toEnum 0x8 = D3D11BindShaderResource
+  toEnum 0x10 = D3D11BindStreamOutput
+  toEnum 0x20 = D3D11BindRenderTarget
+  toEnum 0x40 = D3D11BindDepthStencil
+  toEnum 0x80 = D3D11BindUnorderedAccess
+  toEnum unmatched = error ("D3D11BindFlag.toEnum: cannot match " ++ show unmatched)
+
+instance Storable D3D11BindFlag where
+  sizeOf e = sizeOf ((fromIntegral $ fromEnum e) :: Int32)
+  alignment e = alignment ((fromIntegral $ fromEnum e) :: Int32)
+  peek ptr = peekByteOff (castPtr ptr :: Ptr Int32) 0 >>= (return . toEnum)
+  poke ptr val = pokeByteOff (castPtr ptr :: Ptr Int32) 0 (fromEnum val)
+  
+instance CStorable D3D11BindFlag where
+  cSizeOf = sizeOf
+  cAlignment = alignment
+  cPeek = peek
+  cPoke = poke
+
+d3d11BindFlags :: [D3D11BindFlag] -> Word32
+d3d11BindFlags flags = fromIntegral $ foldl (\acc x -> acc .|. (fromEnum x)) 0 flags
+
+data D3D11PrimitiveTopology = D3D11PrimitiveTopologyUndefined
+                            | D3D11PrimitiveTopologyTrianglelist
+                            deriving (Eq, Show)
+                            
+instance Enum D3D11PrimitiveTopology where
+  fromEnum D3D11PrimitiveTopologyUndefined = 0
+  fromEnum D3D11PrimitiveTopologyTrianglelist = 4
+  toEnum 0 = D3D11PrimitiveTopologyUndefined
+  toEnum 4 = D3D11PrimitiveTopologyTrianglelist
+  toEnum unmatched = error ("D3D11PrimitiveTopology.toEnum: cannot match " ++ show unmatched)

src/Graphics/D3D11Binding/Interface.hs view

@@ -1,9 +1,14 @@ module Graphics.D3D11Binding.Interface 
-( module Graphics.D3D11Binding.Interface.D3D11DepthStencilView
+( module Graphics.D3D11Binding.Interface.D3D11Buffer
+, module Graphics.D3D11Binding.Interface.D3D11ClassLinkage
+, module Graphics.D3D11Binding.Interface.D3D11DepthStencilView
 , module Graphics.D3D11Binding.Interface.D3D11Device
 , module Graphics.D3D11Binding.Interface.D3D11DeviceContext
+, module Graphics.D3D11Binding.Interface.D3D11InputLayout
 , module Graphics.D3D11Binding.Interface.D3D11RenderTargetView
 , module Graphics.D3D11Binding.Interface.D3D11Resource
+, module Graphics.D3D11Binding.Interface.D3DBlob
+, module Graphics.D3D11Binding.Interface.D3DInclude
 
 , module Graphics.D3D11Binding.Interface.DxgiAdapter
 , module Graphics.D3D11Binding.Interface.DxgiSwapChain
@@ -12,12 +17,17 @@ 
 , module Graphics.D3D11Binding.Interface.Unknown
 ) where
-  
+
+import Graphics.D3D11Binding.Interface.D3D11Buffer
+import Graphics.D3D11Binding.Interface.D3D11ClassLinkage
 import Graphics.D3D11Binding.Interface.D3D11DepthStencilView
 import Graphics.D3D11Binding.Interface.D3D11Device
 import Graphics.D3D11Binding.Interface.D3D11DeviceContext
+import Graphics.D3D11Binding.Interface.D3D11InputLayout
 import Graphics.D3D11Binding.Interface.D3D11RenderTargetView
 import Graphics.D3D11Binding.Interface.D3D11Resource
+import Graphics.D3D11Binding.Interface.D3DBlob
+import Graphics.D3D11Binding.Interface.D3DInclude
 
 import Graphics.D3D11Binding.Interface.DxgiAdapter
 import Graphics.D3D11Binding.Interface.DxgiSwapChain

+ src/Graphics/D3D11Binding/Interface/D3D11Buffer.hs view

@@ -0,0 +1,9 @@+module Graphics.D3D11Binding.Interface.D3D11Buffer where
+
+import Graphics.D3D11Binding.Interface.Unknown
+import Graphics.D3D11Binding.Interface.D3D11Resource
+
+data ID3D11Buffer = ID3D11Buffer
+
+instance UnknownInterface ID3D11Buffer
+instance D3D11ResourceInterface ID3D11Buffer

+ src/Graphics/D3D11Binding/Interface/D3D11ClassLinkage.hs view

@@ -0,0 +1,3 @@+module Graphics.D3D11Binding.Interface.D3D11ClassLinkage where
+  
+data ID3D11ClassLinkage = ID3D11ClassLinkage

src/Graphics/D3D11Binding/Interface/D3D11Device.hs view

@@ -3,28 +3,82 @@ 
 import Foreign.Storable
 import Foreign.Marshal.Alloc
+import Foreign.Marshal.Array
 import Foreign.Ptr
 
 import Graphics.Win32
+
 import Graphics.D3D11Binding.Types
+import Graphics.D3D11Binding.Utils
+
 import Graphics.D3D11Binding.Interface.Unknown
+import Graphics.D3D11Binding.Interface.D3D11Buffer
 import Graphics.D3D11Binding.Interface.D3D11Resource
 import Graphics.D3D11Binding.Interface.D3D11RenderTargetView
+import Graphics.D3D11Binding.Interface.D3D11ClassLinkage
+import Graphics.D3D11Binding.Interface.D3D11InputLayout
 
+import Graphics.D3D11Binding.Shader.D3D11VertexShader
+import Graphics.D3D11Binding.Shader.D3D11PixelShader
+
 foreign import stdcall "CreateRenderTargetView" c_createRenderTargetView
   :: Ptr ID3D11Device -> Ptr ID3D11Resource -> Ptr D3D11RenderTargetViewDesc -> Ptr (Ptr ID3D11RenderTargetView) -> IO HRESULT
+
+foreign import stdcall "CreateVertexShader" c_createVertexShader
+  :: Ptr ID3D11Device -> Ptr () -> Word32 -> Ptr ID3D11ClassLinkage -> Ptr (Ptr ID3D11VertexShader) -> IO HRESULT
   
+foreign import stdcall "CreatePixelShader" c_createPixelShader
+  :: Ptr ID3D11Device -> Ptr () -> Word32 -> Ptr ID3D11ClassLinkage -> Ptr (Ptr ID3D11PixelShader) -> IO HRESULT
+
+foreign import stdcall "CreateInputLayout" c_createInputLayout
+  :: Ptr ID3D11Device -> Ptr D3D11InputElementDesc -> Word32 -> Ptr () -> Word32 -> Ptr (Ptr ID3D11InputLayout) -> IO HRESULT
+
+foreign import stdcall "CreateBuffer" c_createBuffer
+  :: Ptr ID3D11Device -> Ptr D3D11BufferDesc -> Ptr D3D11SubresourceData -> Ptr (Ptr ID3D11Buffer) -> IO HRESULT
+
 class (UnknownInterface interface) => D3D11DeviceInterface interface where
-  createRenderTargetView 
+  createRenderTargetView
     :: (D3D11ResourceInterface resource) => 
        Ptr interface -> Ptr resource -> Maybe (D3D11RenderTargetViewDesc) -> IO (Either HRESULT (Ptr ID3D11RenderTargetView))
-  createRenderTargetView this pResource Nothing = alloca $ \renderTargetView -> do
-    hr <- c_createRenderTargetView (castPtr this) (castPtr pResource) nullPtr renderTargetView
-    if hr < 0 then return (Left hr) else Right <$> peek renderTargetView
-  createRenderTargetView this pResource (Just desc) = alloca $ \renderTargetView -> alloca $ \pDesc -> do
-    poke pDesc desc
+  createRenderTargetView this pResource desc = alloca $ \renderTargetView -> maybePoke desc $ \pDesc -> do
     hr <- c_createRenderTargetView (castPtr this) (castPtr pResource) pDesc renderTargetView
-    if hr < 0 then return (Left hr) else Right <$> peek renderTargetView
+    if hr < 0 then return (Left hr) else Right <$> peek renderTargetView    
+  
+  createVertexShader 
+    :: Ptr interface -> Ptr () -> Word32 -> Ptr ID3D11ClassLinkage -> IO (Either HRESULT (Ptr ID3D11VertexShader))
+  createVertexShader this shaderByteCode bytecodeLength pClassLinkage = alloca $ \ppVertexShader -> do
+    hr <- c_createVertexShader (castPtr this) shaderByteCode bytecodeLength pClassLinkage ppVertexShader
+    if hr < 0 then return (Left hr) else Right <$> peek ppVertexShader
+  
+  createPixelShader 
+    :: Ptr interface -> Ptr () -> Word32 -> Ptr ID3D11ClassLinkage -> IO (Either HRESULT (Ptr ID3D11PixelShader))
+  createPixelShader this shaderByteCode bytecodeLength pClassLinkage = alloca $ \ppPixelShader -> do
+    hr <- c_createPixelShader (castPtr this) shaderByteCode bytecodeLength pClassLinkage ppPixelShader
+    if hr < 0 then return (Left hr) else Right <$> peek ppPixelShader
+  
+  createInputLayout
+    :: Ptr interface -> [D3D11InputElementDesc] -> Ptr () -> Word32 -> IO (Either HRESULT (Ptr ID3D11InputLayout))
+  createInputLayout this inputElementDescs shaderByteCode bytecodeLength =
+    alloca $ \ppInputLayout -> alloca $ \pElementDescs -> do
+      pokeArray pElementDescs inputElementDescs
+      hr <- c_createInputLayout
+              (castPtr this)
+              pElementDescs
+              (fromIntegral $ length inputElementDescs)
+              shaderByteCode
+              bytecodeLength
+              ppInputLayout
+      if hr < 0 then return (Left hr) else Right <$> peek ppInputLayout
+        
+  createBuffer 
+    :: (HasSubresourceData resource) => Ptr interface -> D3D11BufferDesc -> [resource] -> IO (Either HRESULT (Ptr ID3D11Buffer))
+  createBuffer this desc resource = 
+    alloca $ \ppBuffer -> alloca $ \pDesc -> alloca $ \pResource -> do
+      poke pDesc desc
+      resource' <- getSubresourceData resource
+      poke pResource resource'
+      hr <- c_createBuffer (castPtr this) pDesc pResource ppBuffer
+      if hr < 0 then return (Left hr) else Right <$> peek ppBuffer
       
 data ID3D11Device = ID3D11Device

src/Graphics/D3D11Binding/Interface/D3D11DeviceContext.hs view

@@ -7,11 +7,21 @@ import Foreign.Ptr
 
 import Graphics.Win32
+
+import Graphics.D3D11Binding.Enums
 import Graphics.D3D11Binding.Types
+import Graphics.D3D11Binding.Utils
+
 import Graphics.D3D11Binding.Interface.Unknown
+import Graphics.D3D11Binding.Interface.D3D11Buffer
 import Graphics.D3D11Binding.Interface.D3D11RenderTargetView
 import Graphics.D3D11Binding.Interface.D3D11DepthStencilView
+import Graphics.D3D11Binding.Interface.D3D11InputLayout
+import Graphics.D3D11Binding.Interface.D3D11ClassInstance
 
+import Graphics.D3D11Binding.Shader.D3D11VertexShader
+import Graphics.D3D11Binding.Shader.D3D11PixelShader
+
 foreign import stdcall "OMSetRenderTargets" c_omSetRenderTargets
   :: Ptr ID3D11DeviceContext -> Word32 -> Ptr (Ptr ID3D11RenderTargetView) -> Ptr ID3D11DepthStencilView -> IO ()
 
@@ -20,7 +30,25 @@ 
 foreign import stdcall "ClearRenderTargetView" c_clearRenderTargetView
   :: Ptr ID3D11DeviceContext -> Ptr ID3D11RenderTargetView -> Ptr Float -> IO ()
+  
+foreign import stdcall "IASetInputLayout" c_iaSetInputLayout
+  :: Ptr ID3D11DeviceContext -> Ptr ID3D11InputLayout -> IO ()
+  
+foreign import stdcall "IASetVertexBuffers" c_iaSetVertexBuffers
+  :: Ptr ID3D11DeviceContext -> Word32 -> Word32 -> Ptr (Ptr ID3D11Buffer) -> Ptr Word32 -> Ptr Word32 -> IO ()
 
+foreign import stdcall "IASetPrimitiveTopology" c_iaSetPrimitiveTopology
+  :: Ptr ID3D11DeviceContext -> Word32 -> IO ()
+  
+foreign import stdcall "VSSetShader" c_vsSetShader
+  :: Ptr ID3D11DeviceContext -> Ptr ID3D11VertexShader -> Ptr (Ptr ID3D11ClassInstance) -> Word32 -> IO () 
+  
+foreign import stdcall "PSSetShader" c_psSetShader
+  :: Ptr ID3D11DeviceContext -> Ptr ID3D11PixelShader -> Ptr (Ptr ID3D11ClassInstance) -> Word32 -> IO () 
+
+foreign import stdcall "Draw" c_draw
+  :: Ptr ID3D11DeviceContext -> Word32 -> Word32 -> IO ()
+
 class (UnknownInterface interface) => D3D11DeviceContextInterface interface where
   omSetRenderTargets :: Ptr interface -> [Ptr ID3D11RenderTargetView] -> Ptr ID3D11DepthStencilView -> IO ()
   omSetRenderTargets ptr renderTargetViews depthStencilView = alloca $ \pRenderTargetViews -> do
@@ -30,12 +58,39 @@   rsSetViewports ptr viewports = alloca $ \pViewports -> do
     pokeArray pViewports viewports
     c_rsSetViewports (castPtr ptr) (fromIntegral $ length viewports) pViewports
+  iaSetInputLayout :: Ptr interface -> Ptr ID3D11InputLayout -> IO ()
+  iaSetInputLayout ptr inputLayout = c_iaSetInputLayout (castPtr ptr) inputLayout
+  iaSetVertexBuffers :: Ptr interface -> Word32 -> [(Ptr ID3D11Buffer, Word32, Word32)] -> IO ()
+  iaSetVertexBuffers ptr startSlot bufferData = do
+    let buffer = map first bufferData
+    let stride = map second bufferData
+    let offset = map third bufferData
+    alloca $ \pBuffer -> alloca $ \pStride -> alloca $ \pOffset -> do
+      pokeArray pBuffer buffer
+      pokeArray pStride stride
+      pokeArray pOffset offset
+      c_iaSetVertexBuffers (castPtr ptr) startSlot (fromIntegral $ length bufferData) pBuffer pStride pOffset
+    where first (a,_,_) = a
+          second (_,b,_) = b
+          third (_,_,c) = c
+  iaSetPrimitiveTopology :: Ptr interface -> D3D11PrimitiveTopology -> IO ()
+  iaSetPrimitiveTopology ptr topology = c_iaSetPrimitiveTopology (castPtr ptr) (fromIntegral $ fromEnum topology)
   clearRenderTargetView :: Ptr interface -> Ptr ID3D11RenderTargetView -> Color -> IO ()
   clearRenderTargetView ptr renderTargetView color = alloca $ \pColor -> do
     poke pColor color
     c_clearRenderTargetView (castPtr ptr) renderTargetView (castPtr pColor)
   clearState :: Ptr interface -> IO ()
   clearState ptr = c_clearState (castPtr ptr)
+  vsSetShader :: Ptr interface -> Ptr ID3D11VertexShader -> [Ptr ID3D11ClassInstance] -> IO ()
+  vsSetShader ptr vertexShader classInstances = maybePokeArray classInstances $ \pClassInstances -> do
+    let classInstanceNum = fromIntegral $ length classInstances
+    c_vsSetShader (castPtr ptr) vertexShader pClassInstances classInstanceNum
+  psSetShader :: Ptr interface -> Ptr ID3D11PixelShader -> [Ptr ID3D11ClassInstance] -> IO ()
+  psSetShader ptr pixelShader classInstances = maybePokeArray classInstances $ \pClassInstances -> do
+    let classInstanceNum = fromIntegral $ length classInstances
+    c_psSetShader (castPtr ptr) pixelShader pClassInstances classInstanceNum
+  draw :: Ptr interface -> Word32 -> Word32 -> IO ()
+  draw ptr vertexCount startVertexLocation = c_draw (castPtr ptr) vertexCount startVertexLocation
 
 data ID3D11DeviceContext = ID3D11DeviceContext

+ src/Graphics/D3D11Binding/Interface/D3D11InputLayout.hs view

@@ -0,0 +1,3 @@+module Graphics.D3D11Binding.Interface.D3D11InputLayout where
+
+data ID3D11InputLayout = ID3D11InputLayout

+ src/Graphics/D3D11Binding/Interface/D3DBlob.hs view

@@ -0,0 +1,24 @@+module Graphics.D3D11Binding.Interface.D3DBlob where
+
+import Data.Word
+
+import Foreign.Ptr
+
+import Graphics.D3D11Binding.Interface.Unknown
+
+data ID3DBlob = ID3DBlob
+
+foreign import stdcall "GetBufferPointer" c_getBufferPointer
+  :: Ptr ID3DBlob -> IO (Ptr ())
+
+foreign import stdcall "GetBufferSize" c_getBufferSize
+  :: Ptr ID3DBlob -> IO Word32
+
+class (UnknownInterface interface) => D3DBlobInterface interface where
+  getBufferPointer :: Ptr interface -> IO (Ptr ())
+  getBufferPointer ptr = c_getBufferPointer (castPtr ptr)
+  getBufferSize :: Ptr interface -> IO Word32
+  getBufferSize ptr = c_getBufferSize (castPtr ptr)
+
+instance UnknownInterface ID3DBlob
+instance D3DBlobInterface ID3DBlob

+ src/Graphics/D3D11Binding/Interface/D3DInclude.hs view

@@ -0,0 +1,3 @@+module Graphics.D3D11Binding.Interface.D3DInclude where
+  
+data ID3DInclude = ID3DInclue

+ src/Graphics/D3D11Binding/Shader.hs view

@@ -0,0 +1,15 @@+module Graphics.D3D11Binding.Shader 
+( module Graphics.D3D11Binding.Shader.Compile
+
+, module Graphics.D3D11Binding.Shader.D3D11VertexShader
+, module Graphics.D3D11Binding.Shader.D3D11PixelShader
+
+, module Graphics.D3D11Binding.Shader.Flags
+) where
+  
+import Graphics.D3D11Binding.Shader.Compile
+
+import Graphics.D3D11Binding.Shader.D3D11VertexShader
+import Graphics.D3D11Binding.Shader.D3D11PixelShader
+
+import Graphics.D3D11Binding.Shader.Flags

+ src/Graphics/D3D11Binding/Shader/Compile.hs view

@@ -0,0 +1,88 @@+module Graphics.D3D11Binding.Shader.Compile where
+
+import System.IO
+
+import Data.Bits
+import Data.Word
+import Data.Maybe
+
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.Marshal.Alloc
+import Foreign.C.String
+
+import Graphics.Win32
+
+import Graphics.D3D11Binding.Utils
+
+import Graphics.D3D11Binding.Interface.D3DBlob
+import Graphics.D3D11Binding.Interface.D3DInclude
+
+import Graphics.D3D11Binding.Shader.Flags
+
+data D3DShaderMacro = D3DShaderMacro
+  { name :: String
+  , definition :: String }
+  
+instance Storable D3DShaderMacro where
+  sizeOf _ = 8
+  alignment _ = 8
+  peek ptr = do 
+    n <- peekByteOff ptr 0
+    d <- peekByteOff ptr 4
+    n' <- peekCString n
+    d' <- peekCString d
+    return $ D3DShaderMacro n' d'
+  poke ptr (D3DShaderMacro n d) = do
+    withCString n $ \n' -> withCString d $ \d' -> do
+      pokeByteOff ptr 0 n'
+      pokeByteOff ptr 4 d'
+
+foreign import stdcall "D3DCompile" c_d3dCompile
+ :: Ptr () -> Word32 -> CString ->
+    Ptr D3DShaderMacro -> Ptr ID3DInclude ->
+    CString -> CString -> D3DCompileFlag -> D3DCompileEffectFlag ->
+    Ptr (Ptr ID3DBlob) -> Ptr (Ptr ID3DBlob) -> IO HRESULT
+    
+d3dCompile 
+  :: String -> Maybe String -> 
+     Maybe D3DShaderMacro -> Ptr ID3DInclude -> 
+     Maybe String -> String -> 
+     [D3DCompileFlag] -> [D3DCompileEffectFlag] ->
+     IO (Either (HRESULT, Ptr ID3DBlob) (Ptr ID3DBlob))
+d3dCompile source sourceName defines pInclude entryPoint target compileFlags effectFlags = do
+  withCStringLen source $ \(csource, len) -> withCString target $ \pTarget ->
+    maybeWithCString sourceName $ \pSourceName -> maybePoke defines $ \pDefines ->
+      maybeWithCString entryPoint $ \pEntryPoint -> alloca $ \ppCode -> alloca $ \ppErrorMsgs -> do
+        let sFlag = foldl (.|.) 0 compileFlags
+        let eFlag = foldl (.|.) 0 effectFlags
+        hr <- c_d3dCompile 
+                (castPtr csource) 
+                (fromIntegral len) 
+                pSourceName 
+                pDefines 
+                pInclude 
+                pEntryPoint 
+                pTarget 
+                sFlag 
+                eFlag 
+                ppCode 
+                ppErrorMsgs
+        if hr < 0 
+        then do
+          pErrorMsgs <- peek ppErrorMsgs
+          return $ Left (hr, pErrorMsgs)
+        else do
+          pCode <- peek ppCode
+          return $ Right pCode
+
+d3dCompileFromFile
+  :: String -> Maybe String -> 
+     Maybe D3DShaderMacro -> Ptr ID3DInclude -> 
+     Maybe String -> String -> 
+     [D3DCompileFlag] -> [D3DCompileEffectFlag] ->
+     IO (Either (HRESULT, Ptr ID3DBlob) (Ptr ID3DBlob))
+d3dCompileFromFile fileName sourceName defines pInclude entryPoint target compileFlags effectFlags =
+  withFile fileName ReadMode $ \handle -> do
+    contents <- hGetContents handle
+    d3dCompile contents sourceName defines pInclude entryPoint target compileFlags effectFlags

+ src/Graphics/D3D11Binding/Shader/D3D11PixelShader.hs view

@@ -0,0 +1,7 @@+module Graphics.D3D11Binding.Shader.D3D11PixelShader where
+
+import Graphics.D3D11Binding.Interface.Unknown
+
+data ID3D11PixelShader = ID3D11PixelShader
+
+instance UnknownInterface ID3D11PixelShader

+ src/Graphics/D3D11Binding/Shader/D3D11VertexShader.hs view

@@ -0,0 +1,7 @@+module Graphics.D3D11Binding.Shader.D3D11VertexShader where
+  
+import Graphics.D3D11Binding.Interface.Unknown
+
+data ID3D11VertexShader = ID3D11VertexShader
+
+instance UnknownInterface ID3D11VertexShader

+ src/Graphics/D3D11Binding/Shader/Flags.hs view

@@ -0,0 +1,76 @@+module Graphics.D3D11Binding.Shader.Flags where
+import Data.Bits
+import Data.Word
+
+type D3DCompileFlag = Word32
+
+d3dCompileDebug :: D3DCompileFlag
+d3dCompileDebug = shift 1 0
+
+d3dCompileSkipValidation :: D3DCompileFlag
+d3dCompileSkipValidation = shift 1 1
+
+d3dCompileSkipOptimization :: D3DCompileFlag
+d3dCompileSkipOptimization = shift 1 2
+
+d3dCompilePackMatrixRowMajor :: D3DCompileFlag
+d3dCompilePackMatrixRowMajor = shift 1 3
+
+d3dCompilePackMatrixColumnMajor :: D3DCompileFlag
+d3dCompilePackMatrixColumnMajor = shift 1 4
+
+d3dCompilePartialPrecision :: D3DCompileFlag
+d3dCompilePartialPrecision = shift 1 5
+
+d3dCompileForceVSSoftwareNoOpt :: D3DCompileFlag
+d3dCompileForceVSSoftwareNoOpt = shift 1 6
+
+d3dCompileForcePSSoftwareNoOpt :: D3DCompileFlag
+d3dCompileForcePSSoftwareNoOpt = shift 1 7
+
+d3dCompileNoPreshader :: D3DCompileFlag
+d3dCompileNoPreshader = shift 1 8
+
+d3dCompileAvoidFlowControl :: D3DCompileFlag
+d3dCompileAvoidFlowControl = shift 1 9
+
+d3dCompilePreferFlowControl :: D3DCompileFlag
+d3dCompilePreferFlowControl = shift 1 10
+
+d3dCompileEnableStrictness :: D3DCompileFlag
+d3dCompileEnableStrictness = shift 1 11
+
+d3dCompileEnableBackwardsCompatibility :: D3DCompileFlag
+d3dCompileEnableBackwardsCompatibility = shift 1 12
+
+d3dCompileIEEEStrictness :: D3DCompileFlag
+d3dCompileIEEEStrictness = shift 1 13
+
+d3dCompileOptimizationLevel0 :: D3DCompileFlag
+d3dCompileOptimizationLevel0 = shift 1 14
+
+d3dCompileOptimizationLevel1 :: D3DCompileFlag
+d3dCompileOptimizationLevel1 = 0
+
+d3dCompileOptimizationLevel2 :: D3DCompileFlag
+d3dCompileOptimizationLevel2 = shift 1 14 .|. shift 1 15
+
+d3dCompileOptimizationLevel3 :: D3DCompileFlag
+d3dCompileOptimizationLevel3 = shift 1 15
+
+d3dCompileReserved16 :: D3DCompileFlag
+d3dCompileReserved16 = shift 1 16
+
+d3dCompileReserved17 :: D3DCompileFlag
+d3dCompileReserved17 = shift 1 17
+
+d3dCompileWarningsAreErrors :: D3DCompileFlag
+d3dCompileWarningsAreErrors = shift 1 18
+
+type D3DCompileEffectFlag = Word32
+
+d3dCompileEffectChildEffect :: D3DCompileEffectFlag
+d3dCompileEffectChildEffect = shift 1 0
+
+d3dCompileEffectAllowSlowOps :: D3DCompileEffectFlag
+d3dCompileEffectAllowSlowOps = shift 1 1

src/Graphics/D3D11Binding/Types.hs view

@@ -1,9 +1,15 @@ {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Graphics.D3D11Binding.Types where
 import GHC.Generics (Generic)
 import Data.Word
 import Data.Bits
 import Control.Applicative
+
+import Foreign.Ptr
+import Foreign.C.String
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Array
 import Foreign.Storable
 import Foreign.CStorable
 
@@ -163,4 +169,95 @@   sizeOf = cSizeOf
   alignment = cAlignment
   poke = cPoke
-  peek = cPeek+  peek = cPeek
+  
+data D3D11InputElementDesc = D3D11InputElementDesc
+  { semanticName :: String
+  , semanticIndex :: Word32
+  , inputElementFormat :: DxgiFormat
+  , inputSlot :: Word32
+  , alignedByteOffset :: Word32
+  , inputSlotClass :: D3D11InputClassification
+  , instanceDataStepRate :: Word32 } deriving (Generic)
+  
+instance CStorable D3D11InputElementDesc where
+  cSizeOf = sizeOf
+  cAlignment = alignment
+  cPoke = poke
+  cPeek = peek
+
+pokeCString ptr str = go ptr str 0
+  where go ptr [] byte = pokeByteOff ptr byte '\0'
+        go ptr (x:xs) byte = do
+          pokeByteOff ptr byte x
+          go ptr xs (byte+1) 
+
+instance Storable D3D11InputElementDesc where
+  sizeOf _ = 32
+  alignment _ = 8
+  poke ptr desc = alloca $ \(namePtr :: CString) -> do
+    pokeCString namePtr (semanticName desc)
+    pokeByteOff ptr 0 namePtr
+    pokeByteOff ptr 8 (semanticIndex desc)
+    pokeByteOff ptr 12 (inputElementFormat desc)
+    pokeByteOff ptr 16 (inputSlot desc)
+    pokeByteOff ptr 20 (alignedByteOffset desc)
+    pokeByteOff ptr 24 (inputSlotClass desc)
+    pokeByteOff ptr 28 (instanceDataStepRate desc)
+  peek ptr = do
+    namePtr <- peekByteOff ptr 0
+    name <- peekCString namePtr
+    index <- peekByteOff ptr 8
+    elementFormat <- peekByteOff ptr 12
+    slot <- peekByteOff ptr 16
+    byteOffset <- peekByteOff ptr 20
+    slotClass <- peekByteOff ptr 24
+    dataStepRate <- peekByteOff ptr 28
+    return $ D3D11InputElementDesc name index elementFormat slot byteOffset slotClass dataStepRate
+
+data D3D11SubresourceData = D3D11SubresourceData
+  { pSysMem :: Ptr ()
+  , sysMemPitch :: Word32
+  , sysMemSlicePitch :: Word32 } deriving (Generic)
+
+instance CStorable D3D11SubresourceData
+instance Storable D3D11SubresourceData where
+  sizeOf = cSizeOf
+  alignment = cAlignment
+  poke = cPoke
+  peek = cPeek
+
+class (Storable dataType) => HasSubresourceData dataType where
+  getSubresourceData :: [dataType] -> IO D3D11SubresourceData
+  getSubresourceData dat = alloca $ \pData -> do
+    pokeArray pData dat
+    return $ D3D11SubresourceData (castPtr pData) (fromIntegral 0) (fromIntegral 0)
+
+data Vertex3 = Vertex3
+  { x :: Float
+  , y :: Float
+  , z :: Float } deriving (Generic)
+  
+instance CStorable Vertex3
+instance Storable Vertex3 where
+  sizeOf = cSizeOf
+  alignment = cAlignment
+  poke = cPoke
+  peek = cPeek
+
+instance HasSubresourceData Vertex3
+
+data D3D11BufferDesc = D3D11BufferDesc
+  { byteWidth :: Word32
+  , usage :: D3D11Usage
+  , bindFlags :: Word32
+  , cpuAccessFlags :: Word32
+  , miscFlags :: Word32
+  , structureByteStride :: Word32 } deriving (Generic)
+  
+instance CStorable D3D11BufferDesc
+instance Storable D3D11BufferDesc where
+  sizeOf = cSizeOf
+  alignment = cAlignment
+  poke = cPoke
+  peek = cPeek