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)