{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Graphics.Rasterific.Patch
(
CoonPatch( .. )
, TensorPatch( .. )
, ParametricValues( .. )
, PatchInterpolation( .. )
, CoonColorWeight
, Subdivided( .. )
, InterpolablePixel
, rasterizeTensorPatch
, rasterizeCoonPatch
, renderImageMesh
, renderCoonMesh
, renderCoonMeshBicubic
, renderCoonPatch
, renderCoonPatchAtDeepness
, renderTensorPatch
, renderTensorPatchAtDeepness
, DebugOption( .. )
, defaultDebug
, drawCoonPatchOutline
, debugDrawCoonPatch
, debugDrawTensorPatch
, parametricBase
, 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( .. ) )
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
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
}
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
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
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
}
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
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]
data Subdivided a = Subdivided
{ Subdivided a -> a
_northWest :: !a
, Subdivided a -> a
_northEast :: !a
, Subdivided a -> a
_southWest :: !a
, Subdivided a -> a
_southEast :: !a
}
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
(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
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
}
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
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
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')
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 (:)) []
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
}
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
}
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]
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']
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
}
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
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
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
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
renderCoonPatchAtDeepness
:: forall m interp px.
(PrimMonad m, RenderablePixel px, BiSampleable interp px)
=> Int
-> 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
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