{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- | Implementation using

-- "An efficient algorithm for subdivising linear Coons surfaces"

-- C.Yao and J.Rokne

-- Computer aided design 8 (1991) 291-303

module Graphics.Rasterific.Patch
    ( -- * Types

      CoonPatch( .. )
    , TensorPatch( .. )
    , ParametricValues( .. )
    , PatchInterpolation( .. )
    , CoonColorWeight
    , Subdivided( .. )
    , InterpolablePixel

      -- * Rendering functions


      -- ** Using Fast Forward Differences

    , rasterizeTensorPatch 
    , rasterizeCoonPatch
    , renderImageMesh
    , renderCoonMesh
    , renderCoonMeshBicubic

      -- ** Subdivision patch rendering

    , renderCoonPatch
    , renderCoonPatchAtDeepness
    , renderTensorPatch
    , renderTensorPatchAtDeepness

      -- * Debugging

    , DebugOption( .. )
    , defaultDebug
    , drawCoonPatchOutline
    , debugDrawCoonPatch
    , debugDrawTensorPatch
    , parametricBase

      -- * Manipulation

    , subdividePatch
    , subdivideTensorPatch
    , horizontalTensorSubdivide
    , transposePatch
    )  where

import Control.Monad.Free( liftF )
import Control.Monad( when, forM_ )
import Control.Monad.Primitive( PrimMonad )
import Data.Monoid( Sum( .. ) )
import Graphics.Rasterific.Types
import Graphics.Rasterific.CubicBezier
import Graphics.Rasterific.CubicBezier.FastForwardDifference
import Graphics.Rasterific.Operators
import Graphics.Rasterific.Linear
import Graphics.Rasterific.Compositor
import Graphics.Rasterific.ComplexPrimitive
import Graphics.Rasterific.Line( lineFromPath )
import Graphics.Rasterific.Immediate
import Graphics.Rasterific.BiSampleable
import Graphics.Rasterific.PatchTypes
import Graphics.Rasterific.MeshPatch
import Graphics.Rasterific.Command

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

-- @

--  North    ----->     East

--      +--------------+

--      |      0       |

--    ^ |              | |

--    | |3            1| |

--    | |              | v

--      |      2       |

--      +--------------+

--  West    <-----      South

-- @



estimateCoonSubdivision :: CoonPatch px -> Int
estimateCoonSubdivision :: CoonPatch px -> Int
estimateCoonSubdivision CoonPatch { px
CubicBezier
_coonValues :: forall weight. CoonPatch weight -> weight
_west :: forall weight. CoonPatch weight -> CubicBezier
_south :: forall weight. CoonPatch weight -> CubicBezier
_east :: forall weight. CoonPatch weight -> CubicBezier
_north :: forall weight. CoonPatch weight -> CubicBezier
_coonValues :: px
_west :: CubicBezier
_south :: CubicBezier
_east :: CubicBezier
_north :: CubicBezier
.. } = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
8 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
    [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
_north, CubicBezier
_west, CubicBezier
_south, CubicBezier
_east]

estimateTensorSubdivision :: TensorPatch px -> Int
estimateTensorSubdivision :: TensorPatch px -> Int
estimateTensorSubdivision TensorPatch px
p = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
8 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
  [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
<$> (((TensorPatch px -> CubicBezier) -> CubicBezier)
-> [TensorPatch px -> CubicBezier] -> [CubicBezier]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TensorPatch px -> CubicBezier) -> TensorPatch px -> CubicBezier
forall a b. (a -> b) -> a -> b
$ TensorPatch px
p) [TensorPatch px -> CubicBezier]
forall weight. [TensorPatch weight -> CubicBezier]
axx [CubicBezier] -> [CubicBezier] -> [CubicBezier]
forall a. [a] -> [a] -> [a]
++ ((TensorPatch (ParametricValues UV) -> CubicBezier) -> CubicBezier)
-> [TensorPatch (ParametricValues UV) -> CubicBezier]
-> [CubicBezier]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TensorPatch (ParametricValues UV) -> CubicBezier)
-> TensorPatch (ParametricValues UV) -> CubicBezier
forall a b. (a -> b) -> a -> b
$ TensorPatch (ParametricValues UV)
t) [TensorPatch (ParametricValues UV) -> CubicBezier]
forall weight. [TensorPatch weight -> CubicBezier]
axx)
    where
     axx :: [TensorPatch weight -> CubicBezier]
axx = [TensorPatch weight -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve0, TensorPatch weight -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve1, TensorPatch weight -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve2, TensorPatch weight -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve3]
     t :: TensorPatch (ParametricValues UV)
t = TensorPatch (ParametricValues UV)
-> TensorPatch (ParametricValues UV)
forall a.
TensorPatch (ParametricValues a)
-> TensorPatch (ParametricValues a)
transposePatch TensorPatch px
p { _tensorValues :: ParametricValues UV
_tensorValues = ParametricValues UV
parametricBase }

meanValue :: ParametricValues UV -> UV
meanValue :: ParametricValues UV -> UV
meanValue = (UV -> CoonColorWeight -> UV
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* CoonColorWeight
0.25) (UV -> UV)
-> (ParametricValues UV -> UV) -> ParametricValues UV -> UV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sum UV -> UV
forall a. Sum a -> a
getSum (Sum UV -> UV)
-> (ParametricValues UV -> Sum UV) -> ParametricValues UV -> UV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UV -> Sum UV) -> ParametricValues UV -> Sum UV
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap UV -> Sum UV
forall a. a -> Sum a
Sum

-- | Horizontally divides the parametric plane

--

-- @

--  N    midNorthEast   E

--      +-------+------+

--      |0      :     1|

--      |       :      |

--      | Left  :Right |

--      |       :      |

--      |3      :     2|

--      +-------+------+

--  W    midSouthWest   S

-- @

subdivideHorizontal :: ParametricValues UV -> (ParametricValues UV, ParametricValues UV)
subdivideHorizontal :: ParametricValues UV -> (ParametricValues UV, ParametricValues UV)
subdivideHorizontal ParametricValues { UV
_westValue :: forall a. ParametricValues a -> a
_southValue :: forall a. ParametricValues a -> a
_eastValue :: forall a. ParametricValues a -> a
_northValue :: forall a. ParametricValues a -> a
_westValue :: UV
_southValue :: UV
_eastValue :: UV
_northValue :: UV
.. } = (ParametricValues UV
l, ParametricValues UV
r) where
  midNorthEast :: UV
midNorthEast = UV
_northValue UV -> UV -> UV
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` UV
_eastValue
  midSouthWest :: UV
midSouthWest = UV
_westValue UV -> UV -> UV
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` UV
_southValue

  l :: ParametricValues UV
l = ParametricValues :: forall a. a -> a -> a -> a -> ParametricValues a
ParametricValues
    { _northValue :: UV
_northValue = UV
_northValue
    , _eastValue :: UV
_eastValue = UV
midNorthEast
    , _southValue :: UV
_southValue = UV
midSouthWest
    , _westValue :: UV
_westValue = UV
_westValue
    }

  r :: ParametricValues UV
r = ParametricValues :: forall a. a -> a -> a -> a -> ParametricValues a
ParametricValues
    { _northValue :: UV
_northValue = UV
midNorthEast
    , _eastValue :: UV
_eastValue = UV
_eastValue
    , _southValue :: UV
_southValue = UV
_southValue
    , _westValue :: UV
_westValue = UV
midSouthWest
    }

-- | Create UVPatch information for each new quadrant

subdivideWeights :: UVPatch -> Subdivided UVPatch
subdivideWeights :: ParametricValues UV -> Subdivided (ParametricValues UV)
subdivideWeights ParametricValues UV
values = Subdivided :: forall a. a -> a -> a -> a -> Subdivided a
Subdivided { ParametricValues UV
_southEast :: ParametricValues UV
_southWest :: ParametricValues UV
_northEast :: ParametricValues UV
_northWest :: ParametricValues UV
_southEast :: ParametricValues UV
_southWest :: ParametricValues UV
_northEast :: ParametricValues UV
_northWest :: ParametricValues UV
.. } where
  ParametricValues
    { _northValue :: forall a. ParametricValues a -> a
_northValue = UV
north
    , _eastValue :: forall a. ParametricValues a -> a
_eastValue = UV
east
    , _southValue :: forall a. ParametricValues a -> a
_southValue = UV
south
    , _westValue :: forall a. ParametricValues a -> a
_westValue = UV
west
    } = ParametricValues UV
values

  --  N       midNorth    E

  --      +-------+------+

  --      |0      :     1|

  --   mid|   grid:Mid   |

  --  West+=======:======+ midEast

  --      |       :      |

  --      |3      :     2|

  --      +-------+------+

  --  W       midSouth    S

  midNorthValue :: UV
midNorthValue = UV
north UV -> UV -> UV
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` UV
east
  midWestValue :: UV
midWestValue = UV
north UV -> UV -> UV
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` UV
west
  midSoutValue :: UV
midSoutValue = UV
west UV -> UV -> UV
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` UV
south
  midEastValue :: UV
midEastValue = UV
east UV -> UV -> UV
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` UV
south

  gridMidValue :: UV
