From 3af8c040637d4289e39577c04fc8b68f8d868f05 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Sat, 27 Apr 2019 21:11:53 -0400
Subject: Uniformable instance for hmatrix vector.

---
 LambdaCube/GL/HMatrix.hs | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

(limited to 'LambdaCube/GL')

diff --git a/LambdaCube/GL/HMatrix.hs b/LambdaCube/GL/HMatrix.hs
index ff5e7a7..127656e 100644
--- a/LambdaCube/GL/HMatrix.hs
+++ b/LambdaCube/GL/HMatrix.hs
@@ -24,8 +24,26 @@ instance (KnownNat r, KnownNat c) => IsUniform (Matrix Float) (UMatrix r c Float
              in Just $ MarshalUMatrix
                      $ \f -> apply mat (\ptr -> f 1 isRowOrder ptr) (\r c sr sc ptr -> ptr)
 
+instance Uniformable (Vector Float) where
+    uniformContexts _ = contexts $ do
+        supports TypeFloat
+        supports TypeV2F
+        supports TypeV3F
+        supports TypeV4F
+
+instance KnownNat n => IsUniform (Vector Float) (USimple n Float) where
+    marshalUniform abi vec
+        | natVal (vectorLength abi) /= fromIntegral (size vec) = Nothing
+        | otherwise = Just $ MarshalUSimple
+                           $ \f -> apply vec (\ptr -> f 1 ptr) (\n ptr -> ptr)
+
 {-
 
+-- C-Haskell vector adapter
+{-# INLINE avec #-}
+avec :: Storable a => Vector a -> (f -> IO r) -> ((CInt -> Ptr a -> f) -> IO r)
+avec v f g = unsafeWith v $ \ptr -> f (g (fromIntegral (Vector.length v)) 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
-- 
cgit v1.2.3