geomancy 0.3.0.0 → 0.3.0.1

raw patch · 15 files changed

+421/−2 lines, 15 filesdep +serialisedep +template-haskellPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: serialise, template-haskell

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• geomancy.cabal +18/−2
• src/Geomancy/IVec2.hs +27/−0
• src/Geomancy/IVec3.hs +27/−0
• src/Geomancy/IVec4.hs +27/−0
• src/Geomancy/Mat4/Internal.hs +83/−0
• src/Geomancy/Point.hs +19/−0
• src/Geomancy/Quaternion.hs +27/−0
• src/Geomancy/Transform.hs +19/−0
• src/Geomancy/UVec2.hs +27/−0
• src/Geomancy/UVec3.hs +27/−0
• src/Geomancy/UVec4.hs +27/−0
• src/Geomancy/Vec2.hs +27/−0
• src/Geomancy/Vec3.hs +30/−0
• src/Geomancy/Vec4.hs +29/−0

@@ -1,5 +1,12 @@ # Changelog for geomancy +## 0.3.0.1++- Added Lift instances for data.+  Opt-out by disabling the `th-lift` flag.+- Added Serialise instances for data.+  Opt-out by disabling the `serialise` flag.+ ## 0.3.0.0  > `[0]` releases without row/col-major, handedness, and counter/clockwise confusion.

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.38.1.+-- This file has been generated from package.yaml by hpack version 0.39.1. -- -- see: https://github.com/sol/hpack  name:           geomancy-version:        0.3.0.0+version:        0.3.0.1 synopsis:       Vectors and matrix manipulation description:    Sometimes it is unavoidable you have to do stuff on CPU.                 Let's at least do it faster.@@ -24,6 +24,14 @@   type: git   location: https://gitlab.com/dpwiz/geomancy +flag serialise+  manual: True+  default: True++flag th-lift+  manual: True+  default: True+ library   exposed-modules:       Geomancy@@ -67,6 +75,14 @@     , simple-affine-space     , webcolor-labels   default-language: Haskell2010+  if flag(th-lift)+    cpp-options: -DTH_LIFT+    build-depends:+        template-haskell+  if flag(serialise)+    cpp-options: -DSERIALISE+    build-depends:+        serialise  test-suite geomancy-test   type: exitcode-stdio-1.0

@@ -1,10 +1,16 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +#ifdef TH_LIFT+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE DerivingStrategies #-}+#endif+ -- | Specialized and inlined @V2 Int32@.  module Geomancy.IVec2@@ -25,6 +31,16 @@ import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff) import GHC.Ix (Ix(..)) +#ifdef TH_LIFT+import Language.Haskell.TH.Syntax (Lift(..))+#endif++#ifdef SERIALISE+import Codec.Serialise (Serialise(..))+import qualified Codec.Serialise.Encoding as Serialise+import qualified Codec.Serialise.Decoding as Serialise+#endif+ import Geomancy.Elementwise (Elementwise(..)) import Graphics.Gl.Block (Block(..)) @@ -32,6 +48,9 @@   {-# UNPACK #-} !Int32   {-# UNPACK #-} !Int32   deriving (Eq, Ord, Show)+#ifdef TH_LIFT+  deriving Lift+#endif  {-# INLINE ivec2 #-} ivec2 :: Int32 -> Int32 -> IVec2@@ -217,3 +236,11 @@         withIVec2 i \i1 i2 ->           inRange (l1, u1) i1 &&           inRange (l2, u2) i2++#ifdef SERIALISE+instance Serialise IVec2 where+  encode v = withIVec2 v \x y ->+    Serialise.encodeListLen 2 <> encode x <> encode y+  decode =+    Serialise.decodeListLenOf 2 *> (ivec2 <$> decode <*> decode)+#endif

