d3d11binding 0.0.0.3 → 0.0.0.4

raw patch · 15 files changed

+577/−23 lines, 15 filesdep +vectnew-component:exe:Cube

Dependencies added: vect

Files

• csource/wrapper.c +39/−0
• d3d11binding.cabal +25/−2
• examples/Cube.hs +317/−0
• examples/Triangle.hs +1/−0
• src/Graphics/D3D11Binding.hs +2/−0
• src/Graphics/D3D11Binding/Enums.hs +5/−0
• src/Graphics/D3D11Binding/Interface/D3D11ClassInstance.hs +3/−0
• src/Graphics/D3D11Binding/Interface/D3D11Device.hs +10/−5
• src/Graphics/D3D11Binding/Interface/D3D11DeviceContext.hs +29/−0
• src/Graphics/D3D11Binding/Math.hs +5/−0
• src/Graphics/D3D11Binding/Math/Matrix.hs +53/−0
• src/Graphics/D3D11Binding/Math/Vertex3.hs +22/−0
• src/Graphics/D3D11Binding/Math/Vertex4.hs +23/−0
• src/Graphics/D3D11Binding/Types.hs +19/−16
• src/Graphics/D3D11Binding/Utils.hs +24/−0

@@ -160,4 +160,43 @@   UINT StartVertexLocation)
 {
   This->lpVtbl->Draw(This, VertexCount, StartVertexLocation); 
+}
+
+void IASetIndexBuffer( 
+  ID3D11DeviceContext* This,
+  ID3D11Buffer *pIndexBuffer,
+  DXGI_FORMAT Format,
+  UINT Offset)
+{
+  This->lpVtbl->IASetIndexBuffer(This, pIndexBuffer, Format, Offset);  
+}
+
+void UpdateSubresource(
+  ID3D11DeviceContext* This,
+  ID3D11Resource *pDstResource, 
+  UINT DstSubresource,
+  const D3D11_BOX *pDstBox,
+  const void *pSrcData,
+  UINT SrcRowPitch,
+  UINT SrcDepthPitch)
+{
+  This->lpVtbl->UpdateSubresource(This, pDstResource, DstSubresource, pDstBox, pSrcData, SrcRowPitch, SrcDepthPitch);
+}
+
+void VSSetConstantBuffers(
+  ID3D11DeviceContext* This,
+  UINT StartSlot,
+  UINT NumBuffers,
+  ID3D11Buffer *const *ppConstantBuffers)
+{
+  This->lpVtbl->VSSetConstantBuffers(This, StartSlot, NumBuffers, ppConstantBuffers);
+}
+
+void DrawIndexed(
+  ID3D11DeviceContext* This,
+  UINT IndexCount,
+  UINT StartIndexLocation,
+  INT BaseVertexLocation)
+{
+  This->lpVtbl->DrawIndexed(This, IndexCount, StartIndexLocation, BaseVertexLocation);
 }

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                d3d11binding
-version:             0.0.0.3
+version:             0.0.0.4
 synopsis:            A raw binding for the directX 11
 description:         A raw binding for the directX 11   
 homepage:            https://github.com/jwvg0425/d3d11binding
@@ -24,11 +24,13 @@ library
   exposed-modules:
     Graphics.D3D11Binding
+    Graphics.D3D11Binding.Utils
     Graphics.D3D11Binding.Enums
     Graphics.D3D11Binding.Types
     Graphics.D3D11Binding.Interface
     
     Graphics.D3D11Binding.Interface.D3D11Buffer
+    Graphics.D3D11Binding.Interface.D3D11ClassInstance
     Graphics.D3D11Binding.Interface.D3D11ClassLinkage
     Graphics.D3D11Binding.Interface.D3D11DepthStencilView
     Graphics.D3D11Binding.Interface.D3D11Device
@@ -54,13 +56,20 @@     
     Graphics.D3D11Binding.Shader.Flags
     
+    Graphics.D3D11Binding.Math
+    
+    Graphics.D3D11Binding.Math.Matrix
+    Graphics.D3D11Binding.Math.Vertex3
+    Graphics.D3D11Binding.Math.Vertex4
+    
     Graphics.D3D11Binding.GUID
   -- other-modules:       
   other-extensions: ForeignFunctionInterface, CPP   
   build-depends:       
     base >=4.8 && < 5,
     Win32 >= 2.3.0.0,
