{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
-- | This module implements drawing primitives to draw directly into

-- the output texture, without generating an intermediate scene

-- representation.

--

-- If you need to draw complex scenes or plot an important set of

-- data, this is the module you should use. The downside is that

-- you must specify everything you need at each draw call, there

-- is no API to help you propagate constants.

--

-- The "stroking" must be done using the functions of the

-- `Graphics.Rasterific.Outline` module.

module Graphics.Rasterific.Immediate
    ( DrawContext
    , DrawOrder( .. )
    , orderToDrawing

    , runDrawContext
    , fillWithTextureAndMask
    , fillWithTexture
    , fillWithTextureNoAA
    , fillOrder

    , textToDrawOrders
    , transformOrder

    , meshToImage
    ) where


import Control.Monad.ST( ST, runST )
import Data.Maybe( fromMaybe )
import qualified Data.Foldable as F
import Control.Monad.Free( liftF )
import Control.Monad.State( evalStateT, execStateT, lift )
import Control.Monad.Trans.State( get )
import Codec.Picture.Types( Image( .. )
                          , Pixel( .. )
                          , MutableImage( .. )
                          , unsafeFreezeImage
                          , fillImageWith )

import Control.Monad.Primitive( PrimMonad, primToPrim )
import qualified Data.Vector.Storable.Mutable as M
import Graphics.Rasterific.Compositor
import Graphics.Rasterific.Linear( V2( .. ) )
import Graphics.Rasterific.Rasterize
import Graphics.Rasterific.Shading
import Graphics.Rasterific.QuadraticBezier
import Graphics.Rasterific.Types
import Graphics.Rasterific.PatchTypes
import Graphics.Rasterific.CubicBezier.FastForwardDifference
import Graphics.Rasterific.Transformations
import Graphics.Rasterific.MeshPatch
import Graphics.Rasterific.ComplexPrimitive
import Graphics.Rasterific.Command
import Graphics.Rasterific.PlaneBoundable

import qualified Data.Vector.Unboxed as VU
import Graphics.Text.TrueType( Dpi, getStringCurveAtPoint )

-- | Reify a filling function call, to be able to manipulate

-- them in a simpler fashion.

data DrawOrder px = DrawOrder
    { -- | Primitives to be filled.

      DrawOrder px -> [[Primitive]]
_orderPrimitives :: ![[Primitive]]
      -- | Texture for the filled primitives.

    , DrawOrder px -> Texture px
_orderTexture    :: !(Texture px)
      -- | How to fill the primitives.

    , DrawOrder px -> FillMethod
_orderFillMethod :: !FillMethod
      -- | Optional mask used for clipping.

    , DrawOrder px -> Maybe (Texture (PixelBaseComponent px))
_orderMask       :: !(Maybe (Texture (PixelBaseComponent px)))
      -- | Function to perform direct drawing

    , DrawOrder px -> forall s. DrawContext (ST s) px ()
_orderDirect     :: !(forall s. DrawContext (ST s) px ())
    }

instance PlaneBoundable (DrawOrder px) where
  planeBounds :: DrawOrder px -> PlaneBound
planeBounds =
    ([Primitive] -> PlaneBound) -> [[Primitive]] -> PlaneBound
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Primitive -> PlaneBound) -> [Primitive] -> PlaneBound
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Primitive -> PlaneBound
forall a. PlaneBoundable a => a -> PlaneBound
planeBounds) ([[Primitive]] -> PlaneBound)
-> (DrawOrder px -> [[Primitive]]) -> DrawOrder px -> PlaneBound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DrawOrder px -> [[Primitive]]
forall px. DrawOrder px -> [[Primitive]]
_orderPrimitives

transformOrder :: (Point -> Point) -> DrawOrder px -> DrawOrder px
transformOrder :: (Point -> Point) -> DrawOrder px -> DrawOrder px
transformOrder Point -> Point
f DrawOrder px
order =
  DrawOrder px
order { _orderPrimitives :: [[Primitive]]
_orderPrimitives = (Point -> Point) -> [[Primitive]] -> [[Primitive]]
forall a. Transformable a => (Point -> Point) -> a -> a
transform Point -> Point
f ([[Primitive]] -> [[Primitive]]) -> [[Primitive]] -> [[Primitive]]
forall a b. (a -> b) -> a -> b
$ DrawOrder px -> [[Primitive]]
forall px. DrawOrder px -> [[Primitive]]
_orderPrimitives DrawOrder px
order }

transformOrderM :: Monad m => (Point -> m Point) -> DrawOrder px -> m (DrawOrder px)
transformOrderM :: (Point -> m Point) -> DrawOrder px -> m (DrawOrder px)
transformOrderM Point -> m Point
f DrawOrder px
order = do
  [[Primitive]]
v <- (Point -> m Point) -> [[Primitive]] -> m [[Primitive]]
forall a (m :: * -> *).
(Transformable a, Monad m) =>
(Point -> m Point) -> a -> m a
transformM Point -> m Point
f ([[Primitive]] -> m [[Primitive]])
-> [[Primitive]] -> m [[Primitive]]
forall a b. (a -> b) -> a -> b
$ DrawOrder px -> [[Primitive]]
forall px. DrawOrder px -> [[Primitive]]
_orderPrimitives DrawOrder px
order 
  DrawOrder px -> m (DrawOrder px)
forall (m :: * -> *) a. Monad m => a -> m a
return (DrawOrder px -> m (DrawOrder px))
-> DrawOrder px -> m (DrawOrder px)
forall a b. (a -> b) -> a -> b
$ DrawOrder px
order { _orderPrimitives :: [[Primitive]]
_orderPrimitives = [[Primitive]]
v}

instance Transformable (DrawOrder px) where
  transform :: (Point -> Point) -> DrawOrder px -> DrawOrder px
transform = (Point -> Point) -> DrawOrder px -> DrawOrder px
forall px. (Point -> Point) -> DrawOrder px -> DrawOrder px
transformOrder
  transformM :: (Point -> m Point) -> DrawOrder px -> m (DrawOrder px)