@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -6,6 +7,11 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +#ifdef TH_LIFT+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE DerivingStrategies #-}+#endif+ -- | Specialized and inlined @V2 Int32@.  module Geomancy.IVec3@@ -29,6 +35,16 @@ import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff) import GHC.Ix (Ix(..)) +#ifdef TH_LIFT+import Language.Haskell.TH.Syntax (Lift)+#endif++#ifdef SERIALISE+import Codec.Serialise (Serialise(..))+import qualified Codec.Serialise.Encoding as Serialise+import qualified Codec.Serialise.Decoding as Serialise+#endif+ import Geomancy.Elementwise (Elementwise(..)) import Graphics.Gl.Block (Block(..)) @@ -37,6 +53,9 @@   {-# UNPACK #-} !Int32   {-# UNPACK #-} !Int32   deriving (Eq, Ord, Show)+#ifdef TH_LIFT+  deriving Lift+#endif  {-# INLINE ivec3 #-} ivec3 :: Int32 -> Int32 -> Int32 -> IVec3@@ -284,3 +303,11 @@           inRange (l1, u1) i1 &&           inRange (l2, u2) i2 &&           inRange (l3, u3) i3++#ifdef SERIALISE+instance Serialise IVec3 where+  encode v = withIVec3 v \x y z ->+    Serialise.encodeListLen 3 <> encode x <> encode y <> encode z+  decode =+    Serialise.decodeListLenOf 3 *> (ivec3 <$> decode <*> decode <*> decode)+#endif

@@ -1,10 +1,16 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +#ifdef TH_LIFT+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE DerivingStrategies #-}+#endif+ -- | Specialized and inlined @V2 Int32@.  module Geomancy.IVec4@@ -25,6 +31,16 @@ import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff) import GHC.Ix (Ix(..)) +#ifdef TH_LIFT+import Language.Haskell.TH.Syntax (Lift)+#endif++#ifdef SERIALISE+import Codec.Serialise (Serialise(..))+import qualified Codec.Serialise.Encoding as Serialise+import qualified Codec.Serialise.Decoding as Serialise+#endif+ import Geomancy.Elementwise (Elementwise(..)) import Graphics.Gl.Block (Block(..)) @@ -34,6 +50,9 @@   {-# UNPACK #-} !Int32   {-# UNPACK #-} !Int32   deriving (Eq, Ord, Show)+#ifdef TH_LIFT+  deriving Lift+#endif  {-# INLINE ivec4 #-} ivec4 :: Int32 -> Int32 -> Int32 -> Int32 -> IVec4@@ -241,3 +260,11 @@           inRange (l2, u2) i2 &&           inRange (l3, u3) i3 &&           inRange (l4, u4) i4++#ifdef SERIALISE+instance Serialise IVec4 where+  encode v = withIVec4 v \x y z w ->+    Serialise.encodeListLen 4 <> encode x <> encode y <> encode z <> encode w+  decode =+    Serialise.decodeListLenOf 4 *> (ivec4 <$> decode <*> decode <*> decode <*> decode)+#endif

