{-|
Copyright   : Written by David Himmelstrup
License     : Unlicense
Maintainer  : lemmih@gmail.com
Stability   : experimental
Portability : POSIX
-}
module Reanimate.Morph.Linear
  ( linear, rawLinear
  , closestLinearCorrespondence
  , closestLinearCorrespondenceA
  , linearTrajectory
  ) where

import           Data.Hashable
import qualified Data.Vector            as V
import           Linear.Vector
import           Reanimate.ColorComponents
import           Reanimate.Math.Common
import           Reanimate.Math.Polygon
import           Reanimate.Morph.Cache
import           Reanimate.Morph.Common

-- | Linear interpolation strategy.
--
--   Example:
--
-- @
-- 'Reanimate.playThenReverseA' $ 'Reanimate.pauseAround' 0.5 0.5 $ 'Reanimate.mkAnimation' 3 $ \\t ->
--   'Reanimate.withStrokeLineJoin' 'Graphics.SvgTree.JoinRound' $
--   let src = 'Reanimate.scale' 8 $ 'Reanimate.center' $ 'Reanimate.LaTeX.latex' \"X\"
--       dst = 'Reanimate.scale' 8 $ 'Reanimate.center' $ 'Reanimate.LaTeX.latex' \"H\"
--   in 'morph' 'linear' src dst t
-- @
--
--   <<docs/gifs/doc_linear.gif>>
linear :: Morph
linear :: Morph
linear = Morph
rawLinear
  { morphPointCorrespondence :: PointCorrespondence
morphPointCorrespondence  =
      Int -> PointCorrespondence -> PointCorrespondence
cachePointCorrespondence (String -> Int
forall a. Hashable a => a -> Int
hash (String
"closest"::String))
        PointCorrespondence
closestLinearCorrespondence }

-- | Linear interpolation strategy without realigning corners.
--   May give better results if the polygons are already aligned.
--   Usually gives worse results.
--
--   Example:
--
-- @
-- 'Reanimate.playThenReverseA' $ 'Reanimate.pauseAround' 0.5 0.5 $ 'Reanimate.mkAnimation' 3 $ \\t ->
--   'Reanimate.withStrokeLineJoin' 'Graphics.SvgTree.JoinRound' $
--   let src = 'Reanimate.scale' 8 $ 'Reanimate.center' $ 'Reanimate.LaTeX.latex' \"X\"
--       dst = 'Reanimate.scale' 8 $ 'Reanimate.center' $ 'Reanimate.LaTeX.latex' \"H\"
--   in 'morph' 'rawLinear' src dst t
-- @
--
--   <<docs/gifs/doc_rawLinear.gif>>
rawLinear :: Morph
rawLinear :: Morph
rawLinear = Morph :: Double
-> ColorComponents
-> PointCorrespondence
-> Trajectory
-> ObjectCorrespondence
-> Morph
Morph
  { morphTolerance :: Double
morphTolerance            = Double
0.001
  , morphColorComponents :: ColorComponents
morphColorComponents      = ColorComponents
labComponents
  , morphPointCorrespondence :: PointCorrespondence
morphPointCorrespondence  = PointCorrespondence
forall a.
(Real a, Fractional a, Epsilon a) =>
APolygon a -> APolygon a -> (APolygon a, APolygon a)
normalizePolygons
  , morphTrajectory :: Trajectory
morphTrajectory           = Trajectory
linearTrajectory
  , morphObjectCorrespondence :: ObjectCorrespondence
morphObjectCorrespondence = ObjectCorrespondence
splitObjectCorrespondence }

-- | Cycle polygons until the sum of the point trajectory path lengths
--   is smallest.
closestLinearCorrespondence :: PointCorrespondence
closestLinearCorrespondence :: PointCorrespondence
closestLinearCorrespondence = PointCorrespondence
forall a.
(Real a, Fractional a, Epsilon a) =>
APolygon a -> APolygon a -> (APolygon a, APolygon a)
closestLinearCorrespondenceA

-- | Cycle polygons until the sum of the point trajectory path lengths
--   is smallest.
closestLinearCorrespondenceA :: (Real a, Fractional a, Epsilon a) => APolygon a -> APolygon a -> (APolygon a, APolygon a)
closestLinearCorrespondenceA :: APolygon a -> APolygon a -> (APolygon a, APolygon a)
closestLinearCorrespondenceA APolygon a
src' APolygon a
dst' =
    (APolygon a
src, APolygon a -> a -> [APolygon a] -> APolygon a
worker APolygon a
dst (APolygon a -> a
score APolygon a
dst) [APolygon a]
options)
  where
    (APolygon a
src, APolygon a
dst) = APolygon a -> APolygon a -> (APolygon a, APolygon a)
forall a.
(Real a, Fractional a, Epsilon a) =>
APolygon a -> APolygon a -> (APolygon a, APolygon a)
normalizePolygons APolygon a
src' APolygon a
dst'
    worker :: APolygon a -> a -> [APolygon a] -> APolygon a
worker APolygon a
bestP a
_bestPScore [] = APolygon a
bestP
    worker APolygon a
bestP a
bestPScore (APolygon a
x:[APolygon a]
xs) =
      let newScore :: a
newScore = APolygon a -> a
score APolygon a
x in
      if a
newScore a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
bestPScore
        then APolygon a -> a -> [APolygon a] -> APolygon a
worker APolygon a
x a
newScore [APolygon a]
xs
        else APolygon a -> a -> [APolygon a] -> APolygon a
worker APolygon a
bestP a
bestPScore [APolygon a]
xs
    options :: [APolygon a]
options = APolygon a -> [APolygon a]
forall a. APolygon a -> [APolygon a]
pCycles APolygon a
dst
    score :: APolygon a -> a
score APolygon a
p = [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
      [ -- approxDist (pAccess src n) (pAccess p n)
        V2 a -> V2 a -> a
forall a. Num a => V2 a -> V2 a -> a
distSquared (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
src Int
n) (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
n)
      | Int
n <- [Int
0 .. APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
srcInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]

-- | Strategy for moving points in a linear (straight-line) trajectory.
linearTrajectory :: Trajectory
linearTrajectory :: Trajectory
linearTrajectory (Polygon
src,Polygon
dst)
  | Polygon -> Int
forall a. APolygon a -> Int
pSize Polygon
src Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Polygon -> Int
forall a. APolygon a -> Int
pSize Polygon
dst = \Double
t -> Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$
    (V2 Rational -> V2 Rational -> V2 Rational)
-> Vector (V2 Rational)
-> Vector (V2 Rational)
-> Vector (V2 Rational)
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith (Rational -> V2 Rational -> V2 Rational -> V2 Rational
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp (Rational -> V2 Rational -> V2 Rational -> V2 Rational)
-> Rational -> V2 Rational -> V2 Rational -> V2 Rational
forall a b. (a -> b) -> a -> b
$ Double -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
t) (Polygon -> Vector (V2 Rational)
forall a. APolygon a -> Vector (V2 a)
polygonPoints Polygon
dst) (Polygon -> Vector (V2 Rational)
forall a. APolygon a -> Vector (V2 a)
polygonPoints Polygon
src)
  | Bool
otherwise = String -> Double -> Polygon
forall a. HasCallStack => String -> a
error (String -> Double -> Polygon) -> String -> Double -> Polygon
forall a b. (a -> b) -> a -> b
$ String
"Invalid lengths: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Polygon -> Int
forall a. APolygon a -> Int
pSize Polygon
src, Polygon -> Int
forall a. APolygon a -> Int
pSize Polygon
dst)