transformM = (Point -> m Point) -> DrawOrder px -> m (DrawOrder px)
forall (m :: * -> *) px.
Monad m =>
(Point -> m Point) -> DrawOrder px -> m (DrawOrder px)
transformOrderM

-- | Transform back a low level drawing order to a more

-- high level Drawing

orderToDrawing :: DrawOrder px -> Drawing px ()
orderToDrawing :: DrawOrder px -> Drawing px ()
orderToDrawing DrawOrder px
order =
  Drawing px () -> Drawing px ()
usingTexture (Drawing px () -> Drawing px ())
-> ([[Primitive]] -> Drawing px ())
-> [[Primitive]]
-> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Primitive] -> Drawing px ()) -> [[Primitive]] -> Drawing px ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Primitive] -> Drawing px ()
filler ([[Primitive]] -> Drawing px ()) -> [[Primitive]] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ DrawOrder px -> [[Primitive]]
forall px. DrawOrder px -> [[Primitive]]
_orderPrimitives DrawOrder px
order
    where
      usingTexture :: Drawing px () -> Drawing px ()
usingTexture Drawing px ()
sub =
          DrawCommand px () -> Drawing px ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (DrawCommand px () -> Drawing px ())
-> DrawCommand px () -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ Texture px -> Drawing px () -> () -> DrawCommand px ()
forall px next.
Texture px -> Drawing px () -> next -> DrawCommand px next
SetTexture (DrawOrder px -> Texture px
forall px. DrawOrder px -> Texture px
_orderTexture DrawOrder px
order) Drawing px ()
sub ()
      filler :: [Primitive] -> Drawing px ()
filler [Primitive]
prims =
          DrawCommand px () -> Drawing px ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (DrawCommand px () -> Drawing px ())
-> DrawCommand px () -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ FillMethod -> [Primitive] -> () -> DrawCommand px ()
forall px next.
FillMethod -> [Primitive] -> next -> DrawCommand px next
Fill (DrawOrder px -> FillMethod
forall px. DrawOrder px -> FillMethod
_orderFillMethod DrawOrder px
order) [Primitive]
prims ()

-- | Render the drawing orders on the canvas.

fillOrder :: (PrimMonad m, RenderablePixel px)
          => DrawOrder px -> DrawContext m px ()
fillOrder :: DrawOrder px -> DrawContext m px ()
fillOrder o :: DrawOrder px
o@DrawOrder { _orderMask :: forall px. DrawOrder px -> Maybe (Texture (PixelBaseComponent px))
_orderMask = Maybe (Texture (PixelBaseComponent px))
Nothing } = do
  [[Primitive]]
-> ([Primitive] -> DrawContext m px ()) -> DrawContext m px ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ (DrawOrder px -> [[Primitive]]
forall px. DrawOrder px -> [[Primitive]]
_orderPrimitives DrawOrder px
o) (([Primitive] -> DrawContext m px ()) -> DrawContext m px ())
-> ([Primitive] -> DrawContext m px ()) -> DrawContext m px ()
forall a b. (a -> b) -> a -> b
$
    FillMethod -> Texture px -> [Primitive] -> DrawContext m px ()
forall (m :: * -> *) px.
(PrimMonad m, RenderablePixel px) =>
FillMethod -> Texture px -> [Primitive] -> DrawContext m px ()
fillWithTexture (DrawOrder px -> FillMethod
forall px. DrawOrder px -> FillMethod
_orderFillMethod DrawOrder px
o) (DrawOrder px -> Texture px
forall px. DrawOrder px -> Texture px
_orderTexture DrawOrder px
o)
  MutableImage (PrimState m) px
img <- StateT
  (MutableImage (PrimState m) px) m (MutableImage (PrimState m) px)
forall (m :: * -> *) s. Monad m => StateT s m s
get
  m () -> DrawContext m px ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> DrawContext m px ()) -> m () -> DrawContext m px ()
forall a b. (a -> b) -> a -> b
$ ST (PrimState m) () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2, PrimState m1 ~ PrimState m2) =>
m1 a -> m2 a
primToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ (StateT (MutableImage (PrimState m) px) (ST (PrimState m)) ()
 -> MutableImage (PrimState m) px -> ST (PrimState m) ())
-> MutableImage (PrimState m) px
-> StateT (MutableImage (PrimState m) px) (ST (PrimState m)) ()
-> ST (PrimState m) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (MutableImage (PrimState m) px) (ST (PrimState m)) ()
-> MutableImage (PrimState m) px -> ST (PrimState m) ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT MutableImage (PrimState m) px
img (StateT (MutableImage (PrimState m) px) (ST (PrimState m)) ()
 -> ST (PrimState m) ())
-> StateT (MutableImage (PrimState m) px) (ST (PrimState m)) ()
-> ST (PrimState m) ()
forall a b. (a -> b) -> a -> b
$ DrawOrder px -> forall s. DrawContext (ST s) px ()
forall px. DrawOrder px -> forall s. DrawContext (ST s) px ()
_orderDirect DrawOrder px
o

fillOrder o :: DrawOrder px
o@DrawOrder { _orderMask :: forall px. DrawOrder px -> Maybe (Texture (PixelBaseComponent px))
_orderMask = Just Texture (PixelBaseComponent px)
mask } = do
  [[Primitive]]
-> ([Primitive] -> DrawContext m px ()) -> DrawContext m px ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ (DrawOrder px -> [[Primitive]]
forall px. DrawOrder px -> [[Primitive]]
_orderPrimitives DrawOrder px
o) (([Primitive] -> DrawContext m px ()) -> DrawContext m px ())
-> ([Primitive] -> DrawContext m px ()) -> DrawContext m px ()
forall a b. (a -> b) -> a -> b
$
    FillMethod