@@ -1,10 +1,15 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnboxedTuples #-} +#ifdef TH_LIFT+{-# LANGUAGE TemplateHaskell #-}+#endif+ -- | General matrix storage and operations.  module Geomancy.Mat4.Internal@@ -28,6 +33,16 @@ import Prelude hiding (zipWith) import GHC.Exts hiding (VecCount(..), toList) +#ifdef TH_LIFT+import Language.Haskell.TH.Syntax (Lift(..))+#endif++#ifdef SERIALISE+import Codec.Serialise (Serialise(..))+import qualified Codec.Serialise.Encoding as Serialise+import qualified Codec.Serialise.Decoding as Serialise+#endif+ import Control.DeepSeq (NFData(rnf)) import Foreign (Storable(..)) import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff)@@ -119,6 +134,35 @@     (F# (indexFloatArray# arr 0xE#))     (F# (indexFloatArray# arr 0xF#)) +#ifdef TH_LIFT+instance Lift Mat4 where+  lift m = withMemory m+    \ e0 e1 e2 e3+      e4 e5 e6 e7+      e8 e9 eA eB+      eC eD eE eF ->+      [|+        fromMemory+          $(lift e0) $(lift e1) $(lift e2) $(lift e3)+          $(lift e4) $(lift e5) $(lift e6) $(lift e7)+          $(lift e8) $(lift e9) $(lift eA) $(lift eB)+          $(lift eC) $(lift eD) $(lift eE) $(lift eF)+      |]+  liftTyped m = withMemory m+    \ e0 e1 e2 e3+      e4 e5 e6 e7+      e8 e9 eA eB+      eC eD eE eF ->+      [||+        fromMemory+          $$(liftTyped e0) $$(liftTyped e1) $$(liftTyped e2) $$(liftTyped e3)+          $$(liftTyped e4) $$(liftTyped e5) $$(liftTyped e6) $$(liftTyped e7)+          $$(liftTyped e8) $$(liftTyped e9) $$(liftTyped eA) $$(liftTyped eB)+          $$(liftTyped eC) $$(liftTyped eD) $$(liftTyped eE) $$(liftTyped eF)+      ||]+#endif++ {- | @I@, the identity matrix.  Neutral element of its monoid, so you can use 'mempty'.@@ -233,6 +277,45 @@   {-# INLINE write430 #-}   {-# INLINE readPacked #-}   {-# INLINE writePacked #-}++#ifdef SERIALISE+instance Serialise Mat4 where+  encode m =+    withMemory m+      \ e0 e1 e2 e3+        e4 e5 e6 e7+        e8 e9 eA eB+        eC eD eE eF ->+          Serialise.encodeListLen 16 <>+          encode e0 <>+          encode e1 <> encode e2 <> encode e3 <>+          encode e4 <> encode e5 <> encode e6  <> encode e7 <>+          encode e8 <> encode e9 <> encode eA  <> encode eB <>+          encode eC <> encode eD <> encode eE  <> encode eF+  decode = do+    Serialise.decodeListLenOf 16+    e0 <- decode+    e1 <- decode+    e2 <- decode+    e3 <- decode+    e4 <- decode+    e5 <- decode+    e6 <- decode+    e7 <- decode+    e8 <- decode+    e9 <- decode+    eA <- decode+    eB <- decode+    eC <- decode+    eD <- decode+    eE <- decode+    eF <- decode+    pure $! fromMemory+      e0 e1 e2 e3+      e4 e5 e6 e7+      e8 e9 eA eB+      eC eD eE eF+#endif  toListMemory :: Mat4 -> [Float] toListMemory = flip withMemory

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-}@@ -13,6 +14,10 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +#ifdef TH_LIFT+{-# LANGUAGE DeriveLift #-}+#endif+ module Geomancy.Point   ( Point(..) @@ -40,6 +45,14 @@ import GHC.TypeNats (KnownNat) import qualified Data.AffineSpace as AffineSpace +#ifdef TH_LIFT+import Language.Haskell.TH.Syntax (Lift)+#endif++#ifdef SERIALISE+import Codec.Serialise (Serialise)+#endif+ import Geomancy.Elementwise (Elementwise(..)) import Graphics.Gl.Block (Block(..)) import Geomancy.Vec2 (Vec2)@@ -52,6 +65,12 @@   deriving (Generic)   deriving stock (Eq, Ord, Show)   deriving newtype (Ix, NFData, Num, Fractional, MonoFunctor, MonoPointed, Elementwise, Storable)+#ifdef TH_LIFT+  deriving Lift+#endif+#ifdef SERIALISE+  deriving newtype Serialise+#endif  deriving anyclass instance   ( KnownNat (PackedSize v)

