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 -- @
29 -- 'Reanimate.playThenReverseA' $ 'Reanimate.pauseAround' 0.5 0.5 $ 'Reanimate.mkAnimation' 3 $ \\t ->
30 -- 'Reanimate.withStrokeLineJoin' 'Graphics.SvgTree.JoinRound' $
31 -- let src = 'Reanimate.scale' 8 $ 'Reanimate.center' $ 'Reanimate.LaTeX.latex' \"X\"
32 -- dst = 'Reanimate.scale' 8 $ 'Reanimate.center' $ 'Reanimate.LaTeX.latex' \"H\"
33 -- in 'morph' 'linear' src dst t
34 -- @
35 --
36 -- <<docs/gifs/doc_linear.gif>>
37 linear :: Morph
38 linear = rawLinear
39 { morphPointCorrespondence =
40 cachePointCorrespondence (hash ("closest"::String))
41 closestLinearCorrespondence }
42
43 -- | Linear interpolation strategy without realigning corners.
44 -- May give better results if the polygons are already aligned.
45 -- Usually gives worse results.
46 --
47 -- Example:
48 --
49 -- @
50 -- 'Reanimate.playThenReverseA' $ 'Reanimate.pauseAround' 0.5 0.5 $ 'Reanimate.mkAnimation' 3 $ \\t ->
51 -- 'Reanimate.withStrokeLineJoin' 'Graphics.SvgTree.JoinRound' $
52 -- let src = 'Reanimate.scale' 8 $ 'Reanimate.center' $ 'Reanimate.LaTeX.latex' \"X\"
53 -- dst = 'Reanimate.scale' 8 $ 'Reanimate.center' $ 'Reanimate.LaTeX.latex' \"H\"
54 -- in 'morph' 'rawLinear' src dst t
55 -- @
56 --
57 -- <<docs/gifs/doc_rawLinear.gif>>
58 rawLinear :: Morph
59 rawLinear = Morph
60 { morphTolerance = 0.001
61 , morphColorComponents = labComponents
62 , morphPointCorrespondence = normalizePolygons
63 , morphTrajectory = linearTrajectory
64 , morphObjectCorrespondence = splitObjectCorrespondence }
65
66 -- | Cycle polygons until the sum of the point trajectory path lengths
67 -- is smallest.
68 closestLinearCorrespondence :: PointCorrespondence
69 closestLinearCorrespondence = closestLinearCorrespondenceA
70
71 -- | Cycle polygons until the sum of the point trajectory path lengths
72 -- is smallest.
73 closestLinearCorrespondenceA :: (Real a, Fractional a, Epsilon a) => APolygon a -> APolygon a -> (APolygon a, APolygon a)
74 closestLinearCorrespondenceA src' dst' =
75 (src, worker dst (score dst) options)
76 where
77 (src, dst) = normalizePolygons src' dst'
78 worker bestP _bestPScore [] = bestP
79 worker bestP bestPScore (x:xs) =
80 let newScore = score x in
81 if newScore < bestPScore
82 then worker x newScore xs
83 else worker bestP bestPScore xs
84 options = pCycles dst
85 score p = sum
86 [ -- approxDist (pAccess src n) (pAccess p n)
87 distSquared (pAccess src n) (pAccess p n)
88 | n <- [0 .. pSize src-1] ]
89
90 -- | Strategy for moving points in a linear (straight-line) trajectory.
91 linearTrajectory :: Trajectory
92 linearTrajectory (src,dst)
93 | pSize src == pSize dst = \t -> mkPolygon $
94 V.zipWith (lerp $ realToFrac t) (polygonPoints dst) (polygonPoints src)
95 | otherwise = error $ "Invalid lengths: " ++ show (pSize src, pSize dst)