Create flag for toggling hgeometry dependency. (#192)

This commit is contained in:
David Himmelstrup 2021-01-14 16:17:21 +08:00 committed by GitHub
commit 091f065e36
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
3 changed files with 58 additions and 9 deletions

View file

@ -37,6 +37,13 @@ Source-Repository head
Type: git Type: git
Location: git://github.com/lemmih/reanimate.git Location: git://github.com/lemmih/reanimate.git
flag no-hgeometry
description:
Disable all features that depend on hgeometry. Should only
be used when developing new hgeometry algorithms.
default: False
manual: True
library library
hs-source-dirs: src hs-source-dirs: src
if os(windows) if os(windows)
@ -105,6 +112,12 @@ library
Reanimate.Scene.Object Reanimate.Scene.Object
Detach Detach
autogen-modules: Paths_reanimate autogen-modules: Paths_reanimate
if flag(no-hgeometry)
ghc-options: -DNO_HGEOMETRY
else
build-depends:
hgeometry >=0.11.0.0,
hgeometry-combinatorial >=0.11.0.0
build-depends: build-depends:
base >=4.10 && <5, base >=4.10 && <5,
JuicyPixels >=3.3.3, JuicyPixels >=3.3.3,
@ -126,8 +139,6 @@ library
fsnotify >=0.3.0.1, fsnotify >=0.3.0.1,
geojson >=3.0.4, geojson >=3.0.4,
hashable >=1.3.0.0, hashable >=1.3.0.0,
hgeometry >=0.11.0.0,
hgeometry-combinatorial >=0.11.0.0,
lens >=4.16.1, lens >=4.16.1,
linear >=1.20.8, linear >=1.20.8,
matrix >=0.3.6.1, matrix >=0.3.6.1,

View file

@ -1,5 +1,6 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-} {-# OPTIONS_HADDOCK hide #-}
module Reanimate.Math.Triangulate module Reanimate.Math.Triangulate
( Triangulation ( Triangulation
@ -11,6 +12,32 @@ module Reanimate.Math.Triangulate
) )
where where
#if NO_HGEOMETRY
import qualified Data.Vector as V
import Control.Monad.ST
import Reanimate.Math.Common
type Triangulation = V.Vector [Int]
edgesToTriangulation :: Int -> [(Int, Int)] -> Triangulation
edgesToTriangulation = error "no hgeometry"
edgesToTriangulationM :: Int -> [(Int, Int)] -> ST s (V.MVector s [Int])
edgesToTriangulationM = error "no hgeometry"
trianglesToTriangulation :: Int -> V.Vector (Int, Int, Int) -> Triangulation
trianglesToTriangulation = error "no hgeometry"
trianglesToTriangulationM
:: Int -> V.Vector (Int, Int, Int) -> ST s (V.MVector s [Int])
trianglesToTriangulationM = error "no hgeometry"
triangulate :: forall a. (Fractional a, Ord a) => Ring a -> Triangulation
triangulate = error "no hgeometry"
#else
import Algorithms.Geometry.PolygonTriangulation.Triangulate (triangulate') import Algorithms.Geometry.PolygonTriangulation.Triangulate (triangulate')
import Algorithms.Geometry.PolygonTriangulation.Types import Algorithms.Geometry.PolygonTriangulation.Types
import Control.Lens import Control.Lens
@ -83,3 +110,5 @@ triangulate r = edgesToTriangulation (ringSize r) ds
[ Point2 x y :+ n [ Point2 x y :+ n
| (n,V2 x y) <- zip [0..] (V.toList (ringUnpack r)) ] | (n,V2 x y) <- zip [0..] (V.toList (ringUnpack r)) ]
-- ringUnpack -- ringUnpack
#endif

View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-| {-|
Module : Reanimate.PolyShape Module : Reanimate.PolyShape
Copyright : Written by David Himmelstrup Copyright : Written by David Himmelstrup
@ -40,15 +41,8 @@ module Reanimate.PolyShape
, plGroupTouching , plGroupTouching
) where ) where
import Algorithms.Geometry.PolygonTriangulation.Triangulate (triangulate')
import Control.Lens ((&), (.~), (^.)) import Control.Lens ((&), (.~), (^.))
import Data.Ext
import Data.Geometry.PlanarSubdivision (PolygonFaceData (..))
import qualified Data.Geometry.Point as Geo
import qualified Data.Geometry.Polygon as Geo
import Data.List (nub, partition, sortOn) import Data.List (nub, partition, sortOn)
import qualified Data.PlaneGraph as Geo
import Data.Proxy (Proxy (Proxy))
import qualified Data.Vector as V import qualified Data.Vector as V
import Geom2D.CubicBezier.Linear (ClosedPath (..), import Geom2D.CubicBezier.Linear (ClosedPath (..),
CubicBezier (..), CubicBezier (..),
@ -72,6 +66,17 @@ import Reanimate.Math.Polygon (Polygon,
pIsCCW) pIsCCW)
import Reanimate.Svg import Reanimate.Svg
#if !defined(NO_HGEOMETRY)
import Algorithms.Geometry.PolygonTriangulation.Triangulate (triangulate')
import Data.Ext
import Data.Geometry.PlanarSubdivision (PolygonFaceData (..))
import qualified Data.Geometry.Point as Geo
import qualified Data.Geometry.Polygon as Geo
import qualified Data.PlaneGraph as Geo
import Data.Proxy (Proxy (Proxy))
#endif
-- | Shape drawn by continuous line. May have overlap, may be convex. -- | Shape drawn by continuous line. May have overlap, may be convex.
newtype PolyShape = PolyShape { unPolyShape :: ClosedPath Double } newtype PolyShape = PolyShape { unPolyShape :: ClosedPath Double }
deriving (Show) deriving (Show)
@ -201,6 +206,9 @@ plDecompose' tol =
-- | Split polygon into smaller, convex polygons. -- | Split polygon into smaller, convex polygons.
decomposePolygon :: [RPoint] -> [[RPoint]] decomposePolygon :: [RPoint] -> [[RPoint]]
#if defined(NO_HGEOMETRY)
decomposePolygon = error "no hgeometry"
#else
decomposePolygon poly = decomposePolygon poly =
[ [ V2 x y [ [ V2 x y
| v <- V.toList (Geo.boundaryVertices f pg) | v <- V.toList (Geo.boundaryVertices f pg)
@ -212,6 +220,7 @@ decomposePolygon poly =
p = Geo.fromPoints $ p = Geo.fromPoints $
[ Geo.Point2 x y :+ () [ Geo.Point2 x y :+ ()
| V2 x y <- poly ] | V2 x y <- poly ]
#endif
plPolygonify :: Double -> PolyShape -> [RPoint] plPolygonify :: Double -> PolyShape -> [RPoint]
plPolygonify tol shape = plPolygonify tol shape =