@@ -1,7 +1,13 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-} +#ifdef TH_LIFT+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE DerivingStrategies #-}+#endif+ -- | Specialized and inlined @Quaternion Float@.  module Geomancy.Quaternion@@ -33,6 +39,16 @@ import Foreign (Storable(..), castPtr) import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff) +#ifdef TH_LIFT+import Language.Haskell.TH.Syntax (Lift)+#endif++#ifdef SERIALISE+import Codec.Serialise (Serialise(..))+import qualified Codec.Serialise.Encoding as Serialise+import qualified Codec.Serialise.Decoding as Serialise+#endif+ import Graphics.Gl.Block (Block(..)) import Geomancy.Vec3 (Vec3, vec3, withVec3) @@ -44,6 +60,9 @@   {-# UNPACK #-} !Float   {-# UNPACK #-} !Float   deriving (Eq, Ord, Show)+#ifdef TH_LIFT+  deriving Lift+#endif  {-# INLINE quaternion #-} quaternion :: Float -> Float -> Float -> Float -> Quaternion@@ -348,3 +367,11 @@   {-# INLINE write430 #-}   {-# INLINE readPacked #-}   {-# INLINE writePacked #-}++#ifdef SERIALISE+instance Serialise Quaternion where+  encode v = withQuaternion v \x y z w ->+    Serialise.encodeListLen 4 <> encode x <> encode y <> encode z <> encode w+  decode =+    Serialise.decodeListLenOf 4 *> (quaternion <$> decode <*> decode <*> decode <*> decode)+#endif

@@ -1,10 +1,15 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE TypeFamilies #-} +#ifdef TH_LIFT+{-# LANGUAGE DeriveLift #-}+#endif+ module Geomancy.Transform   ( Transform(..)   , Mat4.inverse@@ -35,6 +40,14 @@ import Foreign (Storable(..)) import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff) +#ifdef TH_LIFT+import Language.Haskell.TH.Syntax (Lift)+#endif++#ifdef SERIALISE+import Codec.Serialise (Serialise)+#endif+ import Geomancy.Mat4 (Mat4, colMajor) import Geomancy.Quaternion (Quaternion, withQuaternion) import Geomancy.Vec3 (Vec3, vec3, withVec3)@@ -45,6 +58,12 @@  newtype Transform = Transform { unTransform :: Mat4 }   deriving newtype (Show, Semigroup, Monoid, Storable)+#ifdef TH_LIFT+  deriving Lift+#endif+#ifdef SERIALISE+  deriving Serialise+#endif  instance Block Transform where   type PackedSize Transform = 64

@@ -1,10 +1,16 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +#ifdef TH_LIFT+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE DerivingStrategies #-}+#endif+ -- | Specialized and inlined @V2 Word32@.  module Geomancy.UVec2@@ -25,6 +31,16 @@ import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff) import GHC.Ix (Ix(..)) +#ifdef TH_LIFT+import Language.Haskell.TH.Syntax (Lift)+#endif++#ifdef SERIALISE+import Codec.Serialise (Serialise(..))+import qualified Codec.Serialise.Encoding as Serialise+import qualified Codec.Serialise.Decoding as Serialise+#endif+ import Geomancy.Elementwise (Elementwise(..)) import Graphics.Gl.Block (Block(..)) @@ -32,6 +48,9 @@   {-# UNPACK #-} !Word32   {-# UNPACK #-} !Word32   deriving (Eq, Ord, Show)+#ifdef TH_LIFT+  deriving Lift+#endif  {-# INLINE uvec2 #-} uvec2 :: Word32 -> Word32 -> UVec2@@ -217,3 +236,11 @@         withUVec2 i \i1 i2 ->           inRange (l1, u1) i1 &&           inRange (l2, u2) i2++#ifdef SERIALISE+instance Serialise UVec2 where+  encode v = withUVec2 v \x y ->+    Serialise.encodeListLen 2 <> encode x <> encode y+  decode =+    Serialise.decodeListLenOf 2 *> (uvec2 <$> decode <*> decode)+#endif

