metabrush/src/lib/Math/Bezier/Cubic.hs

{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE DeriveFoldable        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DeriveTraversable     #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE UndecidableInstances  #-}

module Math.Bezier.Cubic
  ( Bezier(..)
  , bezier, bezier'
  )
  where

-- base
import GHC.Generics
  ( Generic )

-- acts
import Data.Act
  ( Torsor
    ( (-->) )
  )

-- MetaBrush
import Math.Module
  ( Module (..)
  , lerp
  )
import qualified Math.Bezier.Quadratic as Quadratic
  ( Bezier(Bezier), bezier )

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

-- | Points defining a cubic Bézier curve.
--
-- @ p0 @ and @ p3 @ are endpoints, whereas @ p1 @ and @ p2 @ are control points.
data Bezier p
  = Bezier
    { p0 :: !p
    , p1 :: !p
    , p2 :: !p
    , p3 :: !p
    }
  deriving stock ( Show, Generic, Functor, Foldable, Traversable )

instance Module r p => Module r ( Bezier p ) where
  ( Bezier p0 p1 p2 p3 ) ^+^ ( Bezier q0 q1 q2 q3 ) = Bezier ( p0 ^+^ q0 ) ( p1 ^+^ q1 ) ( p2 ^+^ q2 ) ( p3 ^+^ q3 )
  r *^ bz = fmap ( r *^ ) bz

-- | Cubic Bézier curve.
bezier :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> p
bezier ( Bezier { .. } ) t =
  lerp @v t
    ( Quadratic.bezier @v ( Quadratic.Bezier p0 p1 p2 ) t )
    ( Quadratic.bezier @v ( Quadratic.Bezier p1 p2 p3 ) t )

-- | Derivative of cubic Bézier curve.
bezier' :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> v
bezier' ( Bezier { .. } ) t
  = ( 3 *^ )
  $ lerp @v t
      ( lerp @v t ( p0 --> p1 ) ( p1 --> p2 ) )
      ( lerp @v t ( p1 --> p2 ) ( p2 --> p3 ) )