{-|
Copyright   : Written by David Himmelstrup
License     : Unlicense
Maintainer  : lemmih@gmail.com
Stability   : experimental
Portability : POSIX
-}
module Reanimate.Morph.Rotational
  ( Origin
  , rotationalTrajectory
  , polygonOrigin
  ) where

import qualified Data.Vector            as V
import           Linear.Vector
import           Linear.V2
import           Linear.Metric

import           Reanimate.Ease
import           Reanimate.Morph.Common
import           Reanimate.Math.Polygon

-- | Rotational origin relative to polygon center.
--   (0.5, 0.5) is center of polygon. Top right is (1,1) and
--   bottom left is (0,0)
type Origin = (Double, Double)

-- | Interpolation by rotating around an origin point.
--
--   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' 'Reanimate.Morph.Linear.linear'{'morphTrajectory'='rotationalTrajectory' (0.5,0.5)} src dst t
-- @
--
--   <<docs/gifs/doc_rotationalTrajectory.gif>>
rotationalTrajectory :: Origin -> Trajectory
rotationalTrajectory :: Origin -> Trajectory
rotationalTrajectory Origin
origin (Polygon
src,Polygon
dst) =
    \Double
t ->
      let thisOrigin :: V2 Double
thisOrigin = Double -> V2 Double -> V2 Double -> V2 Double
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp Double
t V2 Double
dstOrigin V2 Double
srcOrigin in
      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
$
      Int -> (Int -> V2 Rational) -> Vector (V2 Rational)
forall a. Int -> (Int -> a) -> Vector a
V.generate (Polygon -> Int
forall a. APolygon a -> Int
pSize Polygon
src) ((Int -> V2 Rational) -> Vector (V2 Rational))
-> (Int -> V2 Rational) -> Vector (V2 Rational)
forall a b. (a -> b) -> a -> b
$ \Int
i ->
        let len :: Double
len = Double -> Double -> Signal
fromToS (Vector Double
srcLengths Vector Double -> Int -> Double
forall a. Vector a -> Int -> a
V.! Int
i) (Vector Double
dstLengths Vector Double -> Int -> Double
forall a. Vector a -> Int -> a
V.! Int
i) Double
t
            ang :: Double
ang = Double -> Double -> Signal
lerpAngle (Vector Double
srcAngles Vector Double -> Int -> Double
forall a. Vector a -> Int -> a
V.! Int
i) (Vector Double
dstAngles Vector Double -> Int -> Double
forall a. Vector a -> Int -> a
V.! Int
i) Double
t
        in Double -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Rational) -> V2 Double -> V2 Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (V2 Double
thisOrigin V2 Double -> V2 Double -> V2 Double
forall a. Num a => a -> a -> a
+ Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (Signal
forall a. Floating a => a -> a
cos Double
ang Double -> Signal
forall a. Num a => a -> a -> a
* Double
len) (Signal
forall a. Floating a => a -> a
sin Double
ang Double -> Signal
forall a. Num a => a -> a -> a
* Double
len))
  where
    srcOrigin :: V2 Double
srcOrigin = Polygon -> Origin -> V2 Double
polygonOrigin Polygon
src Origin
origin
    dstOrigin :: V2 Double
dstOrigin = Polygon -> Origin -> V2 Double
polygonOrigin Polygon
dst Origin
origin
    srcLengths :: V.Vector Double
    srcLengths :: Vector Double
srcLengths = (V2 Rational -> Double) -> Vector (V2 Rational) -> Vector Double
forall a b. (a -> b) -> Vector a -> Vector b
V.map (V2 Double -> V2 Double -> Double
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a -> a
distance V2 Double
srcOrigin (V2 Double -> Double)
-> (V2 Rational -> V2 Double) -> V2 Rational -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Double) -> V2 Rational -> V2 Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac) (Vector (V2 Rational) -> Vector Double)
-> Vector (V2 Rational) -> Vector Double
forall a b. (a -> b) -> a -> b
$ Polygon -> Vector (V2 Rational)
forall a. APolygon a -> Vector (V2 a)
polygonPoints Polygon
src
    dstLengths :: Vector Double
dstLengths = (V2 Rational -> Double) -> Vector (V2 Rational) -> Vector Double
forall a b. (a -> b) -> Vector a -> Vector b
V.map (V2 Double -> V2 Double -> Double
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a -> a
distance V2 Double
dstOrigin (V2 Double -> Double)
-> (V2 Rational -> V2 Double) -> V2 Rational -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Double) -> V2 Rational -> V2 Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac) (Vector (V2 Rational) -> Vector Double)
-> Vector (V2 Rational) -> Vector Double
forall a b. (a -> b) -> a -> b
$ Polygon -> Vector (V2 Rational)
forall a. APolygon a -> Vector (V2 a)
polygonPoints Polygon
dst
    srcAngles :: Vector Double
srcAngles = (V2 Rational -> Double) -> Vector (V2 Rational) -> Vector Double
forall a b. (a -> b) -> Vector a -> Vector b
V.map (V2 Double -> V2 Double -> Double
originAngle V2 Double
srcOrigin (V2 Double -> Double)
-> (V2 Rational -> V2 Double) -> V2 Rational -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Double) -> V2 Rational -> V2 Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac) (Vector (V2 Rational) -> Vector Double)
-> Vector (V2 Rational) -> Vector Double
forall a b. (a -> b) -> a -> b
$ Polygon -> Vector (V2 Rational)
forall a. APolygon a -> Vector (V2 a)
polygonPoints Polygon
src
    dstAngles :: Vector Double