-> Texture px
-> Texture (PixelBaseComponent px)
-> [Primitive]
-> DrawContext m px ()
forall (m :: * -> *) px.
(PrimMonad m, RenderablePixel px) =>
FillMethod
-> Texture px
-> Texture (PixelBaseComponent px)
-> [Primitive]
-> DrawContext m px ()
fillWithTextureAndMask (DrawOrder px -> FillMethod
forall px. DrawOrder px -> FillMethod
_orderFillMethod DrawOrder px
o) (DrawOrder px -> Texture px
forall px. DrawOrder px -> Texture px
_orderTexture DrawOrder px
o) Texture (PixelBaseComponent px)
mask
  MutableImage (PrimState m) px
img <- StateT
  (MutableImage (PrimState m) px) m (MutableImage (PrimState m) px)
forall (m :: * -> *) s. Monad m => StateT s m s
get
  m () -> DrawContext m px ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> DrawContext m px ()) -> m () -> DrawContext m px ()
forall a b. (a -> b) -> a -> b
$ ST (PrimState m) () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2, PrimState m1 ~ PrimState m2) =>
m1 a -> m2 a
primToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ (StateT (MutableImage (PrimState m) px) (ST (PrimState m)) ()
 -> MutableImage (PrimState m) px -> ST (PrimState m) ())
-> MutableImage (PrimState m) px
-> StateT (MutableImage (PrimState m) px) (ST (PrimState m)) ()
-> ST (PrimState m) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (MutableImage (PrimState m) px) (ST (PrimState m)) ()
-> MutableImage (PrimState m) px -> ST (PrimState m) ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT MutableImage (PrimState m) px
img (StateT (MutableImage (PrimState m) px) (ST (PrimState m)) ()
 -> ST (PrimState m) ())
-> StateT (MutableImage (PrimState m) px) (ST (PrimState m)) ()
-> ST (PrimState m) ()
forall a b. (a -> b) -> a -> b
$ DrawOrder px -> forall s. DrawContext (ST s) px ()
forall px. DrawOrder px -> forall s. DrawContext (ST s) px ()
_orderDirect DrawOrder px
o

-- | Start an image rendering. See `fillWithTexture` for

-- an usage example. This function can work with either

-- `IO` or `ST`.

runDrawContext :: forall m px . (PrimMonad m, RenderablePixel px)
               => Int   -- ^ Rendering width

               -> Int   -- ^ Rendering height

               -> px    -- ^ Background color

               -> DrawContext m px () -- ^ Actual drawing computation

               -> m (Image px)
runDrawContext :: Int -> Int -> px -> DrawContext m px () -> m (Image px)
runDrawContext Int
width Int
height px
background DrawContext m px ()
drawing = do
  MVector (PrimState m) (PixelBaseComponent px)
buff <- Int -> m (MVector (PrimState m) (PixelBaseComponent px))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
* px -> Int
forall a. Pixel a => a -> Int
componentCount px
background)
  let mutable :: MutableImage (PrimState m) px
mutable = Int
-> Int
-> MVector (PrimState m) (PixelBaseComponent px)
-> MutableImage (PrimState m) px
forall s a.
Int -> Int -> STVector s (PixelBaseComponent a) -> MutableImage s a
MutableImage Int
width Int
height MVector (PrimState m) (PixelBaseComponent px)
buff
  MutableImage (PrimState m) px -> px -> m ()
forall px (m :: * -> *).
(Pixel px, PackeablePixel px, PrimMonad m,
 Storable (PackedRepresentation px)) =>
MutableImage (PrimState m) px -> px -> m ()
fillImageWith MutableImage (PrimState m) px
mutable px
background
  MutableImage (PrimState m) px
img <- DrawContext m px ()
-> MutableImage (PrimState m) px
-> m (MutableImage (PrimState m) px)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT DrawContext m px ()
drawing MutableImage (PrimState m) px
mutable
  MutableImage (PrimState m) px -> m (Image px)
forall a (m :: * -> *).
(Storable (PixelBaseComponent a), PrimMonad m) =>
MutableImage (PrimState m) a -> m (Image a)
unsafeFreezeImage MutableImage (PrimState m) px
img

mapExec :: Monad m => (a -> m ()) -> [a] -> m ()
mapExec :: (a -> m ()) -> [a] -> m ()
mapExec a -> m ()
f = (a -> m () -> m ()) -> m () -> [a] -> m ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) (m () -> m () -> m ()) -> (a -> m ()) -> a -> m () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m ()
f) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

isCoverageDrawable :: MutableImage s px -> CoverageSpan -> Bool
isCoverageDrawable :: MutableImage s px -> CoverageSpan -> Bool
isCoverageDrawable MutableImage s px
img CoverageSpan
coverage =
    CoverageSpan -> Float
_coverageVal CoverageSpan
coverage Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 Bool -> Bool -> Bool
&& Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0 Bool -> Bool -> Bool
&& Float
y Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0 Bool -> Bool -> Bool
&& Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
imgWidth Bool -> Bool -> Bool
&& Float
y Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
imgHeight
  where
    !imgWidth :: Float
imgWidth = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ MutableImage s px -> Int
forall s a. MutableImage s a -> Int
mutableImageWidth MutableImage s px
img
    !imgHeight :: Float
imgHeight = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ MutableImage s px -> Int
forall s a. MutableImage s a -> Int
mutableImageHeight MutableImage s px
img
    x :: Float
x = CoverageSpan -> Float
_coverageX CoverageSpan
coverage
    y :: Float
y = CoverageSpan -> Float
_coverageY CoverageSpan
coverage

-- | Fill some geometry.

--

-- > immediateDrawExample :: Image PixelRGBA8

-- > immediateDrawExample = runST $

-- >   runDrawContext 200 200 (PixelRGBA8 0 0 0 0) $

-- >     fillWithTexture FillWinding texture geometry

-- >   where

-- >     circlePrimitives = circle (V2 100 100) 50

-- >     geometry = strokize 4 JoinRound (CapRound, CapRound) circlePrimitives

-- >     texture = uniformTexture (PixelRGBA8 255 255 255 255)

--

-- <<docimages/immediate_fill.png>>

--

