d3d11binding (empty) → 0.0.0.1
raw patch · 20 files changed
+1088/−0 lines, 20 filesdep +Win32dep +basedep +c-storable-derivingsetup-changed
Dependencies added: Win32, base, c-storable-deriving, d3d11binding
Files
- LICENSE +20/−0
- README.md +3/−0
- Setup.hs +2/−0
- csource/wrapper.c +62/−0
- d3d11binding.cabal +76/−0
- examples/HelloWorld.hs +124/−0
- src/Graphics/D3D11Binding.hs +68/−0
- src/Graphics/D3D11Binding/Enums.hs +308/−0
- src/Graphics/D3D11Binding/GUID.hs +43/−0
- src/Graphics/D3D11Binding/Interface.hs +27/−0
- src/Graphics/D3D11Binding/Interface/D3D11DepthStencilView.hs +3/−0
- src/Graphics/D3D11Binding/Interface/D3D11Device.hs +32/−0
- src/Graphics/D3D11Binding/Interface/D3D11DeviceContext.hs +51/−0
- src/Graphics/D3D11Binding/Interface/D3D11RenderTargetView.hs +7/−0
- src/Graphics/D3D11Binding/Interface/D3D11Resource.hs +21/−0
- src/Graphics/D3D11Binding/Interface/DxgiAdapter.hs +3/−0
- src/Graphics/D3D11Binding/Interface/DxgiSwapChain.hs +35/−0
- src/Graphics/D3D11Binding/Interface/Texture2D.hs +13/−0
- src/Graphics/D3D11Binding/Interface/Unknown.hs +24/−0
- src/Graphics/D3D11Binding/Types.hs +166/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 jwvg0425 + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,3 @@+# d3d11binding + +this package is a raw binding for the directX 11
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple +main = defaultMain
+ csource/wrapper.c view
@@ -0,0 +1,62 @@+#include "dxgi.h" +#include "d3d11.h" +#include <stdio.h> + +HRESULT Present(IDXGISwapChain* This, UINT sync_interval, UINT flags) +{ + return This->lpVtbl->Present(This, sync_interval, flags); +} + +HRESULT GetBuffer(IDXGISwapChain* This,UINT buffer_idx,REFIID riid,void **surface) +{ + return This->lpVtbl->GetBuffer(This, buffer_idx,riid,surface); +} + + void SetEvictionPriority(ID3D11Texture3D* This, UINT EvictionPriority) + { + This->lpVtbl->SetEvictionPriority(This,EvictionPriority); + } + + HRESULT CreateRenderTargetView( + ID3D11Device* This, + ID3D11Resource *pResource, + const D3D11_RENDER_TARGET_VIEW_DESC *pDesc, + ID3D11RenderTargetView **ppRTView) +{ + return This->lpVtbl->CreateRenderTargetView(This, pResource, pDesc, ppRTView); +} + +ULONG Release(IUnknown* This) +{ + return This->lpVtbl->Release(This); +} + +void OMSetRenderTargets( + ID3D11DeviceContext* This, + UINT NumViews, + ID3D11RenderTargetView *const *ppRenderTargetViews, + ID3D11DepthStencilView *pDepthStencilView) +{ + This->lpVtbl->OMSetRenderTargets(This, NumViews, ppRenderTargetViews, pDepthStencilView); +} + +void RSSetViewports( + ID3D11DeviceContext* This, + UINT NumViewports, + const D3D11_VIEWPORT *pViewports) +{ + This->lpVtbl->RSSetViewports(This, NumViewports, pViewports); +} + +void ClearRenderTargetView( + ID3D11DeviceContext* This, + ID3D11RenderTargetView *pRenderTargetView, + const FLOAT ColorRGBA[ 4 ]) +{ + This->lpVtbl->ClearRenderTargetView(This, pRenderTargetView, ColorRGBA); +} + +void ClearState(ID3D11DeviceContext* This) +{ + This->lpVtbl->ClearState(This); +}
+ d3d11binding.cabal view
@@ -0,0 +1,76 @@+-- Initial d3d11binding.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: d3d11binding +version: 0.0.0.1 +synopsis: A raw binding for the directX 11 +description: A raw binding for the directX 11 +homepage: https://github.com/jwvg0425/d3d11binding +bug-reports: https://github.com/jwvg0425/d3d11binding/issues +license: MIT +license-file: LICENSE +author: jwvg0425 +maintainer: jwvg0425@naver.com +-- copyright: +category: Graphics +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +Source-Repository HEAD + Type: git + Location: git://github.com/jwvg0425/d3d11binding.git + +library + exposed-modules: + Graphics.D3D11Binding + Graphics.D3D11Binding.Enums + Graphics.D3D11Binding.Types + Graphics.D3D11Binding.Interface + + Graphics.D3D11Binding.Interface.D3D11DepthStencilView + Graphics.D3D11Binding.Interface.D3D11Device + Graphics.D3D11Binding.Interface.D3D11DeviceContext + Graphics.D3D11Binding.Interface.D3D11RenderTargetView + Graphics.D3D11Binding.Interface.D3D11Resource + + Graphics.D3D11Binding.Interface.DxgiAdapter + Graphics.D3D11Binding.Interface.DxgiSwapChain + + Graphics.D3D11Binding.Interface.Texture2D + Graphics.D3D11Binding.Interface.Unknown + + 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 + hs-source-dirs: src + default-language: Haskell2010 + extra-libraries: + d3d11 + d3dx11 + D3DCompiler + d3dxof + dxgi + dxguid + includes: + DXGI.h + D3D11.h + d3d11shader.h + D3DCompiler.h + c-sources: + csource/wrapper.c + +executable HelloWorld + main-is: HelloWorld.hs + -- other-modules: + -- other-extensions: + build-depends: + base >= 4.8 && < 5, + Win32 >= 2.3.0.0, + d3d11binding + hs-source-dirs: examples + default-language: Haskell2010
+ examples/HelloWorld.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE ScopedTypeVariables #-} +module Main where +import System.Exit + +import Data.Int + +import Control.Exception +import Control.Monad + +import Foreign (peekByteOff) +import Foreign.Ptr + +import Graphics.Win32 +import System.Win32.DLL (getModuleHandle) + +import Graphics.D3D11Binding + +foreign import stdcall "PostQuitMessage" postQuitMessage :: Int32 -> IO () + +main :: IO () +main = do + hWnd <- createDefaultWindow 800 600 wndProc + (s, d, dc, r) <- initDevice hWnd + use s $ \swapChain -> use d $ \device -> use dc $ \deviceContext -> use r $ \renderTargetView -> do + messagePump hWnd deviceContext swapChain 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 + 800 + 600 + (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 800 600 0 1] + + return (swapChain, device, deviceContext, renderTargetView) + +createDefaultWindow :: Int -> Int -> WindowClosure -> IO HWND +createDefaultWindow width height wndProc = do + let winClass = mkClassName "HelloWorld" + 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 + "Hello, World" + 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 -> IO () +messagePump hwnd deviceContext swapChain renderTargetView = 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 + pump + in pump + +render :: Ptr ID3D11DeviceContext -> Ptr IDxgiSwapChain -> Ptr ID3D11RenderTargetView -> IO () +render deviceContext swapChain renderTargetView = do + clearRenderTargetView deviceContext renderTargetView $ Color 0.0 0.125 0.3 1.0 + present swapChain 0 0 + return ()
+ src/Graphics/D3D11Binding.hs view
@@ -0,0 +1,68 @@+module Graphics.D3D11Binding +( module Graphics.D3D11Binding.Enums +, module Graphics.D3D11Binding.Types +, module Graphics.D3D11Binding.Interface +, module Graphics.D3D11Binding.GUID +, d3d11CreateDeviceAndSwapChain +) where + +import Data.Word + +import Foreign.Ptr + +import Graphics.Win32 + +import Graphics.D3D11Binding.Enums +import Graphics.D3D11Binding.Types +import Graphics.D3D11Binding.Interface +import Graphics.D3D11Binding.GUID + +import Foreign.Marshal.Array +import Foreign.Marshal.Alloc +import Foreign.Storable + +type PIDxgiAdapter = Ptr IDxgiAdapter +type PD3DFeatureLevel = Ptr D3DFeatureLevel +type PDxgiSwapChainDesc = Ptr DxgiSwapChainDesc +type PIDxgiSwapChain = Ptr IDxgiSwapChain +type PID3D11Device = Ptr ID3D11Device +type PID3D11DeviceContext = Ptr ID3D11DeviceContext + +d3d11SdkVersion :: Word32 +d3d11SdkVersion = 7 + +foreign import stdcall "D3D11CreateDeviceAndSwapChain" c_d3d11CreateDeviceAndSwapChain + :: PIDxgiAdapter -> Word32 -> HMODULE -> Word32 -> + PD3DFeatureLevel -> Word32 -> Word32 -> PDxgiSwapChainDesc -> + Ptr PIDxgiSwapChain -> Ptr PID3D11Device -> Ptr D3DFeatureLevel -> + Ptr PID3D11DeviceContext -> IO HRESULT + +d3d11CreateDeviceAndSwapChain + :: PIDxgiAdapter -> D3DDriverType -> HMODULE -> + [D3D11CreateDeviceFlag] -> [D3DFeatureLevel] -> DxgiSwapChainDesc -> + IO (Either HRESULT (PIDxgiSwapChain, PID3D11Device, D3DFeatureLevel, PID3D11DeviceContext)) +d3d11CreateDeviceAndSwapChain adapter driverType software flags featureLevels swapChainDesc = do + featureArray <- newArray featureLevels + let flagSum = createDeviceFlag flags + alloca $ \swapChain -> alloca $ \device -> alloca $ \feature -> alloca $ \context -> alloca $ \sd -> do + poke sd swapChainDesc + hr <- c_d3d11CreateDeviceAndSwapChain + adapter + (fromIntegral $ fromEnum driverType) + software + flagSum + featureArray + (fromIntegral $ length featureLevels) + d3d11SdkVersion + sd + swapChain + device + feature + context + if hr < 0 then return (Left hr) + else do + peekSwapChain <- peek swapChain + peekDevice <- peek device + peekFeature <- peek feature + peekContext <- peek context + return $ Right (peekSwapChain, peekDevice, peekFeature, peekContext)
+ src/Graphics/D3D11Binding/Enums.hs view
@@ -0,0 +1,308 @@+module Graphics.D3D11Binding.Enums where + +import Data.Int +import Data.Word +import Data.Bits +import Foreign.Ptr +import Foreign.Storable +import Foreign.CStorable + +data D3DDriverType = D3DDriverTypeUnknown + | D3DDriverTypeHardware + | D3DDriverTypeReference + | D3DDriverTypeNull + | D3DDriverTypeSoftware + | D3DDriverTypeWarp + deriving (Eq,Show) + +instance Enum D3DDriverType where + fromEnum D3DDriverTypeUnknown = 0 + fromEnum D3DDriverTypeHardware = 1 + fromEnum D3DDriverTypeReference = 2 + fromEnum D3DDriverTypeNull = 3 + fromEnum D3DDriverTypeSoftware = 4 + fromEnum D3DDriverTypeWarp = 5 + toEnum 0 = D3DDriverTypeUnknown + toEnum 1 = D3DDriverTypeHardware + toEnum 2 = D3DDriverTypeReference + toEnum 3 = D3DDriverTypeNull + toEnum 4 = D3DDriverTypeSoftware + toEnum 5 = D3DDriverTypeWarp + toEnum unmatched = error ("D3DDriverType.toEnum: cannot match " ++ show unmatched) + +instance Storable D3DDriverType 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 D3DDriverType where + cSizeOf = sizeOf + cAlignment = alignment + cPeek = peek + cPoke = poke + +data D3DFeatureLevel = D3DFeatureLevel9_1 + | D3DFeatureLevel9_2 + | D3DFeatureLevel9_3 + | D3DFeatureLevel10_0 + | D3DFeatureLevel10_1 + | D3DFeatureLevel11_0 + deriving (Eq, Show) + +instance Enum D3DFeatureLevel where + fromEnum D3DFeatureLevel9_1 = 0x9100 + fromEnum D3DFeatureLevel9_2 = 0x9200 + fromEnum D3DFeatureLevel9_3 = 0x9300 + fromEnum D3DFeatureLevel10_0 = 0xa000 + fromEnum D3DFeatureLevel10_1 = 0xa100 + fromEnum D3DFeatureLevel11_0 = 0xb000 + toEnum 0x9100 = D3DFeatureLevel9_1 + toEnum 0x9200 = D3DFeatureLevel9_2 + toEnum 0x9300 = D3DFeatureLevel9_3 + toEnum 0xa000 = D3DFeatureLevel10_0 + toEnum 0xa100 = D3DFeatureLevel10_1 + toEnum 0xb000 = D3DFeatureLevel11_0 + toEnum unmatched = error ("D3DFeatureLevel.toEnum: cannot match " ++ show unmatched) + +instance Storable D3DFeatureLevel 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 D3DFeatureLevel where + cSizeOf = sizeOf + cAlignment = alignment + cPeek = peek + cPoke = poke + +data DxgiFormat = DxgiFormatUnknown + | DxgiFormatR32G32B32A32Typeless + | DxgiFormatR32G32B32A32Float + | DxgiFormatR32G32B32A32Uint + | DxgiFormatR32G32B32A32Sint + | DxgiFormatR32G32B32Typeless + | DxgiFormatR32G32B32Float + | DxgiFormatR32G32B32Uint + | DxgiFormatR32G32B32Sint + | DxgiFormatR16G16B16A16Typeless + | DxgiFormatR16G16B16A16Float + | DxgiFormatR16G16B16A16Unorm + | DxgiFormatR16G16B16A16Uint + | DxgiFormatR16G16B16A16Snorm + | DxgiFormatR16G16B16A16Sint + | DxgiFormatR32G32Typeless + | DxgiFormatR32G32Float + | DxgiFormatR32G32Uint + | DxgiFormatR32G32Sint + | DxgiFormatR32G8X24Typeless + | DxgiFormatD32FloatS8X24Uint + | DxgiFormatR32FloatX8X24Typeless + | DxgiFormatX32TypelessG8X24Uint + | DxgiFormatR10G10B10A2Typeless + | DxgiFormatR10G10B10A2Unorm + | DxgiFormatR10G10B10A2Uint + | DxgiFormatR11G11B10Float + | DxgiFormatR8G8B8A8Typeless + | DxgiFormatR8G8B8A8Unorm + | DxgiFormatR8G8B8A8UnormSRGB + | DxgiFormatR8G8B8A8Uint + | DxgiFormatR8G8B8A8Snorm + | DxgiFormatR8G8B8A8Sint + | DxgiFormatR16G16Typeless + | DxgiFormatR16G16Float + | DxgiFormatR16G16Unorm + | DxgiFormatR16G16Uint + | DxgiFormatR16G16Snorm + | DxgiFormatR16G16Sint + | DxgiFormatR32Typeless + | DxgiFormatD32Float + | DxgiFormatR32Float + | DxgiFormatR32Uint + | DxgiFormatR32Sint + | DxgiFormatR24G8Typeless + | DxgiFormatD24UnormS8Uint + | DxgiFormatR24UnormX8Typeless + | DxgiFormatX24TypelessG8Uint + | DxgiFormatR8G8Typeless + | DxgiFormatR8G8Unorm + | DxgiFormatR8G8Uint + | DxgiFormatR8G8Snorm + | DxgiFormatR8G8Sint + deriving (Eq, Show) + +instance Enum DxgiFormat where + fromEnum DxgiFormatUnknown = 0 + fromEnum DxgiFormatR8G8B8A8Unorm = 28 + toEnum 0 = DxgiFormatUnknown + toEnum 28 = DxgiFormatR8G8B8A8Unorm + toEnum unmatched = error ("DxgiFormat.toEnum: cannot match " ++ show unmatched) + +instance Storable DxgiFormat 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 DxgiFormat where + cSizeOf = sizeOf + cAlignment = alignment + cPeek = peek + cPoke = poke + +data DxgiModeScanlineOrder = DxgiModeScanlineOrderUnspecified + | DxgiModeScanlineOrderProgressive + | DxgiModeScanlineOrderUpperFieldFirst + | DxgiModeScanlineOrderLowerFieldFirst + deriving (Eq, Show) + +instance Enum DxgiModeScanlineOrder where + fromEnum DxgiModeScanlineOrderUnspecified = 0 + fromEnum DxgiModeScanlineOrderProgressive = 1 + fromEnum DxgiModeScanlineOrderUpperFieldFirst = 2 + fromEnum DxgiModeScanlineOrderLowerFieldFirst = 3 + toEnum 0 = DxgiModeScanlineOrderUnspecified + toEnum 1 = DxgiModeScanlineOrderProgressive + toEnum 2 = DxgiModeScanlineOrderUpperFieldFirst + toEnum 3 = DxgiModeScanlineOrderLowerFieldFirst + toEnum unmatched = error ("DxgiModeScanlineOrder.toEnum: cannot match " ++ show unmatched) + +instance Storable DxgiModeScanlineOrder 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 DxgiModeScanlineOrder where + cSizeOf = sizeOf + cAlignment = alignment + cPeek = peek + cPoke = poke + +data DxgiModeScaling = DxgiModeScalingUnspecified + | DxgiModeScalingCentered + | DxgiModeScalingStretched + deriving (Eq, Show) + +instance Enum DxgiModeScaling where + fromEnum DxgiModeScalingUnspecified = 0 + fromEnum DxgiModeScalingCentered = 1 + fromEnum DxgiModeScalingStretched = 2 + toEnum 0 = DxgiModeScalingUnspecified + toEnum 1 = DxgiModeScalingCentered + toEnum 2 = DxgiModeScalingStretched + toEnum unmatched = error ("DxgiModeScaling.toEnum: cannot match " ++ show unmatched) + +instance Storable DxgiModeScaling 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 DxgiModeScaling where + cSizeOf = sizeOf + cAlignment = alignment + cPeek = peek + cPoke = poke + +data DxgiSwapEffect = DxgiSwapEffectDiscard + | DxgiSwapEffectSequential + deriving (Eq, Show) + +instance Enum DxgiSwapEffect where + fromEnum DxgiSwapEffectDiscard = 0 + fromEnum DxgiSwapEffectSequential = 1 + toEnum 0 = DxgiSwapEffectDiscard + toEnum 1 = DxgiSwapEffectSequential + toEnum unmatched = error ("DxgiSwapEffect.toEnum: cannot match " ++ show unmatched) + +instance Storable DxgiSwapEffect 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 DxgiSwapEffect where + cSizeOf = sizeOf + cAlignment = alignment + cPeek = peek + cPoke = poke + +data D3D11CreateDeviceFlag = D3D11CreateDeviceSinglethreaded + | D3D11CreateDeviceDebug + | D3D11CreateDeviceSwitchToRef + | D3D11CreateDevicePreventInternalThreadingOptimizations + | D3D11CreateDeviceBGRASupport + deriving (Eq, Show) + +instance Enum D3D11CreateDeviceFlag where + fromEnum D3D11CreateDeviceSinglethreaded = 0x1 + fromEnum D3D11CreateDeviceDebug = 0x2 + fromEnum D3D11CreateDeviceSwitchToRef = 0x4 + fromEnum D3D11CreateDevicePreventInternalThreadingOptimizations = 0x8 + fromEnum D3D11CreateDeviceBGRASupport = 0x20 + toEnum 0x1 = D3D11CreateDeviceSinglethreaded + toEnum 0x2 = D3D11CreateDeviceDebug + toEnum 0x4 = D3D11CreateDeviceSwitchToRef + toEnum 0x8 = D3D11CreateDevicePreventInternalThreadingOptimizations + toEnum 0x20 = D3D11CreateDeviceBGRASupport + toEnum unmatched = error ("D3D11CreateDeviceFlag.toEnum: cannot match " ++ show unmatched) + +instance Storable D3D11CreateDeviceFlag 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 D3D11CreateDeviceFlag where + cSizeOf = sizeOf + cAlignment = alignment + cPeek = peek + cPoke = poke + +createDeviceFlag :: [D3D11CreateDeviceFlag] -> Word32 +createDeviceFlag = foldl (.|.) 0 . map (fromIntegral . fromEnum) + +data D3D11RtvDimension = D3D11RtvDimensionUnknown + | D3D11RtvDimensionBuffer + | D3D11RtvDimensionTexture1D + | D3D11RtvDimensionTexture1DArray + | D3D11RtvDimensionTexture2D + | D3D11RtvDimensionTexture2DArray + | D3D11RtvDimensionTexture2DMs + | D3D11RtvDimensionTexture2DMsArray + | D3D11RtvDimensionTexture3D + +instance Enum D3D11RtvDimension where + fromEnum D3D11RtvDimensionUnknown = 0 + fromEnum D3D11RtvDimensionBuffer = 1 + fromEnum D3D11RtvDimensionTexture1D = 2 + fromEnum D3D11RtvDimensionTexture1DArray = 3 + fromEnum D3D11RtvDimensionTexture2D = 4 + fromEnum D3D11RtvDimensionTexture2DArray = 5 + fromEnum D3D11RtvDimensionTexture2DMs = 6 + fromEnum D3D11RtvDimensionTexture2DMsArray = 7 + fromEnum D3D11RtvDimensionTexture3D = 8 + toEnum 0 = D3D11RtvDimensionUnknown + toEnum 1 = D3D11RtvDimensionBuffer + toEnum 2 = D3D11RtvDimensionTexture1D + toEnum 3 = D3D11RtvDimensionTexture1DArray + toEnum 4 = D3D11RtvDimensionTexture2D + toEnum 5 = D3D11RtvDimensionTexture2DArray + toEnum 6 = D3D11RtvDimensionTexture2DMs + toEnum 7 = D3D11RtvDimensionTexture2DMsArray + toEnum 8 = D3D11RtvDimensionTexture3D + toEnum unmatched = error ("D3D11RtvDimension.toEnum: cannot match " ++ show unmatched) + +instance Storable D3D11RtvDimension 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 D3D11RtvDimension where + cSizeOf = sizeOf + cAlignment = alignment + cPeek = peek + cPoke = poke
+ src/Graphics/D3D11Binding/GUID.hs view
@@ -0,0 +1,43 @@+module Graphics.D3D11Binding.GUID where + +import Data.Word + +import Foreign.Storable +import Foreign.CStorable +import Foreign.Ptr +import Foreign.Marshal.Array +import Foreign.Marshal.Alloc + +data GUID = GUID Word32 Word16 Word16 [Word8] deriving (Show) + +instance Storable GUID where + sizeOf _ = 16 + alignment _ = 8 + peek ptr = do + d1 <- peekByteOff ptr 0 + d2 <- peekByteOff ptr 4 + d3 <- peekByteOff ptr 6 + d40 <- peekByteOff ptr 8 + d41 <- peekByteOff ptr 9 + d42 <- peekByteOff ptr 10 + d43 <- peekByteOff ptr 11 + d44 <- peekByteOff ptr 12 + d45 <- peekByteOff ptr 13 + d46 <- peekByteOff ptr 14 + d47 <- peekByteOff ptr 15 + return $ GUID d1 d2 d3 [d40,d41,d42,d43,d44,d45,d46,d47] + poke ptr (GUID d1 d2 d3 d4) = do + pokeByteOff ptr 0 d1 + pokeByteOff ptr 4 d2 + pokeByteOff ptr 6 d3 + pokeByteOff ptr 8 (d4 !! 0) + pokeByteOff ptr 9 (d4 !! 1) + pokeByteOff ptr 10 (d4 !! 2) + pokeByteOff ptr 11 (d4 !! 3) + pokeByteOff ptr 12 (d4 !! 4) + pokeByteOff ptr 13 (d4 !! 5) + pokeByteOff ptr 14 (d4 !! 6) + pokeByteOff ptr 15 (d4 !! 7) + +class HasGUID t where + getGUID :: Ptr (Ptr t) -> GUID
+ src/Graphics/D3D11Binding/Interface.hs view
@@ -0,0 +1,27 @@+module Graphics.D3D11Binding.Interface +( module Graphics.D3D11Binding.Interface.D3D11DepthStencilView +, module Graphics.D3D11Binding.Interface.D3D11Device +, module Graphics.D3D11Binding.Interface.D3D11DeviceContext +, module Graphics.D3D11Binding.Interface.D3D11RenderTargetView +, module Graphics.D3D11Binding.Interface.D3D11Resource + +, module Graphics.D3D11Binding.Interface.DxgiAdapter +, module Graphics.D3D11Binding.Interface.DxgiSwapChain + +, module Graphics.D3D11Binding.Interface.Texture2D + +, module Graphics.D3D11Binding.Interface.Unknown +) where + +import Graphics.D3D11Binding.Interface.D3D11DepthStencilView +import Graphics.D3D11Binding.Interface.D3D11Device +import Graphics.D3D11Binding.Interface.D3D11DeviceContext +import Graphics.D3D11Binding.Interface.D3D11RenderTargetView +import Graphics.D3D11Binding.Interface.D3D11Resource + +import Graphics.D3D11Binding.Interface.DxgiAdapter +import Graphics.D3D11Binding.Interface.DxgiSwapChain + +import Graphics.D3D11Binding.Interface.Texture2D + +import Graphics.D3D11Binding.Interface.Unknown
+ src/Graphics/D3D11Binding/Interface/D3D11DepthStencilView.hs view
@@ -0,0 +1,3 @@+module Graphics.D3D11Binding.Interface.D3D11DepthStencilView where + +data ID3D11DepthStencilView = ID3D11DepthStencilView
+ src/Graphics/D3D11Binding/Interface/D3D11Device.hs view
@@ -0,0 +1,32 @@+module Graphics.D3D11Binding.Interface.D3D11Device where +import Data.Word + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Ptr + +import Graphics.Win32 +import Graphics.D3D11Binding.Types +import Graphics.D3D11Binding.Interface.Unknown +import Graphics.D3D11Binding.Interface.D3D11Resource +import Graphics.D3D11Binding.Interface.D3D11RenderTargetView + +foreign import stdcall "CreateRenderTargetView" c_createRenderTargetView + :: Ptr ID3D11Device -> Ptr ID3D11Resource -> Ptr D3D11RenderTargetViewDesc -> Ptr (Ptr ID3D11RenderTargetView) -> IO HRESULT + +class (UnknownInterface interface) => D3D11DeviceInterface interface where + 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 + hr <- c_createRenderTargetView (castPtr this) (castPtr pResource) pDesc renderTargetView + if hr < 0 then return (Left hr) else Right <$> peek renderTargetView + +data ID3D11Device = ID3D11Device + +instance UnknownInterface ID3D11Device +instance D3D11DeviceInterface ID3D11Device
+ src/Graphics/D3D11Binding/Interface/D3D11DeviceContext.hs view
@@ -0,0 +1,51 @@+module Graphics.D3D11Binding.Interface.D3D11DeviceContext where +import Data.Word + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Ptr + +import Graphics.Win32 +import Graphics.D3D11Binding.Types +import Graphics.D3D11Binding.Interface.Unknown +import Graphics.D3D11Binding.Interface.D3D11RenderTargetView +import Graphics.D3D11Binding.Interface.D3D11DepthStencilView + +foreign import stdcall "OMSetRenderTargets" c_omSetRenderTargets + :: Ptr ID3D11DeviceContext -> Word32 -> Ptr (Ptr ID3D11RenderTargetView) -> Ptr ID3D11DepthStencilView -> IO () + +foreign import stdcall "RSSetViewports" c_rsSetViewports + :: Ptr ID3D11DeviceContext -> Word32 -> Ptr D3D11Viewport -> IO () + +foreign import stdcall "ClearRenderTargetView" c_clearRenderTargetView + :: Ptr ID3D11DeviceContext -> Ptr ID3D11RenderTargetView -> Ptr Float -> IO () + +class (UnknownInterface interface) => D3D11DeviceContextInterface interface where + omSetRenderTargets :: Ptr interface -> [Ptr ID3D11RenderTargetView] -> Ptr ID3D11DepthStencilView -> IO () + omSetRenderTargets ptr renderTargetViews depthStencilView = alloca $ \pRenderTargetViews -> do + pokeArray pRenderTargetViews renderTargetViews + c_omSetRenderTargets (castPtr ptr) (fromIntegral $ length renderTargetViews) pRenderTargetViews depthStencilView + rsSetViewports :: Ptr interface -> [D3D11Viewport] -> IO () + rsSetViewports ptr viewports = alloca $ \pViewports -> do + pokeArray pViewports viewports + c_rsSetViewports (castPtr ptr) (fromIntegral $ length viewports) pViewports + 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) + +data ID3D11DeviceContext = ID3D11DeviceContext + +foreign import stdcall "ClearState" c_clearState + :: Ptr ID3D11DeviceContext -> IO () + +instance UnknownInterface ID3D11DeviceContext where + use i f = do + res <- f i + clearState i + release i + return res +instance D3D11DeviceContextInterface ID3D11DeviceContext
+ src/Graphics/D3D11Binding/Interface/D3D11RenderTargetView.hs view
@@ -0,0 +1,7 @@+module Graphics.D3D11Binding.Interface.D3D11RenderTargetView where + +import Graphics.D3D11Binding.Interface.Unknown + +data ID3D11RenderTargetView = ID3D11RenderTargetView + +instance UnknownInterface ID3D11RenderTargetView
+ src/Graphics/D3D11Binding/Interface/D3D11Resource.hs view
@@ -0,0 +1,21 @@+module Graphics.D3D11Binding.Interface.D3D11Resource where +import Data.Word + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Ptr + +import Graphics.Win32 +import Graphics.D3D11Binding.Types +import Graphics.D3D11Binding.Interface.Unknown + +foreign import stdcall "SetEvictionPriority" c_setEvictionPriority + :: Ptr ID3D11Resource -> Word32 -> IO () + +class (UnknownInterface interface) => D3D11ResourceInterface interface where + setEvictionPriority :: Ptr interface -> Word32 -> IO () + setEvictionPriority ptr w = c_setEvictionPriority (castPtr ptr) w + +data ID3D11Resource = ID3D11Resource +instance UnknownInterface ID3D11Resource +instance D3D11ResourceInterface ID3D11Resource
+ src/Graphics/D3D11Binding/Interface/DxgiAdapter.hs view
@@ -0,0 +1,3 @@+module Graphics.D3D11Binding.Interface.DxgiAdapter where + +data IDxgiAdapter = IDxgiAdapter
+ src/Graphics/D3D11Binding/Interface/DxgiSwapChain.hs view
@@ -0,0 +1,35 @@+module Graphics.D3D11Binding.Interface.DxgiSwapChain where +import Data.Word + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Ptr + +import Graphics.Win32 +import Graphics.D3D11Binding.GUID +import Graphics.D3D11Binding.Types + +import Graphics.D3D11Binding.Interface.Unknown + +foreign import stdcall "Present" c_present + :: Ptr IDxgiSwapChain -> Word32 -> Word32 -> IO HRESULT + +foreign import stdcall "GetBuffer" c_getBuffer + :: Ptr IDxgiSwapChain -> Word32 -> Ptr GUID -> Ptr (Ptr ()) -> IO HRESULT + +class (UnknownInterface interface) => DxgiSwapChainInterface interface where + present :: Ptr interface -> Word32 -> Word32 -> IO HRESULT + present this syncInterval flags = c_present (castPtr this) syncInterval flags + getBuffer :: (HasGUID surface) => Ptr interface -> Word32 -> IO (Either HRESULT (Ptr surface)) + getBuffer this buffer = alloca $ \surface -> alloca $ \pGuid -> do + let guid = getGUID surface + poke pGuid guid + hr <- c_getBuffer (castPtr this) buffer pGuid (castPtr surface) + if hr < 0 then return (Left hr) + else do + peekSurface <- peek surface + return (Right peekSurface) + +data IDxgiSwapChain = IDxgiSwapChain +instance UnknownInterface IDxgiSwapChain +instance DxgiSwapChainInterface IDxgiSwapChain
+ src/Graphics/D3D11Binding/Interface/Texture2D.hs view
@@ -0,0 +1,13 @@+module Graphics.D3D11Binding.Interface.Texture2D where + +import Graphics.D3D11Binding.GUID +import Graphics.D3D11Binding.Interface.Unknown +import Graphics.D3D11Binding.Interface.D3D11Resource + +data ID3D11Texture2D = ID3D11Texture2D + +instance HasGUID ID3D11Texture2D where + getGUID _ = GUID 0x6f15aaf2 0xd208 0x4e89 [0x9a,0xb4,0x48,0x95,0x35,0xd3,0x4f,0x9c] + +instance UnknownInterface ID3D11Texture2D +instance D3D11ResourceInterface ID3D11Texture2D
+ src/Graphics/D3D11Binding/Interface/Unknown.hs view
@@ -0,0 +1,24 @@+module Graphics.D3D11Binding.Interface.Unknown where +import Data.Word + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Ptr + +import Graphics.Win32 +import Graphics.D3D11Binding.Types + +foreign import stdcall "Release" c_release + :: Ptr IUnknown -> IO Word32 + +class UnknownInterface interface where + release :: Ptr interface -> IO Word32 + release ptr = c_release (castPtr ptr) + use :: Ptr interface -> (Ptr interface -> IO result) -> IO result + use i f = do + res <- f i + release i + return res + +data IUnknown = IUnknown +instance UnknownInterface IUnknown
+ src/Graphics/D3D11Binding/Types.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE DeriveGeneric #-} +module Graphics.D3D11Binding.Types where +import GHC.Generics (Generic) +import Data.Word +import Data.Bits +import Control.Applicative +import Foreign.Storable +import Foreign.CStorable + +import Graphics.Win32 + +import Graphics.D3D11Binding.Enums + +type DxgiUsage = Word32 + +dxgiUsageShaderInput :: DxgiUsage +dxgiUsageShaderInput = shift 1 4 + +dxgiUsageRenderTargetOutput :: DxgiUsage +dxgiUsageRenderTargetOutput = shift 1 5 + +dxgiUsageBackBuffer :: DxgiUsage +dxgiUsageBackBuffer = shift 1 6 + +dxgiUsageShared :: DxgiUsage +dxgiUsageShared = shift 1 7 + +dxgiUsageReadOnly :: DxgiUsage +dxgiUsageReadOnly = shift 1 8 + +dxgiUsageDiscardOnPresent :: DxgiUsage +dxgiUsageDiscardOnPresent = shift 1 9 + +dxgiUsageUnorderedAccess :: DxgiUsage +dxgiUsageUnorderedAccess = shift 1 10 + +data DxgiSwapChainDesc = DxgiSwapChainDesc + { bufferDesc :: DxgiModeDesc + , sampleDesc :: DxgiSampleDesc + , bufferUsage :: DxgiUsage + , bufferCount :: Word32 + , outputWindow :: HWND + , windowed :: Bool + , swapEffect :: DxgiSwapEffect + , flags :: Word32 } + deriving (Generic) + +instance CStorable DxgiSwapChainDesc +instance Storable DxgiSwapChainDesc where + sizeOf = cSizeOf + alignment = cAlignment + poke = cPoke + peek = cPeek + +data DxgiModeDesc = DxgiModeDesc + { width :: Word32 + , height :: Word32 + , refreshRate :: DxgiRational + , dxgiModeFormat :: DxgiFormat + , scanlineOrdering :: DxgiModeScanlineOrder + , scaling :: DxgiModeScaling } + deriving (Generic) + +instance CStorable DxgiModeDesc +instance Storable DxgiModeDesc where + sizeOf = cSizeOf + alignment = cAlignment + poke = cPoke + peek = cPeek + +data DxgiRational = DxgiRational + { numerator :: Word32 + , denominator :: Word32 } + deriving (Generic) + +instance CStorable DxgiRational +instance Storable DxgiRational where + sizeOf = cSizeOf + alignment = cAlignment + poke = cPoke + peek = cPeek + +data DxgiSampleDesc = DxgiSampleDesc + { count :: Word32 + , quality :: Word32 } + deriving (Generic) + +instance CStorable DxgiSampleDesc +instance Storable DxgiSampleDesc where + sizeOf = cSizeOf + alignment = cAlignment + poke = cPoke + peek = cPeek + +data Rtv = Rtv Word32 Word32 Word32 deriving (Generic) + +bufferRtv :: Word32 -> Word32 -> Rtv +bufferRtv d1 d2 = Rtv d1 d2 (fromIntegral 0) + +tex1dRtv :: Word32 -> Rtv +tex1dRtv d1 = Rtv d1 (fromIntegral 0) (fromIntegral 0) + +tex1dArrayRtv :: Word32 -> Word32 -> Word32 -> Rtv +tex1dArrayRtv d1 d2 d3 = Rtv d1 d2 d3 + +tex2dRtv :: Word32 -> Rtv +tex2dRtv d1 = Rtv d1 (fromIntegral 0) (fromIntegral 0) + +tex2dArrayRtv :: Word32 -> Word32 -> Word32 -> Rtv +tex2dArrayRtv d1 d2 d3 = Rtv d1 d2 d3 + +tex2dMsRtv :: Rtv +tex2dMsRtv = Rtv (fromIntegral 0) (fromIntegral 0) (fromIntegral 0) + +tex2dMsArrayRtv :: Word32 -> Word32 -> Rtv +tex2dMsArrayRtv d1 d2 = Rtv d1 d2 (fromIntegral 0) + +tex3dArrayRtv :: Word32 -> Word32 -> Word32 -> Rtv +tex3dArrayRtv d1 d2 d3 = Rtv d1 d2 d3 + +instance CStorable Rtv +instance Storable Rtv where + sizeOf = cSizeOf + alignment = cAlignment + poke = cPoke + peek = cPeek + +data D3D11RenderTargetViewDesc = D3D11RenderTargetViewDesc + { renderTargetViewFormat :: DxgiFormat + , viewDimension :: D3D11RtvDimension + , rtv :: Rtv } deriving (Generic) + +instance CStorable D3D11RenderTargetViewDesc +instance Storable D3D11RenderTargetViewDesc where + sizeOf = cSizeOf + alignment = cAlignment + poke = cPoke + peek = cPeek + +data D3D11Viewport = D3D11Viewport + { topLeftX :: Float + , topLeftY :: Float + , viewportWidth :: Float + , viewportHeight :: Float + , minDepth :: Float + , maxDepth :: Float } deriving (Generic) + +instance CStorable D3D11Viewport +instance Storable D3D11Viewport where + sizeOf = cSizeOf + alignment = cAlignment + poke = cPoke + peek = cPeek + +data Color = Color + { red :: Float + , green :: Float + , blue :: Float + , alpha :: Float } deriving (Generic) + +instance CStorable Color +instance Storable Color where + sizeOf = cSizeOf + alignment = cAlignment + poke = cPoke + peek = cPeek