-    c-storable-deriving >= 0.1.3
+    c-storable-deriving >= 0.1.3,
+    vect >= 0.4.7
   hs-source-dirs:      src
   default-language:    Haskell2010
   extra-libraries:
@@ -86,5 +95,19 @@     base >= 4.8 && < 5,
     Win32 >= 2.3.0.0,
     d3d11binding
+  hs-source-dirs: examples
+  default-language: Haskell2010
+  
+executable Cube
+  main-is: Cube.hs
+  -- other-modules:
+  -- other-extensions:
+  build-depends:
+    base >= 4.8 && < 5,
+    Win32 >= 2.3.0.0,
+    d3d11binding,
+    c-storable-deriving >= 0.1.3,
+    vect >= 0.4.7
+    
   hs-source-dirs: examples
   default-language: Haskell2010

@@ -0,0 +1,317 @@+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Main where
+import GHC.Generics (Generic)
+  
+import System.Exit
+  
+import Data.Int
+import Data.Word
+import Data.Vect.Float
+import System.CPUTime
+
+import Control.Exception
+import Control.Monad
+
+import Foreign (peekByteOff)
+import Foreign.CStorable
+import Foreign.Storable
+import Foreign.Ptr
+
+import Graphics.Win32
+import System.Win32.DLL (getModuleHandle)
+
+import Graphics.D3D11Binding
+import Graphics.D3D11Binding.Math.Vertex3
+
+foreign import stdcall "PostQuitMessage" postQuitMessage :: Int32 -> IO ()
+
+data SimpleVertex = SimpleVertex Vertex3 Color deriving (Generic)
+
+instance CStorable SimpleVertex
+instance Storable SimpleVertex where
+  sizeOf = cSizeOf
+  alignment = cAlignment
+  poke = cPoke
+  peek = cPeek
+  
+instance HasSubresourceData SimpleVertex
+
+data ConstantBuffer = ConstantBuffer 
+ { world :: Mat4
+ , view :: Mat4
+ , projection :: Mat4 } deriving (Generic)
+
+instance CStorable ConstantBuffer
+instance Storable ConstantBuffer where
+  sizeOf = cSizeOf
+  alignment = cAlignment
+  poke = cPoke
+  peek = cPeek
+
+instance HasSubresourceData ConstantBuffer
+
+instance HasSubresourceData Word16
+
+
+windowWidth :: (Num a) => a
+windowWidth = 640
+
+windowHeight :: (Num a) => a
+windowHeight = 480
+
+main :: IO ()
+main = do
+  hWnd <- createDefaultWindow windowWidth windowHeight wndProc
+  useDevice hWnd $ \swapChain device deviceContext renderTargetView -> do
+    vb <- compileShaderFromFile "fx/Cube.fx" "VS" "vs_4_0"
+    (il, 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)
+                              , D3D11InputElementDesc
+                                  "COLOR"
+                                  (fromIntegral 0)
+                                  DxgiFormatR32G32B32A32Float
+                                  (fromIntegral 0)
+                                  (fromIntegral 12)
+                                  D3D11InputPerVertexData
+                                  (fromIntegral 0) ]
+                              pointer
+                              size
+      iaSetInputLayout deviceContext inputLayout
+      return (inputLayout, vertexShader)
+    
+    pb <- compileShaderFromFile "fx/Cube.fx" "PS" "ps_4_0"
+    (idb, ps) <- use pb $ \psBlob -> do
+      pointer <- getBufferPointer psBlob
+      size <- getBufferSize psBlob
+      Right pixelShader <- createPixelShader
+                            device
+                            pointer
+                            size
+                            nullPtr
+      
+      let bd = D3D11BufferDesc
+                { byteWidth = fromIntegral $ 8 * sizeOf (undefined :: SimpleVertex)
+                , usage = D3D11UsageDefault
+                , bindFlags = d3d11BindFlags [D3D11BindVertexBuffer]
+                , cpuAccessFlags = 0
+                , miscFlags = 0
+                , structureByteStride = 0 }
+      Right buffer <- createBuffer
+                        device
+                        bd
+                        [ SimpleVertex (Vertex3 (-1.0) 1.0 (-1.0)) (Color 0.0 0.0 1.0 1.0)
+                        , SimpleVertex (Vertex3 1.0 1.0 (-1.0)) (Color 0.0 1.0 0.0 1.0)
+                        , SimpleVertex (Vertex3 1.0 1.0 1.0) (Color 0.0 1.0 1.0 1.0)
+                        , SimpleVertex (Vertex3 (-1.0) 1.0 1.0) (Color 1.0 0.0 0.0 1.0)
+                        , SimpleVertex (Vertex3 (-1.0) (-1.0) (-1.0)) (Color 1.0 0.0 1.0 1.0)
+                        , SimpleVertex (Vertex3 1.0 (-1.0) (-1.0)) (Color 1.0 1.0 0.0 1.0)
+                        , SimpleVertex (Vertex3 1.0 (-1.0) 1.0) (Color 1.0 1.0 1.0 1.0)
+                        , SimpleVertex (Vertex3 (-1.0) (-1.0) 1.0) (Color 0.0 0.0 0.0 1.0) ]
+                        
+      iaSetVertexBuffers deviceContext 0 [(buffer, fromIntegral $ sizeOf (undefined :: SimpleVertex), 0)]
+      
+      let indexBd = D3D11BufferDesc
+                { byteWidth = fromIntegral $ 36 * sizeOf (undefined :: Word32)
+                , usage = D3D11UsageDefault
+                , bindFlags = d3d11BindFlags [D3D11BindIndexBuffer]
+                , cpuAccessFlags = 0
+                , miscFlags = 0
+                , structureByteStride = 0 }
+      Right indexBuffer <- createBuffer
+                             device
+                             indexBd
+                             ([ 3,1,0,
+                                2,1,3,
+
+                                0,5,4,
+                                1,5,0,
+
+                                3,4,7,
+                                0,4,3,
+
+                                1,6,5,
+                                2,6,1,
+
+                                2,7,6,
+                                3,7,2,
+
+                                6,4,5,
+                                7,4,6 ] :: [Word16])
+      
+      iaSetIndexBuffer deviceContext indexBuffer DxgiFormatR16Uint 0
+      iaSetPrimitiveTopology deviceContext D3D11PrimitiveTopologyTrianglelist
+      return (indexBuffer, pixelShader)
+    
+    let constantBd = D3D11BufferDesc
+                { byteWidth = fromIntegral $ sizeOf (undefined :: ConstantBuffer)
+                , usage = D3D11UsageDefault
+                , bindFlags = d3d11BindFlags [D3D11BindConstantBuffer]
+                , cpuAccessFlags = 0
+                , miscFlags = 0
+                , structureByteStride = 0 }
+    
+    Right cb <- createBuffer device constantBd ([] :: [ConstantBuffer])
+    
+    use cb $ \constantBuffer -> use il $ \inputLayout -> 
+      use vs $ \vertexShader -> use idb $ \ indexBuffer -> use ps $ \pixelShader -> do
+        messagePump hWnd deviceContext swapChain renderTargetView vertexShader pixelShader constantBuffer
+
+useDevice hWnd proc = do
+  (s, d, dc, r) <- initDevice hWnd
+  use s $ \swapChain -> use d $ \device -> use dc $ \deviceContext -> use r $ \renderTargetView ->
+    proc swapChain device deviceContext renderTargetView
+  
+wndProc :: WindowClosure
+wndProc hWnd msg wParam lParam
+  | msg == wM_DESTROY = postQuitMessage 0 >> return 0
+  | otherwise = defWindowProc (Just hWnd) msg wParam lParam
+
+initDevice :: HWND -> IO (Ptr IDxgiSwapChain, Ptr ID3D11Device, Ptr ID3D11DeviceContext, Ptr ID3D11RenderTargetView)
+initDevice hWnd = do
+  let bd = DxgiModeDesc 
+            windowWidth 
+            windowHeight 
+            (DxgiRational 60 1) 
+            DxgiFormatR8G8B8A8Unorm 
+            DxgiModeScanlineOrderUnspecified 
+            DxgiModeScalingUnspecified
+  
+  let sd = DxgiSwapChainDesc
+            bd
+            (DxgiSampleDesc 1 0)
+            dxgiUsageRenderTargetOutput
+            1
+            hWnd
+            True
+            DxgiSwapEffectDiscard
+            0
+  
+  Right (swapChain, device, featureLevel, deviceContext) <- d3d11CreateDeviceAndSwapChain
+          nullPtr 
+          D3DDriverTypeHardware
+          nullPtr
+          [D3D11CreateDeviceDebug]
+          [D3DFeatureLevel11_0, D3DFeatureLevel10_1, D3DFeatureLevel10_0]
+          sd
+  
+  Right (backBuffer :: Ptr ID3D11Texture2D) <- getBuffer swapChain (fromIntegral 0)
+  Right renderTargetView <- use backBuffer $ \b -> createRenderTargetView device b Nothing
+  
+  omSetRenderTargets deviceContext [renderTargetView] nullPtr
+  rsSetViewports deviceContext [D3D11Viewport 0 0 windowWidth windowHeight 0 1]
+  
+  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 "Cube Window"
+  icon         <- loadIcon   Nothing iDI_APPLICATION
+  cursor       <- loadCursor Nothing iDC_ARROW
+  bgBrush      <- createSolidBrush (rgb 255 255 255)
+  mainInstance <- getModuleHandle Nothing
+  registerClass
+    ( cS_VREDRAW + cS_HREDRAW
+    , mainInstance
+    , Just icon
+    , Just cursor
+    , Just bgBrush
+    , Nothing
+    , winClass )
+  w <- createWindow
+       winClass
+       "Cube"
+       wS_OVERLAPPEDWINDOW
+       Nothing Nothing
+       (Just width)
+       (Just height)
+       Nothing
+       Nothing
+       mainInstance
+       wndProc
+  
+  showWindow w sW_SHOWNORMAL
+  updateWindow w
+  return w
+
+pM_NOREMOVE, pM_REMOVE, pM_NOYIELD :: UINT
+pM_NOREMOVE = 0x0000
+pM_REMOVE = 0x0001
+pM_NOYIELD = 0x0002
+
+messagePump 
+  :: HWND -> Ptr ID3D11DeviceContext -> 
+     Ptr IDxgiSwapChain -> Ptr ID3D11RenderTargetView ->
+     Ptr ID3D11VertexShader -> Ptr ID3D11PixelShader -> Ptr ID3D11Buffer -> IO ()
+messagePump hwnd deviceContext swapChain renderTargetView vs ps cb = Graphics.Win32.allocaMessage $ \ msg ->
+  let pump = do
+        m <- peekByteOff msg 4 :: IO WindowMessage
+        when (m /= wM_QUIT) $ do
+          r <- c_PeekMessage msg (maybePtr Nothing) 0 0 pM_REMOVE
+          if r /= 0
+          then do
+            translateMessage msg
+            dispatchMessage msg
+            return ()
+          else do
+            render deviceContext swapChain renderTargetView vs ps cb
+          pump
+  in pump
+  
+render 
+  :: Ptr ID3D11DeviceContext -> Ptr IDxgiSwapChain -> Ptr ID3D11RenderTargetView ->
+     Ptr ID3D11VertexShader -> Ptr ID3D11PixelShader -> Ptr ID3D11Buffer -> IO ()
+render deviceContext swapChain renderTargetView vs ps cb = do
+  clearRenderTargetView deviceContext renderTargetView $ Color 0.0 0.125 0.3 1.0
+  
+  t <- getCPUTime
+  let d = (fromIntegral t) / 1000000000000
+  
+  let eye = Vec3 0.0 1.0 (-5.0)
+  let at = Vec3 0.0 1.0 0.0
+  let up = Vec3 0.0 1.0 0.0
+  let world = rotationY d
+  let view = lookAtLH eye at up
+  let projection = perspectiveFovLH (pi / 2) (windowWidth / windowHeight) 0.01 100
+  let cbData = ConstantBuffer (transpose world) (transpose view) (transpose projection)
+  
+  updateSubresource deviceContext cb 0 Nothing cbData 0 0
+  
+  vsSetShader deviceContext vs []
+  vsSetConstantBuffers deviceContext 0 [cb]
+  psSetShader deviceContext ps []
+  
+  drawIndexed deviceContext 36 0 0
+  
+  present swapChain 0 0
+  return ()