fillWithTexture :: (PrimMonad m, RenderablePixel px)
                => FillMethod
                -> Texture px  -- ^ Color/Texture used for the filling

                -> [Primitive] -- ^ Primitives to fill

                -> DrawContext m px ()
fillWithTexture :: FillMethod -> Texture px -> [Primitive] -> DrawContext m px ()
fillWithTexture FillMethod
fillMethod Texture px
texture [Primitive]
els = do
    img :: MutableImage (PrimState m) px
img@(MutableImage Int
width Int
height STVector (PrimState m) (PixelBaseComponent px)
_) <- StateT
  (MutableImage (PrimState m) px) m (MutableImage (PrimState m) px)
forall (m :: * -> *) s. Monad m => StateT s m s
get
    let !mini :: Point
mini = Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
0 Float
0
        !maxi :: Point
maxi = Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
        !filler :: CoverageSpan -> m ()
filler = ST (PrimState m) () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2, PrimState m1 ~ PrimState m2) =>
m1 a -> m2 a
primToPrim (ST (PrimState m) () -> m ())
-> (CoverageSpan -> ST (PrimState m) ()) -> CoverageSpan -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Transformation
 -> Int -> Int -> PatchInterpolation -> MeshPatch px -> Image px)
-> Texture px -> CoverageFiller (ST (PrimState m)) px
forall px s.
RenderablePixel px =>
(Maybe Transformation
 -> Int -> Int -> PatchInterpolation -> MeshPatch px -> Image px)
-> Texture px -> CoverageFiller (ST s) px
transformTextureToFiller Maybe Transformation
-> Int -> Int -> PatchInterpolation -> MeshPatch px -> Image px
forall px.
RenderablePixel px =>
Maybe Transformation
-> Int -> Int -> PatchInterpolation -> MeshPatch px -> Image px
meshToImage Texture px
texture MutableImage (PrimState m) px
MutableImage (PrimState (ST (PrimState m))) px
img
        clipped :: Container Primitive
clipped = (Primitive -> Container Primitive)
-> [Primitive] -> Container Primitive
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Point -> Point -> Primitive -> Container Primitive
clip Point
mini Point
maxi) [Primitive]
els
        spans :: [CoverageSpan]
spans = FillMethod -> Container Primitive -> [CoverageSpan]
rasterize FillMethod
fillMethod Container Primitive
clipped
    m () -> DrawContext m px ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> DrawContext m px ())
-> ([CoverageSpan] -> m ())
-> [CoverageSpan]
-> DrawContext m px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoverageSpan -> m ()) -> [CoverageSpan] -> m ()
forall (m :: * -> *) a. Monad m => (a -> m ()) -> [a] -> m ()
mapExec CoverageSpan -> m ()
filler ([CoverageSpan] -> DrawContext m px ())
-> [CoverageSpan] -> DrawContext m px ()
forall a b. (a -> b) -> a -> b
$ (CoverageSpan -> Bool) -> [CoverageSpan] -> [CoverageSpan]
forall a. (a -> Bool) -> [a] -> [a]
filter (MutableImage (PrimState m) px -> CoverageSpan -> Bool
forall s px. MutableImage s px -> CoverageSpan -> Bool
isCoverageDrawable MutableImage (PrimState m) px
img) [CoverageSpan]
spans

-- | Function identical to 'fillWithTexture' but with anti-aliasing

-- (and transparency) disabled.

fillWithTextureNoAA :: (PrimMonad m, RenderablePixel px)
                => FillMethod
                -> Texture px  -- ^ Color/Texture used for the filling

                -> [Primitive] -- ^ Primitives to fill

                -> DrawContext m px ()
fillWithTextureNoAA :: FillMethod -> Texture px -> [Primitive] -> DrawContext m px ()
fillWithTextureNoAA FillMethod
fillMethod Texture px
texture [Primitive]
els = do
    img :: MutableImage (PrimState m) px
img@(MutableImage Int
width Int
height STVector (PrimState m) (PixelBaseComponent px)
_) <- StateT
  (MutableImage (PrimState m) px) m (MutableImage (PrimState m) px)
forall (m :: * -> *) s. Monad m => StateT s m s
get
    let !mini :: Point
mini = Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
0 Float
0
        !maxi :: Point
maxi = Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
        !filler :: CoverageSpan -> m ()
filler = ST (PrimState m) () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2, PrimState m1 ~ PrimState m2) =>
m1 a -> m2 a
primToPrim (ST (PrimState m) () -> m ())
-> (CoverageSpan -> ST (PrimState m) ()) -> CoverageSpan -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Transformation
 -> Int -> Int -> PatchInterpolation -> MeshPatch px -> Image px)
-> Texture px -> CoverageFiller (ST (PrimState m)) px
forall px s.
RenderablePixel px =>
(Maybe Transformation
 -> Int -> Int -> PatchInterpolation -> MeshPatch px -> Image px)
-> Texture px -> CoverageFiller (ST s) px
transformTextureToFiller Maybe Transformation
-> Int -> Int -> PatchInterpolation -> MeshPatch px -> Image px
forall px.
RenderablePixel px =>
Maybe Transformation
-> Int -> Int -> PatchInterpolation -> MeshPatch px -> Image px
meshToImage Texture px
texture MutableImage (PrimState m) px
MutableImage (PrimState (ST (PrimState m))) px
img
        clipped :: Container Primitive
clipped = (Primitive -> Container Primitive)
-> [Primitive] -> Container Primitive
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Point -> Point -> Primitive -> Container Primitive
clip Point
mini Point
maxi) [Primitive]
els
        spans :: [CoverageSpan]
spans = FillMethod -> Container Primitive -> [CoverageSpan]
rasterize FillMethod
fillMethod Container Primitive
clipped
    m () -> DrawContext m px ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> DrawContext m px ())
