dx9d3d-0.1: DirectX9/D3D/Utility/Basic.hs
module DirectX9.D3D.Utility.Basic
where
import Control.Exception ( bracket_ )
import DirectX9.Types
import DirectX9.D3D.Raw
import DirectX9.D3D.Device
---------------------------------------------------------------------------
-- Matrix and vector stuff
zeroMatrix :: D3DMATRIX
zeroMatrix = D3DMATRIX
0 0 0 0
0 0 0 0
0 0 0 0
0 0 0 0
identityMatrix :: D3DMATRIX
identityMatrix = D3DMATRIX
1 0 0 0
0 1 0 0
0 0 1 0
0 0 0 1
infixr `matrixMul`
matrixMul :: D3DMATRIX -> D3DMATRIX -> D3DMATRIX
matrixMul m1 m2 = D3DMATRIX
(d3dm11 m1*d3dm11 m2 + d3dm12 m1*d3dm21 m2 + d3dm13 m1*d3dm31 m2 + d3dm14 m1*d3dm41 m2)
(d3dm11 m1*d3dm12 m2 + d3dm12 m1*d3dm22 m2 + d3dm13 m1*d3dm32 m2 + d3dm14 m1*d3dm42 m2)
(d3dm11 m1*d3dm13 m2 + d3dm12 m1*d3dm23 m2 + d3dm13 m1*d3dm33 m2 + d3dm14 m1*d3dm43 m2)
(d3dm11 m1*d3dm14 m2 + d3dm12 m1*d3dm24 m2 + d3dm13 m1*d3dm34 m2 + d3dm14 m1*d3dm44 m2)
(d3dm21 m1*d3dm11 m2 + d3dm22 m1*d3dm21 m2 + d3dm23 m1*d3dm31 m2 + d3dm24 m1*d3dm41 m2)
(d3dm21 m1*d3dm12 m2 + d3dm22 m1*d3dm22 m2 + d3dm23 m1*d3dm32 m2 + d3dm24 m1*d3dm42 m2)
(d3dm21 m1*d3dm13 m2 + d3dm22 m1*d3dm23 m2 + d3dm23 m1*d3dm33 m2 + d3dm24 m1*d3dm43 m2)
(d3dm21 m1*d3dm14 m2 + d3dm22 m1*d3dm24 m2 + d3dm23 m1*d3dm34 m2 + d3dm24 m1*d3dm44 m2)
(d3dm31 m1*d3dm11 m2 + d3dm32 m1*d3dm21 m2 + d3dm33 m1*d3dm31 m2 + d3dm34 m1*d3dm41 m2)
(d3dm31 m1*d3dm12 m2 + d3dm32 m1*d3dm22 m2 + d3dm33 m1*d3dm32 m2 + d3dm34 m1*d3dm42 m2)
(d3dm31 m1*d3dm13 m2 + d3dm32 m1*d3dm23 m2 + d3dm33 m1*d3dm33 m2 + d3dm34 m1*d3dm43 m2)
(d3dm31 m1*d3dm14 m2 + d3dm32 m1*d3dm24 m2 + d3dm33 m1*d3dm34 m2 + d3dm34 m1*d3dm44 m2)
(d3dm41 m1*d3dm11 m2 + d3dm42 m1*d3dm21 m2 + d3dm43 m1*d3dm31 m2 + d3dm44 m1*d3dm41 m2)
(d3dm41 m1*d3dm12 m2 + d3dm42 m1*d3dm22 m2 + d3dm43 m1*d3dm32 m2 + d3dm44 m1*d3dm42 m2)
(d3dm41 m1*d3dm13 m2 + d3dm42 m1*d3dm23 m2 + d3dm43 m1*d3dm33 m2 + d3dm44 m1*d3dm43 m2)
(d3dm41 m1*d3dm14 m2 + d3dm42 m1*d3dm24 m2 + d3dm43 m1*d3dm34 m2 + d3dm44 m1*d3dm44 m2)
matrixMulA :: [D3DMATRIX] -> D3DMATRIX
matrixMulA = foldr1 matrixMul
matrixTranspose :: D3DMATRIX -> D3DMATRIX
matrixTranspose m = D3DMATRIX
(d3dm11 m) (d3dm21 m) (d3dm31 m) (d3dm41 m)
(d3dm12 m) (d3dm22 m) (d3dm32 m) (d3dm42 m)
(d3dm13 m) (d3dm23 m) (d3dm33 m) (d3dm43 m)
(d3dm14 m) (d3dm24 m) (d3dm34 m) (d3dm44 m)
vecMatTrans :: D3DVECTOR -> D3DMATRIX -> D3DVECTOR
vecMatTrans (D3DVECTOR x y z) m = D3DVECTOR
(x*d3dm11 m + y*d3dm21 m + z*d3dm31 m+ d3dm41 m)
(x*d3dm12 m + y*d3dm22 m + z*d3dm32 m+ d3dm43 m)
(x*d3dm13 m + y*d3dm23 m + z*d3dm33 m+ d3dm43 m)
vecMatRot :: D3DVECTOR -> D3DMATRIX -> D3DVECTOR
vecMatRot (D3DVECTOR x y z) m = D3DVECTOR
(x*d3dm11 m + y*d3dm21 m + z*d3dm31 m)
(x*d3dm12 m + y*d3dm22 m + z*d3dm32 m)
(x*d3dm13 m + y*d3dm23 m + z*d3dm33 m)
vecLen :: D3DVECTOR -> Float
vecLen (D3DVECTOR x y z) = sqrt (x**2+y**2+z**2)
vecNorm :: D3DVECTOR -> D3DVECTOR
vecNorm v@(D3DVECTOR x y z) = let
len=vecLen v
in if len==0
then D3DVECTOR 0 0 0
else D3DVECTOR (x/len) (y/len) (z/len)
matrixTranslate :: D3DVECTOR -> D3DMATRIX
matrixTranslate (D3DVECTOR x y z) = D3DMATRIX
1 0 0 0
0 1 0 0
0 0 1 0
x y z 1
matrixScale :: D3DVECTOR -> D3DMATRIX
matrixScale (D3DVECTOR x y z) = D3DMATRIX
x 0 0 0
0 y 0 0
0 0 z 0
0 0 0 1
matrixRotateX :: Float -> D3DMATRIX
matrixRotateX a = identityMatrix {
d3dm22 = cos a ,
d3dm23 = sin a ,
d3dm32 = -sin a,
d3dm33 = cos a }
matrixRotateY :: Float -> D3DMATRIX
matrixRotateY a = identityMatrix {
d3dm11 = cos a ,
d3dm13 = -sin a,
d3dm31 = sin a ,
d3dm33 = cos a }
matrixRotateZ :: Float -> D3DMATRIX
matrixRotateZ a = identityMatrix {
d3dm11 = cos a ,
d3dm12 = sin a ,
d3dm21 = -sin a,
d3dm22 = cos a }
matrixRotateYawPitchRoll :: Float -> Float -> Float -> D3DMATRIX
matrixRotateYawPitchRoll y p r =
(matrixRotateX p) `matrixMul`
(matrixRotateZ r) `matrixMul`
(matrixRotateY y)
---------------------------------------------------------------------------
-- D3D-api helpers
defaultD3DPRESENT_PARAMETERS :: D3DPRESENT_PARAMETERS
defaultD3DPRESENT_PARAMETERS = D3DPRESENT_PARAMETERS 0 0 0 0 0 0 0 nullPtr False False 0 0 0 0
defaultD3DLIGHT9 :: D3DLIGHT9
defaultD3DLIGHT9 = D3DLIGHT9 0 noColor noColor noColor nowhere nowhere 0 0 0 0 0 0 0
where
noColor = D3DCOLORVALUE 0 0 0 0
nowhere = D3DVECTOR 0 0 0
drawScene :: Device -> HWND -> IO b -> IO b
drawScene dev hwnd act = bracket_
(devBeginScene dev) (devEndScene dev >> devPresentMinimal dev hwnd) act
devLight :: Device -> Int -> Maybe D3DLIGHT9 -> IO ()
devLight dev idx light = case light of
Nothing -> devLightEnable dev idx False
Just light -> do
devSetLight dev idx light
devLightEnable dev idx True
---------------------------------------------------------------------------
-- Object generation
makeTorus ::
Float -> Float -> Int -> Int -> D3DMATRIX -> (Int -> Int -> a) ->
([((Float,Float,Float),(Float,Float,Float), a)]
,[Int])
makeTorus radius ringsize c1 c2 extramat additional =
(concatMap point [0..c1-1]
,concatMap index [0..c1-1])
where
index r = concatMap (index' r) [0..c2-1]
index' r1 r2 = let
x1 = r1; x2 = (r1+1) `mod` c1; y1 = r2; y2 = (r2+1) `mod` c2
p1 = x1*c2+y1; p2 = x1*c2+y2; p3 = x2*c2+y1; p4 = x2*c2+y2
in [p1,p3,p4, p4,p2,p1]
point p = let
angle = (2*fromIntegral p*pi)/fromIntegral c1
baseMat = matrixRotateY angle
ring = vecMatTrans (D3DVECTOR radius 0 0) $ baseMat
ringMat = matrixTranslate (D3DVECTOR radius 0 0) `matrixMul` baseMat
in map (point' ring ringMat p) [0..c2-1]
point' (D3DVECTOR rx ry rz) mat p1 p2 = let
angle = (2*fromIntegral p2*pi)/fromIntegral c2
(D3DVECTOR x y z) = vecMatTrans (D3DVECTOR ringsize 0 0)
$ extramat `matrixMul` matrixRotateZ angle `matrixMul` mat
(D3DVECTOR nx ny nz) = vecNorm $ D3DVECTOR (x-rx) (y-ry) (z-rz)
in ((x,y,z),(nx,ny,nz), additional p1 p2)