{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Graphics.Rasterific.PatchTypes
(
CoonPatch( .. )
, TensorPatch( .. )
, MeshPatch( .. )
, InterBezier( .. )
, CoonColorWeight
, PatchInterpolation( .. )
, ParametricValues( .. )
, Derivative( .. )
, Derivatives( .. )
, UV
, UVPatch
, CubicCoefficient( .. )
, ImageMesh( .. )
, transposeParametricValues
, coonPointAt
, toTensorPatch
, foldMeshPoints
, isVerticalOrientation
, xDerivative
, yDerivative
) where
import qualified Data.Vector as V
import Codec.Picture( Image )
import Graphics.Rasterific.CubicBezier
import Graphics.Rasterific.MiniLens
import Graphics.Rasterific.Linear
import Graphics.Rasterific.Types
import Graphics.Rasterific.Compositor
import Graphics.Rasterific.Transformations
type CoonColorWeight = Float
data PatchInterpolation
=
PatchBilinear
| PatchBicubic
deriving (PatchInterpolation -> PatchInterpolation -> Bool
(PatchInterpolation -> PatchInterpolation -> Bool)
-> (PatchInterpolation -> PatchInterpolation -> Bool)
-> Eq PatchInterpolation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PatchInterpolation -> PatchInterpolation -> Bool
$c/= :: PatchInterpolation -> PatchInterpolation -> Bool
== :: PatchInterpolation -> PatchInterpolation -> Bool
$c== :: PatchInterpolation -> PatchInterpolation -> Bool
Eq, Int -> PatchInterpolation -> ShowS
[PatchInterpolation] -> ShowS
PatchInterpolation -> String
(Int -> PatchInterpolation -> ShowS)
-> (PatchInterpolation -> String)
-> ([PatchInterpolation] -> ShowS)
-> Show PatchInterpolation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PatchInterpolation] -> ShowS
$cshowList :: [PatchInterpolation] -> ShowS
show :: PatchInterpolation -> String
$cshow :: PatchInterpolation -> String
showsPrec :: Int -> PatchInterpolation -> ShowS
$cshowsPrec :: Int -> PatchInterpolation -> ShowS
Show)
data ParametricValues a = ParametricValues
{ ParametricValues a -> a
_northValue :: !a
, ParametricValues a -> a
_eastValue :: !a
, ParametricValues a -> a
_southValue :: !a
, ParametricValues a -> a
_westValue :: !a
}
deriving (a -> ParametricValues b -> ParametricValues a
(a -> b) -> ParametricValues a -> ParametricValues b
(forall a b. (a -> b) -> ParametricValues a -> ParametricValues b)
-> (forall a b. a -> ParametricValues b -> ParametricValues a)
-> Functor ParametricValues
forall a b. a -> ParametricValues b -> ParametricValues a
forall a b. (a -> b) -> ParametricValues a -> ParametricValues b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ParametricValues b -> ParametricValues a
$c<$ :: forall a b. a -> ParametricValues b -> ParametricValues a
fmap :: (a -> b) -> ParametricValues a -> ParametricValues b
$cfmap :: forall a b. (a -> b) -> ParametricValues a -> ParametricValues b
Functor, Int -> ParametricValues a -> ShowS
[ParametricValues a] -> ShowS
ParametricValues a -> String
(Int -> ParametricValues a -> ShowS)
-> (ParametricValues a -> String)
-> ([ParametricValues a] -> ShowS)
-> Show (ParametricValues a)
forall a. Show a => Int -> ParametricValues a -> ShowS
forall a. Show a => [ParametricValues a] -> ShowS
forall a. Show a => ParametricValues a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParametricValues a] -> ShowS
$cshowList :: forall a. Show a => [ParametricValues a] -> ShowS
show :: ParametricValues a -> String
$cshow :: forall a. Show a => ParametricValues a -> String
showsPrec :: Int -> ParametricValues a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ParametricValues a -> ShowS
Show)
data Derivative px = Derivative
{ Derivative px -> Holder px Float
_derivValues :: !(Holder px Float)
, Derivative px -> Holder px Float
_xDerivative :: !(Holder px Float)
, Derivative px -> Holder px Float
_yDerivative :: !(Holder px Float)
, Derivative px -> Holder px Float
_xyDerivative :: !(Holder px Float)
}
deriving instance Show (Holder px Float) => Show (Derivative px)
xDerivative :: Lens' (Derivative px) (Holder px Float)
xDerivative :: (Holder px Float -> f (Holder px Float))
-> Derivative px -> f (Derivative px)
xDerivative = (Derivative px -> Holder px Float)
-> (Derivative px -> Holder px Float -> Derivative px)
-> Lens
(Derivative px) (Derivative px) (Holder px Float) (Holder px Float)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Derivative px -> Holder px Float
forall px. Derivative px -> Holder px Float
_xDerivative Derivative px -> Holder px Float -> Derivative px
forall px. Derivative px -> Holder px Float -> Derivative px
setter where
setter :: Derivative px -> Holder px Float -> Derivative px
setter Derivative px
o Holder px Float
v = Derivative px
o { _xDerivative :: Holder px Float
_xDerivative = Holder px Float
v }
yDerivative :: Lens' (Derivative px) (Holder px Float)
yDerivative :: (Holder px Float -> f (Holder px Float))
-> Derivative px -> f (Derivative px)
yDerivative = (Derivative px -> Holder px Float)
-> (Derivative px -> Holder px Float -> Derivative px)
-> Lens
(Derivative px) (Derivative px) (Holder px Float) (Holder px Float)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Derivative px -> Holder px Float
forall px. Derivative px -> Holder px Float
_yDerivative Derivative px -> Holder px Float -> Derivative px
forall px. Derivative px -> Holder px Float -> Derivative px
setter where
setter :: Derivative px -> Holder px Float -> Derivative px
setter Derivative px
o Holder px Float
v = Derivative px
o { _yDerivative :: Holder px Float
_yDerivative = Holder px Float
v }
instance Applicative ParametricValues where
pure :: a -> ParametricValues a
pure a
a = a -> a -> a -> a -> ParametricValues a
forall a. a -> a -> a -> a -> ParametricValues a
ParametricValues a
a a
a a
a a
a
ParametricValues a -> b
n a -> b
e a -> b
s a -> b
w <*> :: ParametricValues (a -> b)
-> ParametricValues a -> ParametricValues b
<*> ParametricValues a
n' a
e' a
s' a
w' =
b -> b -> b -> b -> ParametricValues b
forall a. a -> a -> a -> a -> ParametricValues a
ParametricValues (a -> b
n a
n') (a -> b
e a
e') (a -> b
s a
s') (a -> b
w a
w')
instance Foldable ParametricValues where
foldMap :: (a -> m) -> ParametricValues a -> m
foldMap a -> m
f (ParametricValues a
n a
e a
s a
w) = a -> m
f a
n m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
e m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
s m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
w
transposeParametricValues :: ParametricValues a -> ParametricValues a
transposeParametricValues :: ParametricValues a -> ParametricValues a
transposeParametricValues (ParametricValues a
n a
e a
s a
w) = a -> a -> a -> a -> ParametricValues a
forall a. a -> a -> a -> a -> ParametricValues a
ParametricValues a
n a
w a
s a
e
data TensorPatch weight = TensorPatch
{ TensorPatch weight -> CubicBezier
_curve0 :: !CubicBezier
, TensorPatch weight -> CubicBezier
_curve1 :: !CubicBezier
, TensorPatch weight -> CubicBezier
_curve2 :: !CubicBezier
, TensorPatch weight -> CubicBezier
_curve3 :: !CubicBezier
, TensorPatch weight -> weight
_tensorValues :: !weight
}
isVerticalOrientation :: TensorPatch a -> Bool
isVerticalOrientation :: TensorPatch a -> Bool
isVerticalOrientation TensorPatch a
p = Float
dy Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
dx where
CubicBezier Point
a Point
_ Point
_ Point
d = TensorPatch a -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve0 TensorPatch a
p
V2 Float
dx Float
dy = Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Point -> Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Point
d Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
a)
instance Transformable (TensorPatch px) where
transform :: (Point -> Point) -> TensorPatch px -> TensorPatch px
transform Point -> Point
f (TensorPatch CubicBezier
c0 CubicBezier
c1 CubicBezier
c2 CubicBezier
c3 px
v) =
CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> px
-> TensorPatch px
forall weight.
CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> weight
-> TensorPatch weight
TensorPatch
((Point -> Point) -> CubicBezier -> CubicBezier
forall a. Transformable a => (Point -> Point) -> a -> a
transform Point -> Point
f CubicBezier
c0)
((Point -> Point) -> CubicBezier -> CubicBezier
forall a. Transformable a => (Point -> Point) -> a -> a
transform Point -> Point
f CubicBezier
c1)
((Point -> Point) -> CubicBezier -> CubicBezier
forall a. Transformable a => (Point -> Point) -> a -> a
transform Point -> Point
f CubicBezier
c2)
((Point -> Point) -> CubicBezier -> CubicBezier
forall a. Transformable a => (Point -> Point) -> a -> a
transform Point -> Point
f CubicBezier
c3)
px
v
transformM :: (Point -> m Point) -> TensorPatch px -> m (TensorPatch px)
transformM Point -> m Point
f (TensorPatch CubicBezier
c0 CubicBezier
c1 CubicBezier
c2 CubicBezier
c3 px
v) =
CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> px
-> TensorPatch px
forall weight.
CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> weight
-> TensorPatch weight
TensorPatch
(CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> px
-> TensorPatch px)
-> m CubicBezier
-> m (CubicBezier
-> CubicBezier -> CubicBezier -> px -> TensorPatch px)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Point -> m Point) -> CubicBezier -> m CubicBezier
forall a (m :: * -> *).
(Transformable a, Monad m) =>
(Point -> m Point) -> a -> m a
transformM Point -> m Point
f CubicBezier
c0
m (CubicBezier
-> CubicBezier -> CubicBezier -> px -> TensorPatch px)
-> m CubicBezier
-> m (CubicBezier -> CubicBezier -> px -> TensorPatch px)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Point -> m Point) -> CubicBezier -> m CubicBezier
forall a (m :: * -> *).
(Transformable a, Monad m) =>
(Point -> m Point) -> a -> m a
transformM Point -> m Point
f CubicBezier
c1
m (CubicBezier -> CubicBezier -> px -> TensorPatch px)
-> m CubicBezier -> m (CubicBezier -> px -> TensorPatch px)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Point -> m Point) -> CubicBezier -> m CubicBezier
forall a (m :: * -> *).
(Transformable a, Monad m) =>
(Point -> m Point) -> a -> m a
transformM Point -> m Point
f CubicBezier
c2
m (CubicBezier -> px -> TensorPatch px)
-> m CubicBezier -> m (px -> TensorPatch px)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Point -> m Point) -> CubicBezier -> m CubicBezier
forall a (m :: * -> *).
(Transformable a, Monad m) =>
(Point -> m Point) -> a -> m a
transformM Point -> m Point
f CubicBezier
c3
m (px -> TensorPatch px) -> m px -> m (TensorPatch px)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> px -> m px
forall (m :: * -> *) a. Monad m => a -> m a
return px
v
instance {-# OVERLAPPING #-} PointFoldable (TensorPatch px) where
foldPoints :: (b -> Point -> b) -> b -> TensorPatch px -> b
foldPoints b -> Point -> b
f b
acc (TensorPatch CubicBezier
c0 CubicBezier
c1 CubicBezier
c2 CubicBezier
c3 px
_) = CubicBezier -> b -> b
g CubicBezier
c3 (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier -> b -> b
g CubicBezier
c2 (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier -> b -> b
g CubicBezier
c1 (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ CubicBezier -> b -> b
g CubicBezier
c0 b
acc
where g :: CubicBezier -> b -> b
g CubicBezier
v b
a = (b -> Point -> b) -> b -> CubicBezier -> b
forall a b. PointFoldable a => (b -> Point -> b) -> b -> a -> b
foldPoints b -> Point -> b
f b
a CubicBezier
v
data CoonPatch weight = CoonPatch
{ CoonPatch weight -> CubicBezier
_north :: !CubicBezier
, CoonPatch weight -> CubicBezier
_east :: !CubicBezier
, CoonPatch weight -> CubicBezier
_south :: !CubicBezier
, CoonPatch weight -> CubicBezier
_west :: !CubicBezier
, CoonPatch weight -> weight
_coonValues :: !weight
}
deriving Int -> CoonPatch weight -> ShowS
[CoonPatch weight] -> ShowS
CoonPatch weight -> String
(Int -> CoonPatch weight -> ShowS)
-> (CoonPatch weight -> String)
-> ([CoonPatch weight] -> ShowS)
-> Show (CoonPatch weight)
forall weight. Show weight => Int -> CoonPatch weight -> ShowS
forall weight. Show weight => [CoonPatch weight] -> ShowS
forall weight. Show weight => CoonPatch weight -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoonPatch weight] -> ShowS
$cshowList :: forall weight. Show weight => [CoonPatch weight] -> ShowS
show :: CoonPatch weight -> String
$cshow :: forall weight. Show weight => CoonPatch weight -> String
showsPrec :: Int -> CoonPatch weight -> ShowS
$cshowsPrec :: forall weight. Show weight => Int -> CoonPatch weight -> ShowS
Show
instance {-# OVERLAPPING #-} Transformable (CoonPatch px) where
transformM :: (Point -> m Point) -> CoonPatch px -> m (CoonPatch px)
transformM = (Point -> m Point) -> CoonPatch px -> m (CoonPatch px)
forall (m :: * -> *) px.
Monad m =>
(Point -> m Point) -> CoonPatch px -> m (CoonPatch px)
transformCoonM
transform :: (Point -> Point) -> CoonPatch px -> CoonPatch px
transform = (Point -> Point) -> CoonPatch px -> CoonPatch px
forall px. (Point -> Point) -> CoonPatch px -> CoonPatch px
transformCoon
instance {-# OVERLAPPING #-} PointFoldable (CoonPatch px) where
foldPoints :: (b -> Point -> b) -> b -> CoonPatch px -> b
foldPoints b -> Point -> b
f b
acc (CoonPatch CubicBezier
n CubicBezier
e CubicBezier
s CubicBezier
w px
_) = CubicBezier -> b -> b
g CubicBezier
n (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier -> b -> b
g CubicBezier
e (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier -> b -> b
g CubicBezier
s (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ CubicBezier -> b -> b
g CubicBezier
w b
acc
where g :: CubicBezier -> b -> b
g CubicBezier
v b
a = (b -> Point -> b) -> b -> CubicBezier -> b
forall a b. PointFoldable a => (b -> Point -> b) -> b -> a -> b
foldPoints b -> Point -> b
f b
a CubicBezier
v
transformCoonM :: Monad m => (Point -> m Point) -> CoonPatch px -> m (CoonPatch px)
transformCoonM :: (Point -> m Point) -> CoonPatch px -> m (CoonPatch px)
transformCoonM Point -> m Point
f (CoonPatch CubicBezier
n CubicBezier
e CubicBezier
s CubicBezier
w px
v) =
CubicBezier
-> CubicBezier -> CubicBezier -> CubicBezier -> px -> CoonPatch px
forall weight.
CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> weight
-> CoonPatch weight
CoonPatch (CubicBezier
-> CubicBezier -> CubicBezier -> CubicBezier -> px -> CoonPatch px)
-> m CubicBezier
-> m (CubicBezier
-> CubicBezier -> CubicBezier -> px -> CoonPatch px)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Point -> m Point) -> CubicBezier -> m CubicBezier
forall a (m :: * -> *).
(Transformable a, Monad m) =>
(Point -> m Point) -> a -> m a
transformM Point -> m Point
f CubicBezier
n m (CubicBezier -> CubicBezier -> CubicBezier -> px -> CoonPatch px)
-> m CubicBezier
-> m (CubicBezier -> CubicBezier -> px -> CoonPatch px)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Point -> m Point) -> CubicBezier -> m CubicBezier
forall a (m :: * -> *).
(Transformable a, Monad m) =>
(Point -> m Point) -> a -> m a
transformM Point -> m Point
f CubicBezier
e m (CubicBezier -> CubicBezier -> px -> CoonPatch px)
-> m CubicBezier -> m (CubicBezier -> px -> CoonPatch px)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Point -> m Point) -> CubicBezier -> m CubicBezier
forall a (m :: * -> *).
(Transformable a, Monad m) =>
(Point -> m Point) -> a -> m a
transformM Point -> m Point
f CubicBezier
s m (CubicBezier -> px -> CoonPatch px)
-> m CubicBezier -> m (px -> CoonPatch px)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Point -> m Point) -> CubicBezier -> m CubicBezier
forall a (m :: * -> *).
(Transformable a, Monad m) =>
(Point -> m Point) -> a -> m a
transformM Point -> m Point
f CubicBezier
w
m (px -> CoonPatch px) -> m px -> m (CoonPatch px)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> px -> m px
forall (m :: * -> *) a. Monad m => a -> m a
return px
v
transformCoon :: (Point -> Point) -> CoonPatch px -> CoonPatch px
transformCoon :: (Point -> Point) -> CoonPatch px -> CoonPatch px
transformCoon Point -> Point
f (CoonPatch CubicBezier
n CubicBezier
e CubicBezier
s CubicBezier
w px
v) =
CubicBezier
-> CubicBezier -> CubicBezier -> CubicBezier -> px -> CoonPatch px
forall weight.
CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> weight
-> CoonPatch weight
CoonPatch
((Point -> Point) -> CubicBezier -> CubicBezier
forall a. Transformable a => (Point -> Point) -> a -> a
transform Point -> Point
f CubicBezier
n)
((Point -> Point) -> CubicBezier -> CubicBezier
forall a. Transformable a => (Point -> Point) -> a -> a
transform Point -> Point
f CubicBezier
e)
((Point -> Point) -> CubicBezier -> CubicBezier
forall a. Transformable a => (Point -> Point) -> a -> a
transform Point -> Point
f CubicBezier
s)
((Point -> Point) -> CubicBezier -> CubicBezier
forall a. Transformable a => (Point -> Point) -> a -> a
transform Point -> Point
f CubicBezier
w)
px
v
data MeshPatch px = MeshPatch
{
MeshPatch px -> Int
_meshPatchWidth :: !Int
, MeshPatch px -> Int
_meshPatchHeight :: !Int
, MeshPatch px -> Vector Point
_meshPrimaryVertices :: !(V.Vector Point)
, MeshPatch px -> Vector InterBezier
_meshHorizontalSecondary :: !(V.Vector InterBezier)
, MeshPatch px -> Vector InterBezier
_meshVerticalSecondary :: !(V.Vector InterBezier)
, MeshPatch px -> Vector px
_meshColors :: !(V.Vector px)
, MeshPatch px -> Maybe (Vector Derivatives)
_meshTensorDerivatives :: !(Maybe (V.Vector Derivatives))
}
deriving (MeshPatch px -> MeshPatch px -> Bool
(MeshPatch px -> MeshPatch px -> Bool)
-> (MeshPatch px -> MeshPatch px -> Bool) -> Eq (MeshPatch px)
forall px. Eq px => MeshPatch px -> MeshPatch px -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeshPatch px -> MeshPatch px -> Bool
$c/= :: forall px. Eq px => MeshPatch px -> MeshPatch px -> Bool
== :: MeshPatch px -> MeshPatch px -> Bool
$c== :: forall px. Eq px => MeshPatch px -> MeshPatch px -> Bool
Eq, Int -> MeshPatch px -> ShowS
[MeshPatch px] -> ShowS
MeshPatch px -> String
(Int -> MeshPatch px -> ShowS)
-> (MeshPatch px -> String)
-> ([MeshPatch px] -> ShowS)
-> Show (MeshPatch px)
forall px. Show px => Int -> MeshPatch px -> ShowS
forall px. Show px => [MeshPatch px] -> ShowS
forall px. Show px => MeshPatch px -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MeshPatch px] -> ShowS
$cshowList :: forall px. Show px => [MeshPatch px] -> ShowS
show :: MeshPatch px -> String
$cshow :: forall px. Show px => MeshPatch px -> String
showsPrec :: Int -> MeshPatch px -> ShowS
$cshowsPrec :: forall px. Show px => Int -> MeshPatch px -> ShowS
Show, a -> MeshPatch b -> MeshPatch a
(a -> b) -> MeshPatch a -> MeshPatch b
(forall a b. (a -> b) -> MeshPatch a -> MeshPatch b)
-> (forall a b. a -> MeshPatch b -> MeshPatch a)
-> Functor MeshPatch
forall a b. a -> MeshPatch b -> MeshPatch a
forall a b. (a -> b) -> MeshPatch a -> MeshPatch b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MeshPatch b -> MeshPatch a
$c<$ :: forall a b. a -> MeshPatch b -> MeshPatch a
fmap :: (a -> b) -> MeshPatch a -> MeshPatch b
$cfmap :: forall a b. (a -> b) -> MeshPatch a -> MeshPatch b
Functor)
data InterBezier = InterBezier
{ InterBezier -> Point
_inter0 :: !Point
, InterBezier -> Point
_inter1 :: !Point
}
deriving (InterBezier -> InterBezier -> Bool
(InterBezier -> InterBezier -> Bool)
-> (InterBezier -> InterBezier -> Bool) -> Eq InterBezier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InterBezier -> InterBezier -> Bool
$c/= :: InterBezier -> InterBezier -> Bool
== :: InterBezier -> InterBezier -> Bool
$c== :: InterBezier -> InterBezier -> Bool
Eq, Int -> InterBezier -> ShowS
[InterBezier] -> ShowS
InterBezier -> String
(Int -> InterBezier -> ShowS)
-> (InterBezier -> String)
-> ([InterBezier] -> ShowS)
-> Show InterBezier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InterBezier] -> ShowS
$cshowList :: [InterBezier] -> ShowS
show :: InterBezier -> String
$cshow :: InterBezier -> String
showsPrec :: Int -> InterBezier -> ShowS
$cshowsPrec :: Int -> InterBezier -> ShowS
Show)
instance Transformable InterBezier where
transform :: (Point -> Point) -> InterBezier -> InterBezier
transform Point -> Point
f (InterBezier Point
a Point
b) = Point -> Point -> InterBezier
InterBezier (Point -> Point
f Point
a) (Point -> Point
f Point
b)
transformM :: (Point -> m Point) -> InterBezier -> m InterBezier
transformM Point -> m Point
f (InterBezier Point
a Point
b) = Point -> Point -> InterBezier
InterBezier (Point -> Point -> InterBezier)
-> m Point -> m (Point -> InterBezier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> m Point
f Point
a m (Point -> InterBezier) -> m Point -> m InterBezier
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point -> m Point
f Point
b
instance PointFoldable InterBezier where
foldPoints :: (b -> Point -> b) -> b -> InterBezier -> b
foldPoints b -> Point -> b
f b
acc (InterBezier Point
a Point
b) = b -> Point -> b
f (b -> Point -> b
f b
acc Point
a) Point
b
transformMeshM :: Monad m => (Point -> m Point) -> MeshPatch px -> m (MeshPatch px)
transformMeshM :: (Point -> m Point) -> MeshPatch px -> m (MeshPatch px)
transformMeshM Point -> m Point
f MeshPatch { Int
Maybe (Vector Derivatives)
Vector px
Vector Point
Vector InterBezier
_meshTensorDerivatives :: Maybe (Vector Derivatives)
_meshColors :: Vector px
_meshVerticalSecondary :: Vector InterBezier
_meshHorizontalSecondary :: Vector InterBezier
_meshPrimaryVertices :: Vector Point
_meshPatchHeight :: Int
_meshPatchWidth :: Int
_meshTensorDerivatives :: forall px. MeshPatch px -> Maybe (Vector Derivatives)
_meshColors :: forall px. MeshPatch px -> Vector px
_meshVerticalSecondary :: forall px. MeshPatch px -> Vector InterBezier
_meshHorizontalSecondary :: forall px. MeshPatch px -> Vector InterBezier
_meshPrimaryVertices :: forall px. MeshPatch px -> Vector Point
_meshPatchHeight :: forall px. MeshPatch px -> Int
_meshPatchWidth :: forall px. MeshPatch px -> Int
.. } = do
Vector Point
vertices <- (Point -> m Point) -> Vector Point -> m (Vector Point)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Point -> m Point
f Vector Point
_meshPrimaryVertices
Vector InterBezier
hSecondary <- (InterBezier -> m InterBezier)
-> Vector InterBezier -> m (Vector InterBezier)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Point -> m Point) -> InterBezier -> m InterBezier
forall a (m :: * -> *).
(Transformable a, Monad m) =>
(Point -> m Point) -> a -> m a
transformM Point -> m Point
f) Vector InterBezier
_meshHorizontalSecondary
Vector InterBezier
vSecondary <- (InterBezier -> m InterBezier)
-> Vector InterBezier -> m (Vector InterBezier)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Point -> m Point) -> InterBezier -> m InterBezier
forall a (m :: * -> *).
(Transformable a, Monad m) =>
(Point -> m Point) -> a -> m a
transformM Point -> m Point
f) Vector InterBezier
_meshVerticalSecondary
MeshPatch px -> m (MeshPatch px)
forall (m :: * -> *) a. Monad m => a -> m a
return (MeshPatch px -> m (MeshPatch px))
-> MeshPatch px -> m (MeshPatch px)
forall a b. (a -> b) -> a -> b
$ MeshPatch :: forall px.
Int
-> Int
-> Vector Point
-> Vector InterBezier
-> Vector InterBezier
-> Vector px
-> Maybe (Vector Derivatives)
-> MeshPatch px
MeshPatch
{ _meshPatchWidth :: Int
_meshPatchWidth = Int
_meshPatchWidth
, _meshPatchHeight :: Int
_meshPatchHeight = Int
_meshPatchHeight
, _meshPrimaryVertices :: Vector Point
_meshPrimaryVertices = Vector Point
vertices
, _meshHorizontalSecondary :: Vector InterBezier
_meshHorizontalSecondary = Vector InterBezier
hSecondary
, _meshVerticalSecondary :: Vector InterBezier
_meshVerticalSecondary = Vector InterBezier
vSecondary
, _meshColors :: Vector px
_meshColors = Vector px
_meshColors
, _meshTensorDerivatives :: Maybe (Vector Derivatives)
_meshTensorDerivatives = Maybe (Vector Derivatives)
forall a. Maybe a
Nothing
}
instance {-# OVERLAPPING #-} Transformable (MeshPatch px) where
transformM :: (Point -> m Point) -> MeshPatch px -> m (MeshPatch px)
transformM = (Point -> m Point) -> MeshPatch px -> m (MeshPatch px)
forall (m :: * -> *) px.
Monad m =>
(Point -> m Point) -> MeshPatch px -> m (MeshPatch px)
transformMeshM
instance {-# OVERLAPPING #-} PointFoldable (MeshPatch px) where
foldPoints :: (b -> Point -> b) -> b -> MeshPatch px -> b
foldPoints = (b -> Point -> b) -> b -> MeshPatch px -> b
forall a px. (a -> Point -> a) -> a -> MeshPatch px -> a
foldMeshPoints
foldMeshPoints :: (a -> Point -> a) -> a -> MeshPatch px -> a
foldMeshPoints :: (a -> Point -> a) -> a -> MeshPatch px -> a
foldMeshPoints a -> Point -> a
f a
acc MeshPatch px
m = a
acc4 where
acc1 :: a
acc1 = (a -> Point -> a) -> a -> Vector Point -> a
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' a -> Point -> a
f a
acc (MeshPatch px -> Vector Point
forall px. MeshPatch px -> Vector Point
_meshPrimaryVertices MeshPatch px
m)
acc2 :: a
acc2 = (a -> Point -> a) -> a -> Vector InterBezier -> a
forall a b. PointFoldable a => (b -> Point -> b) -> b -> a -> b
foldPoints a -> Point -> a
f a
acc1 (MeshPatch px -> Vector InterBezier
forall px. MeshPatch px -> Vector InterBezier
_meshHorizontalSecondary MeshPatch px
m)
acc3 :: a
acc3 = (a -> Point -> a) -> a -> Vector InterBezier -> a
forall a b. PointFoldable a => (b -> Point -> b) -> b -> a -> b
foldPoints a -> Point -> a
f a
acc2 (MeshPatch px -> Vector InterBezier
forall px. MeshPatch px -> Vector InterBezier
_meshVerticalSecondary MeshPatch px
m)
acc4 :: a
acc4 = case MeshPatch px -> Maybe (Vector Derivatives)
forall px. MeshPatch px -> Maybe (Vector Derivatives)
_meshTensorDerivatives MeshPatch px
m of
Maybe (Vector Derivatives)
Nothing -> a
acc3
Just Vector Derivatives
v -> (a -> Point -> a) -> a -> Vector Derivatives -> a
forall a b. PointFoldable a => (b -> Point -> b) -> b -> a -> b
foldPoints a -> Point -> a
f a
acc3 Vector Derivatives
v
data Derivatives = Derivatives
{ Derivatives -> Point
_interNorthWest :: !Point
, Derivatives -> Point
_interNorthEast :: !Point
, Derivatives -> Point
_interSouthWest :: !Point
, Derivatives -> Point
_interSouthEast :: !Point
}
deriving (Derivatives -> Derivatives -> Bool
(Derivatives -> Derivatives -> Bool)
-> (Derivatives -> Derivatives -> Bool) -> Eq Derivatives
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Derivatives -> Derivatives -> Bool
$c/= :: Derivatives -> Derivatives -> Bool
== :: Derivatives -> Derivatives -> Bool
$c== :: Derivatives -> Derivatives -> Bool
Eq, Int -> Derivatives -> ShowS
[Derivatives] -> ShowS
Derivatives -> String
(Int -> Derivatives -> ShowS)
-> (Derivatives -> String)
-> ([Derivatives] -> ShowS)
-> Show Derivatives
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Derivatives] -> ShowS
$cshowList :: [Derivatives] -> ShowS
show :: Derivatives -> String
$cshow :: Derivatives -> String
showsPrec :: Int -> Derivatives -> ShowS
$cshowsPrec :: Int -> Derivatives -> ShowS
Show)
instance Transformable Derivatives where
transform :: (Point -> Point) -> Derivatives -> Derivatives
transform Point -> Point
f (Derivatives Point
a Point
b Point
c Point
d) =
Point -> Point -> Point -> Point -> Derivatives
Derivatives (Point -> Point
f Point
a) (Point -> Point
f Point
b) (Point -> Point
f Point
c) (Point -> Point
f Point
d)
transformM :: (Point -> m Point) -> Derivatives -> m Derivatives
transformM Point -> m Point
f (Derivatives Point
a Point
b Point
c Point
d) =
Point -> Point -> Point -> Point -> Derivatives
Derivatives (Point -> Point -> Point -> Point -> Derivatives)
-> m Point -> m (Point -> Point -> Point -> Derivatives)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> m Point
f Point
a m (Point -> Point -> Point -> Derivatives)
-> m Point -> m (Point -> Point -> Derivatives)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point -> m Point
f Point
b m (Point -> Point -> Derivatives)
-> m Point -> m (Point -> Derivatives)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point -> m Point
f Point
c m (Point -> Derivatives) -> m Point -> m Derivatives
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point -> m Point
f Point
d
instance PointFoldable Derivatives where
foldPoints :: (b -> Point -> b) -> b -> Derivatives -> b
foldPoints b -> Point -> b
f b
acc (Derivatives Point
a Point
b Point
c Point
d) = b -> Point -> b
f (b -> Point -> b
f (b -> Point -> b
f (b -> Point -> b
f b
acc Point
a) Point
b) Point
c) Point
d
type UV = V2 CoonColorWeight
type UVPatch = ParametricValues UV
newtype CubicCoefficient px = CubicCoefficient
{ CubicCoefficient px -> ParametricValues (V4 (Holder px Float))
getCubicCoefficients :: ParametricValues (V4 (Holder px Float))
}
data ImageMesh px = ImageMesh
{ ImageMesh px -> Image px
_meshImage :: !(Image px)
, ImageMesh px -> Transformation
_meshTransform :: !Transformation
}
coonPointAt :: CoonPatch a -> UV -> Point
coonPointAt :: CoonPatch a -> Point -> Point
coonPointAt CoonPatch { a
CubicBezier
_coonValues :: a
_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
.. } (V2 Float
u Float
v) = Point
sc Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point
sd Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
sb
where
CubicBezier Point
c10 Point
_ Point
_ Point
c11 = CubicBezier
_north
CubicBezier Point
c21 Point
_ Point
_ Point
c20 = CubicBezier
_south
sc :: Point
sc = Float -> Point -> Point -> Point
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp Float
v Point
c2 Point
c1
sd :: Point
sd = Float -> Point -> Point -> Point
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp Float
u Point
d2 Point
d1
sb :: Point
sb = Float -> Point -> Point -> Point
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp Float
v (Float -> Point -> Point -> Point
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp Float
u Point
c21 Point
c20)
(Float -> Point -> Point -> Point
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp Float
u Point
c11 Point
c10)
CubicBezier Point
_ Point
_ Point
_ Point
c1 = (CubicBezier, CubicBezier) -> CubicBezier
forall a b. (a, b) -> a
fst ((CubicBezier, CubicBezier) -> CubicBezier)
-> (CubicBezier, CubicBezier) -> CubicBezier
forall a b. (a -> b) -> a -> b
$ CubicBezier -> Float -> (CubicBezier, CubicBezier)
cubicBezierBreakAt CubicBezier
_north Float
u
CubicBezier Point
_ Point
_ Point
_ Point
c2 = (CubicBezier, CubicBezier) -> CubicBezier
forall a b. (a, b) -> a
fst ((CubicBezier, CubicBezier) -> CubicBezier)
-> (CubicBezier, CubicBezier) -> CubicBezier
forall a b. (a -> b) -> a -> b
$ CubicBezier -> Float -> (CubicBezier, CubicBezier)
cubicBezierBreakAt CubicBezier
_south (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
u)
CubicBezier Point
_ Point
_ Point
_ Point
d2 = (CubicBezier, CubicBezier) -> CubicBezier
forall a b. (a, b) -> a
fst ((CubicBezier, CubicBezier) -> CubicBezier)
-> (CubicBezier, CubicBezier) -> CubicBezier
forall a b. (a -> b) -> a -> b
$ CubicBezier -> Float -> (CubicBezier, CubicBezier)
cubicBezierBreakAt CubicBezier
_east Float
v
CubicBezier Point
_ Point
_ Point
_ Point
d1 = (CubicBezier, CubicBezier) -> CubicBezier
forall a b. (a, b) -> a
fst ((CubicBezier, CubicBezier) -> CubicBezier)
-> (CubicBezier, CubicBezier) -> CubicBezier
forall a b. (a -> b) -> a -> b
$ CubicBezier -> Float -> (CubicBezier, CubicBezier)
cubicBezierBreakAt CubicBezier
_west (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
v)
toTensorPatch :: CoonPatch a -> TensorPatch a
toTensorPatch :: CoonPatch a -> TensorPatch a
toTensorPatch CoonPatch { a
CubicBezier
_coonValues :: a
_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
.. } = TensorPatch :: forall weight.
CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> weight
-> TensorPatch weight
TensorPatch
{ _curve0 :: CubicBezier
_curve0 = CubicBezier
_north
, _curve1 :: CubicBezier
_curve1 = Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
wt Point
p11 Point
p21 Point
et
, _curve2 :: CubicBezier
_curve2 = Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
wb Point
p12 Point
p22 Point
eb
, _curve3 :: CubicBezier
_curve3 = Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
sd Point
sc Point
sb Point
sa
, _tensorValues :: a
_tensorValues = a
_coonValues
}
where
formula :: f a -> f a -> f a -> f a -> f a -> f a -> f a -> f a -> f a
formula f a
a f a
b f a
c f a
d f a
e f a
f f a
g f a
h =
(f a
a f a -> a -> f a
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (-a
4) f a -> f a -> f a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^
(f a
b f a -> f a -> f a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ f a
c) f a -> a -> f a
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* a
6 f a -> f a -> f a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^
(f a
d f a -> f a -> f a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ f a
e) f a -> a -> f a
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* a
2 f a -> f a -> f a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^
(f a
f f a -> f a -> f a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ f a
g) f a -> a -> f a
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* a
3 f a -> f a -> f a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^
f a
h) f a -> a -> f a
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (a
1a -> a -> a
forall a. Fractional a => a -> a -> a
/a
9)
p11 :: Point
p11 = Point
-> Point
-> Point
-> Point
-> Point
-> Point
-> Point
-> Point
-> Point
forall (f :: * -> *) a.
(Additive f, Fractional a) =>
f a -> f a -> f a -> f a -> f a -> f a -> f a -> f a -> f a
formula Point
p00 Point
p10 Point
p01 Point
p30 Point
p03 Point
p13 Point
p31 Point
p33
p21 :: Point
p21 = Point
-> Point
-> Point
-> Point
-> Point
-> Point
-> Point
-> Point
-> Point
forall (f :: * -> *) a.
(Additive f, Fractional a) =>
f a -> f a -> f a -> f a -> f a -> f a -> f a -> f a -> f a
formula Point
p30 Point
p20 Point
p31 Point
p00 Point
p33 Point
p23 Point
p01 Point
p03
p12 :: Point
p12 = Point
-> Point
-> Point
-> Point
-> Point
-> Point
-> Point
-> Point
-> Point
forall (f :: * -> *) a.
(Additive f, Fractional a) =>
f a -> f a -> f a -> f a -> f a -> f a -> f a -> f a -> f a
formula Point
p03 Point
p13 Point
p02 Point
p33 Point
p00 Point
p10 Point
p32 Point
p30
p22 :: Point
p22 = Point
-> Point
-> Point
-> Point
-> Point
-> Point
-> Point
-> Point
-> Point
forall (f :: * -> *) a.
(Additive f, Fractional a) =>
f a -> f a -> f a -> f a -> f a -> f a -> f a -> f a -> f a
formula Point
p33 Point
p23 Point
p32 Point
p03 Point
p30 Point
p20 Point
p02 Point
p00
CubicBezier Point
p00 Point
p10 Point
p20 Point
p30 = CubicBezier
_north
CubicBezier Point
_ Point
p02 Point
p01 Point
_ = CubicBezier
_west
CubicBezier Point
_ Point
p31 Point
p32 Point
_ = CubicBezier
_east
CubicBezier Point
p33 Point
p23 Point
p13 Point
p03 = CubicBezier
_south
CubicBezier Point
sa Point
sb Point
sc Point
sd = CubicBezier
_south
CubicBezier Point
_ Point
et Point
eb Point
_ = CubicBezier
_east
CubicBezier Point
_ Point
wb Point
wt Point
_ = CubicBezier
_west