-> ([CoverageSpan] -> m ())
-> [CoverageSpan]
-> DrawContext m px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoverageSpan -> m ()) -> [CoverageSpan] -> m ()
forall (m :: * -> *) a. Monad m => (a -> m ()) -> [a] -> m ()
mapExec (CoverageSpan -> m ()
filler (CoverageSpan -> m ())
-> (CoverageSpan -> CoverageSpan) -> CoverageSpan -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoverageSpan -> CoverageSpan
toOpaqueCoverage) ([CoverageSpan] -> DrawContext m px ())
-> [CoverageSpan] -> DrawContext m px ()
forall a b. (a -> b) -> a -> b
$ (CoverageSpan -> Bool) -> [CoverageSpan] -> [CoverageSpan]
forall a. (a -> Bool) -> [a] -> [a]
filter (MutableImage (PrimState m) px -> CoverageSpan -> Bool
forall s px. MutableImage s px -> CoverageSpan -> Bool
isCoverageDrawable MutableImage (PrimState m) px
img) [CoverageSpan]
spans

-- | Fill some geometry using a composition mask for visibility.

--

-- > immediateDrawMaskExample :: Image PixelRGBA8

-- > immediateDrawMaskExample = runST $

-- >   runDrawContext 200 200 (PixelRGBA8 0 0 0 255) $

-- >     forM_ [1 .. 10] $ \ix ->

-- >        fillWithTextureAndMask FillWinding texture mask $

-- >            rectangle (V2 10 (ix * 18 - 5)) 180 13

-- >   where

-- >     texture = uniformTexture $ PixelRGBA8 0 0x86 0xc1 255

-- >     mask = sampledImageTexture

-- >          $ runST

-- >          $ runDrawContext 200 200 0

-- >          $ fillWithTexture FillWinding (uniformTexture 255) maskGeometry

-- > 

-- >     maskGeometry = strokize 15 JoinRound (CapRound, CapRound)

-- >                  $ circle (V2 100 100) 80

--

-- <<docimages/immediate_mask.png>>

--

fillWithTextureAndMask
    :: (PrimMonad m, RenderablePixel px)
    => FillMethod
    -> Texture px  -- ^ Color/Texture used for the filling of the geometry

    -> Texture (PixelBaseComponent px) -- ^ Texture used for the mask.

    -> [Primitive]                     -- ^ Primitives to fill

    -> DrawContext m px ()
fillWithTextureAndMask :: FillMethod
-> Texture px
-> Texture (PixelBaseComponent px)
-> [Primitive]
-> DrawContext m px ()
fillWithTextureAndMask FillMethod
fillMethod Texture px
texture Texture (PixelBaseComponent px)
mask [Primitive]
els = do
    img :: MutableImage (PrimState m) px
img@(MutableImage Int
width Int
height STVector (PrimState m) (PixelBaseComponent px)
_) <- StateT
  (MutableImage (PrimState m) px) m (MutableImage (PrimState m) px)
forall (m :: * -> *) s. Monad m => StateT s m s
get
    let !mini :: Point
mini = Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
0 Float
0
        !maxi :: Point
maxi = Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
        spans :: [CoverageSpan]
spans = FillMethod -> Container Primitive -> [CoverageSpan]
rasterize FillMethod
fillMethod (Container Primitive -> [CoverageSpan])
-> Container Primitive -> [CoverageSpan]
forall a b. (a -> b) -> a -> b
$ (Primitive -> Container Primitive)
-> [Primitive] -> Container Primitive
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Point -> Point -> Primitive -> Container Primitive
clip Point
mini Point
maxi) [Primitive]
els
        !shader :: CoverageSpan -> m ()
shader = ST (PrimState m) () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2, PrimState m1 ~ PrimState m2) =>
m1 a -> m2 a
primToPrim
                (ST (PrimState m) () -> m ())
-> (CoverageSpan -> ST (PrimState m) ()) -> CoverageSpan -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Transformation
 -> Int -> Int -> PatchInterpolation -> MeshPatch px -> Image px)
-> Texture px -> CoverageFiller (ST (PrimState m)) px
forall px s.
RenderablePixel px =>
(Maybe Transformation
 -> Int -> Int -> PatchInterpolation -> MeshPatch px -> Image px)
-> Texture px -> CoverageFiller (ST s) px
transformTextureToFiller Maybe Transformation
-> Int -> Int -> PatchInterpolation -> MeshPatch px -> Image px
forall px.
RenderablePixel px =>
Maybe Transformation
-> Int -> Int -> PatchInterpolation -> MeshPatch px -> Image px
meshToImage (Texture px -> Texture (PixelBaseComponent px) -> Texture px
forall px.
Texture px -> Texture (PixelBaseComponent px) -> Texture px
ModulateTexture Texture px
texture Texture (PixelBaseComponent px)
mask) MutableImage (PrimState m) px
MutableImage (PrimState (ST (PrimState m))) px
img
    m () -> DrawContext m px ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> DrawContext m px ())
-> ([CoverageSpan] -> m ())
-> [CoverageSpan]
-> DrawContext m px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoverageSpan -> m ()) -> [CoverageSpan] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CoverageSpan -> m ()
shader ([CoverageSpan] -> DrawContext m px ())
-> [CoverageSpan] -> DrawContext m px ()
forall a b. (a -> b) -> a -> b
$ (CoverageSpan -> Bool) -> [CoverageSpan] -> [CoverageSpan]
forall a. (a -> Bool) -> [a] -> [a]
filter (MutableImage (PrimState m) px -> CoverageSpan -> Bool
forall s px. MutableImage s px -> CoverageSpan -> Bool
isCoverageDrawable MutableImage (PrimState m) px
img) [CoverageSpan]
spans

-- | Helper function transforming text range to draw order.

textToDrawOrders :: Dpi             -- ^ Current output device resolution

                 -> Texture px      -- ^ Texture to use if no texture is defined in the range

                 -> Point           -- ^ Baseline position

                 -> [TextRange px]  -- ^ Text description.

                 -> [DrawOrder px]
textToDrawOrders :: Int -> Texture px -> Point -> [TextRange px] -> [DrawOrder px]
textToDrawOrders Int
dpi Texture px
defaultTexture (V2 Float
x Float
y) [TextRange px]
descriptions = 
    ([Vector (Float, Float)], TextRange px) -> DrawOrder px