@@ -15,6 +15,7 @@ import System.Win32.DLL (getModuleHandle)
 
 import Graphics.D3D11Binding
+import Graphics.D3D11Binding.Math.Vertex3
 
 foreign import stdcall "PostQuitMessage" postQuitMessage :: Int32 -> IO ()
 

@@ -5,6 +5,7 @@ , module Graphics.D3D11Binding.Shader
 , module Graphics.D3D11Binding.GUID
 , module Graphics.D3D11Binding.Utils
+, module Graphics.D3D11Binding.Math
 , d3d11CreateDeviceAndSwapChain
 ) where
 
@@ -20,6 +21,7 @@ import Graphics.D3D11Binding.Shader
 import Graphics.D3D11Binding.GUID
 import Graphics.D3D11Binding.Utils
+import Graphics.D3D11Binding.Math
 
 import Foreign.Marshal.Array
 import Foreign.Marshal.Alloc

@@ -130,15 +130,20 @@                 | DxgiFormatR8G8Uint
                 | DxgiFormatR8G8Snorm
                 | DxgiFormatR8G8Sint
+                | DxgiFormatR16Uint
                 deriving (Eq, Show)
 
 instance Enum DxgiFormat where
   fromEnum DxgiFormatUnknown = 0
+  fromEnum DxgiFormatR32G32B32A32Float = 2
   fromEnum DxgiFormatR32G32B32Float = 6
   fromEnum DxgiFormatR8G8B8A8Unorm = 28