dstAngles = (V2 Rational -> Double) -> Vector (V2 Rational) -> Vector Double
forall a b. (a -> b) -> Vector a -> Vector b
V.map (V2 Double -> V2 Double -> Double
originAngle V2 Double
dstOrigin (V2 Double -> Double)
-> (V2 Rational -> V2 Double) -> V2 Rational -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Double) -> V2 Rational -> V2 Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac) (Vector (V2 Rational) -> Vector Double)
-> Vector (V2 Rational) -> Vector Double
forall a b. (a -> b) -> a -> b
$ Polygon -> Vector (V2 Rational)
forall a. APolygon a -> Vector (V2 a)
polygonPoints Polygon
dst

    originAngle :: V2 Double -> V2 Double -> Double
originAngle V2 Double
o = V2 Double -> V2 Double -> V2 Double -> Double
lineAngle (V2 Double
o V2 Double -> V2 Double -> V2 Double
forall a. Num a => a -> a -> a
+ Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 Double
1 Double
0) V2 Double
o

-- | Compute the absolute position of rotational origin point in polygon.
polygonOrigin :: Polygon -> Origin -> V2 Double
polygonOrigin :: Polygon -> Origin -> V2 Double
polygonOrigin Polygon
poly (Double
originX, Double
originY) =
  case Polygon -> (Rational, Rational, Rational, Rational)
pBoundingBox Polygon
poly of
    (Rational
polyX, Rational
polyY, Rational
polyWidth, Rational
polyHeight) ->
      Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (Rational -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Rational
polyX Double -> Signal
forall a. Num a => a -> a -> a
+ Rational -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Rational
polyWidth Double -> Signal
forall a. Num a => a -> a -> a
* Double
originX)
         (Rational -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Rational
polyY Double -> Signal
forall a. Num a => a -> a -> a
+ Rational -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Rational
polyHeight Double -> Signal
forall a. Num a => a -> a -> a
* Double
originY)


lerpAngle :: Double -> Double -> Double -> Double
lerpAngle :: Double -> Double -> Signal
lerpAngle Double
fromAng Double
toAng Double
t
  | Signal
forall a. Num a => a -> a
abs (Double
fromAng Double -> Signal
forall a. Num a => a -> a -> a
- (Double
toAngDouble -> Signal
forall a. Num a => a -> a -> a
+Double
2Double -> Signal
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi)) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Signal
forall a. Num a => a -> a
abs (Double
fromAng Double -> Signal
forall a. Num a => a -> a -> a
- Double
toAng) = (Double
1Double -> Signal
forall a. Num a => a -> a -> a
-Double
t)Double -> Signal
forall a. Num a => a -> a -> a
*Double
fromAng Double -> Signal
forall a. Num a => a -> a -> a
+ Double
tDouble -> Signal
forall a. Num a => a -> a -> a
*(Double
toAngDouble -> Signal
forall a. Num a => a -> a -> a
+Double
2Double -> Signal
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi)
  | Signal
forall a. Num a => a -> a
abs (Double
fromAng Double -> Signal
forall a. Num a => a -> a -> a
- (Double
toAngDouble -> Signal
forall a. Num a => a -> a -> a
-Double
2Double -> Signal
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi)) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Signal
forall a. Num a => a -> a
abs (Double
fromAng Double -> Signal
forall a. Num a => a -> a -> a
- Double
toAng) = (Double
1Double -> Signal
forall a. Num a => a -> a -> a
-Double
t)Double -> Signal
forall a. Num a => a -> a -> a
*Double
fromAng Double -> Signal
forall a. Num a => a -> a -> a
+ Double
tDouble -> Signal
forall a. Num a => a -> a -> a
*(Double
toAngDouble -> Signal
forall a. Num a => a -> a -> a
-Double
2Double -> Signal
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi)
  | Bool
otherwise = (Double
1Double -> Signal
forall a. Num a => a -> a -> a
-Double
t)Double -> Signal
forall a. Num a => a -> a -> a
*Double
fromAng Double -> Signal
forall a. Num a => a -> a -> a
+ Double
tDouble -> Signal
forall a. Num a => a -> a -> a
*Double
toAng

-- Angle from a through b to c.
lineAngle :: V2 Double -> V2 Double -> V2 Double -> Double
lineAngle :: V2 Double -> V2 Double -> V2 Double -> Double
lineAngle V2 Double
a V2 Double
b V2 Double
c = V2 Double -> V2 Double -> Double
angle' (V2 Double
aV2 Double -> V2 Double -> V2 Double
forall a. Num a => a -> a -> a
-V2 Double
b) (V2 Double
cV2 Double -> V2 Double -> V2 Double
forall a. Num a => a -> a -> a
-V2 Double
b)

angle' :: V2 Double -> V2 Double -> Double
angle' :: V2 Double -> V2 Double -> Double
angle' V2 Double
a V2 Double
b = Double -> Signal
forall a. RealFloat a => a -> a -> a
atan2 (V2 Double -> V2 Double -> Double
forall a. Num a => V2 a -> V2 a -> a
crossZ V2 Double
a V2 Double
b) (V2 Double -> V2 Double -> Double
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
dot V2 Double
a V2 Double
b)