@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -10,6 +11,11 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +#ifdef TH_LIFT+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE DerivingStrategies #-}+#endif+ -- | Specialized and inlined @V2 Word32@.  module Geomancy.UVec3@@ -35,6 +41,16 @@ import GHC.OverloadedLabels (IsLabel(..)) import WebColor.Labels (IsWebColor(..)) +#ifdef TH_LIFT+import Language.Haskell.TH.Syntax (Lift)+#endif++#ifdef SERIALISE+import Codec.Serialise (Serialise(..))+import qualified Codec.Serialise.Encoding as Serialise+import qualified Codec.Serialise.Decoding as Serialise+#endif+ import Geomancy.Elementwise (Elementwise(..)) import Graphics.Gl.Block (Block(..)) @@ -43,6 +59,9 @@   {-# UNPACK #-} !Word32   {-# UNPACK #-} !Word32   deriving (Eq, Ord, Show)+#ifdef TH_LIFT+  deriving Lift+#endif  {-# INLINE uvec3 #-} uvec3 :: Word32 -> Word32 -> Word32 -> UVec3@@ -297,3 +316,11 @@           inRange (l1, u1) i1 &&           inRange (l2, u2) i2 &&           inRange (l3, u3) i3++#ifdef SERIALISE+instance Serialise UVec3 where+  encode v = withUVec3 v \x y z ->+    Serialise.encodeListLen 3 <> encode x <> encode y <> encode z+  decode =+    Serialise.decodeListLenOf 3 *> (uvec3 <$> decode <*> decode <*> decode)+#endif

@@ -1,10 +1,16 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +#ifdef TH_LIFT+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE DerivingStrategies #-}+#endif+ -- | Specialized and inlined @V2 Word32@.  module Geomancy.UVec4@@ -25,6 +31,16 @@ import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff) import GHC.Ix (Ix(..)) +#ifdef TH_LIFT+import Language.Haskell.TH.Syntax (Lift)+#endif++#ifdef SERIALISE+import Codec.Serialise (Serialise(..))+import qualified Codec.Serialise.Encoding as Serialise+import qualified Codec.Serialise.Decoding as Serialise+#endif+ import Geomancy.Elementwise (Elementwise(..)) import Graphics.Gl.Block (Block(..)) @@ -34,6 +50,9 @@   {-# UNPACK #-} !Word32   {-# UNPACK #-} !Word32   deriving (Eq, Ord, Show)+#ifdef TH_LIFT+  deriving Lift+#endif  {-# INLINE uvec4 #-} uvec4 :: Word32 -> Word32 -> Word32 -> Word32 -> UVec4@@ -242,3 +261,11 @@ dot :: UVec4 -> UVec4 -> Word32 dot (UVec4 l1 l2 l3 l4) (UVec4 r1 r2 r3 r4) =   l1 * r1 + l2 * r2 + l3 * r3 + l4 * r4++#ifdef SERIALISE+instance Serialise UVec4 where+  encode v = withUVec4 v \x y z w ->+    Serialise.encodeListLen 4 <> encode x <> encode y <> encode z <> encode w+  decode =+    Serialise.decodeListLenOf 4 *> (uvec4 <$> decode <*> decode <*> decode <*> decode)+#endif

@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -6,6 +7,11 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +#ifdef TH_LIFT+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE DerivingStrategies #-}+#endif+ -- | Specialized and inlined @V2 Float@.  module Geomancy.Vec2@@ -32,6 +38,16 @@ import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff) import qualified Data.VectorSpace as VectorSpace +#ifdef TH_LIFT+import Language.Haskell.TH.Syntax (Lift)+#endif++#ifdef SERIALISE+import Codec.Serialise (Serialise(..))+import qualified Codec.Serialise.Encoding as Serialise+import qualified Codec.Serialise.Decoding as Serialise+#endif+ import Geomancy.Elementwise (Elementwise(..)) import Graphics.Gl.Block (Block(..)) import Geomancy.Gl.Funs (GlModf(..), GlNearest)@@ -40,6 +56,9 @@   {-# UNPACK #-} !Float   {-# UNPACK #-} !Float   deriving (Eq, Ord, Show)+#ifdef TH_LIFT+  deriving Lift+#endif  {-# INLINE vec2 #-} vec2 :: Float -> Float -> Vec2@@ -266,6 +285,14 @@   {-# INLINE write430 #-}   {-# INLINE readPacked #-}   {-# INLINE writePacked #-}++#ifdef SERIALISE+instance Serialise Vec2 where+  encode v = withVec2 v \x y ->+    Serialise.encodeListLen 2 <> encode x <> encode y+  decode =+    Serialise.decodeListLenOf 2 *> (vec2 <$> decode <*> decode)+#endif  instance VectorSpace Vec2 Float where   zeroVector = epoint 0

