{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
#define SVG_2
-- | Module defining the type of mesh patch grid.

module Graphics.Rasterific.MeshPatch
    ( -- * Types

      InterBezier( .. )
    , Derivatives( .. )
    , MeshPatch( .. )
    , CubicCoefficient( .. )

     -- * Functions

    , calculateMeshColorDerivative
    , verticeAt
    , generateLinearGrid
    , generateImageMesh

      -- * Extraction functions

      -- ** Simple

    , coonPatchAt
    , tensorPatchAt
    , coonImagePatchAt
    , tensorImagePatchAt
    , coonPatchAtWithDerivative
    , tensorPatchAtWithDerivative

      -- ** Multiple

    , coonPatchesOf
    , tensorPatchesOf
    , imagePatchesOf
    , tensorImagePatchesOf
    , cubicCoonPatchesOf
    , cubicTensorPatchesOf

      -- * Mutable mesh

    , MutableMesh
    , thawMesh
    , freezeMesh

     -- * Monadic mesh creation

    , withMesh
    , setVertice
    , getVertice
    , setHorizPoints
    , setVertPoints
    , setColor
    ) where

{-import Debug.Trace-}
{-import Text.Printf-}

import Control.Monad.ST( runST )
import Control.Monad.Reader( runReaderT )
import Control.Monad.Reader.Class
import Control.Monad.Primitive( PrimMonad, PrimState )
import Data.Vector( (!) )
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector.Generic as VG

import Codec.Picture( Image( imageWidth, imageHeight ) )
import Graphics.Rasterific.Linear
import Graphics.Rasterific.MiniLens
import Graphics.Rasterific.Types
import Graphics.Rasterific.Compositor
import Graphics.Rasterific.Transformations
import Graphics.Rasterific.PatchTypes

#ifdef SVG_2
slopeOf :: (Additive h, Applicative h)
        => h Float -> h Float -> h Float
        -> Point -> Point -> Point
        -> h Float
slopeOf :: h Float -> h Float -> h Float -> Point -> Point -> Point -> h Float
slopeOf h Float
prevColor h Float
thisColor h Float
nextColor
        Point
prevPoint Point
thisPoint Point
nextPoint 
  | Float -> Bool
forall a. Epsilon a => a -> Bool
nearZero Float
distPrev Bool -> Bool -> Bool
|| Float -> Bool
forall a. Epsilon a => a -> Bool
nearZero Float
distNext = h Float
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
  | Bool
otherwise = Float -> Float -> Float -> Float
slopeVal (Float -> Float -> Float -> Float)
-> h Float -> h (Float -> Float -> Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h Float
slopePrev h (Float -> Float -> Float) -> h Float -> h (Float -> Float)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h Float
slope h (Float -> Float) -> h Float -> h Float
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h Float
slopeNext
  where
    distPrev :: Float
distPrev = Point
thisPoint Point -> Point -> Float
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a -> a
`distance` Point
prevPoint
    distNext :: Float
distNext = Point
thisPoint Point -> Point -> Float
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a -> a
`distance` Point
nextPoint

    slopePrev :: h Float
slopePrev | Float -> Bool
forall a. Epsilon a => a -> Bool
nearZero Float
distPrev = h Float
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
              | Bool
otherwise = (h Float
thisColor h Float -> h Float -> h Float
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ h Float
prevColor) h Float -> Float -> h Float
forall (f :: * -> *) a. (Functor f, Floating a) => f a -> a -> f a
^/ Float
distPrev
    slopeNext :: h Float
slopeNext | Float -> Bool
forall a. Epsilon a => a -> Bool
nearZero Float
distNext = h Float
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
              | Bool
otherwise = (h Float
nextColor h Float -> h Float -> h Float
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ h Float
thisColor) h Float -> Float -> h Float
forall (f :: * -> *) a. (Functor f, Floating a) => f a -> a -> f a
^/ Float
distNext
    slope :: h Float
slope = (h Float
slopePrev h Float -> h Float -> h Float
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ h Float
slopeNext) h Float -> Float -> h Float
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
0.5

    slopeVal :: Float -> Float -> Float -> Float
    slopeVal :: Float -> Float -> Float -> Float
slopeVal Float
sp Float
s Float
sn
      | Float -> Float
forall a. Num a => a -> a
signum Float
sp Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float -> Float
forall a. Num a => a -> a
signum Float
sn = Float
0
      | Float -> Float
forall a. Num a => a -> a
abs Float
s Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float -> Float
forall a. Num a => a -> a
abs Float
minSlope = Float
minSlope
      | Bool
otherwise = Float
s
      where
        minSlope :: Float
minSlope
          | Float -> Float
forall a. Num a => a -> a
abs Float
sp Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float -> Float
forall a. Num a => a -> a
abs Float
sn = Float
3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
sp
          | Bool
otherwise = Float
3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
sn
#else
slopeBasic :: (Additive h)
           => h Float -> h Float
           -> Point -> Point
           -> h Float
slopeBasic prevColor nextColor prevPoint nextPoint 
  | nearZero d = zero
  | otherwise = (nextColor ^-^ prevColor) ^/ d
  where
    d = prevPoint `distance` nextPoint
#endif

-- | Prepare a gradient mesh to use cubic color interpolation, see

-- renderCubicMesh documentation to see the global use of this function.

calculateMeshColorDerivative :: forall px. (InterpolablePixel px)
                             => MeshPatch px -> MeshPatch (Derivative px)
calculateMeshColorDerivative :: MeshPatch px -> MeshPatch (Derivative px)
calculateMeshColorDerivative MeshPatch px
mesh = MeshPatch px
mesh { _meshColors :: Vector (Derivative px)
_meshColors = Vector (Derivative px)
withEdgesDerivatives } where
  withEdgesDerivatives :: Vector (Derivative px)
withEdgesDerivatives =
     Vector (Derivative px)
colorDerivatives Vector (Derivative px)
-> [(Int, Derivative px)] -> Vector (Derivative px)
forall a. Vector a -> [(Int, a)] -> Vector a
V.// ([(Int, Derivative px)]
topDerivative [(Int, Derivative px)]
-> [(Int, Derivative px)] -> [(Int, Derivative px)]
forall a. Semigroup a => a -> a -> a
<> [(Int, Derivative px)]
bottomDerivative [(Int, Derivative px)]
-> [(Int, Derivative px)] -> [(Int, Derivative px)]
forall a. Semigroup a => a -> a -> a
<> [(Int, Derivative px)]
leftDerivative [(Int, Derivative px)]
-> [(Int, Derivative px)] -> [(Int, Derivative px)]
forall a. Semigroup a => a -> a -> a
<> [(Int, Derivative px)]
rightDerivative)
  colorDerivatives :: Vector (Derivative px)
colorDerivatives =
     Int -> [Derivative px] -> Vector (Derivative px)
forall a. Int -> [a] -> Vector a
V.fromListN (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h) [Int -> Int -> Derivative px
interiorDerivative Int
x Int
y | Int
y <- [Int
0 .. Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1], Int
x <- [Int
0 .. Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

  w :: Int
w = MeshPatch px -> Int
forall px. MeshPatch px -> Int
_meshPatchWidth MeshPatch px
mesh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  h :: Int
h = MeshPatch px -> Int
forall px. MeshPatch px -> Int
_meshPatchHeight MeshPatch px
mesh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  clampX :: Int -> Int
clampX = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  clampY :: Int -> Int
clampY = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

  rawColorAt :: Int -> Int -> px
rawColorAt Int
x Int
y =MeshPatch px -> Vector px
forall px. MeshPatch px -> Vector px
_meshColors MeshPatch px
mesh Vector px -> Int -> px
forall a. Vector a -> Int -> a
V.! (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)
  atColor :: Int -> Int -> Holder px Float
atColor Int
x Int
y = px -> Holder px Float
forall a. InterpolablePixel a => a -> Holder a Float
toFloatPixel (px -> Holder px Float) -> px -> Holder px Float
forall a b. (a -> b) -> a -> b
$ Int -> Int -> px
rawColorAt (Int -> Int
clampX Int
x) (Int -> Int
clampY Int
y)
#ifdef SVG_2
  isOnVerticalBorder :: Int -> Bool
isOnVerticalBorder Int
x = Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 
  isOnHorizontalBorder :: Int -> Bool
isOnHorizontalBorder Int
y = Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
#endif

  pointAt :: Int -> Int -> Point
pointAt Int
x Int
y = MeshPatch px -> Int -> Int -> Point
forall px. MeshPatch px -> Int -> Int -> Point
verticeAt MeshPatch px
mesh (Int -> Int
clampX Int
x) (Int -> Int
clampY Int
y)
  derivAt :: Int -> Int -> Derivative px
derivAt Int
x Int
y = Vector (Derivative px)
colorDerivatives  Vector (Derivative px) -> Int -> Derivative px
forall a. Vector a -> Int -> a
V.! (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)


  topDerivative :: [(Int, Derivative px)]
topDerivative = 
    [Lens' (Derivative px) (Holder px Float)
-> Int -> Int -> Int -> Int -> (Int, Derivative px)
edgeDerivative forall px. Lens' (Derivative px) (Holder px Float)
Lens' (Derivative px) (Holder px Float)
yDerivative Int
0 Int
1 Int
x Int
0 | Int
x <- [Int
1 .. Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2]]
  bottomDerivative :: [(Int, Derivative px)]
bottomDerivative = 
    [Lens' (Derivative px) (Holder px Float)
-> Int -> Int -> Int -> Int -> (Int, Derivative px)
edgeDerivative forall px. Lens' (Derivative px) (Holder px Float)
Lens' (Derivative px) (Holder px Float)
yDerivative Int
0 (-Int
1) Int
x (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) | Int
x <- [Int
1 .. Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2]]
  leftDerivative :: [(Int, Derivative px)]
leftDerivative =
    [Lens' (Derivative px) (Holder px Float)
-> Int -> Int -> Int -> Int -> (Int, Derivative px)
edgeDerivative forall px. Lens' (Derivative px) (Holder px Float)
Lens' (Derivative px) (Holder px Float)
xDerivative Int
1 Int
0 Int
0 Int
y | Int
y <- [Int
1 .. Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2]]
  rightDerivative :: [(Int, Derivative px)]
rightDerivative = 
    [Lens' (Derivative px) (Holder px Float)
-> Int -> Int -> Int -> Int -> (Int, Derivative px)
edgeDerivative forall px. Lens' (Derivative px) (Holder px Float)
Lens' (Derivative px) (Holder px Float)
xDerivative (-Int
1) Int
0 (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
y | Int
y <- [Int
1 .. Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2]]

  edgeDerivative :: Lens' (Derivative px) (Holder px Float) -> Int -> Int -> Int -> Int
                 -> (Int, Derivative px)
  edgeDerivative :: Lens' (Derivative px) (Holder px Float)
-> Int -> Int -> Int -> Int -> (Int, Derivative px)
edgeDerivative Lens' (Derivative px) (Holder px Float)
coord Int
dx Int
dy Int
x Int
y
    | Float -> Bool
forall a. Epsilon a => a -> Bool
nearZero Float
d = (Int
ix, Derivative px
oldDeriv)
    | Bool
otherwise = (Int
ix, Derivative px
oldDeriv Derivative px -> (Derivative px -> Derivative px) -> Derivative px
forall a b. a -> (a -> b) -> b
& Lens' (Derivative px) (Holder px Float)
coord Lens' (Derivative px) (Holder px Float)
-> Holder px Float -> Derivative px -> Derivative px
forall s a. Lens' s a -> a -> s -> s
.~ Holder px Float
otherDeriv)
    where
      ix :: Int
ix = Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
      oldDeriv :: Derivative px
oldDeriv = Int -> Int -> Derivative px
derivAt Int
x Int
y
      derivs :: Holder px Float
derivs = Derivative px
oldDeriv Derivative px
-> Lens' (Derivative px) (Holder px Float) -> Holder px Float
forall s t a b. s -> Lens s t a b -> a
.^ Lens' (Derivative px) (Holder px Float)
coord
      otherDeriv :: Holder px Float
otherDeriv = (Holder px Float
c Holder px Float -> Float -> Holder px Float
forall (f :: * -> *) a. (Functor f, Floating a) => f a -> a -> f a
^/ Float
d) Holder px Float -> Holder px Float -> Holder px Float
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Holder px Float
derivs
      c :: Holder px Float
c = (Int -> Int -> Holder px Float
atColor (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dx) (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dy) Holder px Float -> Holder px Float -> Holder px Float
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Int -> Int -> Holder px Float
atColor Int
x Int
y) Holder px Float -> Float -> Holder px Float
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
2
      d :: Float
d = Int -> Int -> Point
pointAt (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dx) (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dy) Point -> Point -> Float
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a -> a
`distance` Int -> Int -> Point
pointAt Int
x Int
y

  -- General case

  interiorDerivative :: Int -> Int -> Derivative px
interiorDerivative Int
x Int
y
#ifdef SVG_2
    | Int -> Bool
isOnHorizontalBorder Int
y Bool -> Bool -> Bool
&& Int -> Bool
isOnVerticalBorder Int
x = Holder px Float
-> Holder px Float
-> Holder px Float
-> Holder px Float
-> Derivative px
forall px.
Holder px Float
-> Holder px Float
-> Holder px Float
-> Holder px Float
-> Derivative px
Derivative Holder px Float
thisColor Holder px Float
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero Holder px Float
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero Holder px Float
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
    | Int -> Bool
isOnHorizontalBorder Int
y = Holder px Float
-> Holder px Float
-> Holder px Float
-> Holder px Float
-> Derivative px
forall px.
Holder px Float
-> Holder px Float
-> Holder px Float
-> Holder px Float
-> Derivative px
Derivative Holder px Float
thisColor Holder px Float
dx Holder px Float
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero Holder px Float
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
    | Int -> Bool
isOnVerticalBorder Int
x = Holder px Float
-> Holder px Float
-> Holder px Float
-> Holder px Float
-> Derivative px
forall px.
Holder px Float
-> Holder px Float
-> Holder px Float
-> Holder px Float
-> Derivative px
Derivative Holder px Float
thisColor Holder px Float
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero Holder px Float
dy Holder px Float
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
#endif
    | Bool
otherwise = Holder px Float
-> Holder px Float
-> Holder px Float
-> Holder px Float
-> Derivative px
forall px.
Holder px Float
-> Holder px Float
-> Holder px Float
-> Holder px Float
-> Derivative px
Derivative Holder px Float
thisColor Holder px Float
dx Holder px Float
dy Holder px Float
dxy
    where
#ifdef SVG_2
      dx :: Holder px Float
dx = Holder px Float
-> Holder px Float
-> Holder px Float
-> Point
-> Point
-> Point
-> Holder px Float
forall (h :: * -> *).
(Additive h, Applicative h) =>
h Float -> h Float -> h Float -> Point -> Point -> Point -> h Float
slopeOf
          Holder px Float
cxPrev Holder px Float
thisColor Holder px Float
cxNext
          Point
xPrev Point
this Point
xNext
      
      dy :: Holder px Float
dy = Holder px Float
-> Holder px Float
-> Holder px Float
-> Point
-> Point
-> Point
-> Holder px Float
forall (h :: * -> *).
(Additive h, Applicative h) =>
h Float -> h Float -> h Float -> Point -> Point -> Point -> h Float
slopeOf
          Holder px Float
cyPrev Holder px Float
thisColor Holder px Float
cyNext
          Point
yPrev Point
this Point
yNext
          -- -}

      
      dxy :: Holder px Float
dxy = Holder px Float
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
#else
      dx = slopeBasic cxPrev cxNext xPrev xNext
      dy = slopeBasic cyPrev cyNext yPrev yNext

      dxy | nearZero xyDist = zero
          | otherwise = (cxyNext ^-^ cyxPrev ^-^ cyxNext ^+^ cxyPrev) ^/ (xyDist)
      xyDist = (xNext `distance` xPrev) * (yNext `distance` yPrev)

      cxyPrev = atColor (x - 1) (y - 1)
      xyPrev = pointAt (x - 1) (y - 1)

      cxyNext = atColor (x + 1) (y + 1)
      xyNext = pointAt (x + 1) (y + 1)

      cyxPrev = atColor (x - 1) (y + 1)
      yxPrev = pointAt (x - 1) (y + 1)

      cyxNext = atColor (x + 1) (y - 1)
      yxNext = pointAt (x + 1) (y - 1)
#endif

      cxPrev :: Holder px Float
cxPrev = Int -> Int -> Holder px Float
atColor (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
y
      thisColor :: Holder px Float
thisColor = Int -> Int -> Holder px Float
atColor Int
x Int
y
      cxNext :: Holder px Float
cxNext = Int -> Int -> Holder px Float
atColor (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
y
      
      cyPrev :: Holder px Float
cyPrev = Int -> Int -> Holder px Float
atColor Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      cyNext :: Holder px Float
cyNext = Int -> Int -> Holder px Float
atColor Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      
      xPrev :: Point
xPrev = Int -> Int -> Point
pointAt (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
y
      this :: Point
this  = Int -> Int -> Point
pointAt Int
x Int
y
      xNext :: Point
xNext = Int -> Int -> Point
pointAt (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
y
      
      yPrev :: Point
yPrev = Int -> Int -> Point
pointAt Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      yNext :: Point
yNext = Int -> Int -> Point
pointAt Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Mutable version of a MeshPatch

data MutableMesh s px = MutableMesh
  { MutableMesh s px -> Int
_meshMutWidth :: !Int
  , MutableMesh s px -> Int
_meshMutHeight :: !Int
  , MutableMesh s px -> MVector s Point
_meshMutPrimaryVertices :: !(MV.MVector s Point)
  , MutableMesh s px -> MVector s InterBezier
_meshMutHorizSecondary :: !(MV.MVector s InterBezier)
  , MutableMesh s px -> MVector s InterBezier
_meshMutVertSecondary :: !(MV.MVector s InterBezier)
  , MutableMesh s px -> MVector s px
_meshMutColors :: !(MV.MVector s px)
  , MutableMesh s px -> Maybe (MVector s Derivatives)
_meshMutTensorDerivatives :: !(Maybe (MV.MVector s Derivatives))
  }

-- | Normal mesh to mutable mesh

thawMesh :: PrimMonad m => MeshPatch px -> m (MutableMesh (PrimState m) px)
thawMesh :: MeshPatch px -> m (MutableMesh (PrimState m) px)
thawMesh MeshPatch { Int
Maybe (Vector Derivatives)
Vector px
Vector Point
Vector InterBezier
_meshTensorDerivatives :: forall px. MeshPatch px -> Maybe (Vector Derivatives)
_meshVerticalSecondary :: forall px. MeshPatch px -> Vector InterBezier
_meshHorizontalSecondary :: forall px. MeshPatch px -> Vector InterBezier
_meshPrimaryVertices :: forall px. MeshPatch px -> Vector Point
_meshTensorDerivatives :: Maybe (Vector Derivatives)
_meshColors :: Vector px
_meshVerticalSecondary :: Vector InterBezier
_meshHorizontalSecondary :: Vector InterBezier
_meshPrimaryVertices :: Vector Point
_meshPatchHeight :: Int
_meshPatchWidth :: Int
_meshPatchHeight :: forall px. MeshPatch px -> Int
_meshPatchWidth :: forall px. MeshPatch px -> Int
_meshColors :: forall px. MeshPatch px -> Vector px
.. } = do
  let _meshMutWidth :: Int
_meshMutWidth = Int
_meshPatchWidth
      _meshMutHeight :: Int
_meshMutHeight = Int
_meshPatchHeight
  MVector (PrimState m) Point
_meshMutPrimaryVertices <- Vector Point -> m (MVector (PrimState m) Point)
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.thaw Vector Point
_meshPrimaryVertices 
  MVector (PrimState m) InterBezier
_meshMutHorizSecondary <- Vector InterBezier -> m (MVector (PrimState m) InterBezier)
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.thaw Vector InterBezier
_meshHorizontalSecondary
  MVector (PrimState m) InterBezier
_meshMutVertSecondary <- Vector InterBezier -> m (MVector (PrimState m) InterBezier)
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.thaw Vector InterBezier
_meshVerticalSecondary
  MVector (PrimState m) px
_meshMutColors <- Vector px -> m (MVector (PrimState m) px)
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.thaw Vector px
_meshColors
  Maybe (MVector (PrimState m) Derivatives)
_meshMutTensorDerivatives <- case Maybe (Vector Derivatives)
_meshTensorDerivatives of
      Maybe (Vector Derivatives)
Nothing -> Maybe (MVector (PrimState m) Derivatives)
-> m (Maybe (MVector (PrimState m) Derivatives))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MVector (PrimState m) Derivatives)
forall a. Maybe a
Nothing
      Just Vector Derivatives
v -> MVector (PrimState m) Derivatives
-> Maybe (MVector (PrimState m) Derivatives)
forall a. a -> Maybe a
Just (MVector (PrimState m) Derivatives
 -> Maybe (MVector (PrimState m) Derivatives))
-> m (MVector (PrimState m) Derivatives)
-> m (Maybe (MVector (PrimState m) Derivatives))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Derivatives -> m (MVector (PrimState m) Derivatives)
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.thaw Vector Derivatives
v
  MutableMesh (PrimState m) px -> m (MutableMesh (PrimState m) px)
forall (m :: * -> *) a. Monad m => a -> m a
return MutableMesh :: forall s px.
Int
-> Int
-> MVector s Point
-> MVector s InterBezier
-> MVector s InterBezier
-> MVector s px
-> Maybe (MVector s Derivatives)
-> MutableMesh s px
MutableMesh { Int
Maybe (MVector (PrimState m) Derivatives)
MVector (PrimState m) px
MVector (PrimState m) Point
MVector (PrimState m) InterBezier
_meshMutTensorDerivatives :: Maybe (MVector (PrimState m) Derivatives)
_meshMutColors :: MVector (PrimState m) px
_meshMutVertSecondary :: MVector (PrimState m) InterBezier
_meshMutHorizSecondary :: MVector (PrimState m) InterBezier
_meshMutPrimaryVertices :: MVector (PrimState m) Point
_meshMutHeight :: Int
_meshMutWidth :: Int
_meshMutTensorDerivatives :: Maybe (MVector (PrimState m) Derivatives)
_meshMutColors :: MVector (PrimState m) px
_meshMutVertSecondary :: MVector (PrimState m) InterBezier
_meshMutHorizSecondary :: MVector (PrimState m) InterBezier
_meshMutPrimaryVertices :: MVector (PrimState m) Point
_meshMutHeight :: Int
_meshMutWidth :: Int
.. }

-- | Mutable mesh to freezed mesh.

freezeMesh :: PrimMonad m => MutableMesh (PrimState m) px -> m (MeshPatch px)
freezeMesh :: MutableMesh (PrimState m) px -> m (MeshPatch px)
freezeMesh MutableMesh { Int
Maybe (MVector (PrimState m) Derivatives)
MVector (PrimState m) px
MVector (PrimState m) Point
MVector (PrimState m) InterBezier
_meshMutTensorDerivatives :: Maybe (MVector (PrimState m) Derivatives)
_meshMutColors :: MVector (PrimState m) px
_meshMutVertSecondary :: MVector (PrimState m) InterBezier
_meshMutHorizSecondary :: MVector (PrimState m) InterBezier
_meshMutPrimaryVertices :: MVector (PrimState m) Point
_meshMutHeight :: Int
_meshMutWidth :: Int
_meshMutTensorDerivatives :: forall s px. MutableMesh s px -> Maybe (MVector s Derivatives)
_meshMutColors :: forall s px. MutableMesh s px -> MVector s px
_meshMutVertSecondary :: forall s px. MutableMesh s px -> MVector s InterBezier
_meshMutHorizSecondary :: forall s px. MutableMesh s px -> MVector s InterBezier
_meshMutPrimaryVertices :: forall s px. MutableMesh s px -> MVector s Point
_meshMutHeight :: forall s px. MutableMesh s px -> Int
_meshMutWidth :: forall s px. MutableMesh s px -> Int
.. } = do
  let _meshPatchWidth :: Int
_meshPatchWidth = Int
_meshMutWidth
      _meshPatchHeight :: Int
_meshPatchHeight = Int
_meshMutHeight
  Vector Point
_meshPrimaryVertices <- MVector (PrimState m) Point -> m (Vector Point)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze MVector (PrimState m) Point
_meshMutPrimaryVertices 
  Vector InterBezier
_meshHorizontalSecondary <- MVector (PrimState m) InterBezier -> m (Vector InterBezier)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze MVector (PrimState m) InterBezier
_meshMutHorizSecondary
  Vector InterBezier
_meshVerticalSecondary <- MVector (PrimState m) InterBezier -> m (Vector InterBezier)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze MVector (PrimState m) InterBezier
_meshMutVertSecondary
  Maybe (Vector Derivatives)
_meshTensorDerivatives <- case Maybe (MVector (PrimState m) Derivatives)
_meshMutTensorDerivatives of
        Maybe (MVector (PrimState m) Derivatives)
Nothing -> Maybe (Vector Derivatives) -> m (Maybe (Vector Derivatives))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Vector Derivatives)
forall a. Maybe a
Nothing
        Just MVector (PrimState m) Derivatives
v -> Vector Derivatives -> Maybe (Vector Derivatives)
forall a. a -> Maybe a
Just (Vector Derivatives -> Maybe (Vector Derivatives))
-> m (Vector Derivatives) -> m (Maybe (Vector Derivatives))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) Derivatives -> m (Vector Derivatives)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze MVector (PrimState m) Derivatives
v
  Vector px
_meshColors <- MVector (PrimState m) px -> m (Vector px)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze MVector (PrimState m) px
_meshMutColors
  MeshPatch px -> m (MeshPatch px)
forall (m :: * -> *) a. Monad m => a -> m a
return MeshPatch :: forall px.
Int
-> Int
-> Vector Point
-> Vector InterBezier
-> Vector InterBezier
-> Vector px
-> Maybe (Vector Derivatives)
-> MeshPatch px
MeshPatch { Int
Maybe (Vector Derivatives)
Vector px
Vector Point
Vector InterBezier
_meshColors :: Vector px
_meshTensorDerivatives :: Maybe (Vector Derivatives)
_meshVerticalSecondary :: Vector InterBezier
_meshHorizontalSecondary :: Vector InterBezier
_meshPrimaryVertices :: Vector Point
_meshPatchHeight :: Int
_meshPatchWidth :: Int
_meshTensorDerivatives :: Maybe (Vector Derivatives)
_meshVerticalSecondary :: Vector InterBezier
_meshHorizontalSecondary :: Vector InterBezier
_meshPrimaryVertices :: Vector Point
_meshPatchHeight :: Int
_meshPatchWidth :: Int
_meshColors :: Vector px
.. }

-- | Retrieve a mesh primary vertice purely

verticeAt :: MeshPatch px
          -> Int -- ^ Between 0 and _meshPatchWidth + 1 (excluded)

          -> Int -- ^ Between 0 and _meshPatchHeight + 1 (excluded)

          -> Point
verticeAt :: MeshPatch px -> Int -> Int -> Point
verticeAt MeshPatch px
m Int
x Int
y = MeshPatch px -> Vector Point
forall px. MeshPatch px -> Vector Point
_meshPrimaryVertices MeshPatch px
m Vector Point -> Int -> Point
forall a. Vector a -> Int -> a
! Int
idx where
    idx :: Int
idx = Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* (MeshPatch px -> Int
forall px. MeshPatch px -> Int
_meshPatchWidth MeshPatch px
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x

-- | Given an original MeshPatch, provide context to mutate it through

-- modification functions.

withMesh :: MeshPatch px
         -> (forall m. (MonadReader (MutableMesh (PrimState m) px) m, PrimMonad m) =>
                        m a)
         -> (a, MeshPatch px)
withMesh :: MeshPatch px
-> (forall (m :: * -> *).
    (MonadReader (MutableMesh (PrimState m) px) m, PrimMonad m) =>
    m a)
-> (a, MeshPatch px)
withMesh MeshPatch px
mesh forall (m :: * -> *).
(MonadReader (MutableMesh (PrimState m) px) m, PrimMonad m) =>
m a
act = (forall s. ST s (a, MeshPatch px)) -> (a, MeshPatch px)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (a, MeshPatch px)) -> (a, MeshPatch px))
-> (forall s. ST s (a, MeshPatch px)) -> (a, MeshPatch px)
forall a b. (a -> b) -> a -> b
$ do
  MutableMesh s px
mut <- MeshPatch px -> ST s (MutableMesh (PrimState (ST s)) px)
forall (m :: * -> *) px.
PrimMonad m =>
MeshPatch px -> m (MutableMesh (PrimState m) px)
thawMesh  MeshPatch px
mesh
  a
v <- ReaderT (MutableMesh s px) (ST s) a -> MutableMesh s px -> ST s a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (MutableMesh s px) (ST s) a
forall (m :: * -> *).
(MonadReader (MutableMesh (PrimState m) px) m, PrimMonad m) =>
m a
act MutableMesh s px
mut
  MeshPatch px
final <- MutableMesh (PrimState (ST s)) px -> ST s (MeshPatch px)
forall (m :: * -> *) px.
PrimMonad m =>
MutableMesh (PrimState m) px -> m (MeshPatch px)
freezeMesh MutableMesh s px
MutableMesh (PrimState (ST s)) px
mut
  (a, MeshPatch px) -> ST s (a, MeshPatch px)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
v, MeshPatch px
final)

-- | Set the vertice of a mesh at a given coordinate

setVertice :: (MonadReader (MutableMesh (PrimState m) px) m, PrimMonad m)
           => Int   -- ^ x coordinate in [0, w]

           -> Int   -- ^ y coordinate in [0, h]

           -> Point -- ^ new point value

           -> m ()
setVertice :: Int -> Int -> Point -> m ()
setVertice Int
x Int
y Point
p = do
  MutableMesh { Int
Maybe (MVector (PrimState m) Derivatives)
MVector (PrimState m) px
MVector (PrimState m) Point
MVector (PrimState m) InterBezier
_meshMutTensorDerivatives :: Maybe (MVector (PrimState m) Derivatives)
_meshMutColors :: MVector (PrimState m) px
_meshMutVertSecondary :: MVector (PrimState m) InterBezier
_meshMutHorizSecondary :: MVector (PrimState m) InterBezier
_meshMutPrimaryVertices :: MVector (PrimState m) Point
_meshMutHeight :: Int
_meshMutWidth :: Int
_meshMutTensorDerivatives :: forall s px. MutableMesh s px -> Maybe (MVector s Derivatives)
_meshMutColors :: forall s px. MutableMesh s px -> MVector s px
_meshMutVertSecondary :: forall s px. MutableMesh s px -> MVector s InterBezier
_meshMutHorizSecondary :: forall s px. MutableMesh s px -> MVector s InterBezier
_meshMutPrimaryVertices :: forall s px. MutableMesh s px -> MVector s Point
_meshMutHeight :: forall s px. MutableMesh s px -> Int
_meshMutWidth :: forall s px. MutableMesh s px -> Int
.. } <- m (MutableMesh (PrimState m) px)
forall r (m :: * -> *). MonadReader r m => m r
ask
  let idx :: Int
idx = Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
_meshMutWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
  MVector (PrimState m) Point -> Int -> Point -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector (PrimState m) Point
_meshMutPrimaryVertices Int
idx Point
p

-- | Get the position of vertice

getVertice :: (MonadReader (MutableMesh (PrimState m) px) m, PrimMonad m)
           => Int -> Int -> m Point
getVertice :: Int -> Int -> m Point
getVertice Int
x Int
y = do
  MutableMesh (PrimState m) px
p <- m (MutableMesh (PrimState m) px)
forall r (m :: * -> *). MonadReader r m => m r
ask
  let idx :: Int
idx = Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* (MutableMesh (PrimState m) px -> Int
forall s px. MutableMesh s px -> Int
_meshMutWidth MutableMesh (PrimState m) px
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
  MVector (PrimState m) Point -> Int -> m Point
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.read (MutableMesh (PrimState m) px -> MVector (PrimState m) Point
forall s px. MutableMesh s px -> MVector s Point
_meshMutPrimaryVertices MutableMesh (PrimState m) px
p) Int
idx

-- | Set the two control bezier points horizontally

setHorizPoints :: (MonadReader (MutableMesh (PrimState m) px) m, PrimMonad m)
               => Int -> Int -> InterBezier -> m ()
setHorizPoints :: Int -> Int -> InterBezier -> m ()
setHorizPoints Int
x Int
y InterBezier
p = do
  MutableMesh { Int
Maybe (MVector (PrimState m) Derivatives)
MVector (PrimState m) px
MVector (PrimState m) Point
MVector (PrimState m) InterBezier
_meshMutTensorDerivatives :: Maybe (MVector (PrimState m) Derivatives)
_meshMutColors :: MVector (PrimState m) px
_meshMutVertSecondary :: MVector (PrimState m) InterBezier
_meshMutHorizSecondary :: MVector (PrimState m) InterBezier
_meshMutPrimaryVertices :: MVector (PrimState m) Point
_meshMutHeight :: Int
_meshMutWidth :: Int
_meshMutTensorDerivatives :: forall s px. MutableMesh s px -> Maybe (MVector s Derivatives)
_meshMutColors :: forall s px. MutableMesh s px -> MVector s px
_meshMutVertSecondary :: forall s px. MutableMesh s px -> MVector s InterBezier
_meshMutHorizSecondary :: forall s px. MutableMesh s px -> MVector s InterBezier
_meshMutPrimaryVertices :: forall s px. MutableMesh s px -> MVector s Point
_meshMutHeight :: forall s px. MutableMesh s px -> Int
_meshMutWidth :: forall s px. MutableMesh s px -> Int
.. } <- m (MutableMesh (PrimState m) px)
forall r (m :: * -> *). MonadReader r m => m r
ask
  let idx :: Int
idx = Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
_meshMutWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
  MVector (PrimState m) InterBezier -> Int -> InterBezier -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector (PrimState m) InterBezier
_meshMutHorizSecondary Int
idx InterBezier
p

-- | Set the two control bezier points vertically

setVertPoints :: (MonadReader (MutableMesh (PrimState m) px) m, PrimMonad m)
              => Int -> Int -> InterBezier -> m ()
setVertPoints :: Int -> Int -> InterBezier -> m ()
setVertPoints Int
x Int
y InterBezier
p = do
  MutableMesh { Int
Maybe (MVector (PrimState m) Derivatives)
MVector (PrimState m) px
MVector (PrimState m) Point
MVector (PrimState m) InterBezier
_meshMutTensorDerivatives :: Maybe (MVector (PrimState m) Derivatives)
_meshMutColors :: MVector (PrimState m) px
_meshMutVertSecondary :: MVector (PrimState m) InterBezier
_meshMutHorizSecondary :: MVector (PrimState m) InterBezier
_meshMutPrimaryVertices :: MVector (PrimState m) Point
_meshMutHeight :: Int
_meshMutWidth :: Int
_meshMutTensorDerivatives :: forall s px. MutableMesh s px -> Maybe (MVector s Derivatives)
_meshMutColors :: forall s px. MutableMesh s px -> MVector s px
_meshMutVertSecondary :: forall s px. MutableMesh s px -> MVector s InterBezier
_meshMutHorizSecondary :: forall s px. MutableMesh s px -> MVector s InterBezier
_meshMutPrimaryVertices :: forall s px. MutableMesh s px -> MVector s Point
_meshMutHeight :: forall s px. MutableMesh s px -> Int
_meshMutWidth :: forall s px. MutableMesh s px -> Int
.. } <- m (MutableMesh (PrimState m) px)
forall r (m :: * -> *). MonadReader r m => m r
ask
  let idx :: Int
idx = Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
_meshMutWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
  MVector (PrimState m) InterBezier -> Int -> InterBezier -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector (PrimState m) InterBezier
_meshMutVertSecondary Int
idx InterBezier
p


-- | Set the value associated to a vertex

setColor :: (MonadReader (MutableMesh (PrimState m) px) m, PrimMonad m)
         => Int -> Int -> px -> m ()
setColor :: Int -> Int -> px -> m ()
setColor Int
x Int
y px
p = do
  MutableMesh { Int
Maybe (MVector (PrimState m) Derivatives)
MVector (PrimState m) px
MVector (PrimState m) Point
MVector (PrimState m) InterBezier
_meshMutTensorDerivatives :: Maybe (MVector (PrimState m) Derivatives)
_meshMutColors :: MVector (PrimState m) px
_meshMutVertSecondary :: MVector (PrimState m) InterBezier
_meshMutHorizSecondary :: MVector (PrimState m) InterBezier
_meshMutPrimaryVertices :: MVector (PrimState m) Point
_meshMutHeight :: Int
_meshMutWidth :: Int
_meshMutTensorDerivatives :: forall s px. MutableMesh s px -> Maybe (MVector s Derivatives)
_meshMutColors :: forall s px. MutableMesh s px -> MVector s px
_meshMutVertSecondary :: forall s px. MutableMesh s px -> MVector s InterBezier
_meshMutHorizSecondary :: forall s px. MutableMesh s px -> MVector s InterBezier
_meshMutPrimaryVertices :: forall s px. MutableMesh s px -> MVector s Point
_meshMutHeight :: forall s px. MutableMesh s px -> Int
_meshMutWidth :: forall s px. MutableMesh s px -> Int
.. } <- m (MutableMesh (PrimState m) px)
forall r (m :: * -> *). MonadReader r m => m r
ask
  let idx :: Int
idx = Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
_meshMutWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
  MVector (PrimState m) px -> Int -> px -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector (PrimState m) px
_meshMutColors Int
idx px
p

-- | Generate a meshpatch at the size given by the image and

-- a number of cell in a mesh

generateImageMesh :: Int      -- ^ Horizontal cell count

                  -> Int      -- ^ Vertical cell count

                  -> Point    -- ^ Position of the corner upper left

                  -> Image px -- ^ Image to transform through a mesh

                  -> MeshPatch (ImageMesh px)
generateImageMesh :: Int -> Int -> Point -> Image px -> MeshPatch (ImageMesh px)
generateImageMesh Int
w Int
h Point
base Image px
img = Int
-> Int
-> Point
-> Point
-> Vector (ImageMesh px)
-> MeshPatch (ImageMesh px)
forall px.
Int -> Int -> Point -> Point -> Vector px -> MeshPatch px
generateLinearGrid Int
w Int
h Point
base (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
dx Float
dy) Vector (ImageMesh px)
infos where
  dx :: Float
dx = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Image px -> Int
forall a. Image a -> Int
imageWidth Image px
img) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
  dy :: Float
dy = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Image px -> Int
forall a. Image a -> Int
imageHeight Image px
img) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h
  infos :: Vector (ImageMesh px)
infos = Int -> [ImageMesh px] -> Vector (ImageMesh px)
forall a. Int -> [a] -> Vector a
V.fromListN ((Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
    [Image px -> Transformation -> ImageMesh px
forall px. Image px -> Transformation -> ImageMesh px
ImageMesh Image px
img (Transformation -> ImageMesh px) -> Transformation -> ImageMesh px
forall a b. (a -> b) -> a -> b
$ Transformation
trans Transformation -> Transformation -> Transformation
forall a. Semigroup a => a -> a -> a
<> Transformation
scaling
        | Int
y <- [Int
0 .. Int
h]
        , Int
x <- [Int
0 .. Int
w]
        , let fx :: Float
fx = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x
              fy :: Float
fy = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y
              trans :: Transformation
trans = Point -> Transformation
translate (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
fx Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dx) (Float
fy Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dy))
              scaling :: Transformation
scaling = Float -> Float -> Transformation
scale Float
dx Float
dy]


-- | Generate a valid gradient with the shape of a simple grid

-- using some simple information. You can use `thawMesh` and `freezeMesh`

-- to mutate it.

generateLinearGrid :: Int           -- ^ Width in patch

                   -> Int           -- ^ Height in patch

                   -> Point         -- ^ Position of the upper left corner

                   -> V2 Float      -- ^ Size of each patch in x adn y

                   -> V.Vector px   -- ^ Vector of values, size must be (width + 1) * (height + 1)

                   -> MeshPatch px
generateLinearGrid :: Int -> Int -> Point -> Point -> Vector px -> MeshPatch px
generateLinearGrid Int
w Int
h Point
base (V2 Float
dx Float
dy) Vector px
colors = MeshPatch :: forall px.
Int
-> Int
-> Vector Point
-> Vector InterBezier
-> Vector InterBezier
-> Vector px
-> Maybe (Vector Derivatives)
-> MeshPatch px
MeshPatch
  { _meshPatchWidth :: Int
_meshPatchWidth = Int
w
  , _meshPatchHeight :: Int
_meshPatchHeight = Int
h
  , _meshPrimaryVertices :: Vector Point
_meshPrimaryVertices = Vector Point
vertices 
  , _meshHorizontalSecondary :: Vector InterBezier
_meshHorizontalSecondary = Vector InterBezier
hSecondary 
  , _meshVerticalSecondary :: Vector InterBezier
_meshVerticalSecondary = Vector InterBezier
vSecondary
  , _meshTensorDerivatives :: Maybe (Vector Derivatives)
_meshTensorDerivatives = Maybe (Vector Derivatives)
forall a. Maybe a
Nothing
  , _meshColors :: Vector px
_meshColors = Vector px
colors
  }
  where
    vertexCount :: Int
vertexCount = (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    vertices :: Vector Point
vertices =
      Int -> [Point] -> Vector Point
forall a. Int -> [a] -> Vector a
V.fromListN Int
vertexCount [Point
base Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
dx Float -> Float -> Float
forall a. Num a => a -> a -> a
* Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Float
dy Float -> Float -> Float
forall a. Num a => a -> a -> a
* Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)
                                        | Int
y <- [Int
0 .. Int
h], Int
x <- [Int
0 .. Int
w]]
    at :: Int -> Int -> Point
at Int
x Int
y = Vector Point
vertices Vector Point -> Int -> Point
forall a. Vector a -> Int -> a
! (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)
    hSecondary :: Vector InterBezier
hSecondary = Int -> [InterBezier] -> Vector InterBezier
forall a. Int -> [a] -> Vector a
V.fromListN ((Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w)
        [Point -> Point -> InterBezier
InterBezier (Point
p0 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point
delta Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
3)) (Point
p0 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point
delta Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (Float
2Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
3))
            | Int
y <- [Int
0 .. Int
h], Int
x <- [Int
0 .. Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
            , let p0 :: Point
p0 = Int -> Int -> Point
at Int
x Int
y
                  p1 :: Point
p1 = Int -> Int -> Point
at (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
y
                  delta :: Point
delta = Point
p1 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
p0
            ]

    vSecondary :: Vector InterBezier
vSecondary = Int -> [InterBezier] -> Vector InterBezier
forall a. Int -> [a] -> Vector a
V.fromListN ((Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h)
        [Point -> Point -> InterBezier
InterBezier (Point
p0 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point
delta Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
3)) (Point
p0 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point
delta Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (Float
2Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
3))
            | Int
y <- [Int
0 .. Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1], Int
x <- [Int
0 .. Int
w]
            , let p0 :: Point
p0 = Int -> Int -> Point
at Int
x Int
y
                  p1 :: Point
p1 = Int -> Int -> Point
at Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                  delta :: Point
delta = Point
p1 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
p0
            ]

type ColorPreparator px pxt = ParametricValues px -> pxt

-- | Extract a coon patch at a given position.

coonPatchAt :: MeshPatch px
            -> Int -- ^ x

            -> Int -- ^ y

            -> CoonPatch (ParametricValues px)
coonPatchAt :: MeshPatch px -> Int -> Int -> CoonPatch (ParametricValues px)
coonPatchAt = ColorPreparator px (ParametricValues px)
-> MeshPatch px -> Int -> Int -> CoonPatch (ParametricValues px)
forall px pxt.
ColorPreparator px pxt
-> MeshPatch px -> Int -> Int -> CoonPatch pxt
coonPatchAt' ColorPreparator px (ParametricValues px)
forall a. a -> a
id

-- | Extract a tensor patch at a given position

tensorPatchAt :: MeshPatch px
              -> Int -- ^ x

              -> Int -- ^ y

              -> TensorPatch (ParametricValues px)
tensorPatchAt :: MeshPatch px -> Int -> Int -> TensorPatch (ParametricValues px)
tensorPatchAt = ColorPreparator px (ParametricValues px)
-> MeshPatch px -> Int -> Int -> TensorPatch (ParametricValues px)
forall px pxt.
ColorPreparator px pxt
-> MeshPatch px -> Int -> Int -> TensorPatch pxt
tensorPatchAt' ColorPreparator px (ParametricValues px)
forall a. a -> a
id

-- | Extract an image patch out of a mesh at a given position.

coonImagePatchAt :: MeshPatch (ImageMesh px)
                 -> Int -- ^ x

                 -> Int -- ^ y

                 -> CoonPatch (ImageMesh px)
coonImagePatchAt :: MeshPatch (ImageMesh px) -> Int -> Int -> CoonPatch (ImageMesh px)
coonImagePatchAt = ColorPreparator (ImageMesh px) (ImageMesh px)
-> MeshPatch (ImageMesh px)
-> Int
-> Int
-> CoonPatch (ImageMesh px)
forall px pxt.
ColorPreparator px pxt
-> MeshPatch px -> Int -> Int -> CoonPatch pxt
coonPatchAt' ColorPreparator (ImageMesh px) (ImageMesh px)
forall a. ParametricValues a -> a
_northValue


-- | Extract a tensor image patch out of a mesh at

-- a given position.

tensorImagePatchAt :: MeshPatch (ImageMesh px)
                   -> Int -- ^ x

                   -> Int -- ^ y

                   -> TensorPatch (ImageMesh px)
tensorImagePatchAt :: MeshPatch (ImageMesh px)
-> Int -> Int -> TensorPatch (ImageMesh px)
tensorImagePatchAt = ColorPreparator (ImageMesh px) (ImageMesh px)
-> MeshPatch (ImageMesh px)
-> Int
-> Int
-> TensorPatch (ImageMesh px)
forall px pxt.
ColorPreparator px pxt
-> MeshPatch px -> Int -> Int -> TensorPatch pxt
tensorPatchAt' ColorPreparator (ImageMesh px) (ImageMesh px)
forall a. ParametricValues a -> a
_northValue

-- | Extract a coon patch for cubic interpolation at a given position

-- see `calculateMeshColorDerivative`

coonPatchAtWithDerivative :: (InterpolablePixel px)
                          => MeshPatch (Derivative px)
                          -> Int -- ^ x

                          -> Int -- ^ y

                          -> CoonPatch (CubicCoefficient px)
coonPatchAtWithDerivative :: MeshPatch (Derivative px)
-> Int -> Int -> CoonPatch (CubicCoefficient px)
coonPatchAtWithDerivative = ColorPreparator (Derivative px) (CubicCoefficient px)
-> MeshPatch (Derivative px)
-> Int
-> Int
-> CoonPatch (CubicCoefficient px)
forall px pxt.
ColorPreparator px pxt
-> MeshPatch px -> Int -> Int -> CoonPatch pxt
coonPatchAt' ColorPreparator (Derivative px) (CubicCoefficient px)
forall px.
InterpolablePixel px =>
ParametricValues (Derivative px) -> CubicCoefficient px
cubicPreparator

-- | Extract a tensor patch for cubic interpolation at a given position

-- see `calculateMeshColorDerivative`

tensorPatchAtWithDerivative :: (InterpolablePixel px)
                            => MeshPatch (Derivative px)
                            -> Int -- ^ x

                            -> Int -- ^ y

                            -> TensorPatch (CubicCoefficient px)
tensorPatchAtWithDerivative :: MeshPatch (Derivative px)
-> Int -> Int -> TensorPatch (CubicCoefficient px)
tensorPatchAtWithDerivative = ColorPreparator (Derivative px) (CubicCoefficient px)
-> MeshPatch (Derivative px)
-> Int
-> Int
-> TensorPatch (CubicCoefficient px)
forall px pxt.
ColorPreparator px pxt
-> MeshPatch px -> Int -> Int -> TensorPatch pxt
tensorPatchAt' ColorPreparator (Derivative px) (CubicCoefficient px)
forall px.
InterpolablePixel px =>
ParametricValues (Derivative px) -> CubicCoefficient px
cubicPreparator

rawMatrix :: V.Vector (V.Vector Float)
rawMatrix :: Vector (Vector Float)
rawMatrix = Int -> [Vector Float] -> Vector (Vector Float)
forall a. Int -> [a] -> Vector a
V.fromListN Int
16 ([Vector Float] -> Vector (Vector Float))
-> [Vector Float] -> Vector (Vector Float)
forall a b. (a -> b) -> a -> b
$ Int -> [Float] -> Vector Float
forall a. Int -> [a] -> Vector a
V.fromListN Int
16 ([Float] -> Vector Float) -> [[Float]] -> [Vector Float]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  [ [ Float
1, Float
0, Float
0, Float
0,  Float
0, Float
0, Float
0, Float
0,  Float
0, Float
0, Float
0, Float
0,  Float
0, Float
0, Float
0, Float
0 ]
  , [ Float
0, Float
0, Float
0, Float
0,  Float
1, Float
0, Float
0, Float
0,  Float
0, Float
0, Float
0, Float
0,  Float
0, Float
0, Float
0, Float
0 ]
  , [-Float
3, Float
3, Float
0, Float
0, -Float
2,-Float
1, Float
0, Float
0,  Float
0, Float
0, Float
0, Float
0,  Float
0, Float
0, Float
0, Float
0 ]
  , [ Float
2,-Float
2, Float
0, Float
0,  Float
1, Float
1, Float
0, Float
0,  Float
0, Float
0, Float
0, Float
0,  Float
0, Float
0, Float
0, Float
0 ]
  , [ Float
0, Float
0, Float
0, Float
0,  Float
0, Float
0, Float
0, Float
0,  Float
1, Float
0, Float
0, Float
0,  Float
0, Float
0, Float
0, Float
0 ]
  , [ Float
0, Float
0, Float
0, Float
0,  Float
0, Float
0, Float
0, Float
0,  Float
0, Float
0, Float
0, Float
0,  Float
1, Float
0, Float
0, Float
0 ]
  , [ Float
0, Float
0, Float
0, Float
0,  Float
0, Float
0, Float
0, Float
0, -Float
3, Float
3, Float
0, Float
0, -Float
2,-Float
1, Float
0, Float
0 ]
  , [ Float
0, Float
0, Float
0, Float
0,  Float
0, Float
0, Float
0, Float
0,  Float
2,-Float
2, Float
0, Float
0,  Float
1, Float
1, Float
0, Float
0 ]
  , [-Float
3, Float
0, Float
3, Float
0,  Float
0, Float
0, Float
0, Float
0, -Float
2, Float
0,-Float
1, Float
0,  Float
0, Float
0, Float
0, Float
0 ]
  , [ Float
0, Float
0, Float
0, Float
0, -Float
3, Float
0, Float
3, Float
0,  Float
0, Float
0, Float
0, Float
0, -Float
2, Float
0,-Float
1, Float
0 ]
  , [ Float
9,-Float
9,-Float
9, Float
9,  Float
6, Float
3,-Float
6,-Float
3,  Float
6,-Float
6, Float
3,-Float
3,  Float
4, Float
2, Float
2, Float
1 ]
  , [-Float
6, Float
6, Float
6,-Float
6, -Float
3,-Float
3, Float
3, Float
3, -Float
4, Float
4,-Float
2, Float
2, -Float
2,-Float
2,-Float
1,-Float
1 ]
  , [ Float
2, Float
0,-Float
2, Float
0,  Float
0, Float
0, Float
0, Float
0,  Float
1, Float
0, Float
1, Float
0,  Float
0, Float
0, Float
0, Float
0 ]
  , [ Float
0, Float
0, Float
0, Float
0,  Float
2, Float
0,-Float
2, Float
0,  Float
0, Float
0, Float
0, Float
0,  Float
1, Float
0, Float
1, Float
0 ]
  , [-Float
6, Float
6, Float
6,-Float
6, -Float
4,-Float
2, Float
4, Float
2, -Float
3, Float
3,-Float
3, Float
3, -Float
2,-Float
1,-Float
2,-Float
1 ]
  , [ Float
4,-Float
4,-Float
4, Float
4,  Float
2, Float
2,-Float
2,-Float
2,  Float
2,-Float
2, Float
2,-Float
2,  Float
1, Float
1, Float
1, Float
1 ]
  ]

cubicPreparator :: (InterpolablePixel px)
                => ParametricValues (Derivative px)
                -> CubicCoefficient px
cubicPreparator :: ParametricValues (Derivative px) -> CubicCoefficient px
cubicPreparator ParametricValues { Derivative px
_westValue :: forall a. ParametricValues a -> a
_southValue :: forall a. ParametricValues a -> a
_eastValue :: forall a. ParametricValues a -> a
_westValue :: Derivative px
_southValue :: Derivative px
_eastValue :: Derivative px
_northValue :: Derivative px
_northValue :: forall a. ParametricValues a -> a
.. } =
    ParametricValues (V4 (Holder px Float)) -> CubicCoefficient px
forall px.
ParametricValues (V4 (Holder px Float)) -> CubicCoefficient px
CubicCoefficient (ParametricValues (V4 (Holder px Float)) -> CubicCoefficient px)
-> ParametricValues (V4 (Holder px Float)) -> CubicCoefficient px
forall a b. (a -> b) -> a -> b
$ V4 (Holder px Float)
-> V4 (Holder px Float)
-> V4 (Holder px Float)
-> V4 (Holder px Float)
-> ParametricValues (V4 (Holder px Float))
forall a. a -> a -> a -> a -> ParametricValues a
ParametricValues (Int -> V4 (Holder px Float)
sliceAt Int
0) (Int -> V4 (Holder px Float)
sliceAt Int
4) (Int -> V4 (Holder px Float)
sliceAt Int
8) (Int -> V4 (Holder px Float)
sliceAt Int
12) where
  Derivative Holder px Float
c00 Holder px Float
fx00 Holder px Float
fy00 Holder px Float
fxy00 = Derivative px
_northValue
  Derivative Holder px Float
c10 Holder px Float
fx10 Holder px Float
fy10 Holder px Float
fxy10 = Derivative px
_eastValue
  Derivative Holder px Float
c01 Holder px Float
fx01 Holder px Float
fy01 Holder px Float
fxy01 = Derivative px
_westValue
  Derivative Holder px Float
c11 Holder px Float
fx11 Holder px Float
fy11 Holder px Float
fxy11 = Derivative px
_southValue

  resultVector :: Vector (Holder px Float)
resultVector = Vector (Holder px Float) -> Vector (Holder px Float)
forall (f :: * -> *).
Additive f =>
Vector (f Float) -> Vector (f Float)
mulVec (Vector (Holder px Float) -> Vector (Holder px Float))
-> Vector (Holder px Float) -> Vector (Holder px Float)
forall a b. (a -> b) -> a -> b
$ Int -> [Holder px Float] -> Vector (Holder px Float)
forall a. Int -> [a] -> Vector a
V.fromListN Int
16
    [  Holder px Float
c00,   Holder px Float
c10,   Holder px Float
c01,   Holder px Float
c11
    , Holder px Float
fx00,  Holder px Float
fx10,  Holder px Float
fx01,  Holder px Float
fx11 
    , Holder px Float
fy00,  Holder px Float
fy10,  Holder px Float
fy01,  Holder px Float
fy11 
    ,Holder px Float
fxy00, Holder px Float
fxy10, Holder px Float
fxy01, Holder px Float
fxy11
    ]

  mulVec :: Vector (f Float) -> Vector (f Float)
mulVec Vector (f Float)
vec = (f Float -> f Float -> f Float)
-> f Float -> Vector (f Float) -> f Float
forall (v :: * -> *) b a.
Vector v b =>
(a -> b -> a) -> a -> v b -> a
VG.foldl' f Float -> f Float -> f Float
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
(^+^) f Float
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero (Vector (f Float) -> f Float)
-> (Vector Float -> Vector (f Float)) -> Vector Float -> f Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f Float -> Float -> f Float)
-> Vector (f Float) -> Vector Float -> Vector (f Float)
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
VG.zipWith f Float -> Float -> f Float
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
(^*) Vector (f Float)
vec (Vector Float -> f Float)
-> Vector (Vector Float) -> Vector (f Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (Vector Float)
rawMatrix

  sliceAt :: Int -> V4 (Holder px Float)
sliceAt Int
i = Holder px Float
-> Holder px Float
-> Holder px Float
-> Holder px Float
-> V4 (Holder px Float)
forall a. a -> a -> a -> a -> V4 a
V4 
    (Vector (Holder px Float)
resultVector Vector (Holder px Float) -> Int -> Holder px Float
forall a. Vector a -> Int -> a
V.! Int
i)
    (Vector (Holder px Float)
resultVector Vector (Holder px Float) -> Int -> Holder px Float
forall a. Vector a -> Int -> a
V.! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
    (Vector (Holder px Float)
resultVector Vector (Holder px Float) -> Int -> Holder px Float
forall a. Vector a -> Int -> a
V.! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
    (Vector (Holder px Float)
resultVector Vector (Holder px Float) -> Int -> Holder px Float
forall a. Vector a -> Int -> a
V.! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3))

tensorPatchAt' :: ColorPreparator px pxt -> MeshPatch px -> Int -> Int
               -> TensorPatch pxt
tensorPatchAt' :: ColorPreparator px pxt
-> MeshPatch px -> Int -> Int -> TensorPatch pxt
tensorPatchAt' ColorPreparator px pxt
preparator mesh :: MeshPatch px
mesh@MeshPatch { _meshTensorDerivatives :: forall px. MeshPatch px -> Maybe (Vector Derivatives)
_meshTensorDerivatives = Maybe (Vector Derivatives)
Nothing } Int
x Int
y =
    CoonPatch pxt -> TensorPatch pxt
forall a. CoonPatch a -> TensorPatch a
toTensorPatch (CoonPatch pxt -> TensorPatch pxt)
-> CoonPatch pxt -> TensorPatch pxt
forall a b. (a -> b) -> a -> b
$ ColorPreparator px pxt
-> MeshPatch px -> Int -> Int -> CoonPatch pxt
forall px pxt.
ColorPreparator px pxt
-> MeshPatch px -> Int -> Int -> CoonPatch pxt
coonPatchAt' ColorPreparator px pxt
preparator MeshPatch px
mesh Int
x Int
y
tensorPatchAt' ColorPreparator px pxt
preparator MeshPatch px
mesh Int
x Int
y = TensorPatch :: forall weight.
CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> weight
-> TensorPatch weight
TensorPatch
  { _curve0 :: CubicBezier
_curve0 = Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
p00 Point
p01 Point
p02 Point
p03
  , _curve1 :: CubicBezier
_curve1 = Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
p10 Point
p11 Point
p12 Point
p13
  , _curve2 :: CubicBezier
_curve2 = Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
p20 Point
p21 Point
p22 Point
p23
  , _curve3 :: CubicBezier
_curve3 = Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
p30 Point
p31 Point
p32 Point
p33
  , _tensorValues :: pxt
_tensorValues = ColorPreparator px pxt
preparator ColorPreparator px pxt -> ColorPreparator px pxt
forall a b. (a -> b) -> a -> b
$ ParametricValues :: forall a. a -> a -> a -> a -> ParametricValues a
ParametricValues
        { _northValue :: px
_northValue = px
c00
        , _eastValue :: px
_eastValue  = px
c03
        , _southValue :: px
_southValue = px
c33
        , _westValue :: px
_westValue  = px
c30
        }
  }
  where
    w :: Int
w = MeshPatch px -> Int
forall px. MeshPatch px -> Int
_meshPatchWidth MeshPatch px
mesh
    vertices :: Vector Point
vertices = MeshPatch px -> Vector Point
forall px. MeshPatch px -> Vector Point
_meshPrimaryVertices MeshPatch px
mesh
    colors :: Vector px
colors = MeshPatch px -> Vector px
forall px. MeshPatch px -> Vector px
_meshColors MeshPatch px
mesh
    
    hInter :: Vector InterBezier
hInter = MeshPatch px -> Vector InterBezier
forall px. MeshPatch px -> Vector InterBezier
_meshHorizontalSecondary MeshPatch px
mesh
    vInter :: Vector InterBezier
vInter = MeshPatch px -> Vector InterBezier
forall px. MeshPatch px -> Vector InterBezier
_meshVerticalSecondary MeshPatch px
mesh
    
    baseIx :: Int
baseIx = (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
    p00 :: Point
p00 = Vector Point
vertices Vector Point -> Int -> Point
forall a. Vector a -> Int -> a
! Int
baseIx
    c00 :: px
c00 = Vector px
colors   Vector px -> Int -> px
forall a. Vector a -> Int -> a
! Int
baseIx
    
    p03 :: Point
p03 = Vector Point
vertices Vector Point -> Int -> Point
forall a. Vector a -> Int -> a
! (Int
baseIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    c03 :: px
c03 = Vector px
colors   Vector px -> Int -> px
forall a. Vector a -> Int -> a
! (Int
baseIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    
    p30 :: Point
p30 = Vector Point
vertices Vector Point -> Int -> Point
forall a. Vector a -> Int -> a
! (Int
baseIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    c30 :: px
c30 = Vector px
colors   Vector px -> Int -> px
forall a. Vector a -> Int -> a
! (Int
baseIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    p33 :: Point
p33 = Vector Point
vertices Vector Point -> Int -> Point
forall a. Vector a -> Int -> a
! (Int
baseIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    c33 :: px
c33 = Vector px
colors   Vector px -> Int -> px
forall a. Vector a -> Int -> a
! (Int
baseIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    
    baseH :: Int
baseH = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
    InterBezier Point
p01 Point
p02 = Vector InterBezier
hInter Vector InterBezier -> Int -> InterBezier
forall a. Vector a -> Int -> a
! Int
baseH
    InterBezier Point
p31 Point
p32 = Vector InterBezier
hInter Vector InterBezier -> Int -> InterBezier
forall a. Vector a -> Int -> a
! (Int
baseH Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w)

    baseV :: Int
baseV = (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
    InterBezier Point
p10 Point
p20 = Vector InterBezier
vInter Vector InterBezier -> Int -> InterBezier
forall a. Vector a -> Int -> a
! Int
baseV
    InterBezier Point
p13 Point
p23 = Vector InterBezier
vInter Vector InterBezier -> Int -> InterBezier
forall a. Vector a -> Int -> a
! (Int
baseV Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

    Derivatives Point
p11 Point
p12 Point
p21 Point
p22 = case MeshPatch px -> Maybe (Vector Derivatives)
forall px. MeshPatch px -> Maybe (Vector Derivatives)
_meshTensorDerivatives MeshPatch px
mesh of
      Maybe (Vector Derivatives)
Nothing -> [Char] -> Derivatives
forall a. HasCallStack => [Char] -> a
error [Char]
"Not a tensor patch"
      Just Vector Derivatives
v -> Vector Derivatives
v Vector Derivatives -> Int -> Derivatives
forall a. Vector a -> Int -> a
! (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)


coonPatchAt' :: ColorPreparator px pxt
             -> MeshPatch px -> Int -> Int -> CoonPatch pxt
coonPatchAt' :: ColorPreparator px pxt
-> MeshPatch px -> Int -> Int -> CoonPatch pxt
coonPatchAt' ColorPreparator px pxt
preparator MeshPatch px
mesh Int
x Int
y = CoonPatch :: forall weight.
CubicBezier
-> CubicBezier
-> CubicBezier
-> CubicBezier
-> weight
-> CoonPatch weight
CoonPatch 
    { _north :: CubicBezier
_north = Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
p00 Point
p01 Point
p02 Point
p03
    , _east :: CubicBezier
_east  = Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
p03 Point
p13 Point
p23 Point
p33
    , _south :: CubicBezier
_south = Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
p33 Point
p32 Point
p31 Point
p30
    , _west :: CubicBezier
_west  = Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
p30 Point
p20 Point
p10 Point
p00
    , _coonValues :: pxt
_coonValues = ColorPreparator px pxt
preparator ColorPreparator px pxt -> ColorPreparator px pxt
forall a b. (a -> b) -> a -> b
$ ParametricValues :: forall a. a -> a -> a -> a -> ParametricValues a
ParametricValues
        { _northValue :: px
_northValue = px
c00
        , _eastValue :: px
_eastValue  = px
c03
        , _southValue :: px
_southValue = px
c33
        , _westValue :: px
_westValue  = px
c30
        }
    }
  where
    w :: Int
w = MeshPatch px -> Int
forall px. MeshPatch px -> Int
_meshPatchWidth MeshPatch px
mesh
    vertices :: Vector Point
vertices = MeshPatch px -> Vector Point
forall px. MeshPatch px -> Vector Point
_meshPrimaryVertices MeshPatch px
mesh
    colors :: Vector px
colors = MeshPatch px -> Vector px
forall px. MeshPatch px -> Vector px
_meshColors MeshPatch px
mesh
    
    hInter :: Vector InterBezier
hInter = MeshPatch px -> Vector InterBezier
forall px. MeshPatch px -> Vector InterBezier
_meshHorizontalSecondary MeshPatch px
mesh
    vInter :: Vector InterBezier
vInter = MeshPatch px -> Vector InterBezier
forall px. MeshPatch px -> Vector InterBezier
_meshVerticalSecondary MeshPatch px
mesh
    
    baseIx :: Int
baseIx = (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
    p00 :: Point
p00 = Vector Point
vertices Vector Point -> Int -> Point
forall a. Vector a -> Int -> a
! Int
baseIx
    c00 :: px
c00 = Vector px
colors   Vector px -> Int -> px
forall a. Vector a -> Int -> a
! Int
baseIx
    
    p03 :: Point
p03 = Vector Point
vertices Vector Point -> Int -> Point
forall a. Vector a -> Int -> a
! (Int
baseIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    c03 :: px
c03 = Vector px
colors   Vector px -> Int -> px
forall a. Vector a -> Int -> a
! (Int
baseIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    
    p30 :: Point
p30 = Vector Point
vertices Vector Point -> Int -> Point
forall a. Vector a -> Int -> a
! (Int
baseIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    c30 :: px
c30 = Vector px
colors   Vector px -> Int -> px
forall a. Vector a -> Int -> a
! (Int
baseIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    p33 :: Point
p33 = Vector Point
vertices Vector Point -> Int -> Point
forall a. Vector a -> Int -> a
! (Int
baseIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    c33 :: px
c33 = Vector px
colors   Vector px -> Int -> px
forall a. Vector a -> Int -> a
! (Int
baseIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    
    baseH :: Int
baseH = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
    InterBezier Point
p01 Point
p02 = Vector InterBezier
hInter Vector InterBezier -> Int -> InterBezier
forall a. Vector a -> Int -> a
! Int
baseH
    InterBezier Point
p31 Point
p32 = Vector InterBezier
hInter Vector InterBezier -> Int -> InterBezier
forall a. Vector a -> Int -> a
! (Int
baseH Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w)

    baseV :: Int
baseV = (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
    InterBezier Point
p10 Point
p20 = Vector InterBezier
vInter Vector InterBezier -> Int -> InterBezier
forall a. Vector a -> Int -> a
! Int
baseV
    InterBezier Point
p13 Point
p23 = Vector InterBezier
vInter Vector InterBezier -> Int -> InterBezier
forall a. Vector a -> Int -> a
! (Int
baseV Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Extract a list of all the coon patches of the mesh.

coonPatchesOf :: MeshPatch px -> [CoonPatch (ParametricValues px)]
coonPatchesOf :: MeshPatch px -> [CoonPatch (ParametricValues px)]
coonPatchesOf mesh :: MeshPatch px
mesh@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)
_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
_meshColors :: forall px. MeshPatch px -> Vector px
.. } =
  [MeshPatch px -> Int -> Int -> CoonPatch (ParametricValues px)
forall px.
MeshPatch px -> Int -> Int -> CoonPatch (ParametricValues px)
coonPatchAt MeshPatch px
mesh Int
x Int
y | Int
y <- [Int
0 .. Int
_meshPatchHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1], Int
x <- [Int
0 .. Int
_meshPatchWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

-- | Extract a list of all the tensor patches of the mesh.

tensorPatchesOf :: MeshPatch px -> [TensorPatch (ParametricValues px)]
tensorPatchesOf :: MeshPatch px -> [TensorPatch (ParametricValues px)]
tensorPatchesOf mesh :: MeshPatch px
mesh@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)
_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
_meshColors :: forall px. MeshPatch px -> Vector px
.. } =
  [MeshPatch px -> Int -> Int -> TensorPatch (ParametricValues px)
forall px.
MeshPatch px -> Int -> Int -> TensorPatch (ParametricValues px)
tensorPatchAt MeshPatch px
mesh Int
x Int
y | Int
y <- [Int
0 .. Int
_meshPatchHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1], Int
x <- [Int
0 .. Int
_meshPatchWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

-- | Extract all the coon patch of a mesh using an image interpolation.

imagePatchesOf :: MeshPatch (ImageMesh px) -> [CoonPatch (ImageMesh px)]
imagePatchesOf :: MeshPatch (ImageMesh px) -> [CoonPatch (ImageMesh px)]
imagePatchesOf mesh :: MeshPatch (ImageMesh px)
mesh@MeshPatch { Int
Maybe (Vector Derivatives)
Vector Point
Vector (ImageMesh px)
Vector InterBezier
_meshTensorDerivatives :: Maybe (Vector Derivatives)
_meshColors :: Vector (ImageMesh px)
_meshVerticalSecondary :: Vector InterBezier
_meshHorizontalSecondary :: Vector InterBezier
_meshPrimaryVertices :: Vector Point
_meshPatchHeight :: Int
_meshPatchWidth :: Int
_meshTensorDerivatives :: forall px. MeshPatch px -> Maybe (Vector Derivatives)
_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
_meshColors :: forall px. MeshPatch px -> Vector px
.. } =
  [MeshPatch (ImageMesh px) -> Int -> Int -> CoonPatch (ImageMesh px)
forall px.
MeshPatch (ImageMesh px) -> Int -> Int -> CoonPatch (ImageMesh px)
coonImagePatchAt MeshPatch (ImageMesh px)
mesh Int
x Int
y | Int
y <- [Int
0 .. Int
_meshPatchHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1], Int
x <- [Int
0 .. Int
_meshPatchWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

-- | Extract all the tensor patch of a mesh using an image interpolation.

tensorImagePatchesOf :: MeshPatch (ImageMesh px) -> [TensorPatch (ImageMesh px)]
tensorImagePatchesOf :: MeshPatch (ImageMesh px) -> [TensorPatch (ImageMesh px)]
tensorImagePatchesOf mesh :: MeshPatch (ImageMesh px)
mesh@MeshPatch { Int
Maybe (Vector Derivatives)
Vector Point
Vector (ImageMesh px)
Vector InterBezier
_meshTensorDerivatives :: Maybe (Vector Derivatives)
_meshColors :: Vector (ImageMesh px)
_meshVerticalSecondary :: Vector InterBezier
_meshHorizontalSecondary :: Vector InterBezier
_meshPrimaryVertices :: Vector Point
_meshPatchHeight :: Int
_meshPatchWidth :: Int
_meshTensorDerivatives :: forall px. MeshPatch px -> Maybe (Vector Derivatives)
_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
_meshColors :: forall px. MeshPatch px -> Vector px
.. } =
  [MeshPatch (ImageMesh px)
-> Int -> Int -> TensorPatch (ImageMesh px)
forall px.
MeshPatch (ImageMesh px)
-> Int -> Int -> TensorPatch (ImageMesh px)
tensorImagePatchAt MeshPatch (ImageMesh px)
mesh Int
x Int
y | Int
y <- [Int
0 .. Int
_meshPatchHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1], Int
x <- [Int
0 .. Int
_meshPatchWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

-- | Extract all the coon patch of a mesh using cubic interpolation.

cubicCoonPatchesOf :: (InterpolablePixel px)
                   => MeshPatch (Derivative px)
                   -> [CoonPatch (CubicCoefficient px)]
cubicCoonPatchesOf :: MeshPatch (Derivative px) -> [CoonPatch (CubicCoefficient px)]
cubicCoonPatchesOf mesh :: MeshPatch (Derivative px)
mesh@MeshPatch { Int
Maybe (Vector Derivatives)
Vector Point
Vector InterBezier
Vector (Derivative px)
_meshTensorDerivatives :: Maybe (Vector Derivatives)
_meshColors :: Vector (Derivative px)
_meshVerticalSecondary :: Vector InterBezier
_meshHorizontalSecondary :: Vector InterBezier
_meshPrimaryVertices :: Vector Point
_meshPatchHeight :: Int
_meshPatchWidth :: Int
_meshTensorDerivatives :: forall px. MeshPatch px -> Maybe (Vector Derivatives)
_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
_meshColors :: forall px. MeshPatch px -> Vector px
.. } =
  [MeshPatch (Derivative px)
-> Int -> Int -> CoonPatch (CubicCoefficient px)
forall px.
InterpolablePixel px =>
MeshPatch (Derivative px)
-> Int -> Int -> CoonPatch (CubicCoefficient px)
coonPatchAtWithDerivative MeshPatch (Derivative px)
mesh Int
x Int
y
        | Int
y <- [Int
0 .. Int
_meshPatchHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
        , Int
x <- [Int
0 .. Int
_meshPatchWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ]

-- | Extract all the tensor patch of a mesh using cubic interpolation.

cubicTensorPatchesOf :: (InterpolablePixel px)
                     => MeshPatch (Derivative px)
                     -> [TensorPatch (CubicCoefficient px)]
cubicTensorPatchesOf :: MeshPatch (Derivative px) -> [TensorPatch (CubicCoefficient px)]
cubicTensorPatchesOf mesh :: MeshPatch (Derivative px)
mesh@MeshPatch { Int
Maybe (Vector Derivatives)
Vector Point
Vector InterBezier
Vector (Derivative px)
_meshTensorDerivatives :: Maybe (Vector Derivatives)
_meshColors :: Vector (Derivative px)
_meshVerticalSecondary :: Vector InterBezier
_meshHorizontalSecondary :: Vector InterBezier
_meshPrimaryVertices :: Vector Point
_meshPatchHeight :: Int
_meshPatchWidth :: Int
_meshTensorDerivatives :: forall px. MeshPatch px -> Maybe (Vector Derivatives)
_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
_meshColors :: forall px. MeshPatch px -> Vector px
.. } =
  [MeshPatch (Derivative px)
-> Int -> Int -> TensorPatch (CubicCoefficient px)
forall px.
InterpolablePixel px =>
MeshPatch (Derivative px)
-> Int -> Int -> TensorPatch (CubicCoefficient px)
tensorPatchAtWithDerivative MeshPatch (Derivative px)
mesh Int
x Int
y
        | Int
y <- [Int
0 .. Int
_meshPatchHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
        , Int
x <- [Int
0 .. Int
_meshPatchWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ]