never executed always true always false
1 {-# LANGUAGE FunctionalDependencies #-}
2 {-# LANGUAGE MultiParamTypeClasses #-}
3 {-# LANGUAGE UndecidableInstances #-}
4 {-|
5 Module : Reanimate.Internal.CubicBezier
6 Copyright : Written by David Himmelstrup
7 License : Unlicense
8 Maintainer : lemmih@gmail.com
9 Stability : experimental
10 Portability : POSIX
11
12 Convenience wrapper around 'Geom2D.CubicBezier'
13
14 -}
15 module Reanimate.Internal.CubicBezier
16 ( AnyBezier(..)
17 , CubicBezier(..)
18 , QuadBezier(..)
19 , OpenPath(..)
20 , ClosedPath(..)
21 , PathJoin(..)
22 , ClosedMetaPath(..)
23 , OpenMetaPath(..)
24 , MetaJoin(..)
25 , MetaNodeType(..)
26 , C.GenericBezier(..)
27 , C.FillRule(..)
28 , C.Tension(..)
29 , quadToCubic
30 , arcLength
31 , arcLengthParam
32 , C.splitBezier
33 , colinear
34 , evalBezier
35 , evalBezierDeriv
36 , bezierHoriz
37 , bezierVert
38 , C.bezierSubsegment
39 , C.reorient
40 , closedPathCurves
41 , openPathCurves
42 , curvesToClosed
43 , closest
44 , unmetaOpen
45 , unmetaClosed
46 , union
47 , bezierIntersection
48 , interpolateVector
49 , vectorDistance
50 , findBezierInflection
51 , findBezierCusp
52 ) where
53
54 import qualified Data.Vector.Unboxed as V
55 import qualified Geom2D.CubicBezier as C
56 import Linear.V2
57
58 ------------------------------------------------------------
59 -- Data types
60
61 -- | A bezier curve of any degree.
62 newtype AnyBezier a = AnyBezier (V.Vector (V2 a))
63
64 -- | A cubic bezier curve.
65 data CubicBezier a = CubicBezier
66 { cubicC0 :: !(V2 a)
67 , cubicC1 :: !(V2 a)
68 , cubicC2 :: !(V2 a)
69 , cubicC3 :: !(V2 a)
70 } deriving (Show, Eq)
71
72 -- | A quadratic bezier curve.
73 data QuadBezier a = QuadBezier
74 { quadC0 :: !(V2 a)
75 , quadC1 :: !(V2 a)
76 , quadC2 :: !(V2 a)
77 } deriving (Show, Eq)
78
79 data OpenPath a = OpenPath [(V2 a, PathJoin a)] (V2 a)
80 deriving (Show, Eq)
81 data ClosedPath a = ClosedPath [(V2 a, PathJoin a)]
82 deriving (Show, Eq)
83
84 data PathJoin a
85 = JoinLine
86 | JoinCurve (V2 a) (V2 a)
87 deriving (Show, Eq)
88
89 data ClosedMetaPath a = ClosedMetaPath [(V2 a, MetaJoin a)]
90 deriving (Show, Eq)
91 data OpenMetaPath a = OpenMetaPath [(V2 a, MetaJoin a)] (V2 a)
92 deriving (Show, Eq)
93
94 data MetaJoin a
95 = MetaJoin
96 { metaTypeL :: MetaNodeType a
97 , tensionL :: C.Tension a
98 , tensionR :: C.Tension a
99 , metaTypeR :: MetaNodeType a
100 }
101 | Controls (V2 a) (V2 a)
102 deriving (Show, Eq)
103
104 data MetaNodeType a
105 = Open
106 | Curl { curlgamma :: a }
107 | Direction { nodedir :: V2 a }
108 deriving (Show, Eq)
109
110 ------------------------------------------------------------
111 -- Methods
112
113 -- | Convert a quadratic bezier to a cubic bezier.
114 quadToCubic :: Fractional a => QuadBezier a -> CubicBezier a
115 quadToCubic = upCast . C.quadToCubic . downCast
116
117 -- | @arcLength c t tol@ finds the arclength of the bezier @c@ at @t@,
118 -- within given tolerance @tol@.
119 arcLength :: CubicBezier Double -> Double -> Double -> Double
120 arcLength bezier t tol = C.arcLength (downCast bezier) t tol
121
122 -- | @arcLengthParam c len tol@ finds the parameter where the curve @c@
123 -- has the arclength @len@, within tolerance @tol@.
124 arcLengthParam :: CubicBezier Double -> Double -> Double -> Double
125 arcLengthParam bezier t tol = C.arcLengthParam (downCast bezier) t tol
126
127 -- | Return @False@ if some points fall outside a line with a thickness of the given tolerance.
128 colinear :: CubicBezier Double -> Double -> Bool
129 colinear bezier tol = C.colinear (downCast bezier) tol
130
131 -- | Calculate a value on the bezier curve.
132 evalBezier :: (C.GenericBezier b, V.Unbox a, Fractional a) => b a -> a -> V2 a
133 evalBezier c p = upCast $ C.evalBezier c p
134
135 -- | Calculate a value and the first derivative on the curve.
136 evalBezierDeriv :: (V.Unbox a, Fractional a,C.GenericBezier b) => b a -> a -> (V2 a, V2 a)
137 evalBezierDeriv c p = upCast $ C.evalBezierDeriv c p
138
139 -- | Find the parameter where the bezier curve is horizontal.
140 bezierHoriz :: CubicBezier Double -> [Double]
141 bezierHoriz = C.bezierHoriz . downCast
142
143 -- | Find the parameter where the bezier curve is vertical.
144 bezierVert :: CubicBezier Double -> [Double]
145 bezierVert = C.bezierVert . downCast
146
147 -- | Create a normal path from a metapath.
148 unmetaOpen :: OpenMetaPath Double -> OpenPath Double
149 unmetaOpen = upCast . C.unmetaOpen . downCast
150
151 unmetaClosed :: ClosedMetaPath Double -> ClosedPath Double
152 unmetaClosed = upCast . C.unmetaClosed . downCast
153
154 -- | `O((n+m)*log(n+m))`, for n segments and m intersections.
155 -- Union of paths, removing overlap and rounding to the given tolerance.
156 union :: [ClosedPath Double] -> C.FillRule -> Double -> [ClosedPath Double]
157 union p fill tol = upCast (C.union (downCast p) fill tol)
158
159 -- | Find the intersections between two Bezier curves, using the Bezier Clip algorithm.
160 -- Returns the parameters for both curves.
161 bezierIntersection :: CubicBezier Double -> CubicBezier Double -> Double -> [(Double, Double)]
162 bezierIntersection a b t = C.bezierIntersection (downCast a) (downCast b) t
163
164 -- | Find the closest value on the bezier to the given point, within tolerance.
165 -- Return the first value found.
166 closest :: CubicBezier Double -> V2 Double -> Double -> Double
167 closest c p t = C.closest (downCast c) (downCast p) t
168
169 -- | Return the closed path as a list of curves.
170 closedPathCurves :: Fractional a => ClosedPath a -> [CubicBezier a]
171 closedPathCurves = upCast . C.closedPathCurves . downCast
172
173 -- | Return the open path as a list of curves.
174 openPathCurves :: Fractional a => OpenPath a -> [CubicBezier a]
175 openPathCurves = upCast . C.openPathCurves . downCast
176
177 -- | Make an open path from a list of curves. The last control point of each curve is ignored.
178 curvesToClosed :: [CubicBezier a] -> ClosedPath a
179 curvesToClosed = upCast . C.curvesToClosed . downCast
180
181 -- | Interpolate between two vectors.
182 interpolateVector :: Num a => V2 a -> V2 a -> a -> V2 a
183 interpolateVector a b p = upCast $ C.interpolateVector (downCast a) (downCast b) p
184
185 -- | Distance between two vectors.
186 vectorDistance :: Floating a => V2 a -> V2 a -> a
187 vectorDistance a b = C.vectorDistance (downCast a) (downCast b)
188
189 -- | Find inflection points on the curve.
190 findBezierInflection :: CubicBezier Double -> [Double]
191 findBezierInflection = C.findBezierInflection . downCast
192
193 -- | Find the cusps of a bezier.
194 findBezierCusp :: CubicBezier Double -> [Double]
195 findBezierCusp = C.findBezierCusp . downCast
196
197 ------------------------------------------------------------
198 -- Instances
199
200 instance C.GenericBezier QuadBezier where
201 degree = C.degree . downCast
202 toVector = C.toVector . downCast
203 unsafeFromVector = upCast . C.unsafeFromVector
204
205 instance C.GenericBezier CubicBezier where
206 degree = C.degree . downCast
207 toVector = C.toVector . downCast
208 unsafeFromVector = upCast . C.unsafeFromVector
209
210 instance C.GenericBezier AnyBezier where
211 degree = C.degree . downCast
212 toVector = C.toVector . downCast
213 unsafeFromVector = upCast . C.unsafeFromVector
214
215 ------------------------------------------------------------
216 -- Casting
217
218 class Cast a b | a -> b, b -> a where
219 downCast :: a -> b
220 upCast :: b -> a
221
222 instance Cast a b => Cast [a] [b] where
223 downCast = map downCast
224 upCast = map upCast
225
226 instance (Cast a a', Cast b b') => Cast (a,b) (a',b') where
227 downCast (a, b) = (downCast a, downCast b)
228 upCast (a, b) = (upCast a, upCast b)
229
230 instance Cast (V2 a) (C.Point a) where
231 downCast (V2 a b) = C.Point a b
232 upCast (C.Point a b) = V2 a b
233
234 instance Cast (CubicBezier a) (C.CubicBezier a) where
235 downCast (CubicBezier a b c d) = C.CubicBezier
236 (downCast a) (downCast b) (downCast c) (downCast d)
237 upCast (C.CubicBezier a b c d) = CubicBezier
238 (upCast a) (upCast b) (upCast c) (upCast d)
239
240 instance Cast (QuadBezier a) (C.QuadBezier a) where
241 downCast (QuadBezier a b c) = C.QuadBezier
242 (downCast a) (downCast b) (downCast c)
243 upCast (C.QuadBezier a b c)= QuadBezier
244 (upCast a) (upCast b) (upCast c)
245
246 instance V.Unbox a => Cast (AnyBezier a) (C.AnyBezier a) where
247 downCast (AnyBezier arr) = C.AnyBezier $
248 V.map (\(V2 a b) -> (a,b)) arr
249 upCast (C.AnyBezier arr) = AnyBezier $
250 V.map (\(a, b) -> V2 a b) arr
251
252 instance Cast (MetaNodeType a) (C.MetaNodeType a) where
253 downCast Open = C.Open
254 downCast (Curl gamma) = C.Curl gamma
255 downCast (Direction dir) = C.Direction (downCast dir)
256 upCast C.Open = Open
257 upCast (C.Curl gamma) = Curl gamma
258 upCast (C.Direction dir) = Direction (upCast dir)
259
260 instance Cast (MetaJoin a) (C.MetaJoin a) where
261 downCast (MetaJoin tyL tL tR tyR) = C.MetaJoin (downCast tyL) tL tR (downCast tyR)
262 downCast (Controls p1 p2) = C.Controls (downCast p1) (downCast p2)
263 upCast (C.MetaJoin tyL tL tR tyR) = MetaJoin (upCast tyL) tL tR (upCast tyR)
264 upCast (C.Controls p1 p2) = Controls (upCast p1) (upCast p2)
265
266 instance Cast (PathJoin a) (C.PathJoin a) where
267 downCast JoinLine = C.JoinLine
268 downCast (JoinCurve a b) = C.JoinCurve (downCast a) (downCast b)
269 upCast C.JoinLine = JoinLine
270 upCast (C.JoinCurve a b) = JoinCurve (upCast a) (upCast b)
271
272 instance Cast (OpenMetaPath a) (C.OpenMetaPath a) where
273 downCast (OpenMetaPath lst end) = C.OpenMetaPath
274 [ (downCast p, downCast j)
275 | (p, j) <- lst ] (downCast end)
276 upCast (C.OpenMetaPath lst end) = OpenMetaPath
277 [ (upCast p, upCast j)
278 | (p, j) <- lst ] (upCast end)
279
280 instance Cast (ClosedMetaPath a) (C.ClosedMetaPath a) where
281 downCast (ClosedMetaPath lst) = C.ClosedMetaPath
282 [ (downCast p, downCast j)
283 | (p, j) <- lst ]
284 upCast (C.ClosedMetaPath lst) = ClosedMetaPath
285 [ (upCast p, upCast j)
286 | (p, j) <- lst ]
287
288 instance Cast (OpenPath a) (C.OpenPath a) where
289 downCast (OpenPath lst end) = C.OpenPath
290 [ (downCast p, downCast j)
291 | (p, j) <- lst ] (downCast end)
292 upCast (C.OpenPath lst end) = OpenPath
293 [ (upCast p, upCast j)
294 | (p, j) <- lst ] (upCast end)
295
296 instance Cast (ClosedPath a) (C.ClosedPath a) where
297 downCast (ClosedPath lst) = C.ClosedPath
298 [ (downCast p, downCast j)
299 | (p, j) <- lst ]
300 upCast (C.ClosedPath lst) = ClosedPath
301 [ (upCast p, upCast j)
302 | (p, j) <- lst ]