@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-}@@ -12,6 +13,11 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +#ifdef TH_LIFT+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE DerivingStrategies #-}+#endif+ -- | Specialized and inlined @V3 Float@.  module Geomancy.Vec3@@ -49,6 +55,16 @@ import GHC.OverloadedLabels (IsLabel(..)) import WebColor.Labels (IsWebColor(..)) +#ifdef TH_LIFT+import Language.Haskell.TH.Syntax (Lift(..))+#endif++#ifdef SERIALISE+import Codec.Serialise (Serialise(..))+import qualified Codec.Serialise.Encoding as Serialise+import qualified Codec.Serialise.Decoding as Serialise+#endif+ import Geomancy.Elementwise (Elementwise(..)) import Graphics.Gl.Block (Block(..)) import Geomancy.Gl.Funs (GlModf(..), GlNearest)@@ -59,6 +75,9 @@   {-# UNPACK #-} !Float   {-# UNPACK #-} !Float   deriving (Eq, Ord, Show)+#ifdef TH_LIFT+  deriving Lift+#endif  {-# INLINE vec3 #-} vec3 :: Float -> Float -> Float -> Vec3@@ -284,6 +303,14 @@   {-# INLINE readPacked #-}   {-# INLINE writePacked #-} +#ifdef SERIALISE+instance Serialise Vec3 where+  encode v = withVec3 v \x y z ->+    Serialise.encodeListLen 3 <> encode x <> encode y <> encode z+  decode =+    Serialise.decodeListLenOf 3 *> (vec3 <$> decode <*> decode <*> decode)+#endif+ {-# INLINE (^*) #-} (^*) :: Vec3 -> Float -> Vec3 Vec3 a b c ^* x =@@ -373,6 +400,9 @@     , MonoFunctor, MonoPointed     , Elementwise     )+#ifdef TH_LIFT+  deriving Lift+#endif  {-# INLINE packed #-} packed :: Float -> Float -> Float -> Packed

@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -14,6 +15,10 @@ {-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE ViewPatterns #-} +#ifdef TH_LIFT+{-# LANGUAGE TemplateHaskell #-}+#endif+ -- | Specialized and inlined @V4 Float@.  module Geomancy.Vec4@@ -50,6 +55,16 @@ import Text.Printf (printf) import WebColor.Labels (IsWebColorAlpha(..)) +#ifdef TH_LIFT+import Language.Haskell.TH.Syntax (Lift(..))+#endif++#ifdef SERIALISE+import Codec.Serialise (Serialise(..))+import qualified Codec.Serialise.Encoding as Serialise+import qualified Codec.Serialise.Decoding as Serialise+#endif+ import Geomancy.Elementwise (Elementwise(..)) import Graphics.Gl.Block (Block(..)) import Geomancy.Gl.Funs (GlModf(..), GlNearest)@@ -155,6 +170,12 @@ instance NFData Vec4 where   rnf Vec4{} = () +#ifdef TH_LIFT+instance Lift Vec4 where+  lift (WithVec4 a b c d) = [| vec4 $(lift a) $(lift b) $(lift c) $(lift d) |]+  liftTyped (WithVec4 a b c d) = [|| vec4 $$(liftTyped a) $$(liftTyped b) $$(liftTyped c) $$(liftTyped d) ||]+#endif+ type instance Element Vec4 = Float  instance MonoFunctor Vec4 where@@ -349,6 +370,14 @@   {-# INLINE write430 #-}   {-# INLINE readPacked #-}   {-# INLINE writePacked #-}++#ifdef SERIALISE+instance Serialise Vec4 where+  encode v = withVec4 v \x y z w ->+    Serialise.encodeListLen 4 <> encode x <> encode y <> encode z <> encode w+  decode =+    Serialise.decodeListLenOf 4 *> (vec4 <$> decode <*> decode <*> decode <*> decode)+#endif  instance VectorSpace Vec4 Float where   zeroVector = epoint 0