+  fromEnum DxgiFormatR16Uint = 57
   toEnum 0 = DxgiFormatUnknown
+  toEnum 2 = DxgiFormatR32G32B32A32Float
   toEnum 6 = DxgiFormatR32G32B32Float
   toEnum 28 = DxgiFormatR8G8B8A8Unorm
+  toEnum 57 = DxgiFormatR16Uint
   toEnum unmatched = error ("DxgiFormat.toEnum: cannot match " ++ show unmatched)
 
 instance Storable DxgiFormat where

@@ -0,0 +1,3 @@+module Graphics.D3D11Binding.Interface.D3D11ClassInstance where
+  
+data ID3D11ClassInstance = ID3D11ClassInstance

@@ -73,12 +73,17 @@   createBuffer 
     :: (HasSubresourceData resource) => Ptr interface -> D3D11BufferDesc -> [resource] -> IO (Either HRESULT (Ptr ID3D11Buffer))
   createBuffer this desc resource = 
-    alloca $ \ppBuffer -> alloca $ \pDesc -> alloca $ \pResource -> do
+    alloca $ \ppBuffer -> alloca $ \pDesc -> 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
+      if null resource
+      then do
+        hr <- c_createBuffer (castPtr this) pDesc nullPtr ppBuffer
+        if hr < 0 then return (Left hr) else Right <$> peek ppBuffer
+      else alloca $ \pResource -> do
+        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
 