toOrder (([Vector (Float, Float)], TextRange px) -> DrawOrder px)
-> [([Vector (Float, Float)], TextRange px)] -> [DrawOrder px]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Vector (Float, Float)]]
-> [TextRange px] -> [([Vector (Float, Float)], TextRange px)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Vector (Float, Float)]]
floatCurves [TextRange px]
linearDescriptions where

  toOrder :: ([Vector (Float, Float)], TextRange px) -> DrawOrder px
toOrder ([Vector (Float, Float)]
curve, TextRange px
d) = DrawOrder :: forall px.
[[Primitive]]
-> Texture px
-> FillMethod
-> Maybe (Texture (PixelBaseComponent px))
-> (forall s. DrawContext (ST s) px ())
-> DrawOrder px
DrawOrder 
    { _orderPrimitives :: [[Primitive]]
_orderPrimitives = [[Vector (Float, Float)] -> [Primitive]
beziersOfChar [Vector (Float, Float)]
curve]
    , _orderFillMethod :: FillMethod
_orderFillMethod = FillMethod
FillWinding
    , _orderMask :: Maybe (Texture (PixelBaseComponent px))
_orderMask = Maybe (Texture (PixelBaseComponent px))
forall a. Maybe a
Nothing
    , _orderTexture :: Texture px
_orderTexture = Texture px -> Maybe (Texture px) -> Texture px
forall a. a -> Maybe a -> a
fromMaybe Texture px
defaultTexture (Maybe (Texture px) -> Texture px)
-> Maybe (Texture px) -> Texture px
forall a b. (a -> b) -> a -> b
$ TextRange px -> Maybe (Texture px)
forall px. TextRange px -> Maybe (Texture px)
_textTexture TextRange px
d
    , _orderDirect :: forall s. DrawContext (ST s) px ()
_orderDirect = () -> StateT (MutableImage s px) (ST s) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    }

  floatCurves :: [[Vector (Float, Float)]]
floatCurves =
    Int
-> (Float, Float)
-> [(Font, PointSize, String)]
-> [[Vector (Float, Float)]]
getStringCurveAtPoint Int
dpi (Float
x, Float
y)
      [(TextRange px -> Font
forall px. TextRange px -> Font
_textFont TextRange px
d, TextRange px -> PointSize
forall px. TextRange px -> PointSize
_textSize TextRange px
d, TextRange px -> String
forall px. TextRange px -> String
_text TextRange px
d) | TextRange px
d <- [TextRange px]
descriptions]

  linearDescriptions :: [TextRange px]
linearDescriptions =
    [[TextRange px]] -> [TextRange px]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [(Char -> TextRange px) -> String -> [TextRange px]
forall a b. (a -> b) -> [a] -> [b]
map (TextRange px -> Char -> TextRange px
forall a b. a -> b -> a
const TextRange px
d) (String -> [TextRange px]) -> String -> [TextRange px]
forall a b. (a -> b) -> a -> b
$ TextRange px -> String
forall px. TextRange px -> String
_text TextRange px
d | TextRange px
d <- [TextRange px]
descriptions]

  beziersOfChar :: [Vector (Float, Float)] -> [Primitive]
beziersOfChar [Vector (Float, Float)]
curves = [[Primitive]] -> [Primitive]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [(Bezier -> Primitive) -> [Bezier] -> [Primitive]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bezier -> Primitive
BezierPrim ([Bezier] -> [Primitive])
-> ([(Float, Float)] -> [Bezier])
-> [(Float, Float)]
-> [Primitive]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point] -> [Bezier]
bezierFromPath ([Point] -> [Bezier])
-> ([(Float, Float)] -> [Point]) -> [(Float, Float)] -> [Bezier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> Point) -> [(Float, Float)] -> [Point]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Float -> Float -> Point) -> (Float, Float) -> Point
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Float -> Float -> Point
forall a. a -> a -> V2 a
V2) ([(Float, Float)] -> [Primitive])
-> [(Float, Float)] -> [Primitive]
forall a b. (a -> b) -> a -> b
$ Vector (Float, Float) -> [(Float, Float)]
forall a. Unbox a => Vector a -> [a]
VU.toList Vector (Float, Float)
c | Vector (Float, Float)
c <- [Vector (Float, Float)]
curves]


meshToImage :: forall px. (RenderablePixel px)
            => Maybe Transformation -> Int-> Int 
            -> PatchInterpolation -> MeshPatch px
            -> Image px
meshToImage :: Maybe Transformation
-> Int -> Int -> PatchInterpolation -> MeshPatch px -> Image px
meshToImage Maybe Transformation
mayTrans Int
width Int
height PatchInterpolation
i MeshPatch px
baseMesh 
  | Bool -> Bool
not Bool
hasTransparency = Image px
rendering
  | Bool
otherwise = (forall s. ST s (Image px)) -> Image px
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Image px)) -> Image px)
-> (forall s. ST s (Image px)) -> Image px
forall a b. (a -> b) -> a -> b
$ Int -> Int -> px -> DrawContext (ST s) px () -> ST s (Image px)
forall (m :: * -> *) px.
(PrimMonad m, RenderablePixel px) =>
Int -> Int -> px -> DrawContext m px () -> m (Image px)
runDrawContext Int
width Int
height px
background (DrawContext (ST s) px () -> ST s (Image px))
-> DrawContext (ST s) px () -> ST s (Image px)
forall a b. (a -> b) -> a -> b
$ DrawOrder px -> DrawContext (ST s) px ()
forall (m :: * -> *) px.
(PrimMonad m, RenderablePixel px) =>
DrawOrder px -> DrawContext m px ()
fillOrder DrawOrder px
order
  where
    mesh :: MeshPatch px
mesh = case Maybe Transformation
mayTrans Maybe Transformation
-> (Transformation -> Maybe Transformation) -> Maybe Transformation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Transformation -> Maybe Transformation
inverseTransformation of
      Maybe Transformation
Nothing -> MeshPatch px
baseMesh
      Just Transformation
