dx9d3d-0.1: DirectX9/D3D/Raw.hs

{-#  LANGUAGE ForeignFunctionInterface #-}
module DirectX9.D3D.Raw
where
import Foreign.Ptr  ( Ptr, plusPtr, castPtr )
import Foreign.Storable ( peekByteOff )
import DirectX9.Types
import DirectX9.D3D.Format

type D3DCOLOR = DWORD

data RECT = RECT !LONG !LONG !LONG !LONG
type LPRECT = Ptr RECT

instance Storable RECT where
    sizeOf _ = 4*(sizeOf (undefined::LONG))
    alignment _ = 4
    poke buf (RECT v1 v2 v3 v4) = return buf
        >>= pokeHelp v1  >>= pokeHelp v2 >>= pokeHelp v3 >>= pokeHelp v4 >> return ()
    peek b = do
        p1 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p2 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p3 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p4 <- peekByteOff b 0
        return $ RECT p1 p2 p3 p4

data D3DMATRIX = D3DMATRIX  {
    d3dm11, d3dm12, d3dm13, d3dm14,
    d3dm21, d3dm22, d3dm23, d3dm24,
    d3dm31, d3dm32, d3dm33, d3dm34,
    d3dm41, d3dm42, d3dm43, d3dm44 :: !Float
    } deriving (Show,Eq, Ord)

instance Storable D3DMATRIX where
    sizeOf _ = 16*(sizeOf (undefined::Float))
    alignment _ = alignment (undefined::Float)
    poke buf m =
        return buf
            >>= pokeHelp (d3dm11 m) >>= pokeHelp (d3dm12 m) >>= pokeHelp (d3dm13 m) >>= pokeHelp (d3dm14 m)
            >>= pokeHelp (d3dm21 m) >>= pokeHelp (d3dm22 m) >>= pokeHelp (d3dm23 m) >>= pokeHelp (d3dm24 m)
            >>= pokeHelp (d3dm31 m) >>= pokeHelp (d3dm32 m) >>= pokeHelp (d3dm33 m) >>= pokeHelp (d3dm34 m)
            >>= pokeHelp (d3dm41 m) >>= pokeHelp (d3dm42 m) >>= pokeHelp (d3dm43 m) >>= pokeHelp (d3dm44 m)
            >> return ()
    peek b = do
        p1 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p2 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p3 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p4 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p5 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p6 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p7 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p8 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p9 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p10 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p11 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p12 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p13 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p14 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p15 <- peekByteOff b 0
        b <- return $ plusPtr b (sizeOf p1)
        p16 <- peekByteOff b 0
        return $ D3DMATRIX p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16

d3DCOLOR_COLORVALUE :: Float -> Float -> Float -> Float -> D3DCOLOR
d3DCOLOR_COLORVALUE r g b a = d3DCOLOR_RGBA (f r) (f g) (f b) (f a)
    where
        f :: Float -> Int
        f a = truncate $ a*255

d3DCOLOR_RGBA :: (Num a, Integral a) => a -> a -> a -> a -> D3DCOLOR
d3DCOLOR_RGBA r g b a =
    (fromIntegral a)*16777216 + 
    (fromIntegral r)*65536 +
    (fromIntegral g)*256 +
    (fromIntegral b)

d3DTS_WORLDMATRIX :: (Integral a) => a-> D3DTRANSFORMSTATETYPE
d3DTS_WORLDMATRIX n = fromIntegral n+256

d3DTS_WORLD :: D3DTRANSFORMSTATETYPE
d3DTS_WORLD =  d3DTS_WORLDMATRIX (0::Int)

pokeHelp :: (Storable b) => b -> Ptr a -> IO (Ptr a)
pokeHelp v buf = do
    poke (castPtr buf) v
    return $ plusPtr buf $ sizeOf v


foreign import stdcall unsafe "fake.h Direct3DCreate9"
    c_Direct3DCreate9 :: UINT -> IO (Ptr IDirect3D9)

#include "d3d_h.h"