geomancy 0.2.5.0 → 0.2.6.0

raw patch · 16 files changed

+358/−451 lines, 16 filesdep +gl-blockPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: gl-block

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• geomancy.cabal +3/−5
• src/Geomancy/Gl/Block.hs +0/−392
• src/Geomancy/IVec2.hs +45/−4
• src/Geomancy/IVec3.hs +48/−5
• src/Geomancy/IVec4.hs +50/−3
• src/Geomancy/Mat4.hs +4/−3
• src/Geomancy/Point.hs +15/−8
• src/Geomancy/Quaternion.hs +4/−3
• src/Geomancy/Transform.hs +4/−3
• src/Geomancy/UVec2.hs +45/−4
• src/Geomancy/UVec3.hs +49/−6
• src/Geomancy/UVec4.hs +51/−4
• src/Geomancy/Vec2.hs +12/−3
• src/Geomancy/Vec3.hs +11/−5
• src/Geomancy/Vec4.hs +10/−3

@@ -1,5 +1,12 @@ # Changelog for geomancy +## 0.2.6.0++* `Geomancy.Gl.Block` extract to `gl-block` package as `Graphics.Gl.Block`.+* Added `convert` function to vector modules to facilitate type-changing operations like rounding.+* Added `Ix` instances for integral vectors.+* Added `dot` for integral vectors.+ ## 0.2.5.0  * Added Geomancy.Gl.Block to derive packed/std140/std430 layouts generically.

@@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.1.+-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack------ hash: 59ae45be42c160113744e837a79c301457335f8547aae5b17d0c74f61a052e60  name:           geomancy-version:        0.2.5.0+version:        0.2.6.0 synopsis:       Geometry and matrix manipulation description:    Sometimes it is unavoidable you have to do stuff on CPU.                 Let's at least do it faster.@@ -30,7 +28,6 @@   exposed-modules:       Geomancy       Geomancy.Elementwise-      Geomancy.Gl.Block       Geomancy.Gl.Funs       Geomancy.Interpolate       Geomancy.IVec2@@ -63,6 +60,7 @@       base >=4.7 && <5     , containers     , deepseq+    , gl-block     , mono-traversable     , ptrdiff     , simple-affine-space