@@ -14,6 +14,7 @@ 
 import Graphics.D3D11Binding.Interface.Unknown
 import Graphics.D3D11Binding.Interface.D3D11Buffer
+import Graphics.D3D11Binding.Interface.D3D11Resource
 import Graphics.D3D11Binding.Interface.D3D11RenderTargetView
 import Graphics.D3D11Binding.Interface.D3D11DepthStencilView
 import Graphics.D3D11Binding.Interface.D3D11InputLayout
@@ -37,6 +38,9 @@ foreign import stdcall "IASetVertexBuffers" c_iaSetVertexBuffers
   :: Ptr ID3D11DeviceContext -> Word32 -> Word32 -> Ptr (Ptr ID3D11Buffer) -> Ptr Word32 -> Ptr Word32 -> IO ()
 
+foreign import stdcall "IASetIndexBuffer" c_iaSetIndexBuffer
+  :: Ptr ID3D11DeviceContext -> Ptr ID3D11Buffer -> Word32 -> Word32 -> IO ()
+
 foreign import stdcall "IASetPrimitiveTopology" c_iaSetPrimitiveTopology
   :: Ptr ID3D11DeviceContext -> Word32 -> IO ()
   
@@ -48,7 +52,16 @@ 
 foreign import stdcall "Draw" c_draw
   :: Ptr ID3D11DeviceContext -> Word32 -> Word32 -> IO ()
+  
+foreign import stdcall "UpdateSubresource" c_updateSubresource
+  :: Ptr ID3D11DeviceContext -> Ptr ID3D11Resource -> Word32 -> Ptr D3D11Box -> Ptr () -> Word32 -> Word32 -> IO ()
 
+foreign import stdcall "VSSetConstantBuffers" c_vsSetConstantBuffers
+  :: Ptr ID3D11DeviceContext -> Word32 -> Word32 -> Ptr (Ptr ID3D11Buffer) -> IO ()
+
+foreign import stdcall "DrawIndexed" c_drawIndexed
+  :: Ptr ID3D11DeviceContext -> Word32 -> Word32 -> Word32 -> IO ()
+
 class (UnknownInterface interface) => D3D11DeviceContextInterface interface where
   omSetRenderTargets :: Ptr interface -> [Ptr ID3D11RenderTargetView] -> Ptr ID3D11DepthStencilView -> IO ()
   omSetRenderTargets ptr renderTargetViews depthStencilView = alloca $ \pRenderTargetViews -> do
