{-# 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 Data.List.NonEmpty (NonEmpty (..))
import Diagrams.CubicSpline.NonSingleton (NonSingleton (..))

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
p1 : Point v n
p2 : [Point v n]
ps) = [[v n]] -> t
flattenBeziers ([[v n]] -> t)
-> (NonSingleton (Point v n) -> [[v n]])
-> NonSingleton (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]])
-> (NonSingleton (Point v n) -> [[v n]])
-> NonSingleton (Point v n)
-> [[v n]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> NonSingleton (v n) -> [[v n]]
forall a. Fractional a => Bool -> NonSingleton a -> [[a]]
solveCubicSplineCoefficients Bool
closed (NonSingleton (v n) -> [[v n]])
-> (NonSingleton (Point v n) -> NonSingleton (v n))
-> NonSingleton (Point v n)
-> [[v n]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point v n -> v n)
-> NonSingleton (Point v n) -> NonSingleton (v n)
forall a b. (a -> b) -> NonSingleton a -> NonSingleton b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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) (NonSingleton (Point v n) -> t) -> NonSingleton (Point v n) -> t
forall a b. (a -> b) -> a -> b
$ (Point v n
p1 Point v n -> NonEmpty (Point v n) -> NonSingleton (Point v n)
forall a. a -> NonEmpty a -> NonSingleton a
:|| (Point v n
p2 Point v n -> [Point v n] -> NonEmpty (Point v n)
forall a. a -> [a] -> NonEmpty a
:| [Point v n]
ps))
 where
  f :: [a] -> [a]
f [a
a, a
b, a
c, a
d] = [a
a, (a
3 a -> a -> a
forall a. Num a => a -> a -> a
* a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
3, (a
3 a -> a -> a
forall a. Num a => a -> a -> a
* a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
c) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
3, a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
c a -> 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)