@@ -1,392 +0,0 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE BlockArguments #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE DeriveGeneric #-}---- |--- Copyright :  (c) 2014-2019 Edward Kmett--- License   :  BSD-2-Clause OR Apache-2.0--- Maintainer:  Edward Kmett <ekmett@gmail.com>--- Stability :  experimental--- Portability: non-portable------ OpenGL STD140 and STD430 support------ Note STD430 can only be used for shader storage blocks, NOT--- uniform blocks!-module Geomancy.Gl.Block-( Block(..)-, GBlock(..)-, Packed(..)-, STD140(..)-, STD430(..)-) where--import Control.Monad.IO.Class (MonadIO(..))-import Data.Word (Word32)-import Data.Int (Int32)-import Data.Proxy (Proxy(..))-import Foreign.Ptr (Ptr)-import Foreign.Ptr.Diff (Diff(..), peekDiffOff, pokeDiffOff)-import Foreign.Storable (Storable(..))-import GHC.Generics (Generic, Rep, M1(..), K1(..), U1(..), C, D, S, (:*:)(..), from, to)-import Data.Data (Data, Typeable)--newtype Packed a = Packed { getPacked :: a }-  deriving (Data,Typeable,Generic,Functor,Foldable,Traversable,Eq,Ord,Show,Read)--instance Block a => Storable (Packed a) where-  alignment _ = 1-  sizeOf _ = sizeOfPacked (Proxy :: Proxy a)-  peekByteOff p o = Packed <$> readPacked p (Diff o)-  pokeByteOff p o = writePacked p (Diff o) . getPacked--newtype STD140 a = STD140 { getSTD140 :: a }-  deriving (Data,Typeable,Generic,Functor,Foldable,Traversable,Eq,Ord,Show,Read)--instance Block a => Storable (STD140 a) where-  alignment _ = alignment140 (Proxy :: Proxy a)-  sizeOf _ = sizeOf140 (Proxy :: Proxy a)-  peekByteOff p o = STD140 <$> read140 p (Diff o)-  pokeByteOff p o = write140 p (Diff o) . getSTD140--newtype STD430 a = STD430 { getSTD430 :: a }-  deriving (Data,Typeable,Generic,Functor,Foldable,Traversable,Eq,Ord,Show,Read)--instance Block a => Storable (STD430 a) where-  alignment _ = alignment430 (Proxy :: Proxy a)-  sizeOf _ = sizeOf430 (Proxy :: Proxy a)-  peekByteOff p o = STD430 <$> read430 p (Diff o)-  pokeByteOff p o = write430 p (Diff o) . getSTD430---- | This describes how to load and store primitives--- through a uniform/shader storage blocks according to--- OpenGL STD140 and STD430.------ There are lots of fiddly little constants around, beware.-class Block b where-  -- | As per 'Storable' 'alignment', but matching OpenGL STD140.-  alignment140 :: proxy b -> Int-  default alignment140 :: GBlock (Rep b) => proxy b -> Int-  alignment140 _ = galignment140 (Proxy :: Proxy (Rep b))--  -- | As per 'Storable' 'sizeOf', but matching OpenGL STD140.-  sizeOf140 :: proxy b -> Int-  default sizeOf140 :: GBlock (Rep b) => proxy b -> Int-  sizeOf140 _ = gsizeOf140 (Proxy :: Proxy (Rep b))--  -- | Structures get smashed up to a minimum of a vec4 alignment in 140 mode-  isStruct :: proxy b -> Bool-  isStruct _ = True--  read140 :: MonadIO m => Ptr a -> Diff a b -> m b-  default read140 :: (MonadIO m, Generic b, GBlock (Rep b)) => Ptr a -> Diff a b -> m b-  read140 p (Diff o) = liftIO $ to <$> gread140 p o--  write140 :: MonadIO m => Ptr a -> Diff a b -> b -> m ()-  default write140 :: (MonadIO m, Generic b, GBlock (Rep b)) => Ptr a -> Diff a b -> b -> m ()-  write140 p (Diff o) b = liftIO $ gwrite140 p o (from b)--  -- | As per 'Storable' 'alignment', but matching OpenGL STD430.-  alignment430 :: proxy b -> Int-  default alignment430 :: GBlock (Rep b) => proxy b -> Int-  alignment430 _ = galignment430 (Proxy :: Proxy (Rep b))--  -- | As per 'Storable' 'sizeOf', but matching OpenGL STD430.-  sizeOf430 :: proxy b -> Int-  default sizeOf430 :: GBlock (Rep b) => proxy b -> Int-  sizeOf430 _ = gsizeOf430 (Proxy :: Proxy (Rep b))--  read430 :: MonadIO m => Ptr a -> Diff a b -> m b-  default read430 :: (MonadIO m, Generic b, GBlock (Rep b)) => Ptr a -> Diff a b -> m b-  read430 p (Diff o) = liftIO $ to <$> gread430 p o--  write430 :: MonadIO m => Ptr a -> Diff a b -> b -> m ()-  default write430 :: (MonadIO m, Generic b, GBlock (Rep b)) => Ptr a -> Diff a b -> b -> m ()-  write430 p (Diff o) b = liftIO $ gwrite430 p o (from b)--  -- | As per 'Storable' 'sizeOf', but without padding and no alignment-  sizeOfPacked :: proxy b -> Int-  default sizeOfPacked :: GBlock (Rep b) => proxy b -> Int-  sizeOfPacked _ = gsizeOfPacked (Proxy :: Proxy (Rep b))--  readPacked :: MonadIO m => Ptr a -> Diff a b -> m b-  default readPacked :: (MonadIO m, Generic b, GBlock (Rep b)) => Ptr a -> Diff a b -> m b-  readPacked p (Diff o) = liftIO $ to <$> greadPacked p o--  writePacked :: MonadIO m => Ptr a -> Diff a b -> b -> m ()-  default writePacked :: (MonadIO m, Generic b, GBlock (Rep b)) => Ptr a -> Diff a b -> b -> m ()-  writePacked p (Diff o) b = liftIO $ gwritePacked p o (from b)---- | Automatically derive STD140 and STD430 alignment using GHC Generics-class GBlock f where-  galignment140    :: p f -> Int-  galignment430    :: p f -> Int-  gsizeOf140    :: p f -> Int-  gsizeOf430    :: p f -> Int-  gsizeOfPacked :: p f -> Int-  gread140    :: Ptr a -> Int -> IO (f b)-  gread430    :: Ptr a -> Int -> IO (f b)-  greadPacked :: Ptr a -> Int -> IO (f b)-  gwrite140    :: Ptr a -> Int -> f b -> IO ()-  gwrite430    :: Ptr a -> Int -> f b -> IO ()-  gwritePacked :: Ptr a -> Int -> f b -> IO ()--instance GBlock U1 where-  galignment140 _ = 1-  gsizeOf140    _ = 0-  galignment430 _ = 1-  gsizeOf430    _ = 0-  gsizeOfPacked    _ = 0-  gread140 _ _ = return U1-  gread430 _ _ = return U1-  greadPacked _ _ = return U1-  gwrite140 _ _ U1 = return ()-  gwrite430 _ _ U1 = return ()-  gwritePacked _ _ U1 = return ()--instance (GBlock f, GBlock g) => GBlock (f :*: g) where-  gsizeOfPacked _ = gsizeOfPacked (Proxy :: Proxy f) + gsizeOfPacked (Proxy :: Proxy g)-  galignment140 _ = galignment140 (Proxy :: Proxy f)-              `max` galignment140 (Proxy :: Proxy g)-  galignment430 _ = galignment430 (Proxy :: Proxy f)-              `max` galignment430 (Proxy :: Proxy g)-  gsizeOf140 _ = roundUp (gsizeOf140 (Proxy :: Proxy f)) (galignment140 (Proxy :: Proxy g)) + gsizeOf140 (Proxy :: Proxy g)-  gsizeOf430 _ = roundUp (gsizeOf430 (Proxy :: Proxy f)) (galignment430 (Proxy :: Proxy g)) + gsizeOf430 (Proxy :: Proxy g)-  gread140 p o = (:*:) <$> gread140 p o <*> gread140 p (o + roundUp (gsizeOf140 (Proxy :: Proxy f)) (galignment140 (Proxy :: Proxy g)))-  gread430 p o = (:*:) <$> gread430 p o <*> gread430 p (o + roundUp (gsizeOf430 (Proxy :: Proxy f)) (galignment430 (Proxy :: Proxy g)))-  greadPacked p o = (:*:) <$> greadPacked p o <*> greadPacked p (o + gsizeOfPacked (Proxy :: Proxy f))-  gwrite140 p o (a :*: b) = do-    gwrite140 p o a-    gwrite140 p (o + roundUp (gsizeOf140 (Proxy :: Proxy f)) (galignment140 (Proxy :: Proxy g))) b-  gwrite430 p o (a :*: b) = do-    gwrite430 p o a-    gwrite430 p (o + roundUp (gsizeOf430 (Proxy :: Proxy f)) (galignment430 (Proxy :: Proxy g))) b-  gwritePacked p o (a :*: b) = do-    gwritePacked p o a-    gwritePacked p (o + gsizeOfPacked (Proxy :: Proxy f)) b--instance GBlock f => GBlock (M1 S c f) where-  galignment140    _ = galignment140 (Proxy :: Proxy f)-  galignment430    _ = galignment430 (Proxy :: Proxy f)-  gsizeOf140    _ = gsizeOf140 (Proxy :: Proxy f)-  gsizeOf430    _ = gsizeOf430 (Proxy :: Proxy f)-  gsizeOfPacked _ = gsizeOfPacked (Proxy :: Proxy f)-  gread140 p o = M1 <$> gread140 p o-  gread430 p o = M1 <$> gread430 p o-  greadPacked p o = M1 <$> greadPacked p o-  gwrite140 p o (M1 a) = gwrite140 p o a-  gwrite430 p o (M1 a) = gwrite430 p o a-  gwritePacked p o (M1 a) = gwritePacked p o a--instance GBlock f => GBlock (M1 C c f) where-  galignment140    _ = lcm 16 $ galignment140 (Proxy :: Proxy f) -- std140 rule 9-  galignment430    _ = galignment430 (Proxy :: Proxy f) -- std140 rule 9, relaxed by std430-  gsizeOf140    _ = roundUp (gsizeOf140 (Proxy :: Proxy f)) (galignment140 (Proxy :: Proxy f)) -- std140 rule 9-  gsizeOf430    _ = roundUp (gsizeOf430 (Proxy :: Proxy f)) (galignment430 (Proxy :: Proxy f)) -- std140 rule 9, relaxed by std430-  gsizeOfPacked _ = gsizeOfPacked (Proxy :: Proxy f)-  gread140 p o = M1 <$> gread140 p o-  gread430 p o = M1 <$> gread430 p o-  greadPacked p o = M1 <$> greadPacked p o-  gwrite140 p o (M1 a) = gwrite140 p o a-  gwrite430 p o (M1 a) = gwrite430 p o a-  gwritePacked p o (M1 a) = gwritePacked p o a--instance GBlock f => GBlock (M1 D c f) where-  galignment140 _ = galignment140 (Proxy :: Proxy f)-  galignment430 _ = galignment430 (Proxy :: Proxy f)-  gsizeOf140    _ = gsizeOf140 (Proxy :: Proxy f)-  gsizeOf430    _ = gsizeOf430 (Proxy :: Proxy f)-  gsizeOfPacked    _ = gsizeOfPacked (Proxy :: Proxy f)-  gread140 p o = M1 <$> gread140 p o-  gread430 p o = M1 <$> gread430 p o-  greadPacked p o = M1 <$> greadPacked p o-  gwrite140 p o (M1 a) = gwrite140 p o a-  gwrite430 p o (M1 a) = gwrite430 p o a-  gwritePacked p o (M1 a) = gwritePacked p o a--instance Block c => GBlock (K1 i c) where-  galignment140 _ = alignment140 (Proxy :: Proxy c)-  galignment430 _ = alignment430 (Proxy :: Proxy c)-  gsizeOf140    _ = sizeOf140 (Proxy :: Proxy c)-  gsizeOf430    _ = sizeOf430 (Proxy :: Proxy c)-  gsizeOfPacked    _ = sizeOfPacked (Proxy :: Proxy c)-  gread140 p o = K1 <$> read140 p (Diff o)-  gread430 p o = K1 <$> read430 p (Diff o)-  greadPacked p o = K1 <$> readPacked p (Diff o)-  gwrite140 p o (K1 a) = write140 p (Diff o) a-  gwrite430 p o (K1 a) = write430 p (Diff o) a-  gwritePacked p o (K1 a) = writePacked p (Diff o) a--toBool :: Int32 -> Bool-toBool 0 = False-toBool _ = True--fromBool :: Bool -> Int32-fromBool False = 0-fromBool True = 1--instance Block Bool where-  sizeOfPacked _ = 4-  alignment140 _ = 4-  sizeOf140      = sizeOfPacked-  alignment430   = alignment140-  sizeOf430      = sizeOf140-  isStruct _     = False-  read140 p (Diff d) = fmap toBool $ peekDiffOff p (Diff d)-  write140 p (Diff d) = pokeDiffOff p (Diff d) . fromBool-  read430     = read140-  write430    = write140-  readPacked  = read140-  writePacked = write140-  {-# INLINE sizeOfPacked #-}-  {-# INLINE alignment140 #-}-  {-# INLINE sizeOf140 #-}-  {-# INLINE alignment430 #-}-  {-# INLINE sizeOf430 #-}-  {-# INLINE isStruct #-}-  {-# INLINE read140 #-}-  {-# INLINE write140 #-}-  {-# INLINE read430 #-}-  {-# INLINE write430 #-}-  {-# INLINE readPacked #-}-  {-# INLINE writePacked #-}--instance Block Int32 where-  sizeOfPacked _ = 4-  alignment140 _ = 4-  sizeOf140      = sizeOfPacked-  alignment430   = alignment140-  sizeOf430      = sizeOf140-  isStruct _     = False-  read140     = peekDiffOff-  write140    = pokeDiffOff-  read430     = read140-  write430    = write140-  readPacked  = read140-  writePacked = write140-  {-# INLINE sizeOfPacked #-}-  {-# INLINE alignment140 #-}-  {-# INLINE sizeOf140 #-}-  {-# INLINE alignment430 #-}-  {-# INLINE sizeOf430 #-}-  {-# INLINE isStruct #-}-  {-# INLINE read140 #-}-  {-# INLINE write140 #-}-  {-# INLINE read430 #-}-  {-# INLINE write430 #-}-  {-# INLINE readPacked #-}-  {-# INLINE writePacked #-}--instance Block Word32 where-  sizeOfPacked _ = 4-  alignment140 _ = 4-  sizeOf140      = sizeOfPacked-  alignment430   = alignment140-  sizeOf430      = sizeOf140-  isStruct _     = False-  read140     = peekDiffOff-  write140    = pokeDiffOff-  read430     = read140-  write430    = write140-  readPacked  = read140-  writePacked = write140-  {-# INLINE sizeOfPacked #-}-  {-# INLINE alignment140 #-}-  {-# INLINE sizeOf140 #-}-  {-# INLINE alignment430 #-}-  {-# INLINE sizeOf430 #-}-  {-# INLINE isStruct #-}-  {-# INLINE read140 #-}-  {-# INLINE write140 #-}-  {-# INLINE read430 #-}-  {-# INLINE write430 #-}-  {-# INLINE readPacked #-}-  {-# INLINE writePacked #-}--instance Block Float where-  sizeOfPacked _ = 4-  alignment140 _ = 4-  sizeOf140      = sizeOfPacked-  alignment430   = alignment140-  sizeOf430      = sizeOf140-  isStruct _     = False-  read140     = peekDiffOff-  write140    = pokeDiffOff-  read430     = read140-  write430    = write140-  readPacked  = read140-  writePacked = write140-  {-# INLINE sizeOfPacked #-}-  {-# INLINE alignment140 #-}-  {-# INLINE sizeOf140 #-}-  {-# INLINE alignment430 #-}-  {-# INLINE sizeOf430 #-}-  {-# INLINE isStruct #-}-  {-# INLINE read140 #-}-  {-# INLINE write140 #-}-  {-# INLINE read430 #-}-  {-# INLINE write430 #-}-  {-# INLINE readPacked #-}-  {-# INLINE writePacked #-}--instance Block Double where-  sizeOfPacked _ = 8-  alignment140 _ = 8-  sizeOf140      = sizeOfPacked-  alignment430   = alignment140-  sizeOf430      = sizeOf140-  isStruct _     = False-  read140     = peekDiffOff-  write140    = pokeDiffOff-  read430     = read140-  write430    = write140-  readPacked  = read140-  writePacked = write140-  {-# INLINE sizeOfPacked #-}-  {-# INLINE alignment140 #-}-  {-# INLINE sizeOf140 #-}-  {-# INLINE alignment430 #-}-  {-# INLINE sizeOf430 #-}-  {-# INLINE isStruct #-}-  {-# INLINE read140 #-}-  {-# INLINE write140 #-}-  {-# INLINE read430 #-}-  {-# INLINE write430 #-}-  {-# INLINE readPacked #-}-  {-# INLINE writePacked #-}---- -- | Can be used for fixed-sized arrays--- instance (Dim n, Block a) => Block (V n a) where---   isStruct _ = isStruct (Proxy :: Proxy a)---   alignment140 _---     | isStruct (Proxy :: Proxy a) = lcm 16 n -- std140 rule 9---     | otherwise = n---     where n = alignment140 (Proxy :: Proxy a)---   alignment430 _ = alignment430 (Proxy :: Proxy a)---   sizeOf140 _ = roundUp (sizeOf140 (Proxy :: Proxy a)) (alignment140 (Proxy :: Proxy a)) * reflectDim (Proxy :: Proxy n)---   sizeOf430 _ = roundUp (sizeOf430 (Proxy :: Proxy a)) (alignment430 (Proxy :: Proxy a)) * reflectDim (Proxy :: Proxy n)---   read140 p (Diff o) = liftIO $ sequence $ tabulate \i -> read140 p $ Diff (o + i*d) where---     d = roundUp (sizeOf140 (Proxy :: Proxy a)) (alignment140 (Proxy :: Proxy a))---   write140 p (Diff o) v = liftIO $ iforM_ v \i -> write140 p (Diff (o + i*d)) where---     d = roundUp (sizeOf140 (Proxy :: Proxy a)) (alignment140 (Proxy :: Proxy a))---   read430 p (Diff o) = liftIO $ sequence $ tabulate \i -> read430 p $ Diff (o + i*d) where---     d = roundUp (sizeOf430 (Proxy :: Proxy a)) (alignment430 (Proxy :: Proxy a))---   write430 p (Diff o) v = liftIO $ iforM_ v \i -> write430 p (Diff (o + i*d)) where---     d = roundUp (sizeOf430 (Proxy :: Proxy a)) (alignment430 (Proxy :: Proxy a))---- | @roundUp k n@ rounds up k up to an integral multiple of n-roundUp :: Int -> Int -> Int-roundUp k n = k + mod (n - k) n--instance (Block a, Block b) => Block (a, b)-instance (Block a, Block b, Block c) => Block (a, b, c)