trans -> 
        (Point -> Point) -> MeshPatch px -> MeshPatch px
forall a. Transformable a => (Point -> Point) -> a -> a
transform (Transformation -> Point -> Point
applyTransformation Transformation
trans) MeshPatch px
baseMesh
    
    background :: px
background = px
forall px. RenderablePixel px => px
emptyPx :: px
    clipBackground :: PixelBaseComponent px
clipBackground = PixelBaseComponent px
forall a. Modulable a => a
emptyValue :: PixelBaseComponent px
    
    rendering :: Image px
rendering = (forall s. ST s (Image px)) -> Image px
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Image px)) -> Image px)
-> (forall s. ST s (Image px)) -> Image px
forall a b. (a -> b) -> a -> b
$ Int -> Int -> px -> DrawContext (ST s) px () -> ST s (Image px)
forall (m :: * -> *) px.
(PrimMonad m, RenderablePixel px) =>
Int -> Int -> px -> DrawContext m px () -> m (Image px)
runDrawContext Int
width Int
height px
background (DrawContext (ST s) px () -> ST s (Image px))
-> DrawContext (ST s) px () -> ST s (Image px)
forall a b. (a -> b) -> a -> b
$ case PatchInterpolation
i of
      PatchInterpolation
PatchBilinear -> (CoonPatch (ParametricValues px)
 -> StateT (MutableImage s px) (ST s) ())
-> [CoonPatch (ParametricValues px)]
-> StateT (MutableImage s px) (ST s) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CoonPatch (ParametricValues px)
-> StateT (MutableImage s px) (ST s) ()
forall (m :: * -> *) px src.
(PrimMonad m, ModulablePixel px, BiSampleable src px) =>
CoonPatch src -> DrawContext m px ()
rasterizeCoonPatch ([CoonPatch (ParametricValues px)]
 -> StateT (MutableImage s px) (ST s) ())
-> [CoonPatch (ParametricValues px)]
-> StateT (MutableImage s px) (ST s) ()
forall a b. (a -> b) -> a -> b
$ MeshPatch px -> [CoonPatch (ParametricValues px)]
forall px. MeshPatch px -> [CoonPatch (ParametricValues px)]
coonPatchesOf MeshPatch px
opaqueMesh 
      PatchInterpolation
PatchBicubic ->
          (CoonPatch (CubicCoefficient px)
 -> StateT (MutableImage s px) (ST s) ())
-> [CoonPatch (CubicCoefficient px)]
-> StateT (MutableImage s px) (ST s) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CoonPatch (CubicCoefficient px)
-> StateT (MutableImage s px) (ST s) ()
forall (m :: * -> *) px src.
(PrimMonad m, ModulablePixel px, BiSampleable src px) =>
CoonPatch src -> DrawContext m px ()
rasterizeCoonPatch
              ([CoonPatch (CubicCoefficient px)]
 -> StateT (MutableImage s px) (ST s) ())
-> (MeshPatch (Derivative px) -> [CoonPatch (CubicCoefficient px)])
-> MeshPatch (Derivative px)
-> StateT (MutableImage s px) (ST s) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MeshPatch (Derivative px) -> [CoonPatch (CubicCoefficient px)]
forall px.
InterpolablePixel px =>
MeshPatch (Derivative px) -> [CoonPatch (CubicCoefficient px)]
cubicCoonPatchesOf 
              (MeshPatch (Derivative px) -> StateT (MutableImage s px) (ST s) ())
-> MeshPatch (Derivative px)
-> StateT (MutableImage s px) (ST s) ()
forall a b. (a -> b) -> a -> b
$ MeshPatch px -> MeshPatch (Derivative px)
forall px.
InterpolablePixel px =>
MeshPatch px -> MeshPatch (Derivative px)
calculateMeshColorDerivative MeshPatch px
opaqueMesh 
    
    hasTransparency :: Bool
hasTransparency =
        (px -> Bool) -> Vector px -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.any ((PixelBaseComponent px -> PixelBaseComponent px -> Bool
forall a. Eq a => a -> a -> Bool
/= PixelBaseComponent px
forall a. Modulable a => a
fullValue) (PixelBaseComponent px -> Bool)
-> (px -> PixelBaseComponent px) -> px -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. px -> PixelBaseComponent px
forall a. Pixel a => a -> PixelBaseComponent a
pixelOpacity) (Vector px -> Bool) -> Vector px -> Bool
forall a b. (a -> b) -> a -> b
$ MeshPatch px -> Vector px
forall px. MeshPatch px -> Vector px
_meshColors MeshPatch px
mesh
    
    opacifier :: a -> a
opacifier a
px = (Int
 -> PixelBaseComponent a
 -> PixelBaseComponent a
 -> PixelBaseComponent a)
-> (PixelBaseComponent a
    -> PixelBaseComponent a -> PixelBaseComponent a)
-> a
-> a
-> a
forall a.
Pixel a =>
(Int
 -> PixelBaseComponent a
 -> PixelBaseComponent a
 -> PixelBaseComponent a)
-> (PixelBaseComponent a
    -> PixelBaseComponent a -> PixelBaseComponent a)
-> a
-> a
-> a
mixWithAlpha (\Int
_ PixelBaseComponent a
_ PixelBaseComponent a
a -> PixelBaseComponent a
a) (\PixelBaseComponent a
_ PixelBaseComponent a
_ -> PixelBaseComponent a
forall a. Modulable a => a
fullValue) a
px a
px
    
    opaqueMesh :: MeshPatch px
opaqueMesh = px -> px
forall a. (Pixel a, Modulable (PixelBaseComponent a)) => a -> a
opacifier (px -> px) -> MeshPatch px -> MeshPatch px
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MeshPatch px
mesh
    transparencyMesh :: MeshPatch (PixelBaseComponent px)
transparencyMesh = px -> PixelBaseComponent px
forall a. Pixel a => a -> PixelBaseComponent a
pixelOpacity (px -> PixelBaseComponent px)
-> MeshPatch px -> MeshPatch (PixelBaseComponent px)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MeshPatch px
mesh
    
    clipPath :: Image (PixelBaseComponent px)