gridMidValue = UV
midSoutValue UV -> UV -> UV
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` UV
midNorthValue

  _northWest :: ParametricValues UV
_northWest = ParametricValues :: forall a. a -> a -> a -> a -> ParametricValues a
ParametricValues
    { _northValue :: UV
_northValue = UV
north
    , _eastValue :: UV
_eastValue = UV
midNorthValue
    , _southValue :: UV
_southValue = UV
gridMidValue
    , _westValue :: UV
_westValue = UV
midWestValue
    }

  _northEast :: ParametricValues UV
_northEast = ParametricValues :: forall a. a -> a -> a -> a -> ParametricValues a
ParametricValues
    { _northValue :: UV
_northValue = UV
midNorthValue
    , _eastValue :: UV
_eastValue = UV
east
    , _southValue :: UV
_southValue = UV
midEastValue
    , _westValue :: UV
_westValue = UV
gridMidValue
    }

  _southWest :: ParametricValues UV
_southWest = ParametricValues :: forall a. a -> a -> a -> a -> ParametricValues a
ParametricValues
    { _northValue :: UV
_northValue = UV
midWestValue
    , _eastValue :: UV
_eastValue  = UV
gridMidValue
    , _southValue :: UV
_southValue = UV
midSoutValue
    , _westValue :: UV
_westValue = UV
west
    }
  
  _southEast :: ParametricValues UV
_southEast = ParametricValues :: forall a. a -> a -> a -> a -> ParametricValues a
ParametricValues
    { _northValue :: UV
_northValue = UV
gridMidValue
    , _eastValue :: UV
_eastValue = UV
midEastValue
    , _southValue :: UV
_southValue = UV
south
    , _westValue :: UV
_westValue = UV
midSoutValue
    }

westCurveOfPatch :: TensorPatch px -> CubicBezier
westCurveOfPatch :: TensorPatch px -> CubicBezier
westCurveOfPatch TensorPatch
  { _curve0 :: forall weight. TensorPatch weight -> CubicBezier
_curve0 = CubicBezier UV
c0 UV
_ UV
_ UV
_
  , _curve1 :: forall weight. TensorPatch weight -> CubicBezier
_curve1 = CubicBezier UV
c1 UV
_ UV
_ UV
_
  , _curve2 :: forall weight. TensorPatch weight -> CubicBezier
_curve2 = CubicBezier UV
c2 UV
_ UV
_ UV
_
  , _curve3 :: forall weight. TensorPatch weight -> CubicBezier
_curve3 = CubicBezier UV
c3 UV
_ UV
_ UV
_
  } = UV -> UV -> UV -> UV -> CubicBezier
CubicBezier UV
c0 UV
c1 UV
c2 UV
c3

eastCurveOfPatch :: TensorPatch px -> CubicBezier
eastCurveOfPatch :: TensorPatch px -> CubicBezier
eastCurveOfPatch TensorPatch
  { _curve0 :: forall weight. TensorPatch weight -> CubicBezier
_curve0 = CubicBezier UV
_ UV
_ UV
_ UV
c0
  , _curve1 :: forall weight. TensorPatch weight -> CubicBezier
_curve1 = CubicBezier UV
_ UV
_ UV
_ UV
c1
  , _curve2 :: forall weight. TensorPatch weight -> CubicBezier
_curve2 = CubicBezier UV
_ UV
_ UV
_ UV
c2
  , _curve3 :: forall weight. TensorPatch weight -> CubicBezier
_curve3 = CubicBezier UV
_ UV
_ UV
_ UV
c3
  } = UV -> UV -> UV -> UV -> CubicBezier
CubicBezier UV
c0 UV
c1 UV
c2 UV
c3

-- | Swap vertical/horizontal orientation of a tensor patch

transposePatch :: TensorPatch (ParametricValues a) -> TensorPatch (ParametricValues a)
transposePatch :: TensorPatch (ParametricValues a)
-> TensorPatch (ParametricValues a)
transposePatch TensorPatch
  { _curve0 :: forall weight. TensorPatch weight -> CubicBezier
_curve0 = CubicBezier UV
c00 UV
c01 UV
c02 UV
c03
  , _curve1 :: forall weight. TensorPatch weight -> CubicBezier
_curve1 = CubicBezier UV
c10 UV
c11 UV
c12 UV
c13
  , _curve2 :: forall weight. TensorPatch weight -> CubicBezier
_curve2 = CubicBezier UV
c20 UV
c21 UV
c22 UV
c23
  , _curve3 :: forall weight. TensorPatch weight -> CubicBezier
_curve3 = CubicBezier UV
c30 UV
c31 UV
c32 UV
c33
  , _tensorValues :: forall weight. TensorPatch weight -> weight
_tensorValues = ParametricValues a
values
  } = TensorPatch :: forall weight.
CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> weight
-> TensorPatch weight
TensorPatch
    { _curve0 :: CubicBezier
_curve0 = UV -> UV -> UV -> UV -> CubicBezier
CubicBezier UV
c00 UV
c10 UV
c20 UV
c30
    , _curve1 :: CubicBezier
_curve1 = UV -> UV -> UV -> UV -> CubicBezier
CubicBezier UV
c01 UV
c11 UV
c21 UV
c31
    , _curve2 :: CubicBezier
_curve2 = UV -> UV -> UV -> UV -> CubicBezier
CubicBezier UV
c02 UV
c12 UV
c22 UV
c32
    , _curve3 :: CubicBezier
_curve3 = UV -> UV -> UV -> UV -> CubicBezier
CubicBezier UV
c03 UV
c13 UV
c23 UV
c33
    , _tensorValues :: ParametricValues a
_tensorValues = ParametricValues a -> ParametricValues a
forall a. ParametricValues a -> ParametricValues a
transposeParametricValues ParametricValues a
values
    }


-- | Perform an operation like:

--

-- @

--    o--------o--------o--------o

--    |        |        |        |

--    |        |        |        |

--    |        |        |        |

--    o--------o--------o--------o

--    |        |        |        |

--    |        |        |        |

--    |        |        |        |

--    o--------o--------o--------o

--    |        |        |        |

--    |        |        |        |

--    |        |        |        |

--    o--------o--------o--------o

--    |        |        |        |

--    |        |        |        |

--    |        |        |        |

--    o--------o--------o--------o

--

--       to (more or less)

--

--    o----*---o----*----o----*---o

--    |    |   |    |    |    |   |

--    |    |   |    |    |    |   |

--    |    |   |    |    |    |   |

--    o----*---o----*----o----*---o

--    |    |   |    |    |    |   |

--    |    |   |    |    |    |   |

--    |    |   |    |    |    |   |

--    o----*---o----*----o----*---o

--    |    |   |    |    |    |   |

--    |    |   |    |    |    |   |

--    |    |   |    |    |    |   |

--    o----*---o----*----o----*---o

--    |    |   |    |    |    |   |

--    |    |   |    |    |    |   |

--    |    |   |    |    |    |   |

--    o----*---o----*----o----*---o

--    <------------><------------->

--       Left            Right

-- @

--

horizontalTensorSubdivide :: TensorPatch UVPatch -> (TensorPatch UVPatch, TensorPatch UVPatch)
horizontalTensorSubdivide :: TensorPatch (ParametricValues UV)
-> (TensorPatch (ParametricValues UV),
    TensorPatch (ParametricValues UV))
horizontalTensorSubdivide TensorPatch (ParametricValues UV)
p = (CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> ParametricValues UV
-> TensorPatch (ParametricValues UV)
forall weight.
CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> weight
-> TensorPatch weight
TensorPatch CubicBezier
l0 CubicBezier
l1 CubicBezier
l2 CubicBezier
l3 ParametricValues UV
vl, CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> ParametricValues UV
-> TensorPatch (ParametricValues UV)
forall weight.
CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> weight
-> TensorPatch weight
TensorPatch CubicBezier
r0 CubicBezier
r1 CubicBezier
r2 CubicBezier
r3 ParametricValues UV
vr) where
  (CubicBezier
l0, CubicBezier
r0) = CubicBezier -> (CubicBezier, CubicBezier)
divideCubicBezier (CubicBezier -> (CubicBezier, CubicBezier))
-> CubicBezier -> (CubicBezier, CubicBezier)
forall a b. (a -> b) -> a -> b
$ TensorPatch (ParametricValues UV) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve0 TensorPatch (ParametricValues UV)
p
  (CubicBezier
l1, CubicBezier
r1) = CubicBezier -> (CubicBezier, CubicBezier)
divideCubicBezier (CubicBezier -> (CubicBezier, CubicBezier))
-> CubicBezier -> (CubicBezier, CubicBezier)
forall a b. (a -> b) -> a -> b
$ TensorPatch (ParametricValues UV) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve1 TensorPatch (ParametricValues UV)
p
  (CubicBezier
l2, CubicBezier
r2) = CubicBezier -> (CubicBezier, CubicBezier)
divideCubicBezier (CubicBezier -> (CubicBezier, CubicBezier))
-> CubicBezier -> (CubicBezier, CubicBezier)
forall a b. (a -> b) -> a -> b
$ TensorPatch (ParametricValues UV) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve2 TensorPatch (ParametricValues UV)
p
  (CubicBezier
l3, CubicBezier
r3) = CubicBezier -> (CubicBezier, CubicBezier)
divideCubicBezier (CubicBezier -> (CubicBezier, CubicBezier))
-> CubicBezier -> (CubicBezier, CubicBezier)
forall a b. (a -> b) -> a -> b
$ TensorPatch (ParametricValues UV) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve3 TensorPatch (ParametricValues UV)
p
  (ParametricValues UV
vl, ParametricValues UV
vr) = ParametricValues UV -> (ParametricValues UV, ParametricValues UV)
subdivideHorizontal (ParametricValues UV -> (ParametricValues UV, ParametricValues UV))
-> ParametricValues UV
-> (ParametricValues UV, ParametricValues UV)
forall a b. (a -> b) -> a -> b
$ TensorPatch (ParametricValues UV) -> ParametricValues UV
forall weight. TensorPatch weight -> weight
_tensorValues TensorPatch (ParametricValues UV)
p

-- | Subdivide a tensor patch into 4 new quadrant.

-- Perform twice the horizontal subdivision with a transposition.

subdivideTensorPatch :: TensorPatch UVPatch -> Subdivided (TensorPatch UVPatch)
subdivideTensorPatch :: TensorPatch (ParametricValues UV)
-> Subdivided (TensorPatch (ParametricValues UV))
subdivideTensorPatch TensorPatch (ParametricValues UV)
p = Subdivided (TensorPatch (ParametricValues UV))
subdivided where
  (TensorPatch (ParametricValues UV)
west, TensorPatch (ParametricValues UV)
east) = TensorPatch (ParametricValues UV)
-> (TensorPatch (ParametricValues UV),
    TensorPatch (ParametricValues UV))
horizontalTensorSubdivide TensorPatch (ParametricValues UV)
p
  (TensorPatch (ParametricValues UV)
northWest, TensorPatch (ParametricValues UV)
southWest) = TensorPatch (ParametricValues UV)
-> (TensorPatch (ParametricValues UV),
    TensorPatch (ParametricValues UV))
horizontalTensorSubdivide (TensorPatch (ParametricValues UV)
 -> (TensorPatch (ParametricValues UV),
     TensorPatch (ParametricValues UV)))
-> TensorPatch (ParametricValues UV)
-> (TensorPatch (ParametricValues UV),
    TensorPatch (ParametricValues UV))
forall a b. (a -> b) -> a -> b
$ TensorPatch (ParametricValues UV)
-> TensorPatch (ParametricValues UV)
forall a.
TensorPatch (ParametricValues a)
-> TensorPatch (ParametricValues a)
transposePatch TensorPatch (ParametricValues UV)
west
  (TensorPatch (ParametricValues UV)
northEast, TensorPatch (ParametricValues UV)
southEast) = TensorPatch (ParametricValues UV)
-> (TensorPatch (ParametricValues UV),
    TensorPatch (ParametricValues UV))
horizontalTensorSubdivide (TensorPatch (ParametricValues UV)
 -> (TensorPatch (ParametricValues UV),
     TensorPatch (ParametricValues UV)))
-> TensorPatch (ParametricValues UV)
-> (TensorPatch (ParametricValues UV),
    TensorPatch (ParametricValues UV))
forall a b. (a -> b) -> a -> b
$ TensorPatch (ParametricValues UV)
-> TensorPatch (ParametricValues UV)
forall a.
TensorPatch (ParametricValues a)
-> TensorPatch (ParametricValues a)
transposePatch TensorPatch (ParametricValues UV)
east
  subdivided :: Subdivided (TensorPatch (ParametricValues UV))
subdivided = Subdivided :: forall a. a -> a -> a -> a -> Subdivided a
Subdivided
    { _northWest :: TensorPatch (ParametricValues UV)
_northWest = TensorPatch (ParametricValues UV)
northWest
    , _northEast :: TensorPatch (ParametricValues UV)
_northEast = TensorPatch (ParametricValues UV)
northEast
    , _southWest :: TensorPatch (ParametricValues UV)
_southWest = TensorPatch (ParametricValues UV)
southWest
    , _southEast :: TensorPatch (ParametricValues UV)
_southEast = TensorPatch (ParametricValues UV)
southEast
    }

basePointOfCoonPatch :: CoonPatch (ParametricValues px) -> [(Point, px)]
basePointOfCoonPatch :: CoonPatch (ParametricValues px) -> [(UV, px)]
basePointOfCoonPatch CoonPatch
    { _north :: forall weight. CoonPatch weight -> CubicBezier
_north = CubicBezier UV
a UV
_ UV
_ UV
b
    , _south :: forall weight. CoonPatch weight -> CubicBezier
_south = CubicBezier UV
c UV
_ UV
_ UV
d
    , _coonValues :: forall weight. CoonPatch weight -> weight
_coonValues = ParametricValues { px
_westValue :: px
_southValue :: px
_eastValue :: px
_northValue :: px
_westValue :: forall a. ParametricValues a -> a
_southValue :: forall a. ParametricValues a -> a
_eastValue :: forall a. ParametricValues a -> a
_northValue :: forall a. ParametricValues a -> a
.. }
    } = [(UV
a, px
_northValue), (UV
b, px
_eastValue), (UV
c, px
_southValue), (UV
d, px
_westValue)]

controlPointOfCoonPatch :: CoonPatch px -> [Point]
controlPointOfCoonPatch :: CoonPatch px -> [UV]
controlPointOfCoonPatch CoonPatch
    { _north :: forall weight. CoonPatch weight -> CubicBezier
_north = CubicBezier UV
_ UV
a UV
b UV
_
    , _east :: forall weight. CoonPatch weight -> CubicBezier
_east  = CubicBezier UV
_ UV
c UV
d UV
_
    , _south :: forall weight. CoonPatch weight -> CubicBezier
_south = CubicBezier UV
_ UV
e UV
f UV
_
    , _west :: forall weight. CoonPatch weight -> CubicBezier
_west  = CubicBezier UV
_ UV
g UV
h UV
_
    } = [UV
a, UV
b, UV
c, UV
d, UV
e, UV
f, UV
g, UV
h]

-- | Store the new generated information after subdivision

-- in 4 quadrants.

data Subdivided a = Subdivided
  { Subdivided a -> a
_northWest :: !a -- ^ Upper left

  , Subdivided a -> a
_northEast :: !a -- ^ Upper right

  , Subdivided a -> a
_southWest :: !a -- ^ Lower left

  , Subdivided a -> a
_southEast :: !a -- ^ Lower right

  }

-- | Split a coon patch into four new quadrants

subdividePatch :: CoonPatch UVPatch -> Subdivided (CoonPatch UVPatch)
subdividePatch :: CoonPatch (ParametricValues UV)
-> Subdivided (CoonPatch (ParametricValues UV))
subdividePatch CoonPatch (ParametricValues UV)
patch = Subdivided :: forall a. a -> a -> a -> a -> Subdivided a
Subdivided
    { _northWest :: CoonPatch (ParametricValues UV)
_northWest = CoonPatch (ParametricValues UV)
northWest
    , _northEast :: CoonPatch (ParametricValues UV)
_northEast = CoonPatch (ParametricValues UV)
northEast
    , _southWest :: CoonPatch (ParametricValues UV)
_southWest = CoonPatch (ParametricValues UV)
southWest
    , _southEast :: CoonPatch (ParametricValues UV)
_southEast = CoonPatch (ParametricValues UV)
southEast
    } where
  north :: CubicBezier
north@(CubicBezier UV
nw UV
_ UV
_ UV
ne) = CoonPatch (ParametricValues UV) -> CubicBezier
forall weight. CoonPatch weight -> CubicBezier
_north CoonPatch (ParametricValues UV)
patch
  south :: CubicBezier
south@(CubicBezier UV
se UV
_ UV
_ UV
sw) = CoonPatch (ParametricValues UV) -> CubicBezier
forall weight. CoonPatch weight -> CubicBezier
_south CoonPatch (ParametricValues UV)
patch

  midNorthLinear :: UV
midNorthLinear = UV
nw UV -> UV -> UV
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` UV
ne
  midSouthLinear :: UV