@@ -1,7 +1,9 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}  -- | Specialized and inlined @V2 Int32@. @@ -10,17 +12,21 @@   , ivec2   , withIVec2   , pattern WithIVec2+  , convert   , fromTuple+  , dot   ) where  import Control.DeepSeq (NFData(rnf))+import Data.Coerce (Coercible, coerce) import Data.Int (Int32) import Data.MonoTraversable (Element, MonoFunctor(..), MonoPointed(..)) import Foreign (Storable(..)) import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff)+import GHC.Ix (Ix(..))  import Geomancy.Elementwise (Elementwise(..))-import Geomancy.Gl.Block (Block(..))+import Graphics.Gl.Block (Block(..))  data IVec2 = IVec2   {-# UNPACK #-} !Int32@@ -38,6 +44,12 @@   -> r withIVec2 (IVec2 a b) f = f a b +{-# INLINE convert #-}+convert :: Coercible v IVec2 => (Int32 -> a) -> (a -> a -> r) -> v -> r+convert f t v =+  withIVec2 (coerce v) \a b ->+    t (f a) (f b)+ pattern WithIVec2 :: Int32 -> Int32 -> IVec2 pattern WithIVec2 a b <- ((`withIVec2` (,)) -> (a, b)) {-# COMPLETE WithIVec2 #-}@@ -46,6 +58,11 @@ fromTuple :: (Int32, Int32) -> IVec2 fromTuple (x, y) = ivec2 x y +{-# INLINE dot #-}+dot :: IVec2 -> IVec2 -> Int32+dot (IVec2 l1 l2) (IVec2 r1 r2) =+  l1 * r1 + l2 * r2+ instance NFData IVec2 where   rnf IVec2{} = () @@ -152,7 +169,7 @@     <*> peekByteOff ptr 4  instance Block IVec2 where-  sizeOfPacked _  = 8+  type PackedSize IVec2 = 8   alignment140 _  = 8   sizeOf140 _     = 8   alignment430    = alignment140@@ -164,7 +181,6 @@   write430    = write140   readPacked  = read140   writePacked = write140-  {-# INLINE sizeOfPacked #-}   {-# INLINE alignment140 #-}   {-# INLINE sizeOf140 #-}   {-# INLINE alignment430 #-}@@ -176,3 +192,28 @@   {-# INLINE write430 #-}   {-# INLINE readPacked #-}   {-# INLINE writePacked #-}++instance Ix IVec2 where+  {-# INLINE range #-}+  range (l, u) =+    withIVec2 l \l1 l2 ->+      withIVec2 u \u1 u2 ->+        ivec2+          <$> range (l1, u1)+          <*> range (l2, u2)++  {-# INLINE unsafeIndex #-}+  unsafeIndex (l, u) i =+    withIVec2 l \l1 l2 ->+      withIVec2 u \u1 u2 ->+        withIVec2 i \i1 i2 ->+          unsafeIndex (l2, u2) i2 + unsafeRangeSize (l2, u2) *+          unsafeIndex (l1, u1) i1++  {-# INLINE inRange #-}+  inRange (l, u) i =+    withIVec2 l \l1 l2 ->+      withIVec2 u \u1 u2 ->+        withIVec2 i \i1 i2 ->+          inRange (l1, u1) i1 &&+          inRange (l2, u2) i2

@@ -1,4 +1,6 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-}@@ -11,20 +13,24 @@   , ivec3   , withIVec3   , pattern WithIVec3+  , convert   , fromTuple+  , dot    , Packed(..)   , packed   ) where  import Control.DeepSeq (NFData(rnf))+import Data.Coerce (Coercible, coerce) import Data.Int (Int32) import Data.MonoTraversable (Element, MonoFunctor(..), MonoPointed(..)) import Foreign (Storable(..)) import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff)+import GHC.Ix (Ix(..))  import Geomancy.Elementwise (Elementwise(..))-import Geomancy.Gl.Block (Block(..))+import Graphics.Gl.Block (Block(..))  data IVec3 = IVec3   {-# UNPACK #-} !Int32@@ -47,10 +53,21 @@ pattern WithIVec3 a b c <- ((`withIVec3` (,,)) -> (a, b, c)) {-# COMPLETE WithIVec3 #-} +{-# INLINE convert #-}+convert :: Coercible v IVec3 => (Int32 -> a) -> (a -> a -> a -> r) -> v -> r+convert f t v =+  withIVec3 (coerce v) \a b c ->+    t (f a) (f b) (f c)+ {-# INLINE fromTuple #-} fromTuple :: (Int32, Int32, Int32) -> IVec3 fromTuple (a, b, c) = ivec3 a b c +{-# INLINE dot #-}+dot :: IVec3 -> IVec3 -> Int32+dot (IVec3 l1 l2 l3) (IVec3 r1 r2 r3) =+  l1 * r1 + l2 * r2 + l3 * r3+ instance NFData IVec3 where   rnf IVec3{} = () @@ -191,7 +208,7 @@     <*> peekByteOff ptr 8  instance Block IVec3 where-  sizeOfPacked _  = 12+  type PackedSize IVec3 = 12   alignment140 _  = 16   sizeOf140 _     = 16   alignment430    = alignment140@@ -203,7 +220,6 @@   write430    = write140   readPacked  = read140   writePacked = write140-  {-# INLINE sizeOfPacked #-}   {-# INLINE alignment140 #-}   {-# INLINE sizeOf140 #-}   {-# INLINE alignment430 #-}@@ -217,7 +233,7 @@   {-# INLINE writePacked #-}  instance Block Packed where-  sizeOfPacked _  = 12+  type PackedSize Packed = 12   alignment140 _  = 16   sizeOf140 _     = 16   alignment430    = alignment140@@ -229,7 +245,6 @@   write430    = write140   readPacked  = read140   writePacked = write140-  {-# INLINE sizeOfPacked #-}   {-# INLINE alignment140 #-}   {-# INLINE sizeOf140 #-}   {-# INLINE alignment430 #-}@@ -241,3 +256,31 @@   {-# INLINE write430 #-}   {-# INLINE readPacked #-}   {-# INLINE writePacked #-}++instance Ix IVec3 where+  {-# INLINE range #-}+  range (l, u) =+    withIVec3 l \l1 l2 l3 ->+      withIVec3 u \u1 u2 u3 ->+        ivec3+          <$> range (l1, u1)+          <*> range (l2, u2)+          <*> range (l3, u3)++  {-# INLINE unsafeIndex #-}+  unsafeIndex (l, u) i =+    withIVec3 l \l1 l2 l3 ->+      withIVec3 u \u1 u2 u3 ->+        withIVec3 i \i1 i2 i3 ->+          unsafeIndex (l3, u3) i3 + unsafeRangeSize (l3, u3) * (+          unsafeIndex (l2, u2) i2 + unsafeRangeSize (l2, u2) * (+          unsafeIndex (l1, u1) i1))++  {-# INLINE inRange #-}+  inRange (l, u) i =+    withIVec3 l \l1 l2 l3 ->+      withIVec3 u \u1 u2 u3 ->+        withIVec3 i \i1 i2 i3 ->+          inRange (l1, u1) i1 &&+          inRange (l2, u2) i2 &&+          inRange (l3, u3) i3

@@ -1,4 +1,6 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-}@@ -10,17 +12,21 @@   , ivec4   , withIVec4   , pattern WithIVec4+  , convert   , fromTuple+  , dot   ) where  import Control.DeepSeq (NFData(rnf))+import Data.Coerce (Coercible, coerce) import Data.Int (Int32) import Data.MonoTraversable (Element, MonoFunctor(..), MonoPointed(..)) import Foreign (Storable(..)) import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff)+import GHC.Ix (Ix(..))  import Geomancy.Elementwise (Elementwise(..))-import Geomancy.Gl.Block (Block(..))+import Graphics.Gl.Block (Block(..))  data IVec4 = IVec4   {-# UNPACK #-} !Int32@@ -44,10 +50,21 @@ pattern WithIVec4 a b c d <- ((`withIVec4` (,,,)) -> (a, b, c, d)) {-# COMPLETE WithIVec4 #-} +{-# INLINE convert #-}+convert :: Coercible v IVec4 => (Int32 -> a) -> (a -> a -> a -> a -> r) -> v -> r+convert f t v =+  withIVec4 (coerce v) \a b c d ->+    t (f a) (f b) (f c) (f d)+ {-# INLINE fromTuple #-} fromTuple :: (Int32, Int32, Int32, Int32) -> IVec4 fromTuple (x, y, z, w) = ivec4 x y z w +{-# INLINE dot #-}+dot :: IVec4 -> IVec4 -> Int32+dot (IVec4 l1 l2 l3 l4) (IVec4 r1 r2 r3 r4) =+  l1 * r1 + l2 * r2 + l3 * r3 + l4 * r4+ instance NFData IVec4 where   rnf IVec4{} = () @@ -170,7 +187,7 @@     <*> peekByteOff ptr 12  instance Block IVec4 where-  sizeOfPacked _  = 16+  type PackedSize IVec4 = 16   alignment140 _  = 16   sizeOf140 _     = 16   alignment430    = alignment140@@ -182,7 +199,6 @@   write430    = write140   readPacked  = read140   writePacked = write140-  {-# INLINE sizeOfPacked #-}   {-# INLINE alignment140 #-}   {-# INLINE sizeOf140 #-}   {-# INLINE alignment430 #-}@@ -194,3 +210,34 @@   {-# INLINE write430 #-}   {-# INLINE readPacked #-}   {-# INLINE writePacked #-}++instance Ix IVec4 where+  {-# INLINE range #-}+  range (l, u) =+    withIVec4 l \l1 l2 l3 l4 ->+      withIVec4 u \u1 u2 u3 u4 ->+        ivec4+          <$> range (l1, u1)+          <*> range (l2, u2)+          <*> range (l3, u3)+          <*> range (l4, u4)++  {-# INLINE unsafeIndex #-}+  unsafeIndex (l, u) i =+    withIVec4 l \l1 l2 l3 l4 ->+      withIVec4 u \u1 u2 u3 u4 ->+        withIVec4 i \i1 i2 i3 i4 ->+          unsafeIndex (l4, u4) i4 + unsafeRangeSize (l4, u4) * (+          unsafeIndex (l3, u3) i3 + unsafeRangeSize (l3, u3) * (+          unsafeIndex (l2, u2) i2 + unsafeRangeSize (l2, u2) * (+          unsafeIndex (l1, u1) i1)))++  {-# INLINE inRange #-}+  inRange (l, u) i =+    withIVec4 l \l1 l2 l3 l4 ->+      withIVec4 u \u1 u2 u3 u4 ->+        withIVec4 i \i1 i2 i3 i4 ->+          inRange (l1, u1) i1 &&+          inRange (l2, u2) i2 &&+          inRange (l3, u3) i3 &&+          inRange (l4, u4) i4

@@ -1,8 +1,10 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE ViewPatterns #-}@@ -46,7 +48,7 @@ import qualified Data.Foldable as Foldable import qualified Data.List as List -import Geomancy.Gl.Block (Block(..))+import Graphics.Gl.Block (Block(..)) import Geomancy.Vec4 (Vec4(..), unsafeNewVec4)  data Mat4 = Mat4 ByteArray#@@ -510,7 +512,7 @@       (# world', Mat4 arr' #)  instance Block Mat4 where-  sizeOfPacked _  = 64+  type PackedSize Mat4 = 64   alignment140 _  = 16   sizeOf140       = sizeOfPacked   alignment430    = alignment140@@ -522,7 +524,6 @@   write430    = write140   readPacked  = read140   writePacked = write140-  {-# INLINE sizeOfPacked #-}   {-# INLINE alignment140 #-}   {-# INLINE sizeOf140 #-}   {-# INLINE alignment430 #-}

@@ -1,16 +1,17 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}  module Geomancy.Point   ( Point(..)@@ -35,10 +36,12 @@ import Data.MonoTraversable (Element, MonoFunctor(..), MonoPointed(..)) import Foreign.Storable (Storable) import GHC.Generics (Generic)+import GHC.Ix (Ix)+import GHC.TypeNats (KnownNat) import qualified Data.AffineSpace as AffineSpace  import Geomancy.Elementwise (Elementwise(..))-import Geomancy.Gl.Block (Block(..))+import Graphics.Gl.Block (Block(..)) import Geomancy.Vec2 (Vec2) import Geomancy.Vec3 (Vec3, Packed) import Geomancy.Vec4 (Vec4)@@ -47,9 +50,13 @@  newtype Point v = Point v   deriving (Generic)-  deriving anyclass (Block)   deriving stock (Eq, Ord, Show)-  deriving newtype (NFData, Num, Fractional, MonoFunctor, MonoPointed, Elementwise, Storable)+  deriving newtype (Ix, NFData, Num, Fractional, MonoFunctor, MonoPointed, Elementwise, Storable)++deriving anyclass instance+  ( KnownNat (PackedSize v)+  , Block v+  ) => Block (Point v)  type instance Element (Point v) = Element v 

@@ -1,4 +1,6 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}  -- | Specialized and inlined @Quaternion Float@. @@ -29,7 +31,7 @@ import Foreign (Storable(..), castPtr) import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff) -import Geomancy.Gl.Block (Block(..))+import Graphics.Gl.Block (Block(..)) import Geomancy.Vec3 (Vec3, vec3, withVec3)  import qualified Geomancy.Vec3 as Vec3@@ -267,7 +269,7 @@     fixedUp = Vec3.cross (Vec3.cross dir3 up) dir3  instance Block Quaternion where-  sizeOfPacked _  = 16+  type PackedSize Quaternion = 16   alignment140 _  = 16   sizeOf140       = sizeOfPacked   alignment430    = alignment140@@ -279,7 +281,6 @@   write430    = write140   readPacked  = read140   writePacked = write140-  {-# INLINE sizeOfPacked #-}   {-# INLINE alignment140 #-}   {-# INLINE sizeOf140 #-}   {-# INLINE alignment430 #-}

@@ -1,6 +1,8 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-}+{-# LANGUAGE TypeFamilies #-}  module Geomancy.Transform   ( Transform(..)@@ -36,13 +38,13 @@ import Geomancy.Vec4 (fromVec3, withVec4)  import qualified Geomancy.Mat4 as Mat4-import Geomancy.Gl.Block (Block(..))+import Graphics.Gl.Block (Block(..))  newtype Transform = Transform { unTransform :: Mat4 }   deriving newtype (Show, Semigroup, Monoid, Storable)  instance Block Transform where-  sizeOfPacked _  = 64+  type PackedSize Transform = 64   alignment140 _  = 16   sizeOf140       = sizeOfPacked   alignment430    = alignment140@@ -54,7 +56,6 @@   write430    = write140   readPacked  = read140   writePacked = write140-  {-# INLINE sizeOfPacked #-}   {-# INLINE alignment140 #-}   {-# INLINE sizeOf140 #-}   {-# INLINE alignment430 #-}

@@ -1,4 +1,6 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-}@@ -10,17 +12,21 @@   , uvec2   , withUVec2   , pattern WithUVec2+  , convert   , fromTuple+  , dot   ) where  import Control.DeepSeq (NFData(rnf))-import Data.Word (Word32)+import Data.Coerce (Coercible, coerce) import Data.MonoTraversable (Element, MonoFunctor(..), MonoPointed(..))+import Data.Word (Word32) import Foreign (Storable(..)) import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff)+import GHC.Ix (Ix(..))  import Geomancy.Elementwise (Elementwise(..))-import Geomancy.Gl.Block (Block(..))+import Graphics.Gl.Block (Block(..))  data UVec2 = UVec2   {-# UNPACK #-} !Word32@@ -42,6 +48,12 @@ pattern WithUVec2 a b <- ((`withUVec2` (,)) -> (a, b)) {-# COMPLETE WithUVec2 #-} +{-# INLINE convert #-}+convert :: Coercible v UVec2 => (Word32 -> a) -> (a -> a -> r) -> v -> r+convert f t v =+  withUVec2 (coerce v) \a b ->+    t (f a) (f b)+ {-# INLINE fromTuple #-} fromTuple :: (Word32, Word32) -> UVec2 fromTuple (x, y) = uvec2 x y@@ -133,6 +145,11 @@     where       x' = fromInteger x +{-# INLINE dot #-}+dot :: UVec2 -> UVec2 -> Word32+dot (UVec2 l1 l2) (UVec2 r1 r2) =+  l1 * r1 + l2 * r2+ instance Storable UVec2 where   {-# INLINE sizeOf #-}   sizeOf _ = 8@@ -152,7 +169,7 @@     <*> peekByteOff ptr 4  instance Block UVec2 where-  sizeOfPacked _  = 8+  type PackedSize UVec2 = 8   alignment140 _  = 8   sizeOf140 _     = 8   alignment430    = alignment140@@ -164,7 +181,6 @@   write430    = write140   readPacked  = read140   writePacked = write140-  {-# INLINE sizeOfPacked #-}   {-# INLINE alignment140 #-}   {-# INLINE sizeOf140 #-}   {-# INLINE alignment430 #-}@@ -176,3 +192,28 @@   {-# INLINE write430 #-}   {-# INLINE readPacked #-}   {-# INLINE writePacked #-}++instance Ix UVec2 where+  {-# INLINE range #-}+  range (l, u) =+    withUVec2 l \l1 l2 ->+      withUVec2 u \u1 u2 ->+        uvec2+          <$> range (l1, u1)+          <*> range (l2, u2)++  {-# INLINE unsafeIndex #-}+  unsafeIndex (l, u) i =+    withUVec2 l \l1 l2 ->+      withUVec2 u \u1 u2 ->+        withUVec2 i \i1 i2 ->+          unsafeIndex (l2, u2) i2 + unsafeRangeSize (l2, u2) *+          unsafeIndex (l1, u1) i1++  {-# INLINE inRange #-}+  inRange (l, u) i =+    withUVec2 l \l1 l2 ->+      withUVec2 u \u1 u2 ->+        withUVec2 i \i1 i2 ->+          inRange (l1, u1) i1 &&+          inRange (l2, u2) i2

@@ -1,4 +1,6 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-}@@ -11,20 +13,24 @@   , uvec3   , withUVec3   , pattern WithUVec3+  , convert   , fromTuple+  , dot    , Packed(..)   , packed   ) where  import Control.DeepSeq (NFData(rnf))-import Data.Word (Word32)+import Data.Coerce (Coercible, coerce) import Data.MonoTraversable (Element, MonoFunctor(..), MonoPointed(..))+import Data.Word (Word32) import Foreign (Storable(..)) import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff)+import GHC.Ix (Ix(..))  import Geomancy.Elementwise (Elementwise(..))-import Geomancy.Gl.Block (Block(..))+import Graphics.Gl.Block (Block(..))  data UVec3 = UVec3   {-# UNPACK #-} !Word32@@ -47,10 +53,21 @@ pattern WithUVec3 a b c <- ((`withUVec3` (,,)) -> (a, b, c)) {-# COMPLETE WithUVec3 #-} +{-# INLINE convert #-}+convert :: Coercible v UVec3 => (Word32 -> a) -> (a -> a -> a -> r) -> v -> r+convert f t v =+  withUVec3 (coerce v) \a b c ->+    t (f a) (f b) (f c)+ {-# INLINE fromTuple #-} fromTuple :: (Word32, Word32, Word32) -> UVec3 fromTuple (a, b, c) = uvec3 a b c +{-# INLINE dot #-}+dot :: UVec3 -> UVec3 -> Word32+dot (UVec3 l1 l2 l3) (UVec3 r1 r2 r3) =+  l1 * r1 + l2 * r2 + l3 * r3+ instance NFData UVec3 where   rnf UVec3{} = () @@ -192,7 +209,7 @@     <*> peekByteOff ptr 8  instance Block UVec3 where-  sizeOfPacked _  = 12+  type PackedSize UVec3 = 12   alignment140 _  = 16   sizeOf140 _     = 16   alignment430    = alignment140@@ -204,7 +221,6 @@   write430    = write140   readPacked  = read140   writePacked = write140-  {-# INLINE sizeOfPacked #-}   {-# INLINE alignment140 #-}   {-# INLINE sizeOf140 #-}   {-# INLINE alignment430 #-}@@ -218,7 +234,7 @@   {-# INLINE writePacked #-}  instance Block Packed where-  sizeOfPacked _  = 12+  type PackedSize Packed = 12   alignment140 _  = 16   sizeOf140 _     = 16   alignment430    = alignment140@@ -230,7 +246,6 @@   write430    = write140   readPacked  = read140   writePacked = write140-  {-# INLINE sizeOfPacked #-}   {-# INLINE alignment140 #-}   {-# INLINE sizeOf140 #-}   {-# INLINE alignment430 #-}@@ -242,3 +257,31 @@   {-# INLINE write430 #-}   {-# INLINE readPacked #-}   {-# INLINE writePacked #-}++instance Ix UVec3 where+  {-# INLINE range #-}+  range (l, u) =+    withUVec3 l \l1 l2 l3 ->+      withUVec3 u \u1 u2 u3 ->+        uvec3+          <$> range (l1, u1)+          <*> range (l2, u2)+          <*> range (l3, u3)++  {-# INLINE unsafeIndex #-}+  unsafeIndex (l, u) i =+    withUVec3 l \l1 l2 l3 ->+      withUVec3 u \u1 u2 u3 ->+        withUVec3 i \i1 i2 i3 ->+          unsafeIndex (l3, u3) i3 + unsafeRangeSize (l3, u3) * (+          unsafeIndex (l2, u2) i2 + unsafeRangeSize (l2, u2) * (+          unsafeIndex (l1, u1) i1))++  {-# INLINE inRange #-}+  inRange (l, u) i =+    withUVec3 l \l1 l2 l3 ->+      withUVec3 u \u1 u2 u3 ->+        withUVec3 i \i1 i2 i3 ->+          inRange (l1, u1) i1 &&+          inRange (l2, u2) i2 &&+          inRange (l3, u3) i3

@@ -1,4 +1,6 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-}@@ -10,17 +12,21 @@   , uvec4   , withUVec4   , pattern WithUVec4+  , convert   , fromTuple+  , dot   ) where  import Control.DeepSeq (NFData(rnf))-import Data.Word (Word32)+import Data.Coerce (Coercible, coerce) import Data.MonoTraversable (Element, MonoFunctor(..), MonoPointed(..))+import Data.Word (Word32) import Foreign (Storable(..)) import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff)+import GHC.Ix (Ix(..))  import Geomancy.Elementwise (Elementwise(..))-import Geomancy.Gl.Block (Block(..))+import Graphics.Gl.Block (Block(..))  data UVec4 = UVec4   {-# UNPACK #-} !Word32@@ -44,6 +50,12 @@ pattern WithUVec4 a b c d <- ((`withUVec4` (,,,)) -> (a, b, c, d)) {-# COMPLETE WithUVec4 #-} +{-# INLINE convert #-}+convert :: Coercible v UVec4 => (Word32 -> a) -> (a -> a -> a -> a -> r) -> v -> r+convert f t v =+  withUVec4 (coerce v) \a b c d ->+    t (f a) (f b) (f c) (f d)+ {-# INLINE fromTuple #-} fromTuple :: (Word32, Word32, Word32, Word32) -> UVec4 fromTuple (x, y, z, w) = uvec4 x y z w@@ -171,7 +183,7 @@     <*> peekByteOff ptr 12  instance Block UVec4 where-  sizeOfPacked _  = 16+  type PackedSize UVec4 = 16   alignment140 _  = 16   sizeOf140 _     = 16   alignment430    = alignment140@@ -183,7 +195,6 @@   write430    = write140   readPacked  = read140   writePacked = write140-  {-# INLINE sizeOfPacked #-}   {-# INLINE alignment140 #-}   {-# INLINE sizeOf140 #-}   {-# INLINE alignment430 #-}@@ -195,3 +206,39 @@   {-# INLINE write430 #-}   {-# INLINE readPacked #-}   {-# INLINE writePacked #-}++instance Ix UVec4 where+  {-# INLINE range #-}+  range (l, u) =+    withUVec4 l \l1 l2 l3 l4 ->+      withUVec4 u \u1 u2 u3 u4 ->+        uvec4+          <$> range (l1, u1)+          <*> range (l2, u2)+          <*> range (l3, u3)+          <*> range (l4, u4)++  {-# INLINE unsafeIndex #-}+  unsafeIndex (l, u) i =+    withUVec4 l \l1 l2 l3 l4 ->+      withUVec4 u \u1 u2 u3 u4 ->+        withUVec4 i \i1 i2 i3 i4 ->+          unsafeIndex (l4, u4) i4 + unsafeRangeSize (l4, u4) * (+          unsafeIndex (l3, u3) i3 + unsafeRangeSize (l3, u3) * (+          unsafeIndex (l2, u2) i2 + unsafeRangeSize (l2, u2) * (+          unsafeIndex (l1, u1) i1)))++  {-# INLINE inRange #-}+  inRange (l, u) i =+    withUVec4 l \l1 l2 l3 l4 ->+      withUVec4 u \u1 u2 u3 u4 ->+        withUVec4 i \i1 i2 i3 i4 ->+          inRange (l1, u1) i1 &&+          inRange (l2, u2) i2 &&+          inRange (l3, u3) i3 &&+          inRange (l4, u4) i4++{-# INLINE dot #-}+dot :: UVec4 -> UVec4 -> Word32+dot (UVec4 l1 l2 l3 l4) (UVec4 r1 r2 r3 r4) =+  l1 * r1 + l2 * r2 + l3 * r3 + l4 * r4

@@ -1,4 +1,6 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-}@@ -12,6 +14,7 @@   , withVec2   , pattern WithVec2   , fromTuple+  , convert    , (^*)   , (^/)@@ -22,6 +25,7 @@   ) where  import Control.DeepSeq (NFData(rnf))+import Data.Coerce (Coercible, coerce) import Data.MonoTraversable (Element, MonoFunctor(..), MonoPointed(..)) import Data.VectorSpace (VectorSpace) import Foreign (Storable(..))@@ -29,7 +33,7 @@ import qualified Data.VectorSpace as VectorSpace  import Geomancy.Elementwise (Elementwise(..))-import Geomancy.Gl.Block (Block(..))+import Graphics.Gl.Block (Block(..)) import Geomancy.Gl.Funs (GlModf(..), GlNearest)  data Vec2 = Vec2@@ -48,6 +52,12 @@   -> r withVec2 (Vec2 a b) f = f a b +{-# INLINE convert #-}+convert :: Coercible v Vec2 => (Float -> a) -> (a -> a -> r) -> v -> r+convert f t v =+  withVec2 (coerce v) \a b ->+    t (f a) (f b)+ pattern WithVec2 :: Float -> Float -> Vec2 pattern WithVec2 a b <- ((`withVec2` (,)) -> (a, b)) {-# COMPLETE WithVec2 #-}@@ -233,7 +243,7 @@     <*> peekByteOff ptr 4  instance Block Vec2 where-  sizeOfPacked _  = 8+  type PackedSize Vec2 = 8   alignment140 _  = 8   sizeOf140 _     = 8   alignment430    = alignment140@@ -245,7 +255,6 @@   write430    = write140   readPacked  = read140   writePacked = write140-  {-# INLINE sizeOfPacked #-}   {-# INLINE alignment140 #-}   {-# INLINE sizeOf140 #-}   {-# INLINE alignment430 #-}

@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -15,6 +16,7 @@   , vec3   , withVec3   , pattern WithVec3+  , convert   , fromVec2   , fromTuple @@ -43,7 +45,7 @@ import qualified Data.VectorSpace as VectorSpace  import Geomancy.Elementwise (Elementwise(..))-import Geomancy.Gl.Block (Block(..))+import Graphics.Gl.Block (Block(..)) import Geomancy.Gl.Funs (GlModf(..), GlNearest) import Geomancy.Vec2 (Vec2, withVec2) @@ -64,6 +66,12 @@   -> r withVec3 (Vec3 a b c) f = f a b c +{-# INLINE convert #-}+convert :: Coercible v Vec3 => (Float -> a) -> (a -> a -> a -> r) -> v -> r+convert f t v =+  withVec3 (coerce v) \a b c ->+    t (f a) (f b) (f c)+ pattern WithVec3 :: Float -> Float -> Float -> Vec3 pattern WithVec3 a b c <- ((`withVec3` (,,)) -> (a, b, c)) {-# COMPLETE WithVec3 #-}@@ -238,7 +246,7 @@       ptr' = castPtr ptr  instance Block Vec3 where-  sizeOfPacked _  = 12+  type PackedSize Vec3 = 12   alignment140 _  = 16   sizeOf140 _     = 16   alignment430    = alignment140@@ -250,7 +258,6 @@   write430    = write140   readPacked  = read140   writePacked = write140-  {-# INLINE sizeOfPacked #-}   {-# INLINE alignment140 #-}   {-# INLINE sizeOf140 #-}   {-# INLINE alignment430 #-}@@ -382,7 +389,7 @@       ptr' = castPtr ptr  instance Block Packed where-  sizeOfPacked _  = 12+  type PackedSize Packed = 12   alignment140 _  = 16   sizeOf140 _     = 16   alignment430    = alignment140@@ -394,7 +401,6 @@   write430    = write140   readPacked  = read140   writePacked = write140-  {-# INLINE sizeOfPacked #-}   {-# INLINE alignment140 #-}   {-# INLINE sizeOf140 #-}   {-# INLINE alignment430 #-}

@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -16,6 +17,7 @@   , vec4   , withVec4   , pattern WithVec4+  , convert   , fromVec2   , fromVec22   , fromVec3@@ -43,7 +45,7 @@ import qualified Data.VectorSpace as VectorSpace  import Geomancy.Elementwise (Elementwise(..))-import Geomancy.Gl.Block (Block(..))+import Graphics.Gl.Block (Block(..)) import Geomancy.Gl.Funs (GlModf(..), GlNearest) import Geomancy.Vec2 (Vec2, withVec2) import Geomancy.Vec3 (Vec3, withVec3)@@ -77,6 +79,12 @@     (F# (indexFloatArray# arr 0x2#))     (F# (indexFloatArray# arr 0x3#)) +{-# INLINE convert #-}+convert :: Coercible v Vec4 => (Float -> a) -> (a -> a -> a -> a -> r) -> v -> r+convert f t v =+  withVec4 (coerce v) \a b c d->+    t (f a) (f b) (f c) (f d)+ {-# INLINE compareVec4 #-} compareVec4 :: Vec4 -> Vec4 -> Ordering compareVec4 (Vec4 src1) (Vec4 src2) =@@ -302,7 +310,7 @@       (# world', Vec4 arr' #)  instance Block Vec4 where-  sizeOfPacked _  = 16+  type PackedSize Vec4 = 16   alignment140 _  = 16   sizeOf140       = sizeOfPacked   alignment430    = alignment140@@ -314,7 +322,6 @@   write430    = write140   readPacked  = read140   writePacked = write140-  {-# INLINE sizeOfPacked #-}   {-# INLINE alignment140 #-}   {-# INLINE sizeOf140 #-}   {-# INLINE alignment430 #-}