{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies     #-}
{-# 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 []  = forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Bool -> Located (Trail' Line v n) -> Located (Trail v n)
closeIf Bool
closed forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n
emptyLine forall a. a -> Point (V a) (N a) -> Located a
`at` forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin
cubicSpline Bool
closed [Point v n
p] = forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Bool -> Located (Trail' Line v n) -> Located (Trail v n)
closeIf Bool
closed forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n
emptyLine forall a. a -> Point (V a) (N a) -> Located a
`at` Point v n
p
cubicSpline Bool
closed [Point v n]
ps  = [[v n]] -> t
flattenBeziers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Fractional a => [a] -> [a]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Bool -> [a] -> [[a]]
solveCubicSplineCoefficients Bool
closed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (g :: * -> *) a. Lens' (Point g a) (g a)
lensP) 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
3forall a. Num a => a -> a -> a
*a
aforall a. Num a => a -> a -> a
+a
b)forall a. Fractional a => a -> a -> a
/a
3, (a
3forall a. Num a => a -> a -> a
*a
aforall a. Num a => a -> a -> a
+a
2forall a. Num a => a -> a -> a
*a
bforall a. Num a => a -> a -> a
+a
c)forall a. Fractional a => a -> a -> a
/a
3, a
aforall a. Num a => a -> a -> a
+a
bforall a. Num a => a -> a -> a
+a
cforall a. Num a => a -> a -> a
+a
d]
    flattenBeziers :: [[v n]] -> t
flattenBeziers bs :: [[v n]]
bs@((v n
b:[v n]
_):[[v n]]
_)
      = forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Bool -> Located (Trail' Line v n) -> Located (Trail v n)
closeIf Bool
closed forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail' Line v n
lineFromSegments (forall a b. (a -> b) -> [a] -> [b]
map forall {v :: * -> *} {n}. Num (v n) => [v n] -> Segment Closed v n
bez [[v n]]
bs) forall a. a -> Point (V a) (N a) -> Located a
`at` 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] = forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 (v n
b forall a. Num a => a -> a -> a
- v n
a) (v n
c forall a. Num a => a -> a -> a
- v n
a) (v n
d 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 = forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc (if Bool
c then forall (v :: * -> *) n. Trail' Loop v n -> Trail v n
wrapLoop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Loop v n
glueLine else forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine)