never executed always true always false
1 {-|
2 Copyright : Written by David Himmelstrup
3 License : Unlicense
4 Maintainer : lemmih@gmail.com
5 Stability : experimental
6 Portability : POSIX
7 -}
8 module Reanimate.Morph.Linear
9 ( linear, rawLinear
10 , closestLinearCorrespondence
11 , closestLinearCorrespondenceA
12 , linearTrajectory
13 ) where
14
15 import Data.Hashable
16 import qualified Data.Vector as V
17 import Linear.Vector
18 import Reanimate.ColorComponents
19 import Reanimate.Math.Common
20 import Reanimate.Math.Polygon
21 import Reanimate.Morph.Cache
22 import Reanimate.Morph.Common
23
24 -- | Linear interpolation strategy.
25 --
26 -- Example:
27 --
28 -- > playThenReverseA $ pauseAround 0.5 0.5 $ mkAnimation 3 $ \t ->
29 -- > withStrokeLineJoin JoinRound $
30 -- > let src = scale 8 $ center $ latex "X"
31 -- > dst = scale 8 $ center $ latex "H"
32 -- > in morph linear src dst t
33 --
34 -- <<docs/gifs/doc_linear.gif>>
35 linear :: Morph
36 linear = rawLinear
37 { morphPointCorrespondence =
38 cachePointCorrespondence (hash ("closest"::String))
39 closestLinearCorrespondence }
40
41 -- | Linear interpolation strategy without realigning corners.
42 -- May give better results if the polygons are already aligned.
43 -- Usually gives worse results.
44 --
45 -- Example:
46 --
47 -- > playThenReverseA $ pauseAround 0.5 0.5 $ mkAnimation 3 $ \t ->
48 -- > withStrokeLineJoin JoinRound $
49 -- > let src = scale 8 $ center $ latex "X"
50 -- > dst = scale 8 $ center $ latex "H"
51 -- > in morph rawLinear src dst t
52 --
53 -- <<docs/gifs/doc_rawLinear.gif>>
54 rawLinear :: Morph
55 rawLinear = Morph
56 { morphTolerance = 0.001
57 , morphColorComponents = labComponents
58 , morphPointCorrespondence = normalizePolygons
59 , morphTrajectory = linearTrajectory
60 , morphObjectCorrespondence = splitObjectCorrespondence }
61
62 -- | Cycle polygons until the sum of the point trajectory path lengths
63 -- is smallest.
64 closestLinearCorrespondence :: PointCorrespondence
65 closestLinearCorrespondence = closestLinearCorrespondenceA
66
67 -- | Cycle polygons until the sum of the point trajectory path lengths
68 -- is smallest.
69 closestLinearCorrespondenceA :: (Real a, Fractional a, Epsilon a) => APolygon a -> APolygon a -> (APolygon a, APolygon a)
70 closestLinearCorrespondenceA src' dst' =
71 (src, worker dst (score dst) options)
72 where
73 (src, dst) = normalizePolygons src' dst'
74 worker bestP _bestPScore [] = bestP
75 worker bestP bestPScore (x:xs) =
76 let newScore = score x in
77 if newScore < bestPScore
78 then worker x newScore xs
79 else worker bestP bestPScore xs
80 options = pCycles dst
81 score p = sum
82 [ -- approxDist (pAccess src n) (pAccess p n)
83 distSquared (pAccess src n) (pAccess p n)
84 | n <- [0 .. pSize src-1] ]
85
86 -- | Strategy for moving points in a linear (straight-line) trajectory.
87 linearTrajectory :: Trajectory
88 linearTrajectory (src,dst)
89 | pSize src == pSize dst = \t -> mkPolygon $
90 V.zipWith (lerp $ realToFrac t) (polygonPoints dst) (polygonPoints src)
91 | otherwise = error $ "Invalid lengths: " ++ show (pSize src, pSize dst)