```{-# LANGUAGE TypeFamilies               #-}
{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Wumpus.Drawing.Basis.BezierCurve
-- Copyright   :  (c) Stephen Tetley 2011
--
-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
-- Stability   :  highly unstable
-- Portability :  GHC
--
-- Datatype for cubic Bezier curve.
--
--------------------------------------------------------------------------------

module Wumpus.Drawing.Basis.BezierCurve
(

BezierCurve(..)
, vbezierCurve
, subdivide
, subdividet

, bezierLength

) where

import Wumpus.Drawing.Basis.Geometry

import Wumpus.Core                              -- package: wumpus-core

import Data.AffineSpace                         -- package: vector-space

--------------------------------------------------------------------------------

-- | A Strict cubic Bezier curve.
--
data BezierCurve u = BezierCurve !(Point2 u) !(Point2 u) !(Point2 u) !(Point2 u)
deriving (Eq,Ord,Show)

type instance DUnit (BezierCurve u) = u

vbezierCurve :: Num u
=> Vec2 u -> Vec2 u -> Vec2 u -> Point2 u -> BezierCurve u
vbezierCurve v1 v2 v3 p0 = BezierCurve p0 p1 p2 p3
where
p1 = p0 .+^ v1
p2 = p1 .+^ v2
p3 = p2 .+^ v3

-- | Curve subdivision via de Casteljau\'s algorithm.
--
subdivide :: Fractional u
=> BezierCurve u -> (BezierCurve u, BezierCurve u)
subdivide (BezierCurve p0 p1 p2 p3) =
(BezierCurve p0 p01 p012 p0123, BezierCurve p0123 p123 p23 p3)
where
p01   = midpoint p0    p1
p12   = midpoint p1    p2
p23   = midpoint p2    p3
p012  = midpoint p01   p12
p123  = midpoint p12   p23
p0123 = midpoint p012  p123

-- | subdivide with an affine weight along the line...
--
subdividet :: Real u
=> u -> BezierCurve u -> (BezierCurve u, BezierCurve u)
subdividet t (BezierCurve p0 p1 p2 p3) =
(BezierCurve p0 p01 p012 p0123, BezierCurve p0123 p123 p23 p3)
where
p01   = affineComb t p0    p1
p12   = affineComb t p1    p2
p23   = affineComb t p2    p3
p012  = affineComb t p01   p12
p123  = affineComb t p12   p23
p0123 = affineComb t p012  p123

--------------------------------------------------------------------------------

-- | 'bezierLength' : @ start_point * control_1 * control_2 *
--        end_point -> Length @
--
-- Find the length of a Bezier curve. The result is an
-- approximation, with the /tolerance/ is 0.1 of a point. This
-- seems good enough for drawing (potentially the tolerance could
-- be larger still).
--
-- The result is found through repeated subdivision so the
-- calculation is potentially costly.
--
bezierLength :: (Floating u, Ord u, Tolerance u)
=> BezierCurve u -> u
bezierLength = gravesenLength length_tolerance

-- | Jens Gravesen\'s bezier arc-length approximation.
--
-- Note this implementation is parametrized on error tolerance.
--
gravesenLength :: (Floating u, Ord u) => u -> BezierCurve u -> u
gravesenLength err_tol crv = step crv
where
step c = let l1 = ctrlPolyLength c
l0 = cordLength c
in if   l1-l0 > err_tol
then let (a,b) = subdivide c in step a + step b
else 0.5*l0 + 0.5*l1

-- | Length of the tree lines spanning the control points.
--
ctrlPolyLength :: Floating u => BezierCurve u -> u
ctrlPolyLength (BezierCurve p0 p1 p2 p3) = len p0 p1 + len p1 p2 + len p2 p3
where
len pa pb = vlength \$ pvec pa pb

-- | Length of the cord - start point to end point.
--
cordLength :: Floating u => BezierCurve u -> u
cordLength (BezierCurve p0 _ _ p3) = vlength \$ pvec p0 p3

```