blob: ff5e7a79462ad6a37e51cec37548ce3c876e6196 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module LambdaCube.GL.HMatrix where
import GHC.TypeLits
import LambdaCube.GL.Uniform
import Numeric.LinearAlgebra
import Numeric.LinearAlgebra.Devel
import Graphics.Rendering.OpenGL.GL (GLboolean)
instance Uniformable (Matrix Float) where
uniformContexts _ = contexts floatMatrices
instance (KnownNat r, KnownNat c) => IsUniform (Matrix Float) (UMatrix r c Float) where
marshalUniform abi mat = case matrixDimensions abi of
(r,c) | fromIntegral (natVal r) /= rows mat -> Nothing
| fromIntegral (natVal c) /= cols mat -> Nothing
_ -> let isRowOrder = case orderOf mat of
RowMajor -> 1 :: GLboolean
ColumnMajor -> 0 :: GLboolean
in Just $ MarshalUMatrix
$ \f -> apply mat (\ptr -> f 1 isRowOrder ptr) (\r c sr sc ptr -> ptr)
{-
-- apply :: Storable a => Matrix a -> (f -> IO r) -> (CInt -> CInt -> CInt -> CInt -> Ptr a -> f) -> IO r
{-# INLINE amat #-}
amat :: Storable a => Matrix a -> (f -> IO r) -> (CInt -> CInt -> CInt -> CInt -> Ptr a -> f) -> IO r
amat x f g = unsafeWith (xdat x) (f . g r c sr sc)
where
r = fi (rows x)
c = fi (cols x)
sr = fi (xRow x)
sc = fi (xCol x)
apply (0 :: Matrix Float)
:: (b -> IO r)
-> (Foreign.C.Types.CInt
-> Foreign.C.Types.CInt
-> Foreign.C.Types.CInt
-> Foreign.C.Types.CInt
-> GHC.Ptr.Ptr Float
-> b)
-> IO r
-}
|