diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Data/Packed/Foreign.hs | 85 |
1 files changed, 85 insertions, 0 deletions
diff --git a/lib/Data/Packed/Foreign.hs b/lib/Data/Packed/Foreign.hs new file mode 100644 index 0000000..fe171b1 --- /dev/null +++ b/lib/Data/Packed/Foreign.hs | |||
@@ -0,0 +1,85 @@ | |||
1 | -- | FFI and hmatrix helpers. | ||
2 | -- | ||
3 | -- Sample usage, to upload a perspective matrix to a shader. | ||
4 | -- | ||
5 | -- @ glUniformMatrix4fv 0 1 (fromIntegral gl_TRUE) \`appMatrix\` perspective 0.01 100 (pi\/2) (4\/3) | ||
6 | -- @ | ||
7 | -- | ||
8 | module Data.Packed.Foreign where | ||
9 | import Data.Packed.Internal | ||
10 | import qualified Data.Vector.Storable as S | ||
11 | import System.IO.Unsafe (unsafePerformIO) | ||
12 | import Foreign (Ptr, ForeignPtr, Storable) | ||
13 | import Foreign.C.Types (CInt) | ||
14 | |||
15 | {-# INLINE app #-} | ||
16 | -- | Only useful since it is left associated with a precedence of 1, unlike 'Prelude.$', which is right associative. | ||
17 | -- e.g. | ||
18 | -- | ||
19 | -- @ | ||
20 | -- someFunction | ||
21 | -- \`appMatrixLen\` m | ||
22 | -- \`appVectorLen\` v | ||
23 | -- \`app\` other | ||
24 | -- \`app\` arguments | ||
25 | -- \`app\` go here | ||
26 | -- @ | ||
27 | -- | ||
28 | -- One could also write: | ||
29 | -- | ||
30 | -- @ | ||
31 | -- (someFunction | ||
32 | -- \`appMatrixLen\` m | ||
33 | -- \`appVectorLen\` v) | ||
34 | -- other | ||
35 | -- arguments | ||
36 | -- (go here) | ||
37 | -- @ | ||
38 | -- | ||
39 | app :: (a -> b) -> a -> b | ||
40 | app f = f | ||
41 | |||
42 | {-# INLINE appVector #-} | ||
43 | appVector :: Storable a => (Ptr a -> b) -> Vector a -> b | ||
44 | appVector f x = unsafePerformIO (S.unsafeWith x (return . f)) | ||
45 | |||
46 | {-# INLINE appVectorLen #-} | ||
47 | appVectorLen :: Storable a => (CInt -> Ptr a -> b) -> Vector a -> b | ||
48 | appVectorLen f x = unsafePerformIO (S.unsafeWith x (return . f (fromIntegral (S.length x)))) | ||
49 | |||
50 | {-# INLINE appMatrix #-} | ||
51 | appMatrix :: Element a => (Ptr a -> b) -> Matrix a -> b | ||
52 | appMatrix f x = unsafePerformIO (S.unsafeWith (flatten x) (return . f)) | ||
53 | |||
54 | {-# INLINE appMatrixLen #-} | ||
55 | appMatrixLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b | ||
56 | appMatrixLen f x = unsafePerformIO (S.unsafeWith (flatten x) (return . f r c)) | ||
57 | where | ||
58 | r = fromIntegral (rows x) | ||
59 | c = fromIntegral (cols x) | ||
60 | |||
61 | {-# INLINE appMatrixRaw #-} | ||
62 | appMatrixRaw :: Storable a => Matrix a -> (Ptr a -> b) -> b | ||
63 | appMatrixRaw x f = unsafePerformIO (S.unsafeWith (xdat x) (return . f)) | ||
64 | |||
65 | {-# INLINE appMatrixRawLen #-} | ||
66 | appMatrixRawLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b | ||
67 | appMatrixRawLen f x = unsafePerformIO (S.unsafeWith (xdat x) (return . f r c)) | ||
68 | where | ||
69 | r = fromIntegral (rows x) | ||
70 | c = fromIntegral (cols x) | ||
71 | |||
72 | infixl 1 `app` | ||
73 | infixl 1 `appVector` | ||
74 | infixl 1 `appMatrix` | ||
75 | infixl 1 `appMatrixRaw` | ||
76 | |||
77 | {-# INLINE unsafeMatrixToVector #-} | ||
78 | -- | This will disregard the order of the matrix, and simply return it as-is. | ||
79 | unsafeMatrixToVector :: Matrix a -> Vector a | ||
80 | unsafeMatrixToVector = xdat | ||
81 | |||
82 | {-# INLINE unsafeMatrixToForeignPtr #-} | ||
83 | unsafeMatrixToForeignPtr :: Storable a => Matrix a -> (ForeignPtr a, Int) | ||
84 | unsafeMatrixToForeignPtr m = S.unsafeToForeignPtr0 (xdat m) | ||
85 | |||