@@ -73,6 +86,8 @@     where first (a,_,_) = a
           second (_,b,_) = b
           third (_,_,c) = c
+  iaSetIndexBuffer :: Ptr interface -> Ptr ID3D11Buffer -> DxgiFormat -> Word32 -> IO ()
+  iaSetIndexBuffer ptr buffer format offset = c_iaSetIndexBuffer (castPtr ptr) buffer (fromIntegral $ fromEnum format) offset
   iaSetPrimitiveTopology :: Ptr interface -> D3D11PrimitiveTopology -> IO ()
   iaSetPrimitiveTopology ptr topology = c_iaSetPrimitiveTopology (castPtr ptr) (fromIntegral $ fromEnum topology)
   clearRenderTargetView :: Ptr interface -> Ptr ID3D11RenderTargetView -> Color -> IO ()
@@ -85,12 +100,26 @@   vsSetShader ptr vertexShader classInstances = maybePokeArray classInstances $ \pClassInstances -> do
     let classInstanceNum = fromIntegral $ length classInstances
     c_vsSetShader (castPtr ptr) vertexShader pClassInstances classInstanceNum
+  vsSetConstantBuffers :: Ptr interface -> Word32 -> [Ptr ID3D11Buffer] -> IO ()
+  vsSetConstantBuffers ptr startSlot buffers = alloca $ \pBuffer -> do
+    pokeArray pBuffer buffers
+    c_vsSetConstantBuffers (castPtr ptr) startSlot (fromIntegral $ length buffers) pBuffer
   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
+  drawIndexed :: Ptr interface -> Word32 -> Word32 -> Word32 -> IO ()
+  drawIndexed ptr indexCount startIndexLocation baseVertexLocation =
+    c_drawIndexed (castPtr ptr) indexCount startIndexLocation baseVertexLocation
+  updateSubresource :: 
+    (D3D11ResourceInterface resource, Storable store) => 
+    Ptr interface -> Ptr resource -> Word32 -> Maybe D3D11Box -> store -> Word32 -> Word32 -> IO ()
+  updateSubresource ptr dstResource dstSubresource dstBox srcData srcRowPitch srcDepthPitch = 
+    maybePoke dstBox $ \pDstBox -> alloca $ \pSrcData -> do
+      poke pSrcData srcData
+      c_updateSubresource (castPtr ptr) (castPtr dstResource) dstSubresource pDstBox (castPtr pSrcData) srcRowPitch srcDepthPitch
 
 data ID3D11DeviceContext = ID3D11DeviceContext
 

@@ -0,0 +1,5 @@+module Graphics.D3D11Binding.Math 
+( module Graphics.D3D11Binding.Math.Matrix
+) where
+
+import Graphics.D3D11Binding.Math.Matrix

@@ -0,0 +1,53 @@+module Graphics.D3D11Binding.Math.Matrix where
+  
+import Data.Vect.Float
+
+import Foreign.Ptr
+import Foreign.Marshal.Array
+import Foreign.Storable
+import Foreign.CStorable
+    
+instance CStorable Mat4 where
+  cSizeOf = sizeOf
+  cAlignment = alignment
+  cPeek = peek
+  cPoke = poke
+
+lookAtLH :: Vec3 -> Vec3 -> Vec3 -> Mat4
+lookAtLH eye focus up = lookToLH eye eyeDir up
+  where eyeDir = focus &- eye
+ 
+lookToLH :: Vec3 -> Vec3 -> Vec3 -> Mat4
+lookToLH eye eyeDir up = transpose m
+  where r2@(Vec3 r2x r2y r2z) = normalize eyeDir
+        r0@(Vec3 r0x r0y r0z) = normalize (up &^ r2)
+        r1@(Vec3 r1x r1y r1z) = r2 &^ r0
+        negEye = neg eye
+        d0 = r0 &. negEye
+        d1 = r1 &. negEye
+        d2 = r2 &. negEye
+        m = Mat4 (Vec4 r0x r0y r0z d0)
+                 (Vec4 r1x r1y r1z d1)
+                 (Vec4 r2x r2y r2z d2)
+                 (Vec4   0   0   0  1)
+                 
+perspectiveFovLH :: Float -> Float -> Float -> Float -> Mat4
+perspectiveFovLH fovAngleY aspectRatio nearZ farZ = m
+  where sinFov = sin (fovAngleY * 0.5)
+        cosFov = cos (fovAngleY * 0.5)
+        height = cosFov / sinFov
+        width = height / aspectRatio
+        rate = farZ / (farZ - nearZ)
+        m = Mat4 (Vec4 width 0 0 0)
+                 (Vec4 0 height 0 0)
+                 (Vec4 0 0 rate 1.0)
+                 (Vec4 0 0 ((-rate)*nearZ) 0)
+                 
+rotationY :: Float -> Mat4
+rotationY angle = m
+  where sinAngle = sin angle
+        cosAngle = cos angle
+        m = Mat4 (Vec4 cosAngle 0 (-sinAngle) 0)
+                 (Vec4 0 1 0 0)
+                 (Vec4 sinAngle 0 cosAngle 0)
+                 (Vec4 0 0 0 1)

