2020-08-05 20:23:16 +00:00
|
|
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
|
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
|
|
{-# LANGUAGE DeriveTraversable #-}
|
|
|
|
{-# LANGUAGE DerivingStrategies #-}
|
|
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
{-# LANGUAGE TypeApplications #-}
|
|
|
|
{-# LANGUAGE UndecidableInstances #-}
|
2020-08-04 06:15:06 +00:00
|
|
|
|
|
|
|
module Math.Bezier.Quadratic
|
|
|
|
( Bezier(..)
|
|
|
|
, bezier, bezier'
|
2020-08-10 14:38:27 +00:00
|
|
|
, subdivide
|
2020-08-04 06:15:06 +00:00
|
|
|
)
|
|
|
|
where
|
|
|
|
|
|
|
|
-- base
|
|
|
|
import GHC.Generics
|
|
|
|
( Generic )
|
|
|
|
|
|
|
|
-- acts
|
|
|
|
import Data.Act
|
2020-08-05 20:23:16 +00:00
|
|
|
( Torsor
|
2020-08-04 06:15:06 +00:00
|
|
|
( (-->) )
|
|
|
|
)
|
|
|
|
|
|
|
|
-- MetaBrush
|
|
|
|
import Math.Module
|
|
|
|
( Module (..)
|
|
|
|
, lerp
|
|
|
|
)
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
|
|
|
-- | Points defining a quadratic Bézier curve.
|
|
|
|
--
|
|
|
|
-- @ p0 @ and @ p2 @ are endpoints, whereas @ p1 @ is a control point.
|
|
|
|
data Bezier p
|
|
|
|
= Bezier
|
|
|
|
{ p0 :: !p
|
|
|
|
, p1 :: !p
|
|
|
|
, p2 :: !p
|
|
|
|
}
|
|
|
|
deriving stock ( Show, Generic, Functor, Foldable, Traversable )
|
|
|
|
|
|
|
|
-- | Quadratic Bézier curve.
|
|
|
|
bezier :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> p
|
|
|
|
bezier ( Bezier { .. } ) t = lerp @v t ( lerp @v t p0 p1 ) ( lerp @v t p1 p2 )
|
|
|
|
|
|
|
|
-- | Derivative of quadratic Bézier curve.
|
|
|
|
bezier' :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> v
|
2020-08-10 14:38:27 +00:00
|
|
|
bezier' ( Bezier { .. } ) t = 2 *^ lerp @v t ( p0 --> p1 ) ( p1 --> p2 )
|
|
|
|
|
|
|
|
-- | Subdivide a quadratic Bézier curve into two parts.
|
|
|
|
subdivide :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> ( Bezier p, Bezier p )
|
|
|
|
subdivide ( Bezier { .. } ) t = ( Bezier p0 q1 pt, Bezier pt r1 p2 )
|
|
|
|
where
|
|
|
|
pt, q1, r1 :: p
|
|
|
|
q1 = lerp @v t p0 p1
|
|
|
|
r1 = lerp @v t p1 p2
|
|
|
|
pt = lerp @v t q1 r1
|