midSouthLinear = UV
sw UV -> UV -> UV
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` UV
se
  midWestLinear :: UV
midWestLinear = UV
nw UV -> UV -> UV
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` UV
sw
  midEastLinear :: UV
midEastLinear = UV
ne UV -> UV -> UV
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` UV
se

  -- These points are to calculate S_C and S_D

  (northLeft :: CubicBezier
northLeft@(CubicBezier UV
_ UV
_ UV
_ UV
midNorth), CubicBezier
northRight) = CubicBezier -> (CubicBezier, CubicBezier)
divideCubicBezier CubicBezier
north
  (CubicBezier
southRight, southLeft :: CubicBezier
southLeft@(CubicBezier UV
midSouth UV
_ UV
_ UV
_ )) = CubicBezier -> (CubicBezier, CubicBezier)
divideCubicBezier CubicBezier
south
  (CubicBezier
westBottom, westTop :: CubicBezier
westTop@(CubicBezier UV
midWest UV
_ UV
_ UV
_)) = CubicBezier -> (CubicBezier, CubicBezier)
divideCubicBezier (CubicBezier -> (CubicBezier, CubicBezier))
-> CubicBezier -> (CubicBezier, CubicBezier)
forall a b. (a -> b) -> a -> b
$ CoonPatch (ParametricValues UV) -> CubicBezier
forall weight. CoonPatch weight -> CubicBezier
_west CoonPatch (ParametricValues UV)
patch
  (eastTop :: CubicBezier
eastTop@(CubicBezier UV
_ UV
_ UV
_ UV
midEast), CubicBezier
eastBottom) = CubicBezier -> (CubicBezier, CubicBezier)
divideCubicBezier (CubicBezier -> (CubicBezier, CubicBezier))
-> CubicBezier -> (CubicBezier, CubicBezier)
forall a b. (a -> b) -> a -> b
$ CoonPatch (ParametricValues UV) -> CubicBezier
forall weight. CoonPatch weight -> CubicBezier
_east CoonPatch (ParametricValues UV)
patch

  -- This points are to calculate S_B

  midNorthSouth :: CubicBezier
midNorthSouth = CubicBezier
north CubicBezier -> CubicBezier -> CubicBezier
`midCurve` CubicBezier
south
  midEastWest :: CubicBezier
midEastWest = CoonPatch (ParametricValues UV) -> CubicBezier
forall weight. CoonPatch weight -> CubicBezier
_east CoonPatch (ParametricValues UV)
patch CubicBezier -> CubicBezier -> CubicBezier
`midCurve` CoonPatch (ParametricValues UV) -> CubicBezier
forall weight. CoonPatch weight -> CubicBezier
_west CoonPatch (ParametricValues UV)
patch 

  (CubicBezier
splitNorthSouthTop, CubicBezier
splitNorthSouthBottom) =
      CubicBezier -> (CubicBezier, CubicBezier)
divideCubicBezier (CubicBezier -> (CubicBezier, CubicBezier))
-> CubicBezier -> (CubicBezier, CubicBezier)
forall a b. (a -> b) -> a -> b
$ CubicBezier -> CubicBezier -> CubicBezier -> CubicBezier
combine
        CubicBezier
midEastWest
        (UV
midNorth UV -> UV -> CubicBezier
`straightLine` UV
midSouth)
        (UV
midNorthLinear UV -> UV -> CubicBezier
`straightLine` UV
midSouthLinear)

  (CubicBezier
splitWestEastLeft, CubicBezier
splitWestEastRight) =
      CubicBezier -> (CubicBezier, CubicBezier)
divideCubicBezier (CubicBezier -> (CubicBezier, CubicBezier))
-> CubicBezier -> (CubicBezier, CubicBezier)
forall a b. (a -> b) -> a -> b
$ CubicBezier -> CubicBezier -> CubicBezier -> CubicBezier
combine
        CubicBezier
midNorthSouth
        (UV
midWest UV -> UV -> CubicBezier
`straightLine` UV
midEast)
        (UV
midWestLinear UV -> UV -> CubicBezier
`straightLine` UV
midEastLinear)

  weights :: Subdivided (ParametricValues UV)
weights = ParametricValues UV -> Subdivided (ParametricValues UV)
subdivideWeights (ParametricValues UV -> Subdivided (ParametricValues UV))
-> ParametricValues UV -> Subdivided (ParametricValues UV)
forall a b. (a -> b) -> a -> b
$ CoonPatch (ParametricValues UV) -> ParametricValues UV
forall weight. CoonPatch weight -> weight
_coonValues CoonPatch (ParametricValues UV)
patch

  northWest :: CoonPatch (ParametricValues UV)
northWest = CoonPatch :: forall weight.
CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> weight
-> CoonPatch weight
CoonPatch
    { _west :: CubicBezier
_west = CubicBezier
westTop
    , _north :: CubicBezier
_north = CubicBezier
northLeft
    , _east :: CubicBezier
_east = CubicBezier
splitNorthSouthTop
    , _south :: CubicBezier
_south = CubicBezier -> CubicBezier
inverseBezier CubicBezier
splitWestEastLeft
    , _coonValues :: ParametricValues UV
_coonValues = Subdivided (ParametricValues UV) -> ParametricValues UV
forall a. Subdivided a -> a
_northWest Subdivided (ParametricValues UV)
weights
    }

  northEast :: CoonPatch (ParametricValues UV)
northEast = CoonPatch :: forall weight.
CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> weight
-> CoonPatch weight
CoonPatch
    { _west :: CubicBezier
_west = CubicBezier -> CubicBezier
inverseBezier CubicBezier
splitNorthSouthTop
    , _north :: CubicBezier
_north = CubicBezier
northRight
    , _east :: CubicBezier
_east = CubicBezier
eastTop
    , _south :: CubicBezier
_south = CubicBezier -> CubicBezier
inverseBezier CubicBezier
splitWestEastRight
    , _coonValues :: ParametricValues UV
_coonValues = Subdivided (ParametricValues UV) -> ParametricValues UV
forall a. Subdivided a -> a
_northEast Subdivided (ParametricValues UV)
weights
    }

  southWest :: CoonPatch (ParametricValues UV)
southWest = CoonPatch :: forall weight.
CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> weight
-> CoonPatch weight
CoonPatch
    { _west :: CubicBezier
_west = CubicBezier
westBottom
    , _north :: CubicBezier
_north = CubicBezier
splitWestEastLeft
    , _east :: CubicBezier
_east = CubicBezier
splitNorthSouthBottom
    , _south :: CubicBezier
_south = CubicBezier
southLeft
    , _coonValues :: ParametricValues UV
_coonValues = Subdivided (ParametricValues UV) -> ParametricValues UV
forall a. Subdivided a -> a
_southWest Subdivided (ParametricValues UV)
weights
    }

  southEast :: CoonPatch (ParametricValues UV)
southEast = CoonPatch :: forall weight.
CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> weight
-> CoonPatch weight
CoonPatch
    { _west :: CubicBezier
_west = CubicBezier -> CubicBezier
inverseBezier CubicBezier
splitNorthSouthBottom
    , _north :: CubicBezier
_north = CubicBezier
splitWestEastRight
    , _east :: CubicBezier
_east = CubicBezier
eastBottom
    , _south :: CubicBezier
_south = CubicBezier
southRight
    , _coonValues :: ParametricValues UV
_coonValues = Subdivided (ParametricValues UV) -> ParametricValues UV
forall a. Subdivided a -> a
_southEast Subdivided (ParametricValues UV)
weights
    }


-- | We must reinverse some bezier curve to match the global

-- direction

inverseBezier :: CubicBezier -> CubicBezier
inverseBezier :: CubicBezier -> CubicBezier
inverseBezier (CubicBezier UV
a UV
b UV
c UV
d) = UV -> UV -> UV -> UV -> CubicBezier
CubicBezier UV
d UV
c UV
b UV
a

-- | Calculate the new cubic bezier using S

combine :: CubicBezier -> CubicBezier -> CubicBezier -> CubicBezier
combine :: CubicBezier -> CubicBezier -> CubicBezier -> CubicBezier
combine (CubicBezier UV
a1 UV
b1 UV
c1 UV
d1)
        (CubicBezier UV
a2 UV
b2 UV
c2 UV
d2)
        (CubicBezier UV
a3 UV
b3 UV
c3 UV
d3) =
  UV -> UV -> UV -> UV -> CubicBezier
CubicBezier (UV
a1 UV -> UV -> UV
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ UV
a2 UV -> UV -> UV
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ UV
a3)
              (UV
b1 UV -> UV -> UV
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ UV
b2 UV -> UV -> UV
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ UV
b3)
              (UV
c1 UV -> UV -> UV
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ UV
c2 UV -> UV -> UV
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ UV
c3)
              (UV
d1 UV -> UV -> UV
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ UV
d2 UV -> UV -> UV
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ UV
d3)


straightLine :: Point -> Point -> CubicBezier
straightLine :: UV -> UV -> CubicBezier
straightLine UV
a UV
b = UV -> UV -> UV -> UV -> CubicBezier
CubicBezier UV
a UV
p1 UV
p2 UV
b where
  p1 :: UV
p1 = CoonColorWeight -> UV -> UV -> UV
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp (CoonColorWeight
1CoonColorWeight -> CoonColorWeight -> CoonColorWeight
forall a. Fractional a => a -> a -> a
/CoonColorWeight
3) UV
b UV
a
  p2 :: UV
p2 = CoonColorWeight -> UV -> UV -> UV
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp (CoonColorWeight
2CoonColorWeight -> CoonColorWeight -> CoonColorWeight
forall a. Fractional a => a -> a -> a
/CoonColorWeight
3) UV
b UV
a


-- | The curves in the coon patch are inversed!

midCurve :: CubicBezier -> CubicBezier -> CubicBezier
midCurve :: CubicBezier -> CubicBezier -> CubicBezier
midCurve (CubicBezier UV
a UV
b UV
c UV
d) (CubicBezier UV
d' UV
c' UV
b' UV
a') =
  UV -> UV -> UV -> UV -> CubicBezier
CubicBezier
    (UV
a UV -> UV -> UV
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` UV
a')
    (UV
b UV -> UV -> UV
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` UV
b')
    (UV
c UV -> UV -> UV
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` UV
c')
    (UV
d UV -> UV -> UV
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` UV
d')

-- | Draw the 4 bezier spline representing the boundary of a coon patch.

drawCoonPatchOutline :: CoonPatch px -> Drawing pxb ()
drawCoonPatchOutline :: CoonPatch px -> Drawing pxb ()
drawCoonPatchOutline CoonPatch { px
CubicBezier
_coonValues :: px
_west :: CubicBezier
_south :: CubicBezier
_east :: CubicBezier
_north :: CubicBezier
_coonValues :: forall weight. CoonPatch weight -> weight
_west :: forall weight. CoonPatch weight -> CubicBezier
_south :: forall weight. CoonPatch weight -> CubicBezier
_east :: forall weight. CoonPatch weight -> CubicBezier
_north :: forall weight. CoonPatch weight -> CubicBezier
.. } =
  DrawCommand pxb () -> Drawing pxb ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (DrawCommand pxb () -> Drawing pxb ())
-> DrawCommand pxb () -> Drawing pxb ()
forall a b. (a -> b) -> a -> b
$ CoonColorWeight
-> Join -> (Cap, Cap) -> [Primitive] -> () -> DrawCommand pxb ()
forall px next.
CoonColorWeight
-> Join -> (Cap, Cap) -> [Primitive] -> next -> DrawCommand px next
Stroke CoonColorWeight
2 Join
JoinRound (Cap
CapRound, Cap
CapRound) [Primitive]
prims ()
  where
    prims :: [Primitive]
prims = [CubicBezier] -> [Primitive]
forall a. Geometry a => a -> [Primitive]
toPrimitives [CubicBezier
_north, CubicBezier
_east, CubicBezier
_south, CubicBezier
_west]

pointsOf :: PointFoldable v => v -> [Point]
pointsOf :: v -> [UV]
pointsOf = ([UV] -> UV -> [UV]) -> [UV] -> v -> [UV]
forall a b. PointFoldable a => (b -> UV -> b) -> b -> a -> b
foldPoints ((UV -> [UV] -> [UV]) -> [UV] -> UV -> [UV]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) []

-- | Used to describe how to debug print a coon/tensort patch.

data DebugOption = DebugOption
  { DebugOption -> Bool
_drawControlMesh    :: !Bool
  , DebugOption -> Bool
_drawBaseVertices   :: !Bool
  , DebugOption -> Bool
_drawControVertices :: !Bool
  , DebugOption -> Bool
_colorVertices      :: !Bool
  , DebugOption -> Bool
_drawOutline        :: !Bool
  , DebugOption -> PixelRGBA8
_outlineColor       :: !PixelRGBA8
  , DebugOption -> PixelRGBA8
_controlMeshColor   :: !PixelRGBA8
  , DebugOption -> PixelRGBA8
_vertexColor        :: !PixelRGBA8
  , DebugOption -> PixelRGBA8
_controlColor       :: !PixelRGBA8
  }

-- | Default options drawing nearly everything.

defaultDebug :: DebugOption
defaultDebug :: DebugOption
defaultDebug = DebugOption :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> PixelRGBA8
-> PixelRGBA8
-> PixelRGBA8
-> PixelRGBA8
-> DebugOption
DebugOption
  { _drawControlMesh :: Bool
_drawControlMesh    = Bool
True
  , _drawBaseVertices :: Bool
_drawBaseVertices   = Bool
True
  , _drawControVertices :: Bool
_drawControVertices = Bool
True
  , _drawOutline :: Bool
_drawOutline        = Bool
True
  , _colorVertices :: Bool
_colorVertices      = Bool
False
  , _outlineColor :: PixelRGBA8
_outlineColor       = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
0 Pixel8
0 Pixel8
0 Pixel8
255
  , _controlMeshColor :: PixelRGBA8
_controlMeshColor   = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
50 Pixel8
50 Pixel8
128 Pixel8
255
  , _vertexColor :: PixelRGBA8
_vertexColor        = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
20 Pixel8
20 Pixel8
40 Pixel8
255
  , _controlColor :: PixelRGBA8
_controlColor       = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
20 Pixel8
20 Pixel8
40 Pixel8
255
  }

-- | Helper function drawing many information about a coon patch.

debugDrawCoonPatch :: DebugOption -> CoonPatch (ParametricValues PixelRGBA8)
                   -> Drawing PixelRGBA8 ()
debugDrawCoonPatch :: DebugOption
-> CoonPatch (ParametricValues PixelRGBA8) -> Drawing PixelRGBA8 ()
debugDrawCoonPatch DebugOption { Bool
PixelRGBA8
_controlColor :: PixelRGBA8
_vertexColor :: PixelRGBA8
_controlMeshColor :: PixelRGBA8
_outlineColor :: PixelRGBA8
_drawOutline :: Bool
_colorVertices :: Bool
_drawControVertices :: Bool
_drawBaseVertices :: Bool
_drawControlMesh :: Bool
_controlColor :: DebugOption -> PixelRGBA8
_vertexColor :: DebugOption -> PixelRGBA8
_controlMeshColor :: DebugOption -> PixelRGBA8
_outlineColor :: DebugOption -> PixelRGBA8
_drawOutline :: DebugOption -> Bool
_colorVertices :: DebugOption -> Bool
_drawControVertices :: DebugOption -> Bool
_drawBaseVertices :: DebugOption -> Bool
_drawControlMesh :: DebugOption -> Bool
.. } patch :: CoonPatch (ParametricValues PixelRGBA8)
patch@(CoonPatch { CubicBezier
ParametricValues PixelRGBA8
_coonValues :: ParametricValues PixelRGBA8
_west :: CubicBezier
_south :: CubicBezier
_east :: CubicBezier
_north :: CubicBezier
_coonValues :: forall weight. CoonPatch weight -> weight
_west :: forall weight. CoonPatch weight -> CubicBezier
_south :: forall weight. CoonPatch weight -> CubicBezier
_east :: forall weight. CoonPatch weight -> CubicBezier
_north :: forall weight. CoonPatch weight -> CubicBezier
.. }) = do
  let stroker :: [Primitive] -> m ()
stroker [Primitive]
v = DrawCommand px () -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (DrawCommand px () -> m ()) -> DrawCommand px () -> m ()
forall a b. (a -> b) -> a -> b
$ CoonColorWeight
-> Join -> (Cap, Cap) -> [Primitive] -> () -> DrawCommand px ()
forall px next.
CoonColorWeight
-> Join -> (Cap, Cap) -> [Primitive] -> next -> DrawCommand px next
Stroke CoonColorWeight
2 Join
JoinRound (Cap
CapRound, Cap
CapRound) [Primitive]
v ()
      fill :: [Primitive] -> m ()
fill [Primitive]
sub = DrawCommand px () -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (DrawCommand px () -> m ()) -> DrawCommand px () -> m ()
forall a b. (a -> b) -> a -> b
$ FillMethod -> [Primitive] -> () -> DrawCommand px ()
forall px next.
FillMethod -> [Primitive] -> next -> DrawCommand px next
Fill FillMethod
FillWinding [Primitive]
sub ()
      setColor' :: px -> Drawing px () -> m ()
setColor' px
c Drawing px ()
inner = DrawCommand px () -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (DrawCommand px () -> m ()) -> DrawCommand px () -> m ()
forall a b. (a -> b) -> a -> b
$ Texture px -> Drawing px () -> () -> DrawCommand px ()
forall px next.
Texture px -> Drawing px () -> next -> DrawCommand px next
SetTexture (px -> Texture px
forall px. px -> Texture px
SolidTexture px
c) Drawing px ()
inner ()
  Bool -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
_drawOutline (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$
    PixelRGBA8 -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
px -> Drawing px () -> m ()
setColor' PixelRGBA8
_outlineColor (CoonPatch (ParametricValues PixelRGBA8) -> Drawing PixelRGBA8 ()
forall px pxb. CoonPatch px -> Drawing pxb ()
drawCoonPatchOutline CoonPatch (ParametricValues PixelRGBA8)
patch)

  Bool -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
_drawBaseVertices (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$
    [(UV, PixelRGBA8)]
-> ((UV, PixelRGBA8) -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (CoonPatch (ParametricValues PixelRGBA8) -> [(UV, PixelRGBA8)]
forall px. CoonPatch (ParametricValues px) -> [(UV, px)]
basePointOfCoonPatch CoonPatch (ParametricValues PixelRGBA8)
patch) (((UV, PixelRGBA8) -> Drawing PixelRGBA8 ())
 -> Drawing PixelRGBA8 ())
-> ((UV, PixelRGBA8) -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ \(UV
p, PixelRGBA8
c) ->
       if Bool -> Bool
not Bool
_colorVertices then
         PixelRGBA8 -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
px -> Drawing px () -> m ()
setColor' PixelRGBA8
_vertexColor ([Primitive] -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
[Primitive] -> m ()
stroker ([Primitive] -> Drawing PixelRGBA8 ())
-> [Primitive] -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ UV -> CoonColorWeight -> [Primitive]
circle UV
p CoonColorWeight
4)
       else do
         PixelRGBA8 -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
px -> Drawing px () -> m ()
setColor' PixelRGBA8
c (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> ([Primitive] -> Drawing PixelRGBA8 ())
-> [Primitive]
-> Drawing PixelRGBA8 ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive] -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
[Primitive] -> m ()
fill ([Primitive] -> Drawing PixelRGBA8 ())
-> [Primitive] -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ UV -> CoonColorWeight -> [Primitive]
circle UV
p CoonColorWeight
4
         PixelRGBA8 -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
px -> Drawing px () -> m ()
setColor' PixelRGBA8
_vertexColor (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> ([Primitive] -> Drawing PixelRGBA8 ())
-> [Primitive]
-> Drawing PixelRGBA8 ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive] -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
[Primitive] -> m ()
stroker ([Primitive] -> Drawing PixelRGBA8 ())
-> [Primitive] -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ UV -> CoonColorWeight -> [Primitive]
circle UV
p CoonColorWeight
5

  Bool -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
_drawControVertices (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$
    [UV] -> (UV -> Drawing PixelRGBA8 ()) -> Drawing PixelRGBA8 ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (CoonPatch (ParametricValues PixelRGBA8) -> [UV]
forall px. CoonPatch px -> [UV]
controlPointOfCoonPatch CoonPatch (ParametricValues PixelRGBA8)
patch) ((UV -> Drawing PixelRGBA8 ()) -> Drawing PixelRGBA8 ())
-> (UV -> Drawing PixelRGBA8 ()) -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ \UV
p ->
       PixelRGBA8 -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
px -> Drawing px () -> m ()
setColor' PixelRGBA8
_controlColor (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> ([Primitive] -> Drawing PixelRGBA8 ())
-> [Primitive]
-> Drawing PixelRGBA8 ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive] -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
[Primitive] -> m ()
stroker ([Primitive] -> Drawing PixelRGBA8 ())
-> [Primitive] -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ UV -> CoonColorWeight -> [Primitive]
circle UV
p CoonColorWeight
4

  let controlDraw :: CubicBezier -> Drawing PixelRGBA8 ()
controlDraw = [Primitive] -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
[Primitive] -> m ()
stroker ([Primitive] -> Drawing PixelRGBA8 ())
-> (CubicBezier -> [Primitive])
-> CubicBezier
-> Drawing PixelRGBA8 ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Line] -> [Primitive]
forall a. Geometry a => a -> [Primitive]
toPrimitives ([Line] -> [Primitive])
-> (CubicBezier -> [Line]) -> CubicBezier -> [Primitive]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UV] -> [Line]
lineFromPath ([UV] -> [Line]) -> (CubicBezier -> [UV]) -> CubicBezier -> [Line]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier -> [UV]
forall v. PointFoldable v => v -> [UV]
pointsOf
  Bool -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
_drawControlMesh (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$
    PixelRGBA8 -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
px -> Drawing px () -> m ()
setColor' PixelRGBA8
_controlMeshColor (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ do
        (CubicBezier -> Drawing PixelRGBA8 ())
-> [CubicBezier] -> Drawing PixelRGBA8 ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CubicBezier -> Drawing PixelRGBA8 ()
controlDraw [CubicBezier
_north, CubicBezier
_east, CubicBezier
_west, CubicBezier
_south]

-- | Helper function drawing many information about a tensor patch.

debugDrawTensorPatch :: DebugOption -> TensorPatch (ParametricValues px)
                     -> Drawing PixelRGBA8 ()
debugDrawTensorPatch :: DebugOption
-> TensorPatch (ParametricValues px) -> Drawing PixelRGBA8 ()
debugDrawTensorPatch DebugOption { Bool
PixelRGBA8
_controlColor :: PixelRGBA8
_vertexColor :: PixelRGBA8
_controlMeshColor :: PixelRGBA8
_outlineColor :: PixelRGBA8
_drawOutline :: Bool
_colorVertices :: Bool
_drawControVertices :: Bool
_drawBaseVertices :: Bool
_drawControlMesh :: Bool
_controlColor :: DebugOption -> PixelRGBA8
_vertexColor :: DebugOption -> PixelRGBA8
_controlMeshColor :: DebugOption -> PixelRGBA8
_outlineColor :: DebugOption -> PixelRGBA8
_drawOutline :: DebugOption -> Bool
_colorVertices :: DebugOption -> Bool
_drawControVertices :: DebugOption -> Bool
_drawBaseVertices :: DebugOption -> Bool
_drawControlMesh :: DebugOption -> Bool
.. } TensorPatch (ParametricValues px)
p = do
  let stroker :: [Primitive] -> m ()
stroker [Primitive]
v = DrawCommand px () -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (DrawCommand px () -> m ()) -> DrawCommand px () -> m ()
forall a b. (a -> b) -> a -> b
$ CoonColorWeight
-> Join -> (Cap, Cap) -> [Primitive] -> () -> DrawCommand px ()
forall px next.
CoonColorWeight
-> Join -> (Cap, Cap) -> [Primitive] -> next -> DrawCommand px next
Stroke CoonColorWeight
2 Join
JoinRound (Cap
CapRound, Cap
CapRound) [Primitive]
v ()
      setColor' :: px -> Drawing px () -> m ()
setColor' px
c Drawing px ()
inner =
          DrawCommand px () -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (DrawCommand px () -> m ()) -> DrawCommand px () -> m ()
forall a b. (a -> b) -> a -> b
$ Texture px -> Drawing px () -> () -> DrawCommand px ()
forall px next.
Texture px -> Drawing px () -> next -> DrawCommand px next
SetTexture (px -> Texture px
forall px. px -> Texture px
SolidTexture px
c) Drawing px ()
inner ()
      p' :: TensorPatch (ParametricValues px)
p' = TensorPatch (ParametricValues px)
-> TensorPatch (ParametricValues px)
forall a.
TensorPatch (ParametricValues a)
-> TensorPatch (ParametricValues a)
transposePatch TensorPatch (ParametricValues px)
p

  Bool -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
_drawOutline (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$
    PixelRGBA8 -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
px -> Drawing px () -> m ()
setColor' PixelRGBA8
_outlineColor (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$
        (CubicBezier -> Drawing PixelRGBA8 ())
-> [CubicBezier] -> Drawing PixelRGBA8 ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Primitive] -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
[Primitive] -> m ()
stroker ([Primitive] -> Drawing PixelRGBA8 ())
-> (CubicBezier -> [Primitive])
-> CubicBezier
-> Drawing PixelRGBA8 ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier -> [Primitive]
forall a. Geometry a => a -> [Primitive]
toPrimitives)
            [ TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve0 TensorPatch (ParametricValues px)
p, TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve1 TensorPatch (ParametricValues px)
p, TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve2 TensorPatch (ParametricValues px)
p, TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve3 TensorPatch (ParametricValues px)
p
            , TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve0 TensorPatch (ParametricValues px)
p', TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve1 TensorPatch (ParametricValues px)
p', TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve2 TensorPatch (ParametricValues px)
p', TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve3 TensorPatch (ParametricValues px)
p']

  Bool -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
_drawBaseVertices   (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$
    PixelRGBA8 -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
px -> Drawing px () -> m ()
setColor' PixelRGBA8
_vertexColor (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$
        [UV] -> (UV -> Drawing PixelRGBA8 ()) -> Drawing PixelRGBA8 ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (TensorPatch (ParametricValues px) -> [UV]
forall v. PointFoldable v => v -> [UV]
pointsOf TensorPatch (ParametricValues px)
p) ((UV -> Drawing PixelRGBA8 ()) -> Drawing PixelRGBA8 ())
-> (UV -> Drawing PixelRGBA8 ()) -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ \UV
pp -> [Primitive] -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
[Primitive] -> m ()
stroker ([Primitive] -> Drawing PixelRGBA8 ())
-> [Primitive] -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ UV -> CoonColorWeight -> [Primitive]
circle UV
pp CoonColorWeight
4

  let controlDraw :: CubicBezier -> Drawing PixelRGBA8 ()
controlDraw = [Primitive] -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
[Primitive] -> m ()
stroker ([Primitive] -> Drawing PixelRGBA8 ())
-> (CubicBezier -> [Primitive])
-> CubicBezier
-> Drawing PixelRGBA8 ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Line] -> [Primitive]
forall a. Geometry a => a -> [Primitive]
toPrimitives ([Line] -> [Primitive])
-> (CubicBezier -> [Line]) -> CubicBezier -> [Primitive]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UV] -> [Line]
lineFromPath ([UV] -> [Line]) -> (CubicBezier -> [UV]) -> CubicBezier -> [Line]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier -> [UV]
forall v. PointFoldable v => v -> [UV]
pointsOf
  Bool -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
_drawControlMesh (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$
    PixelRGBA8 -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
px -> Drawing px () -> m ()
setColor' PixelRGBA8
_controlMeshColor (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ do
        (CubicBezier -> Drawing PixelRGBA8 ())
-> [CubicBezier] -> Drawing PixelRGBA8 ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CubicBezier -> Drawing PixelRGBA8 ()
controlDraw
            [ TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve0 TensorPatch (ParametricValues px)
p, TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve1 TensorPatch (ParametricValues px)
p, TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve2 TensorPatch (ParametricValues px)
p, TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve3 TensorPatch (ParametricValues px)
p
            , TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve0 TensorPatch (ParametricValues px)
p', TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve1 TensorPatch (ParametricValues px)
p', TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve2 TensorPatch (ParametricValues px)
p', TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve3 TensorPatch (ParametricValues px)
p']

-- | Define the unit square in [0, 1]^2

parametricBase :: UVPatch
parametricBase :: ParametricValues UV
parametricBase = ParametricValues :: forall a. a -> a -> a -> a -> ParametricValues a
ParametricValues
  { _northValue :: UV
_northValue = CoonColorWeight -> CoonColorWeight -> UV
forall a. a -> a -> V2 a
V2 CoonColorWeight
0 CoonColorWeight
0
  , _eastValue :: UV
_eastValue  = CoonColorWeight -> CoonColorWeight -> UV
forall a. a -> a -> V2 a
V2 CoonColorWeight
1 CoonColorWeight
0
  , _southValue :: UV
_southValue = CoonColorWeight -> CoonColorWeight -> UV
forall a. a -> a -> V2 a
V2 CoonColorWeight
1 CoonColorWeight
1
  , _westValue :: UV
_westValue  = CoonColorWeight -> CoonColorWeight -> UV
forall a. a -> a -> V2 a
V2 CoonColorWeight
0 CoonColorWeight
1
  }

-- | Render a simple coon mesh, with only color on the vertices.

renderCoonMesh :: forall m px.
                  (PrimMonad m, RenderablePixel px, BiSampleable (ParametricValues px) px)
               => MeshPatch px -> DrawContext m px ()
renderCoonMesh :: MeshPatch px -> DrawContext m px ()
renderCoonMesh = (CoonPatch (ParametricValues px) -> DrawContext m px ())
-> [CoonPatch (ParametricValues px)] -> DrawContext m px ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TensorPatch (ParametricValues px) -> DrawContext m px ()
forall (m :: * -> *) px src.
(PrimMonad m, ModulablePixel px, BiSampleable src px) =>
TensorPatch src -> DrawContext m px ()
rasterizeTensorPatch (TensorPatch (ParametricValues px) -> DrawContext m px ())
-> (CoonPatch (ParametricValues px)
    -> TensorPatch (ParametricValues px))
-> CoonPatch (ParametricValues px)
-> DrawContext m px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoonPatch (ParametricValues px)
-> TensorPatch (ParametricValues px)
forall a. CoonPatch a -> TensorPatch a
toTensorPatch) ([CoonPatch (ParametricValues px)] -> DrawContext m px ())
-> (MeshPatch px -> [CoonPatch (ParametricValues px)])
-> MeshPatch px
-> DrawContext m px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MeshPatch px -> [CoonPatch (ParametricValues px)]
forall px. MeshPatch px -> [CoonPatch (ParametricValues px)]
coonPatchesOf

-- | Render a coon mesh but using cubic interpolation for the color.

renderCoonMeshBicubic :: forall m px.
                         ( PrimMonad m
                         , RenderablePixel px
                         , BiSampleable (CubicCoefficient px) px)
                      => MeshPatch px -> DrawContext m px ()
renderCoonMeshBicubic :: MeshPatch px -> DrawContext m px ()
renderCoonMeshBicubic =
  (CoonPatch (CubicCoefficient px) -> DrawContext m px ())
-> [CoonPatch (CubicCoefficient px)] -> DrawContext m px ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TensorPatch (CubicCoefficient px) -> DrawContext m px ()
forall (m :: * -> *) px src.
(PrimMonad m, ModulablePixel px, BiSampleable src px) =>
TensorPatch src -> DrawContext m px ()
rasterizeTensorPatch (TensorPatch (CubicCoefficient px) -> DrawContext m px ())
-> (CoonPatch (CubicCoefficient px)
    -> TensorPatch (CubicCoefficient px))
-> CoonPatch (CubicCoefficient px)
-> DrawContext m px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoonPatch (CubicCoefficient px)
-> TensorPatch (CubicCoefficient px)
forall a. CoonPatch a -> TensorPatch a
toTensorPatch)
    ([CoonPatch (CubicCoefficient px)] -> DrawContext m px ())
-> (MeshPatch px -> [CoonPatch (CubicCoefficient px)])
-> MeshPatch px
-> DrawContext m px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MeshPatch (Derivative px) -> [CoonPatch (CubicCoefficient px)]
forall px.
InterpolablePixel px =>
MeshPatch (Derivative px) -> [CoonPatch (CubicCoefficient px)]
cubicCoonPatchesOf
    (MeshPatch (Derivative px) -> [CoonPatch (CubicCoefficient px)])
-> (MeshPatch px -> MeshPatch (Derivative px))
-> MeshPatch px
-> [CoonPatch (CubicCoefficient px)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MeshPatch px -> MeshPatch (Derivative px)
forall px.
InterpolablePixel px =>
MeshPatch px -> MeshPatch (Derivative px)
calculateMeshColorDerivative

-- | Render an mesh patch by interpolating accross an image.

renderImageMesh :: PrimMonad m
                => MeshPatch (ImageMesh PixelRGBA8) -> DrawContext m PixelRGBA8 ()
renderImageMesh :: MeshPatch (ImageMesh PixelRGBA8) -> DrawContext m PixelRGBA8 ()
renderImageMesh = (CoonPatch (ImageMesh PixelRGBA8) -> DrawContext m PixelRGBA8 ())
-> [CoonPatch (ImageMesh PixelRGBA8)]
-> DrawContext m PixelRGBA8 ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TensorPatch (ImageMesh PixelRGBA8) -> DrawContext m PixelRGBA8 ()
forall (m :: * -> *) px src.
(PrimMonad m, ModulablePixel px, BiSampleable src px) =>
TensorPatch src -> DrawContext m px ()
rasterizeTensorPatch (TensorPatch (ImageMesh PixelRGBA8) -> DrawContext m PixelRGBA8 ())
-> (CoonPatch (ImageMesh PixelRGBA8)
    -> TensorPatch (ImageMesh PixelRGBA8))
-> CoonPatch (ImageMesh PixelRGBA8)
-> DrawContext m PixelRGBA8 ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoonPatch (ImageMesh PixelRGBA8)
-> TensorPatch (ImageMesh PixelRGBA8)
forall a. CoonPatch a -> TensorPatch a
toTensorPatch) ([CoonPatch (ImageMesh PixelRGBA8)] -> DrawContext m PixelRGBA8 ())
-> (MeshPatch (ImageMesh PixelRGBA8)
    -> [CoonPatch (ImageMesh PixelRGBA8)])
-> MeshPatch (ImageMesh PixelRGBA8)
-> DrawContext m PixelRGBA8 ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MeshPatch (ImageMesh PixelRGBA8)
-> [CoonPatch (ImageMesh PixelRGBA8)]
forall px. MeshPatch (ImageMesh px) -> [CoonPatch (ImageMesh px)]
imagePatchesOf

-- | Render a coon patch using the subdivision algorithm (potentially slower

-- and less precise in case of image mesh.

renderCoonPatch :: forall m interp px.
                   (PrimMonad m, RenderablePixel px, BiSampleable interp px)
                => CoonPatch interp -> DrawContext m px ()
renderCoonPatch :: CoonPatch interp -> DrawContext m px ()
renderCoonPatch CoonPatch interp
p = Int -> CoonPatch interp -> DrawContext m px ()
forall (m :: * -> *) interp px.
(PrimMonad m, RenderablePixel px, BiSampleable interp px) =>
Int -> CoonPatch interp -> DrawContext m px ()
renderCoonPatchAtDeepness (CoonPatch interp -> Int
forall px. CoonPatch px -> Int
estimateCoonSubdivision CoonPatch interp
p) CoonPatch interp
p

-- | Render a coon patch using the subdivision algorithm (potentially slower

-- and less precise in case of image mesh). You can provide a max deepness

renderCoonPatchAtDeepness
    :: forall m interp px.
       (PrimMonad m, RenderablePixel px, BiSampleable interp px)
    => Int              -- ^ Maximum subdivision deepness

    -> CoonPatch interp
    -> DrawContext m px ()
renderCoonPatchAtDeepness :: Int -> CoonPatch interp -> DrawContext m px ()
renderCoonPatchAtDeepness Int
maxDeepness CoonPatch interp
originalPatch = Int -> CoonPatch (ParametricValues UV) -> DrawContext m px ()
go Int
maxDeepness CoonPatch (ParametricValues UV)
basePatch where
  baseColors :: interp
baseColors = CoonPatch interp -> interp
forall weight. CoonPatch weight -> weight
_coonValues CoonPatch interp
originalPatch

  basePatch :: CoonPatch (ParametricValues UV)
basePatch = CoonPatch interp
originalPatch { _coonValues :: ParametricValues UV
_coonValues = ParametricValues UV
parametricBase }

  drawPatchUniform :: CoonPatch (ParametricValues UV) -> DrawContext m px ()
drawPatchUniform CoonPatch { CubicBezier
ParametricValues UV
_coonValues :: ParametricValues UV
_west :: CubicBezier
_south :: CubicBezier
_east :: CubicBezier
_north :: CubicBezier
_coonValues :: forall weight. CoonPatch weight -> weight
_west :: forall weight. CoonPatch weight -> CubicBezier
_south :: forall weight. CoonPatch weight -> CubicBezier
_east :: forall weight. CoonPatch weight -> CubicBezier
_north :: forall weight. CoonPatch weight -> CubicBezier
.. } = FillMethod -> Texture px -> [Primitive] -> DrawContext m px ()
forall (m :: * -> *) px.
(PrimMonad m, RenderablePixel px) =>
FillMethod -> Texture px -> [Primitive] -> DrawContext m px ()
fillWithTextureNoAA FillMethod
FillWinding Texture px
texture [Primitive]
geometry where
    geometry :: [Primitive]
geometry = CubicBezier -> Primitive
forall a. Primitivable a => a -> Primitive
toPrim (CubicBezier -> Primitive) -> [CubicBezier] -> [Primitive]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CubicBezier
_north, CubicBezier
_east, CubicBezier
_south, CubicBezier
_west]
    !(V2 CoonColorWeight
u CoonColorWeight
v) =ParametricValues UV -> UV
meanValue ParametricValues UV
_coonValues
    !texture :: Texture px
texture = px -> Texture px
forall px. px -> Texture px
SolidTexture (px -> Texture px) -> px -> Texture px
forall a b. (a -> b) -> a -> b
$ interp -> CoonColorWeight -> CoonColorWeight -> px
forall sampled px.
BiSampleable sampled px =>
sampled -> CoonColorWeight -> CoonColorWeight -> px
interpolate interp
baseColors CoonColorWeight
u CoonColorWeight
v

  go :: Int -> CoonPatch (ParametricValues UV) -> DrawContext m px ()
go Int
0 CoonPatch (ParametricValues UV)
patch = CoonPatch (ParametricValues UV) -> DrawContext m px ()
drawPatchUniform CoonPatch (ParametricValues UV)
patch
  go Int
depth (CoonPatch (ParametricValues UV)
-> Subdivided (CoonPatch (ParametricValues UV))
subdividePatch -> Subdivided { CoonPatch (ParametricValues UV)
_southEast :: CoonPatch (ParametricValues UV)
_southWest :: CoonPatch (ParametricValues UV)
_northEast :: CoonPatch (ParametricValues UV)
_northWest :: CoonPatch (ParametricValues UV)
_southEast :: forall a. Subdivided a -> a
_southWest :: forall a. Subdivided a -> a
_northEast :: forall a. Subdivided a -> a
_northWest :: forall a. Subdivided a -> a
.. }) =
    let d :: Int
d = Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
1 :: Int) in
    Int -> CoonPatch (ParametricValues UV) -> DrawContext m px ()
go Int
d CoonPatch (ParametricValues UV)
_northWest DrawContext m px () -> DrawContext m px () -> DrawContext m px ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> CoonPatch (ParametricValues UV) -> DrawContext m px ()
go Int
d CoonPatch (ParametricValues UV)
_northEast DrawContext m px () -> DrawContext m px () -> DrawContext m px ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> CoonPatch (ParametricValues UV) -> DrawContext m px ()
go Int
d CoonPatch (ParametricValues UV)
_southWest DrawContext m px () -> DrawContext m px () -> DrawContext m px ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> CoonPatch (ParametricValues UV) -> DrawContext m px ()
go Int
d CoonPatch (ParametricValues UV)
_southEast

renderTensorPatch :: forall m sampled px. 
                     (PrimMonad m, RenderablePixel px, BiSampleable sampled px)
                  => TensorPatch sampled -> DrawContext m px ()
renderTensorPatch :: TensorPatch sampled -> DrawContext m px ()
renderTensorPatch TensorPatch sampled
p = Int -> TensorPatch sampled -> DrawContext m px ()
forall (m :: * -> *) sampled px.
(PrimMonad m, RenderablePixel px, BiSampleable sampled px) =>
Int -> TensorPatch sampled -> DrawContext m px ()
renderTensorPatchAtDeepness (TensorPatch sampled -> Int
forall px. TensorPatch px -> Int
estimateTensorSubdivision TensorPatch sampled
p) TensorPatch sampled
p

-- | Render a tensor patch using the subdivision algorithm (potentially slower

-- and less precise in case of image mesh.

renderTensorPatchAtDeepness
  :: forall m sampled px. 
     (PrimMonad m, RenderablePixel px, BiSampleable sampled px)
  => Int -> TensorPatch sampled -> DrawContext m px ()
renderTensorPatchAtDeepness :: Int -> TensorPatch sampled -> DrawContext m px ()
renderTensorPatchAtDeepness Int
maxDeepness TensorPatch sampled
originalPatch = Int -> TensorPatch (ParametricValues UV) -> DrawContext m px ()
go Int
maxDeepness TensorPatch (ParametricValues UV)
basePatch where
  baseColors :: sampled
baseColors = TensorPatch sampled -> sampled
forall weight. TensorPatch weight -> weight
_tensorValues TensorPatch sampled
originalPatch

  basePatch :: TensorPatch (ParametricValues UV)
basePatch = TensorPatch sampled
originalPatch { _tensorValues :: ParametricValues UV
_tensorValues = ParametricValues UV
parametricBase }

  drawPatchUniform :: TensorPatch (ParametricValues UV) -> DrawContext m px ()
drawPatchUniform TensorPatch (ParametricValues UV)
p = FillMethod -> Texture px -> [Primitive] -> DrawContext m px ()
forall (m :: * -> *) px.
(PrimMonad m, RenderablePixel px) =>
FillMethod -> Texture px -> [Primitive] -> DrawContext m px ()
fillWithTextureNoAA FillMethod
FillWinding Texture px
texture [Primitive]
geometry where
    geometry :: [Primitive]
geometry = CubicBezier -> Primitive
forall a. Primitivable a => a -> Primitive
toPrim (CubicBezier -> Primitive) -> [CubicBezier] -> [Primitive]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TensorPatch (ParametricValues UV) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve0 TensorPatch (ParametricValues UV)
p, TensorPatch (ParametricValues UV) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
westCurveOfPatch TensorPatch (ParametricValues UV)
p, TensorPatch (ParametricValues UV) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve3 TensorPatch (ParametricValues UV)
p, TensorPatch (ParametricValues UV) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
eastCurveOfPatch TensorPatch (ParametricValues UV)
p]
    !(V2 CoonColorWeight
u CoonColorWeight
v) = ParametricValues UV -> UV
meanValue (ParametricValues UV -> UV) -> ParametricValues UV -> UV
forall a b. (a -> b) -> a -> b
$ TensorPatch (ParametricValues UV) -> ParametricValues UV
forall weight. TensorPatch weight -> weight
_tensorValues TensorPatch (ParametricValues UV)
p
    texture :: Texture px
texture = px -> Texture px
forall px. px -> Texture px
SolidTexture (px -> Texture px) -> px -> Texture px
forall a b. (a -> b) -> a -> b
$ sampled -> CoonColorWeight -> CoonColorWeight -> px
forall sampled px.
BiSampleable sampled px =>
sampled -> CoonColorWeight -> CoonColorWeight -> px
interpolate sampled
baseColors CoonColorWeight
u CoonColorWeight
v

  go :: Int -> TensorPatch (ParametricValues UV) -> DrawContext m px ()
go Int
0 TensorPatch (ParametricValues UV)
patch = TensorPatch (ParametricValues UV) -> DrawContext m px ()
drawPatchUniform TensorPatch (ParametricValues UV)
patch
  go Int
depth (TensorPatch (ParametricValues UV)
-> Subdivided (TensorPatch (ParametricValues UV))
subdivideTensorPatch -> Subdivided { TensorPatch (ParametricValues UV)
_southEast :: TensorPatch (ParametricValues UV)
_southWest :: TensorPatch (ParametricValues UV)
_northEast :: TensorPatch (ParametricValues UV)
_northWest :: TensorPatch (ParametricValues UV)
_southEast :: forall a. Subdivided a -> a
_southWest :: forall a. Subdivided a -> a
_northEast :: forall a. Subdivided a -> a
_northWest :: forall a. Subdivided a -> a
.. }) =
    let d :: Int
d = Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
1 :: Int) in
    Int -> TensorPatch (ParametricValues UV) -> DrawContext m px ()
go Int
d TensorPatch (ParametricValues UV)
_northWest DrawContext m px () -> DrawContext m px () -> DrawContext m px ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> TensorPatch (ParametricValues UV) -> DrawContext m px ()
go Int
d TensorPatch (ParametricValues UV)
_northEast DrawContext m px () -> DrawContext m px () -> DrawContext m px ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> TensorPatch (ParametricValues UV) -> DrawContext m px ()
go Int
d TensorPatch (ParametricValues UV)
_southWest DrawContext m px () -> DrawContext m px () -> DrawContext m px ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> TensorPatch (ParametricValues UV) -> DrawContext m px ()
go Int
d TensorPatch (ParametricValues UV)
_southEast