@@ -0,0 +1,22 @@+{-# LANGUAGE DeriveGeneric #-}
+module Graphics.D3D11Binding.Math.Vertex3 where
+import GHC.Generics (Generic)
+
+import Foreign.Storable
+import Foreign.CStorable
+
+import Graphics.D3D11Binding.Types
+
+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

@@ -0,0 +1,23 @@+{-# LANGUAGE DeriveGeneric #-}
+module Graphics.D3D11Binding.Math.Vertex4 where
+import GHC.Generics (Generic)
+
+import Foreign.Storable
+import Foreign.CStorable
+
+import Graphics.D3D11Binding.Types
+
+data Vertex4 = Vertex4
+  { x :: Float
+  , y :: Float
+  , z :: Float
+  , w :: Float } deriving (Generic)
+  
+instance CStorable Vertex4
+instance Storable Vertex4 where
+  sizeOf = cSizeOf
+  alignment = cAlignment
+  poke = cPoke
+  peek = cPeek
+
+instance HasSubresourceData Vertex4

@@ -195,8 +195,9 @@ instance Storable D3D11InputElementDesc where
   sizeOf _ = 32
   alignment _ = 8
-  poke ptr desc = alloca $ \(namePtr :: CString) -> do
-    pokeCString namePtr (semanticName desc)
+  poke ptr desc = do
+    -- TODO : free namePtr
+    namePtr <- newCString (semanticName desc)
     pokeByteOff ptr 0 namePtr
     pokeByteOff ptr 8 (semanticIndex desc)
     pokeByteOff ptr 12 (inputElementFormat desc)
@@ -229,24 +230,11 @@ 
 class (Storable dataType) => HasSubresourceData dataType where
   getSubresourceData :: [dataType] -> IO D3D11SubresourceData
+  getSubresourceData [] = return $ D3D11SubresourceData nullPtr (fromIntegral 0) (fromIntegral 0)
   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
@@ -261,3 +249,18 @@   alignment = cAlignment
   poke = cPoke
   peek = cPeek
+
+data D3D11Box = D3D11Box
+  { left :: Word32
+  , top :: Word32
+  , front :: Word32
+  , right :: Word32
+  , bottom :: Word32
+  , back :: Word32 } deriving (Generic)
+
+instance CStorable D3D11Box
+instance Storable D3D11Box where
+  sizeOf = cSizeOf
+  alignment = cAlignment
+  poke = cPoke
+  peek = cPeek

@@ -0,0 +1,24 @@+module Graphics.D3D11Binding.Utils where
+
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.Marshal.Array
+import Foreign.Marshal.Alloc
+import Foreign.C.String
+
+
+maybePoke :: (Storable a) => Maybe a -> (Ptr a -> IO b) -> IO b
+maybePoke Nothing proc = proc nullPtr
+maybePoke (Just m) proc = alloca $ \ptr -> do
+  poke ptr m
+  proc ptr
+
+maybeWithCString :: Maybe String -> (CString -> IO a) -> IO a
+maybeWithCString Nothing proc = proc nullPtr
+maybeWithCString (Just m) proc = withCString m proc
+
+maybePokeArray :: (Storable a) => [a] -> (Ptr a -> IO b) -> IO b
+maybePokeArray [] proc = proc nullPtr
+maybePokeArray xs proc = alloca $ \ptr -> do
+  pokeArray ptr xs
+  proc ptr