summaryrefslogtreecommitdiff
path: root/lib/Data/Packed/Foreign.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Data/Packed/Foreign.hs')
-rw-r--r--lib/Data/Packed/Foreign.hs85
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--
8module Data.Packed.Foreign where
9import Data.Packed.Internal
10import qualified Data.Vector.Storable as S
11import System.IO.Unsafe (unsafePerformIO)
12import Foreign (Ptr, ForeignPtr, Storable)
13import 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--
39app :: (a -> b) -> a -> b
40app f = f
41
42{-# INLINE appVector #-}
43appVector :: Storable a => (Ptr a -> b) -> Vector a -> b
44appVector f x = unsafePerformIO (S.unsafeWith x (return . f))
45
46{-# INLINE appVectorLen #-}
47appVectorLen :: Storable a => (CInt -> Ptr a -> b) -> Vector a -> b
48appVectorLen f x = unsafePerformIO (S.unsafeWith x (return . f (fromIntegral (S.length x))))
49
50{-# INLINE appMatrix #-}
51appMatrix :: Element a => (Ptr a -> b) -> Matrix a -> b
52appMatrix f x = unsafePerformIO (S.unsafeWith (flatten x) (return . f))
53
54{-# INLINE appMatrixLen #-}
55appMatrixLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b
56appMatrixLen 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 #-}
62appMatrixRaw :: Storable a => Matrix a -> (Ptr a -> b) -> b
63appMatrixRaw x f = unsafePerformIO (S.unsafeWith (xdat x) (return . f))
64
65{-# INLINE appMatrixRawLen #-}
66appMatrixRawLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b
67appMatrixRawLen f x = unsafePerformIO (S.unsafeWith (xdat x) (return . f r c))
68 where
69 r = fromIntegral (rows x)
70 c = fromIntegral (cols x)
71
72infixl 1 `app`
73infixl 1 `appVector`
74infixl 1 `appMatrix`
75infixl 1 `appMatrixRaw`
76
77{-# INLINE unsafeMatrixToVector #-}
78-- | This will disregard the order of the matrix, and simply return it as-is.
79unsafeMatrixToVector :: Matrix a -> Vector a
80unsafeMatrixToVector = xdat
81
82{-# INLINE unsafeMatrixToForeignPtr #-}
83unsafeMatrixToForeignPtr :: Storable a => Matrix a -> (ForeignPtr a, Int)
84unsafeMatrixToForeignPtr m = S.unsafeToForeignPtr0 (xdat m)
85