{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
module Graphics.Rasterific.CubicBezier.FastForwardDifference
    ( ForwardDifferenceCoefficient( .. )
    , bezierToForwardDifferenceCoeff
    , rasterizerCubicBezier
    , rasterizeTensorPatch
    , rasterizeCoonPatch
    , estimateFDStepCount
    ) where

import Control.Monad.Primitive( PrimMonad )
import Control.Monad.State( lift, get )
import Control.Monad.ST( ST )
import Data.Bits( unsafeShiftL )

import Codec.Picture( PixelRGBA8 )
import Codec.Picture.Types( MutableImage( .. ) )

import Graphics.Rasterific.Compositor
import Graphics.Rasterific.Command
import Graphics.Rasterific.Types
import Graphics.Rasterific.Linear
import Graphics.Rasterific.BiSampleable
import Graphics.Rasterific.PatchTypes
import Graphics.Rasterific.Shading

data ForwardDifferenceCoefficient = ForwardDifferenceCoefficient
    { ForwardDifferenceCoefficient -> Float
_fdA :: {-# UNPACK #-} !Float
    , ForwardDifferenceCoefficient -> Float
_fdB :: {-# UNPACK #-} !Float
    , ForwardDifferenceCoefficient -> Float
_fdC :: {-# UNPACK #-} !Float
    }

-- | Given a cubic curve, return the initial step size and

-- the coefficient for the forward difference.

-- Initial step is assumed to be "1"

bezierToForwardDifferenceCoeff
    :: CubicBezier
    -> V2 ForwardDifferenceCoefficient
bezierToForwardDifferenceCoeff :: CubicBezier -> V2 ForwardDifferenceCoefficient
bezierToForwardDifferenceCoeff (CubicBezier Point
x Point
y Point
z Point
w) = ForwardDifferenceCoefficient
-> ForwardDifferenceCoefficient -> V2 ForwardDifferenceCoefficient
forall a. a -> a -> V2 a
V2 ForwardDifferenceCoefficient
xCoeffs ForwardDifferenceCoefficient
yCoeffs
  where
    xCoeffs :: ForwardDifferenceCoefficient
xCoeffs = ForwardDifferenceCoefficient :: Float -> Float -> Float -> ForwardDifferenceCoefficient
ForwardDifferenceCoefficient { _fdA :: Float
_fdA = Float
ax, _fdB :: Float
_fdB = Float
bx, _fdC :: Float
_fdC = Float
cx }
    yCoeffs :: ForwardDifferenceCoefficient
yCoeffs = ForwardDifferenceCoefficient :: Float -> Float -> Float -> ForwardDifferenceCoefficient
ForwardDifferenceCoefficient { _fdA :: Float
_fdA = Float
ay, _fdB :: Float
_fdB = Float
by, _fdC :: Float
_fdC = Float
cy }

    V2 Float
ax Float
ay = Point
w Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
x
    V2 Float
bx Float
by = (Point
w Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
z Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
2 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point
y) Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
6
    V2 Float
cx Float
cy = (Point
w Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
z Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
3 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point
y Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
3 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
x) Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
6

halveFDCoefficients :: ForwardDifferenceCoefficient -> ForwardDifferenceCoefficient
halveFDCoefficients :: ForwardDifferenceCoefficient -> ForwardDifferenceCoefficient
halveFDCoefficients (ForwardDifferenceCoefficient Float
a Float
b Float
c) =
    ForwardDifferenceCoefficient :: Float -> Float -> Float -> ForwardDifferenceCoefficient
ForwardDifferenceCoefficient { _fdA :: Float
_fdA = Float
a', _fdB :: Float
_fdB = Float
b', _fdC :: Float
_fdC = Float
c' }
  where
    c' :: Float
c' = Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.125
    b' :: Float
b' = Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.25 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
c'
    a' :: Float
a' = (Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
b') Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5

updateForwardDifferencing :: ForwardDifferenceCoefficient -> ForwardDifferenceCoefficient
updateForwardDifferencing :: ForwardDifferenceCoefficient -> ForwardDifferenceCoefficient
updateForwardDifferencing (ForwardDifferenceCoefficient Float
a Float
b Float
c) =
  Float -> Float -> Float -> ForwardDifferenceCoefficient
ForwardDifferenceCoefficient (Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
b) (Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
c) Float
c

updatePointsAndCoeff :: (Applicative f', Applicative f, Additive f)
                     => f' (f Float) -> f' (f ForwardDifferenceCoefficient)
                     -> (f' (f Float), f' (f ForwardDifferenceCoefficient))
updatePointsAndCoeff :: f' (f Float)
-> f' (f ForwardDifferenceCoefficient)
-> (f' (f Float), f' (f ForwardDifferenceCoefficient))
updatePointsAndCoeff f' (f Float)
pts f' (f ForwardDifferenceCoefficient)
coeffs =
    (f Float -> f ForwardDifferenceCoefficient -> f Float
forall (f :: * -> *).
Additive f =>
f Float -> f ForwardDifferenceCoefficient -> f Float
advancePoint (f Float -> f ForwardDifferenceCoefficient -> f Float)
-> f' (f Float) -> f' (f ForwardDifferenceCoefficient -> f Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f' (f Float)
pts f' (f ForwardDifferenceCoefficient -> f Float)
-> f' (f ForwardDifferenceCoefficient) -> f' (f Float)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f' (f ForwardDifferenceCoefficient)
coeffs, (ForwardDifferenceCoefficient -> ForwardDifferenceCoefficient)
-> f ForwardDifferenceCoefficient -> f ForwardDifferenceCoefficient
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForwardDifferenceCoefficient -> ForwardDifferenceCoefficient
updateForwardDifferencing (f ForwardDifferenceCoefficient -> f ForwardDifferenceCoefficient)
-> f' (f ForwardDifferenceCoefficient)
-> f' (f ForwardDifferenceCoefficient)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f' (f ForwardDifferenceCoefficient)
coeffs)
  where
    fstOf :: ForwardDifferenceCoefficient -> Float
fstOf (ForwardDifferenceCoefficient Float
a Float
_ Float
_) = Float
a
    advancePoint :: f Float -> f ForwardDifferenceCoefficient -> f Float
advancePoint f Float
v f ForwardDifferenceCoefficient
c = f Float
v f Float -> f Float -> f Float
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (ForwardDifferenceCoefficient -> Float
fstOf (ForwardDifferenceCoefficient -> Float)
-> f ForwardDifferenceCoefficient -> f Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f ForwardDifferenceCoefficient
c)


estimateFDStepCount :: CubicBezier -> Int
estimateFDStepCount :: CubicBezier -> Int
estimateFDStepCount (CubicBezier Point
p0 Point
p1 Point
p2 Point
p3) =
  Float -> Int
toInt (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Point
p0 Point -> Point -> Float
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`qd` Point
p1, Point
p2 Point -> Point -> Float
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`qd` Point
p3, (Point
p0 Point -> Point -> Float
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`qd` Point
p2) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
4, (Point
p1 Point -> Point -> Float
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`qd` Point
p3) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
4]
  where
    toInt :: Float -> Int
toInt = (Float, Int) -> Int
forall a a. Integral a => (a, a) -> a
scale ((Float, Int) -> Int) -> (Float -> (Float, Int)) -> Float -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> (Float, Int)
frexp (Float -> (Float, Int))
-> (Float -> Float) -> Float -> (Float, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
1 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float
18 Float -> Float -> Float
forall a. Num a => a -> a -> a
*)
    scale :: (a, a) -> a
scale (a
_, a
r) = (a
r a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2


fixIter :: Int -> (a -> a) -> a -> a
fixIter :: Int -> (a -> a) -> a -> a
fixIter Int
count a -> a
f = Int -> a -> a
forall t. (Eq t, Num t) => t -> a -> a
go Int
count
  where
    go :: t -> a -> a
go t
0 a
a = a
a
    go t
n a
a = t -> a -> a
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
f a
a

isPointInImage :: MutableImage s a -> Point -> Bool
isPointInImage :: MutableImage s a -> Point -> Bool
isPointInImage MutableImage { mutableImageWidth :: forall s a. MutableImage s a -> Int
mutableImageWidth = Int
w, mutableImageHeight :: forall s a. MutableImage s a -> Int
mutableImageHeight = Int
h } (V2 Float
x Float
y) =
   Float
0 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
x Bool -> Bool -> Bool
&& Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w Bool -> Bool -> Bool
&& Float
0 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
y Bool -> Bool -> Bool
&& Float
y Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h

isCubicBezierOutsideImage :: MutableImage s a -> CubicBezier -> Bool
isCubicBezierOutsideImage :: MutableImage s a -> CubicBezier -> Bool
isCubicBezierOutsideImage MutableImage s a
img (CubicBezier Point
a Point
b Point
c Point
d) =
  Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Point -> Bool
isIn Point
a Bool -> Bool -> Bool
|| Point -> Bool
isIn Point
b Bool -> Bool -> Bool
|| Point -> Bool
isIn Point
c Bool -> Bool -> Bool
|| Point -> Bool
isIn Point
d
  where isIn :: Point -> Bool
isIn = MutableImage s a -> Point -> Bool
forall s a. MutableImage s a -> Point -> Bool
isPointInImage MutableImage s a
img

isCubicBezierInImage :: MutableImage s a -> CubicBezier -> Bool
isCubicBezierInImage :: MutableImage s a -> CubicBezier -> Bool
isCubicBezierInImage MutableImage s a
img (CubicBezier Point
a Point
b Point
c Point
d) =
    Point -> Bool
isIn Point
a Bool -> Bool -> Bool
&& Point -> Bool
isIn Point
b Bool -> Bool -> Bool
&& Point -> Bool
isIn Point
c Bool -> Bool -> Bool
&& Point -> Bool
isIn Point
d
  where isIn :: Point -> Bool
isIn = MutableImage s a -> Point -> Bool
forall s a. MutableImage s a -> Point -> Bool
isPointInImage MutableImage s a
img

-- | Rasterize a cubic bezier curve using the Fast Forward Diffrence

-- algorithm.

rasterizerCubicBezier :: (PrimMonad m, ModulablePixel px, BiSampleable src px)
                      => src -> CubicBezier
                      -> Float -> Float
                      -> Float -> Float
                      -> DrawContext m px ()
{-# SPECIALIZE INLINE
  rasterizerCubicBezier :: (ParametricValues PixelRGBA8) -> CubicBezier
                        -> Float -> Float
                        -> Float -> Float
                        -> DrawContext (ST s) PixelRGBA8 () #-}
rasterizerCubicBezier :: src
-> CubicBezier
-> Float
-> Float
-> Float
-> Float
-> DrawContext m px ()
rasterizerCubicBezier src
source CubicBezier
bez Float
uStart Float
vStart Float
uEnd Float
vEnd = do
  MutableImage (PrimState m) px
canvas <- StateT
  (MutableImage (PrimState m) px) m (MutableImage (PrimState m) px)
forall s (m :: * -> *). MonadState s m => m s
get
  let !baseFfd :: V2 ForwardDifferenceCoefficient
baseFfd = CubicBezier -> V2 ForwardDifferenceCoefficient
bezierToForwardDifferenceCoeff CubicBezier
bez
      !shiftCount :: Int
shiftCount = CubicBezier -> Int
estimateFDStepCount CubicBezier
bez
      maxStepCount :: Int
      maxStepCount :: Int
maxStepCount = Int
1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
shiftCount
      !(V2 (ForwardDifferenceCoefficient Float
ax' Float
bx' Float
cx)
           (ForwardDifferenceCoefficient Float
ay' Float
by' Float
cy)) =
               Int
-> (ForwardDifferenceCoefficient -> ForwardDifferenceCoefficient)
-> ForwardDifferenceCoefficient
-> ForwardDifferenceCoefficient
forall a. Int -> (a -> a) -> a -> a
fixIter Int
shiftCount ForwardDifferenceCoefficient -> ForwardDifferenceCoefficient
halveFDCoefficients (ForwardDifferenceCoefficient -> ForwardDifferenceCoefficient)
-> V2 ForwardDifferenceCoefficient
-> V2 ForwardDifferenceCoefficient
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V2 ForwardDifferenceCoefficient
baseFfd

      !(V2 Float
_du Float
dv) = (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
uEnd Float
vEnd Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
uStart Float
vStart) Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Floating a) => f a -> a -> f a
^/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxStepCount
      !(V2 Float
xStart Float
yStart) = CubicBezier -> Point
_cBezierX0 CubicBezier
bez
      
      go :: Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> m ()
go !Int
currentStep Float
_ Float
_ Float
_ Float
_ Float
_ Float
_ Float
_ | Int
currentStep Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxStepCount = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      go !Int
currentStep !Float
ax !Float
bx !Float
ay !Float
by !Float
x !Float
y !Float
v = do
        let !color :: px
color = src -> Float -> Float -> px
forall sampled px.
BiSampleable sampled px =>
sampled -> Float -> Float -> px
interpolate src
source Float
uStart Float
v
        MutableImage (PrimState m) px -> px -> Int -> Int -> m ()
forall (m :: * -> *) px.
(ModulablePixel px, PrimMonad m) =>
MutableImage (PrimState m) px -> px -> Int -> Int -> m ()
plotOpaquePixel MutableImage (PrimState m) px
canvas px
color (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
x) (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
y)
        Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> m ()
go (Int
currentStep Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            (Float
ax Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
bx) (Float
bx Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cx)
            (Float
ay Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
by) (Float
by Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cy)
            (Float
x  Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ax) (Float
y  Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ay)
            (Float
v  Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
dv)

      goUnsafe :: Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> m ()
goUnsafe !Int
currentStep Float
_ Float
_ Float
_ Float
_ Float
_ Float
_ Float
_ | Int
currentStep Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxStepCount = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      goUnsafe !Int
currentStep !Float
ax !Float
bx !Float
ay !Float
by !Float
x !Float
y !Float
v = do
        let !color :: px
color = src -> Float -> Float -> px
forall sampled px.
BiSampleable sampled px =>
sampled -> Float -> Float -> px
interpolate src
source Float
uStart Float
v
        MutableImage (PrimState m) px -> px -> Int -> Int -> m ()
forall (m :: * -> *) px.
(ModulablePixel px, PrimMonad m) =>
MutableImage (PrimState m) px -> px -> Int -> Int -> m ()
unsafePlotOpaquePixel MutableImage (PrimState m) px
canvas px
color (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
x) (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
y)
        Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> m ()
goUnsafe (Int
currentStep Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            (Float
ax Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
bx) (Float
bx Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cx)
            (Float
ay Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
by) (Float
by Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cy)
            (Float
x  Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ax) (Float
y  Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ay)
            (Float
v  Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
dv)

  if MutableImage (PrimState m) px -> CubicBezier -> Bool
forall s a. MutableImage s a -> CubicBezier -> Bool
isCubicBezierOutsideImage MutableImage (PrimState m) px
canvas CubicBezier
bez then
    () -> DrawContext m px ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  else if MutableImage (PrimState m) px -> CubicBezier -> Bool
forall s a. MutableImage s a -> CubicBezier -> Bool
isCubicBezierInImage MutableImage (PrimState m) px
canvas CubicBezier
bez then
    m () -> DrawContext m px ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> DrawContext m px ()) -> m () -> DrawContext m px ()
forall a b. (a -> b) -> a -> b
$ Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> m ()
goUnsafe Int
0 Float
ax' Float
bx' Float
ay' Float
by' Float
xStart Float
yStart Float
vStart
  else
    m () -> DrawContext m px ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> DrawContext m px ()) -> m () -> DrawContext m px ()
forall a b. (a -> b) -> a -> b
$ Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> m ()
go Int
0 Float
ax' Float
bx' Float
ay' Float
by' Float
xStart Float
yStart Float
vStart

-- | Rasterize a coon patch using the Fast Forward Diffrence algorithm,

-- likely to be faster than the subdivision one.

rasterizeCoonPatch :: (PrimMonad m, ModulablePixel px, BiSampleable src px)
                    => CoonPatch src -> DrawContext m px ()
{-# SPECIALIZE rasterizeCoonPatch :: CoonPatch (ParametricValues PixelRGBA8)
                                  -> DrawContext (ST s) PixelRGBA8 () #-}
rasterizeCoonPatch :: CoonPatch src -> DrawContext m px ()
rasterizeCoonPatch = TensorPatch src -> DrawContext m px ()
forall (m :: * -> *) px src.
(PrimMonad m, ModulablePixel px, BiSampleable src px) =>
TensorPatch src -> DrawContext m px ()
rasterizeTensorPatch (TensorPatch src -> DrawContext m px ())
-> (CoonPatch src -> TensorPatch src)
-> CoonPatch src
-> DrawContext m px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoonPatch src -> TensorPatch src
forall a. CoonPatch a -> TensorPatch a
toTensorPatch

-- | Rasterize a tensor patch using the Fast Forward Diffrence algorithm,

-- likely to be faster than the subdivision one.

rasterizeTensorPatch :: (PrimMonad m, ModulablePixel px, BiSampleable src px)
                     => TensorPatch src -> DrawContext m px ()
{-# SPECIALIZE rasterizeTensorPatch :: TensorPatch (ParametricValues PixelRGBA8)
                                    -> DrawContext (ST s) PixelRGBA8 () #-}
rasterizeTensorPatch :: TensorPatch src -> DrawContext m px ()
rasterizeTensorPatch TensorPatch { src
CubicBezier
_tensorValues :: forall weight. TensorPatch weight -> weight
_curve3 :: forall weight. TensorPatch weight -> CubicBezier
_curve2 :: forall weight. TensorPatch weight -> CubicBezier
_curve1 :: forall weight. TensorPatch weight -> CubicBezier
_curve0 :: forall weight. TensorPatch weight -> CubicBezier
_tensorValues :: src
_curve3 :: CubicBezier
_curve2 :: CubicBezier
_curve1 :: CubicBezier
_curve0 :: CubicBezier
.. } =
    Int
-> V4 Point
-> V4 (V2 ForwardDifferenceCoefficient)
-> Float
-> DrawContext m px ()
forall (m :: * -> *) px t.
(PrimMonad m, Pixel px, PackeablePixel px, InterpolablePixel px,
 InterpolablePixel (PixelBaseComponent px),
 Modulable (PixelBaseComponent px), BiSampleable src px, Num t,
 Storable (PackedRepresentation px), Eq t) =>
t
-> V4 Point
-> V4 (V2 ForwardDifferenceCoefficient)
-> Float
-> StateT (MutableImage (PrimState m) px) m ()
go Int
maxStepCount V4 Point
basePoints V4 (V2 ForwardDifferenceCoefficient)
ffCoeff Float
0
  where
    !curves :: V4 CubicBezier
curves = CubicBezier
-> CubicBezier -> CubicBezier -> CubicBezier -> V4 CubicBezier
forall a. a -> a -> a -> a -> V4 a
V4 CubicBezier
_curve0 CubicBezier
_curve1 CubicBezier
_curve2 CubicBezier
_curve3
    !shiftStep :: Int
shiftStep = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ CubicBezier -> Int
estimateFDStepCount (CubicBezier -> Int) -> [CubicBezier] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CubicBezier
_curve0, CubicBezier
_curve1, CubicBezier
_curve2, CubicBezier
_curve3]
    
    !basePoints :: V4 Point
basePoints = CubicBezier -> Point
_cBezierX0 (CubicBezier -> Point) -> V4 CubicBezier -> V4 Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V4 CubicBezier
curves
    !ffCoeff :: V4 (V2 ForwardDifferenceCoefficient)
ffCoeff =
      (ForwardDifferenceCoefficient -> ForwardDifferenceCoefficient)
-> V2 ForwardDifferenceCoefficient
-> V2 ForwardDifferenceCoefficient
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
-> (ForwardDifferenceCoefficient -> ForwardDifferenceCoefficient)
-> ForwardDifferenceCoefficient
-> ForwardDifferenceCoefficient
forall a. Int -> (a -> a) -> a -> a
fixIter Int
shiftStep ForwardDifferenceCoefficient -> ForwardDifferenceCoefficient
halveFDCoefficients) (V2 ForwardDifferenceCoefficient
 -> V2 ForwardDifferenceCoefficient)
-> (CubicBezier -> V2 ForwardDifferenceCoefficient)
-> CubicBezier
-> V2 ForwardDifferenceCoefficient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier -> V2 ForwardDifferenceCoefficient
bezierToForwardDifferenceCoeff (CubicBezier -> V2 ForwardDifferenceCoefficient)
-> V4 CubicBezier -> V4 (V2 ForwardDifferenceCoefficient)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V4 CubicBezier
curves
    
    maxStepCount :: Int
    !maxStepCount :: Int
maxStepCount = Int
1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
shiftStep

    !du :: Float
du = Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxStepCount
    
    toBezier :: V4 Point -> CubicBezier
toBezier (V4 Point
a Point
b Point
c Point
d) = Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
a Point
b Point
c Point
d
    
    go :: t
-> V4 Point
-> V4 (V2 ForwardDifferenceCoefficient)
-> Float
-> StateT (MutableImage (PrimState m) px) m ()
go t
0 V4 Point
_pts V4 (V2 ForwardDifferenceCoefficient)
_coeffs Float
_uvStart = () -> StateT (MutableImage (PrimState m) px) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go t
i !V4 Point
pts !V4 (V2 ForwardDifferenceCoefficient)
coeffs !Float
ut = do
      let (V4 Point
newPoints, V4 (V2 ForwardDifferenceCoefficient)
newCoeff) = V4 Point
-> V4 (V2 ForwardDifferenceCoefficient)
-> (V4 Point, V4 (V2 ForwardDifferenceCoefficient))
forall (f' :: * -> *) (f :: * -> *).
(Applicative f', Applicative f, Additive f) =>
f' (f Float)
-> f' (f ForwardDifferenceCoefficient)
-> (f' (f Float), f' (f ForwardDifferenceCoefficient))
updatePointsAndCoeff V4 Point
pts V4 (V2 ForwardDifferenceCoefficient)
coeffs
      src
-> CubicBezier
-> Float
-> Float
-> Float
-> Float
-> StateT (MutableImage (PrimState m) px) m ()
forall (m :: * -> *) px src.
(PrimMonad m, ModulablePixel px, BiSampleable src px) =>
src
-> CubicBezier
-> Float
-> Float
-> Float
-> Float
-> DrawContext m px ()
rasterizerCubicBezier src
_tensorValues (V4 Point -> CubicBezier
toBezier V4 Point
pts) Float
ut Float
0 Float
ut Float
1
      t
-> V4 Point
-> V4 (V2 ForwardDifferenceCoefficient)
-> Float
-> StateT (MutableImage (PrimState m) px) m ()
go (t
i t -> t -> t
forall a. Num a => a -> a -> a
- t
1) V4 Point
newPoints V4 (V2 ForwardDifferenceCoefficient)
newCoeff (Float
ut Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
du)

frexp :: Float -> (Float, Int)
frexp :: Float -> (Float, Int)
frexp Float
x
   | Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
x = [Char] -> (Float, Int)
forall a. HasCallStack => [Char] -> a
error [Char]
"NaN given to frexp"
   | Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
x = [Char] -> (Float, Int)
forall a. HasCallStack => [Char] -> a
error [Char]
"infinity given to frexp"
   | Bool
otherwise  = Float -> Int -> (Float, Int)
forall a b. (Ord a, Fractional a, Num b) => a -> b -> (a, b)
go Float
x Int
0
  where
    go :: a -> b -> (a, b)
go a
s b
e
      | a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
1.0 = a -> b -> (a, b)
go (a
s a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2) (b
e b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)
      | a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0.5 = a -> b -> (a, b)
go (a
s a -> a -> a
forall a. Num a => a -> a -> a
* a
2) (b
e b -> b -> b
forall a. Num a => a -> a -> a
- b
1)
      | Bool
otherwise = (a
s, b
e)