clipPath =
      (forall s. ST s (Image (PixelBaseComponent px)))
-> Image (PixelBaseComponent px)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Image (PixelBaseComponent px)))
 -> Image (PixelBaseComponent px))
-> (forall s. ST s (Image (PixelBaseComponent px)))
-> Image (PixelBaseComponent px)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> PixelBaseComponent px
-> DrawContext (ST s) (PixelBaseComponent px) ()
-> ST s (Image (PixelBaseComponent px))
forall (m :: * -> *) px.
(PrimMonad m, RenderablePixel px) =>
Int -> Int -> px -> DrawContext m px () -> m (Image px)
runDrawContext Int
width Int
height PixelBaseComponent px
clipBackground (DrawContext (ST s) (PixelBaseComponent px) ()
 -> ST s (Image (PixelBaseComponent px)))
-> DrawContext (ST s) (PixelBaseComponent px) ()
-> ST s (Image (PixelBaseComponent px))
forall a b. (a -> b) -> a -> b
$ case PatchInterpolation
i of
        PatchInterpolation
PatchBilinear -> (CoonPatch (ParametricValues (PixelBaseComponent px))
 -> StateT (MutableImage s (PixelBaseComponent px)) (ST s) ())
-> [CoonPatch (ParametricValues (PixelBaseComponent px))]
-> StateT (MutableImage s (PixelBaseComponent px)) (ST s) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CoonPatch (ParametricValues (PixelBaseComponent px))
-> StateT (MutableImage s (PixelBaseComponent px)) (ST s) ()
forall (m :: * -> *) px src.
(PrimMonad m, ModulablePixel px, BiSampleable src px) =>
CoonPatch src -> DrawContext m px ()
rasterizeCoonPatch ([CoonPatch (ParametricValues (PixelBaseComponent px))]
 -> StateT (MutableImage s (PixelBaseComponent px)) (ST s) ())
-> [CoonPatch (ParametricValues (PixelBaseComponent px))]
-> StateT (MutableImage s (PixelBaseComponent px)) (ST s) ()
forall a b. (a -> b) -> a -> b
$ MeshPatch (PixelBaseComponent px)
-> [CoonPatch (ParametricValues (PixelBaseComponent px))]
forall px. MeshPatch px -> [CoonPatch (ParametricValues px)]
coonPatchesOf MeshPatch (PixelBaseComponent px)
transparencyMesh
        PatchInterpolation
PatchBicubic ->
            (CoonPatch (CubicCoefficient (PixelBaseComponent px))
 -> StateT (MutableImage s (PixelBaseComponent px)) (ST s) ())
-> [CoonPatch (CubicCoefficient (PixelBaseComponent px))]
-> StateT (MutableImage s (PixelBaseComponent px)) (ST s) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CoonPatch (CubicCoefficient (PixelBaseComponent px))
-> StateT (MutableImage s (PixelBaseComponent px)) (ST s) ()
forall (m :: * -> *) px src.
(PrimMonad m, ModulablePixel px, BiSampleable src px) =>
CoonPatch src -> DrawContext m px ()
rasterizeCoonPatch
                ([CoonPatch (CubicCoefficient (PixelBaseComponent px))]
 -> StateT (MutableImage s (PixelBaseComponent px)) (ST s) ())
-> (MeshPatch (Derivative (PixelBaseComponent px))
    -> [CoonPatch (CubicCoefficient (PixelBaseComponent px))])
-> MeshPatch (Derivative (PixelBaseComponent px))
-> StateT (MutableImage s (PixelBaseComponent px)) (ST s) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MeshPatch (Derivative (PixelBaseComponent px))
-> [CoonPatch (CubicCoefficient (PixelBaseComponent px))]
forall px.
InterpolablePixel px =>
MeshPatch (Derivative px) -> [CoonPatch (CubicCoefficient px)]
cubicCoonPatchesOf 
                (MeshPatch (Derivative (PixelBaseComponent px))
 -> StateT (MutableImage s (PixelBaseComponent px)) (ST s) ())
-> MeshPatch (Derivative (PixelBaseComponent px))
-> StateT (MutableImage s (PixelBaseComponent px)) (ST s) ()
forall a b. (a -> b) -> a -> b
$ MeshPatch (PixelBaseComponent px)
-> MeshPatch (Derivative (PixelBaseComponent px))
forall px.
InterpolablePixel px =>
MeshPatch px -> MeshPatch (Derivative px)
calculateMeshColorDerivative MeshPatch (PixelBaseComponent px)
transparencyMesh
    
    order :: DrawOrder px
order = DrawOrder :: forall px.
[[Primitive]]
-> Texture px
-> FillMethod
-> Maybe (Texture (PixelBaseComponent px))
-> (forall s. DrawContext (ST s) px ())
-> DrawOrder px
DrawOrder
          { _orderPrimitives :: [[Primitive]]
_orderPrimitives = [Point -> Float -> Float -> [Primitive]
rectangle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
0 Float
0) (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)]
          , _orderTexture :: Texture px
_orderTexture    = Texture px -> Texture (PixelBaseComponent px) -> Texture px
forall px.
Texture px -> Texture (PixelBaseComponent px) -> Texture px
AlphaModulateTexture (Image px -> Texture px
forall px. Image px -> Texture px
RawTexture Image px
rendering) (Image (PixelBaseComponent px) -> Texture (PixelBaseComponent px)
forall px. Image px -> Texture px
RawTexture Image (PixelBaseComponent px)
clipPath)
          , _orderFillMethod :: FillMethod
_orderFillMethod = FillMethod
FillWinding
          , _orderMask :: Maybe (Texture (PixelBaseComponent px))
_orderMask       = Maybe (Texture (PixelBaseComponent px))
forall a. Maybe a
Nothing
          , _orderDirect :: forall s. DrawContext (ST s) px ()
_orderDirect     = () -> StateT (MutableImage s px) (ST s) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          }