{-# LANGUAGE ConstraintKinds  #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies     #-}
{-# LANGUAGE TypeOperators    #-}

{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.CubicSpline
-- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- A /cubic spline/ is a smooth, connected sequence of cubic curves.
-- This module provides two methods for constructing splines.
--
-- The 'cubicSpline' method can be used to create closed or open cubic
-- splines from a list of points. The resulting splines /pass through/
-- all the control points, but depend on the control points in a
-- "global" way (that is, changing one control point may alter the
-- entire curve).  For access to the internals of the spline
-- generation algorithm, see "Diagrams.CubicSpline.Internal".
--
-- 'bspline' creates a cubic B-spline, which starts and ends at the
-- first and last control points, but does not necessarily pass
-- through any of the other control points.  It depends on the control
-- points in a "local" way, that is, changing one control point will
-- only affect a local portion of the curve near that control point.
--
-----------------------------------------------------------------------------
module Diagrams.CubicSpline
       (
         -- * Constructing paths from cubic splines
         cubicSpline
       , BSpline
       , bspline
       ) where

import           Control.Lens                  (view)

import           Diagrams.Core
import           Diagrams.CubicSpline.Boehm
import           Diagrams.CubicSpline.Internal
import           Diagrams.Located              (Located, at, mapLoc)
import           Diagrams.Segment
import           Diagrams.Trail
import           Diagrams.TrailLike            (TrailLike (..))

import           Linear.Affine
import           Linear.Metric

-- | Construct a spline path-like thing of cubic segments from a list of
--   vertices, with the first vertex as the starting point.  The first
--   argument specifies whether the path should be closed.
--
--   <<diagrams/src_Diagrams_CubicSpline_cubicSplineEx.svg#diagram=cubicSplineEx&width=600>>
--
--   > pts = map p2 [(0,0), (2,3), (5,-2), (-4,1), (0,3)]
--   > spot = circle 0.2 # fc blue # lw none
--   > mkPath closed = position (zip pts (repeat spot))
--   >              <> cubicSpline closed pts
--   > cubicSplineEx = (mkPath False ||| strutX 2 ||| mkPath True)
--   >               # centerXY # pad 1.1
--
--   For more information, see <http://mathworld.wolfram.com/CubicSpline.html>.
cubicSpline :: (V t ~ v, N t ~ n, TrailLike t, Fractional (v n)) => Bool -> [Point v n] -> t
cubicSpline :: forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t, Fractional (v n)) =>
Bool -> [Point v n] -> t
cubicSpline Bool
closed []  = Located (Trail v n) -> t
Located (Trail (V t) (N t)) -> t
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail v n) -> t)
-> (Located (Trail' Line v n) -> Located (Trail v n))
-> Located (Trail' Line v n)
-> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Located (Trail' Line v n) -> Located (Trail v n)
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Bool -> Located (Trail' Line v n) -> Located (Trail v n)
closeIf Bool
closed (Located (Trail' Line v n) -> t) -> Located (Trail' Line v n) -> t
forall a b. (a -> b) -> a -> b
$ Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n
emptyLine Trail' Line v n
-> Point (V (Trail' Line v n)) (N (Trail' Line v n))
-> Located (Trail' Line v n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point v n
Point (V (Trail' Line v n)) (N (Trail' Line v n))
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin
cubicSpline Bool
closed [Point v n
p] = Located (Trail v n) -> t
Located (Trail (V t) (N t)) -> t
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail v n) -> t)
-> (Located (Trail' Line v n) -> Located (Trail v n))
-> Located (Trail' Line v n)
-> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Located (Trail' Line v n) -> Located (Trail v n)
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Bool -> Located (Trail' Line v n) -> Located (Trail v n)
closeIf Bool
closed (Located (Trail' Line v n) -> t) -> Located (Trail' Line v n) -> t
forall a b. (a -> b) -> a -> b
$ Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n
emptyLine Trail' Line v n
-> Point (V (Trail' Line v n)) (N (Trail' Line v n))
-> Located (Trail' Line v n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point v n
Point (V (Trail' Line v n)) (N (Trail' Line v n))
p
cubicSpline Bool
closed [Point v n]
ps  = [[v n]] -> t
flattenBeziers ([[v n]] -> t) -> ([Point v n] -> [[v n]]) -> [Point v n] -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([v n] -> [v n]) -> [[v n]] -> [[v n]]
forall a b. (a -> b) -> [a] -> [b]
map [v n] -> [v n]
forall {a}. Fractional a => [a] -> [a]
f ([[v n]] -> [[v n]])
-> ([Point v n] -> [[v n]]) -> [Point v n] -> [[v n]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [v n] -> [[v n]]
forall a. Fractional a => Bool -> [a] -> [[a]]
solveCubicSplineCoefficients Bool
closed ([v n] -> [[v n]])
-> ([Point v n] -> [v n]) -> [Point v n] -> [[v n]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point v n -> v n) -> [Point v n] -> [v n]
forall a b. (a -> b) -> [a] -> [b]
map (Getting (v n) (Point v n) (v n) -> Point v n -> v n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (v n) (Point v n) (v n)
forall (f1 :: * -> *) a (g :: * -> *) b (f2 :: * -> *).
Functor f2 =>
(f1 a -> f2 (g b)) -> Point f1 a -> f2 (Point g b)
lensP) ([Point v n] -> t) -> [Point v n] -> t
forall a b. (a -> b) -> a -> b
$ [Point v n]
ps
  where
    f :: [a] -> [a]
f [a
a,a
b,a
c,a
d] = [a
a, (a
3a -> a -> a
forall a. Num a => a -> a -> a
*a
aa -> a -> a
forall a. Num a => a -> a -> a
+a
b)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
3, (a
3a -> a -> a
forall a. Num a => a -> a -> a
*a
aa -> a -> a
forall a. Num a => a -> a -> a
+a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
ba -> a -> a
forall a. Num a => a -> a -> a
+a
c)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
3, a
aa -> a -> a
forall a. Num a => a -> a -> a
+a
ba -> a -> a
forall a. Num a => a -> a -> a
+a
ca -> a -> a
forall a. Num a => a -> a -> a
+a
d]
    flattenBeziers :: [[v n]] -> t
flattenBeziers bs :: [[v n]]
bs@((v n
b:[v n]
_):[[v n]]
_)
      = Located (Trail v n) -> t
Located (Trail (V t) (N t)) -> t
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail v n) -> t)
-> (Located (Trail' Line v n) -> Located (Trail v n))
-> Located (Trail' Line v n)
-> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Located (Trail' Line v n) -> Located (Trail v n)
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Bool -> Located (Trail' Line v n) -> Located (Trail v n)
closeIf Bool
closed (Located (Trail' Line v n) -> t) -> Located (Trail' Line v n) -> t
forall a b. (a -> b) -> a -> b
$ [Segment Closed v n] -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail' Line v n
lineFromSegments (([v n] -> Segment Closed v n) -> [[v n]] -> [Segment Closed v n]
forall a b. (a -> b) -> [a] -> [b]
map [v n] -> Segment Closed v n
forall {v :: * -> *} {n}. Num (v n) => [v n] -> Segment Closed v n
bez [[v n]]
bs) Trail' Line v n
-> Point (V (Trail' Line v n)) (N (Trail' Line v n))
-> Located (Trail' Line v n)
forall a. a -> Point (V a) (N a) -> Located a
`at` v n -> Point v n
forall (f :: * -> *) a. f a -> Point f a
P v n
b
    bez :: [v n] -> Segment Closed v n
bez [v n
a,v n
b,v n
c,v n
d] = v n -> v n -> v n -> Segment Closed v n
forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 (v n
b v n -> v n -> v n
forall a. Num a => a -> a -> a
- v n
a) (v n
c v n -> v n -> v n
forall a. Num a => a -> a -> a
- v n
a) (v n
d v n -> v n -> v n
forall a. Num a => a -> a -> a
- v n
a)

closeIf :: (Metric v, OrderedField n)
        => Bool -> Located (Trail' Line v n) -> Located (Trail v n)
closeIf :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Bool -> Located (Trail' Line v n) -> Located (Trail v n)
closeIf Bool
c = (Trail' Line v n -> Trail v n)
-> Located (Trail' Line v n) -> Located (Trail v n)
forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc (if Bool
c then Trail' Loop v n -> Trail v n
forall (v :: * -> *) n. Trail' Loop v n -> Trail v n
wrapLoop (Trail' Loop v n -> Trail v n)
-> (Trail' Line v n -> Trail' Loop v n)
-> Trail' Line v n
-> Trail v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> Trail' Loop v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Loop v n
glueLine else Trail' Line v n -> Trail v n
forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine)