geomancy 0.2.2.3 → 0.2.2.4

raw patch · 4 files changed

+259/−3 lines, 4 filesdep +containersPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: containers

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• geomancy.cabal +6/−3
• src/Geomancy/Transform/Tree.hs +132/−0
• src/Geomancy/Tree.hs +117/−0

@@ -1,5 +1,9 @@ # Changelog for geomancy +## 0.2.2.4+++ Add Transform trees.+ ## 0.2.2.3  + Add IVec and UVec 32-bit integer vectors.

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: 0bbbcdde42a68176d0c54cb31c5798701541c1ce73877ad066e6aec522450641+-- hash: 1480b5bc5e86691e54a70d648214d4951a3685c03bc3eeb8741a8429eaa0b13c  name:           geomancy-version:        0.2.2.3+version:        0.2.2.4 synopsis:       Geometry and matrix manipulation description:    Sometimes it is unavoidable you have to do stuff on CPU.                 Let's at least do it faster.@@ -35,6 +35,8 @@       Geomancy.Mat4       Geomancy.Quaternion       Geomancy.Transform+      Geomancy.Transform.Tree+      Geomancy.Tree       Geomancy.UVec2       Geomancy.UVec3       Geomancy.UVec4@@ -52,6 +54,7 @@       cbits/mat4.c   build-depends:       base >=4.7 && <5+    , containers     , deepseq   default-language: Haskell2010 

@@ -0,0 +1,132 @@+module Geomancy.Transform.Tree+  ( Transformed+  , apply+  , node_+  , leaf_+  , collect_++  , translate_+  , translateV_++  , rotateX_+  , rotateY_+  , rotateZ_+  , rotateQ_++  , scale_+  , scaleX_+  , scaleY_+  , scaleZ_+  , scaleXY_+  , scale3_+  ) where++import Geomancy.Quaternion (Quaternion)+import Geomancy.Transform (Transform)+import Geomancy.Tree (Tree, apply, node_, leaf_, collect_)+import Geomancy.Vec3 (Vec3)++import qualified Geomancy.Transform as Transform++type Transformed a = Tree (Transform, Maybe a)++{-# INLINE translate_ #-}+translate_+  :: Float+  -> Float+  -> Float+  -> [Transformed a]+  -> Transformed a+translate_ x y z =+  node_ (Transform.translate x y z)++{-# INLINE translateV_ #-}+translateV_+  :: Vec3+  -> [Transformed a]+  -> Transformed a+translateV_ xyz =+  node_ (Transform.translateV xyz)++{-# INLINE rotateX_ #-}+rotateX_+  :: Float+  -> [Transformed a]+  -> Transformed a+rotateX_ rads =+  node_ (Transform.rotateX rads)++{-# INLINE rotateY_ #-}+rotateY_+  :: Float+  -> [Transformed a]+  -> Transformed a+rotateY_ rads =+  node_ (Transform.rotateY rads)++{-# INLINE rotateZ_ #-}+rotateZ_+  :: Float+  -> [Transformed a]+  -> Transformed a+rotateZ_ rads =+  node_ (Transform.rotateZ rads)++{-# INLINE rotateQ_ #-}+rotateQ_+  :: Quaternion+  -> [Transformed a]+  -> Transformed a+rotateQ_ rot =+  node_ (Transform.rotateQ rot)++{-# INLINE scale_ #-}+scale_+  :: Float+  -> [Transformed a]+  -> Transformed a+scale_ x =+  node_ (Transform.scale x)++{-# INLINE scaleX_ #-}+scaleX_+  :: Float+  -> [Transformed a]+  -> Transformed a+scaleX_ rads =+  node_ (Transform.scaleX rads)++{-# INLINE scaleY_ #-}+scaleY_+  :: Float+  -> [Transformed a]+  -> Transformed a+scaleY_ rads =+  node_ (Transform.scaleY rads)++{-# INLINE scaleZ_ #-}+scaleZ_+  :: Float+  -> [Transformed a]+  -> Transformed a+scaleZ_ rads =+  node_ (Transform.scaleZ rads)++{-# INLINE scaleXY_ #-}+scaleXY_+  :: Float+  -> Float+  -> [Transformed a]+  -> Transformed a+scaleXY_ x y =+  node_ (Transform.scaleXY x y)++{-# INLINE scale3_ #-}+scale3_+  :: Float+  -> Float+  -> Float+  -> [Transformed a]+  -> Transformed a+scale3_ x y z =+  node_ (Transform.scale3 x y z)

@@ -0,0 +1,117 @@+module Geomancy.Tree+  ( Tree(..)++  , apply+  , applyWith+  , mapAccum++  , node_+  , leaf_+  , collect_++  , annotateMap+  , annotateWith+  ) where++import Data.Tree (Tree(..))+import Data.Foldable (toList)++-- * Merging annotations++{- |+  Distribute annotations down the tree without changing the type.+-}+{-# INLINEABLE apply #-}+apply :: Semigroup ann => Tree (ann, a) -> Tree (ann, a)+apply (Node (rootAnn, root) rootChildren) =+  Node+    (rootAnn, root)+    (map (applyWith (<>) rootAnn) rootChildren)++{- |+  Distribute accumulator down the tree using the accumulator function.+-}+{-# INLINEABLE applyWith #-}+applyWith+  :: (ann -> acc -> acc)+  -> acc+  -> Tree (ann, a)+  -> Tree (acc, a)+applyWith f = mapAccum next+  where+    -- nextAcc = f ann acc+    next acc (ann, item) =+      let+        acc' = f ann acc+      in+        (acc', (acc', item))++{- |+  Transform a tree by combining branch-independent accumulator with node contents.+-}+{-# INLINEABLE mapAccum #-}+mapAccum+  :: (t -> a -> (t, b))+  -> t+  -> Tree a+  -> Tree b+mapAccum f acc (Node item children) =+  Node+    nextNode+    (map (mapAccum f nextAcc) children)+  where+    (nextAcc, nextNode) = f acc item++-- ** Shortcuts for monoidal annotation and Maybe-wrapped items++{-# INLINEABLE node_ #-}+node_ :: ann -> [Tree (ann, Maybe a)] -> Tree (ann, Maybe a)+node_ ann = Node (ann, Nothing)++{-# INLINEABLE leaf_ #-}+leaf_ :: Monoid ann => a -> Tree (ann, Maybe a)+leaf_ x = Node (mempty, Just x) []++collect_ :: Monoid ann => Tree (ann, Maybe a) -> [(ann, a)]+collect_ root = do+  (ann, Just item) <- toList $ apply root+  pure (ann, item)++-- * Adding annotations++{- |+  Annotate nodes with bottom-up monoidal summary.+-}+annotateMap+  :: Monoid ann+  => (a -> ann)+  -> Tree a+  -> Tree (ann, a)+annotateMap f =+  annotateWith f (\x anns -> f x <> mconcat anns)++{- |+  Annotate the nodes with bottom-up summary.+-}+annotateWith+  :: (a -> ann)+  -> (a -> [ann] -> ann)+  -> Tree a+  -> Tree (ann, a)+annotateWith leaf node = go+  where+    go (Node x ts) =+      case ts of+        [] ->+          Node (leaf x, x) []+        _ ->+          let+            inner = map go ts+          in+            Node+              ( node+                  x+                  (map (fst . rootLabel) inner)+              , x+              )+              inner