{-# LANGUAGE ConstraintKinds           #-}
{-# LANGUAGE CPP                       #-}
{-# LANGUAGE DeriveDataTypeable        #-}
{-# LANGUAGE DeriveGeneric             #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TemplateHaskell           #-}
{-# LANGUAGE TupleSections             #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE TypeSynonymInstances      #-}
{-# LANGUAGE ViewPatterns              #-}

-------------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Backend.Rasterific
-- Copyright   :  (c) 2014-2015 diagrams-rasterific team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- A full-featured rendering backend for diagrams using Rasterific,
-- implemented natively in Haskell (making it easy to use on any
-- platform). Can create png, tif, bmp, jpg, pdf, and animated GIFs.
--
-- To invoke the Rasterific backend, you have three options.
--
-- * You can use the "Diagrams.Backend.Rasterific.CmdLine" module to create
--   standalone executables which output images when invoked.
--
-- * You can use the 'renderRasterific' function provided by this module,
--   which gives you more flexible programmatic control over when and
--   how images are output (making it easy to, for example, write a
--   single program that outputs multiple images, or one that outputs
--   images dynamically based on user input, and so on).
--
-- * For the most flexibility (/e.g./ if you want access to the
--   resulting Rasterific value directly in memory without writing it to
--   disk), you can manually invoke the 'renderDia' method from the
--   'Diagrams.Core.Types.Backend' instance for @Rasterific@.  In particular,
--   'Diagrams.Core.Types.renderDia' has the generic type
--
-- > renderDia :: b -> Options b v n -> QDiagram b v n m -> Result b v n
--
-- (omitting a few type class constraints).  @b@ represents the
-- backend type, @v@ the vector space, @n@ the numeric field, and @m@ the type
-- of monoidal query annotations on the diagram.  'Options' and 'Result' are
-- associated data and type families, respectively, which yield the
-- type of option records and rendering results specific to any
-- particular backend.  For @b ~ Rasterific@, @v ~ V2@, and @n ~ n@, we have
--
-- > data Options Rasterific V2 n = RasterificOptions
-- >        { _size      :: SizeSpec2D n -- ^ The requested size of the output
-- >        }
--
-- @
-- type family Result Rasterific V2 n = 'Image PixelRGBA8'
-- @
--
-- So the type of 'renderDia' resolves to
--
-- @
-- renderDia :: Rasterific -> Options Rasterific V2 n -> QDiagram Rasterific V2 n m -> 'Image PixelRGBA8'
-- @
--
-- which you could call like @renderDia Rasterific (RasterificOptions (mkWidth 250))
-- myDiagram@.
--
-------------------------------------------------------------------------------
module Diagrams.Backend.Rasterific
  ( -- * Rasterific backend
    Rasterific(..)
  , B -- rendering token
  , Options(..)

    -- * Rendering
  , renderRasterific
  , renderPdf
  , renderPdfBS
  , renderPdfBSWithDPI
  , size

  , writeJpeg
  , GifDelay
  , GifLooping (..)
  , animatedGif

    -- * Text with envelopes
  , texterific
  , texterific'

    -- * Internals
    -- | These are low level functions whose implimentaion may change in
    --   the future. They're exported because they can sometimes be
    --   useful.
  , PaletteOptions (..)
  , defaultPaletteOptions
  , rasterGif
  , rasterRgb8

  ) where

import           Diagrams.Core.Compile
import           Diagrams.Core.Transform             (matrixHomRep)
import           Diagrams.Core.Types

import           Diagrams.Prelude                    hiding (height, local,
                                                      opacity, output, width)
import           Diagrams.TwoD.Adjust                (adjustDia2D)
import           Diagrams.TwoD.Text                  hiding (Font)

import           Codec.Picture
import           Codec.Picture.ColorQuant            (defaultPaletteOptions)
import           Codec.Picture.Types                 (convertImage,
                                                      convertPixel,
                                                      dropTransparency,
                                                      promoteImage)


import qualified Graphics.Rasterific                 as R
import           Graphics.Rasterific.Texture         (Gradient,
                                                      linearGradientTexture, radialGradientWithFocusTexture,
                                                      transformTexture,
                                                      uniformTexture,
                                                      withSampler)

import qualified Graphics.Rasterific.Transformations as R
import           Graphics.Text.TrueType              (Dpi)

import           Control.Monad.Reader
import           Diagrams.Backend.Rasterific.Text

import           Data.ByteString.Lazy                (ByteString)
import qualified Data.ByteString.Lazy                as L (writeFile)
import qualified Data.Foldable                       as F
import           Data.Hashable                       (Hashable (..))
import           Data.Maybe                          (fromMaybe)
import           Data.Tree
import           Data.Typeable
import           Data.Word                           (Word8)

import           System.FilePath                     (takeExtension)

--------------------------------------------------------------------------------
-- | This data declaration is simply used as a token to distinguish
--   the Rasterific backend: (1) when calling functions where the type
--   inference engine would otherwise have no way to know which
--   backend you wanted to use, and (2) as an argument to the
--   'Backend' and 'Renderable' type classes.
data Rasterific = Rasterific
  deriving (Rasterific -> Rasterific -> Bool
(Rasterific -> Rasterific -> Bool)
-> (Rasterific -> Rasterific -> Bool) -> Eq Rasterific
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rasterific -> Rasterific -> Bool
$c/= :: Rasterific -> Rasterific -> Bool
== :: Rasterific -> Rasterific -> Bool
$c== :: Rasterific -> Rasterific -> Bool
Eq,Eq Rasterific
Eq Rasterific
-> (Rasterific -> Rasterific -> Ordering)
-> (Rasterific -> Rasterific -> Bool)
-> (Rasterific -> Rasterific -> Bool)
-> (Rasterific -> Rasterific -> Bool)
-> (Rasterific -> Rasterific -> Bool)
-> (Rasterific -> Rasterific -> Rasterific)
-> (Rasterific -> Rasterific -> Rasterific)
-> Ord Rasterific
Rasterific -> Rasterific -> Bool
Rasterific -> Rasterific -> Ordering
Rasterific -> Rasterific -> Rasterific
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Rasterific -> Rasterific -> Rasterific
$cmin :: Rasterific -> Rasterific -> Rasterific
max :: Rasterific -> Rasterific -> Rasterific
$cmax :: Rasterific -> Rasterific -> Rasterific
>= :: Rasterific -> Rasterific -> Bool
$c>= :: Rasterific -> Rasterific -> Bool
> :: Rasterific -> Rasterific -> Bool
$c> :: Rasterific -> Rasterific -> Bool
<= :: Rasterific -> Rasterific -> Bool
$c<= :: Rasterific -> Rasterific -> Bool
< :: Rasterific -> Rasterific -> Bool
$c< :: Rasterific -> Rasterific -> Bool
compare :: Rasterific -> Rasterific -> Ordering
$ccompare :: Rasterific -> Rasterific -> Ordering
$cp1Ord :: Eq Rasterific
Ord,ReadPrec [Rasterific]
ReadPrec Rasterific
Int -> ReadS Rasterific
ReadS [Rasterific]
(Int -> ReadS Rasterific)
-> ReadS [Rasterific]
-> ReadPrec Rasterific
-> ReadPrec [Rasterific]
-> Read Rasterific
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Rasterific]
$creadListPrec :: ReadPrec [Rasterific]
readPrec :: ReadPrec Rasterific
$creadPrec :: ReadPrec Rasterific
readList :: ReadS [Rasterific]
$creadList :: ReadS [Rasterific]
readsPrec :: Int -> ReadS Rasterific
$creadsPrec :: Int -> ReadS Rasterific
Read,Int -> Rasterific -> ShowS
[Rasterific] -> ShowS
Rasterific -> String
(Int -> Rasterific -> ShowS)
-> (Rasterific -> String)
-> ([Rasterific] -> ShowS)
-> Show Rasterific
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rasterific] -> ShowS
$cshowList :: [Rasterific] -> ShowS
show :: Rasterific -> String
$cshow :: Rasterific -> String
showsPrec :: Int -> Rasterific -> ShowS
$cshowsPrec :: Int -> Rasterific -> ShowS
Show,Typeable)

type B = Rasterific

type instance V Rasterific = V2
type instance N Rasterific = Double

-- | The custom monad in which intermediate drawing options take
--   place; 'Graphics.Rasterific.Drawing' is Rasterific's own rendering
--   monad.
type RenderM n = ReaderT (Style V2 n) RenderR

type RenderR = R.Drawing PixelRGBA8

liftR :: RenderR a -> RenderM n a
liftR :: RenderR a -> RenderM n a
liftR = RenderR a -> RenderM n a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

runRenderM :: TypeableFloat n => RenderM n a -> RenderR a
runRenderM :: RenderM n a -> RenderR a
runRenderM = (RenderM n a -> Style V2 n -> RenderR a)
-> Style V2 n -> RenderM n a -> RenderR a
forall a b c. (a -> b -> c) -> b -> a -> c
flip RenderM n a -> Style V2 n -> RenderR a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Style V2 n
forall a. Monoid a => a
mempty Style V2 n -> (Style V2 n -> Style V2 n) -> Style V2 n
forall a b. a -> (a -> b) -> b
# AlphaColour Double -> Style V2 n -> Style V2 n
forall n a c.
(InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) =>
c -> a -> a
recommendFillColor AlphaColour Double
forall a. Num a => AlphaColour a
transparent)

-- From Diagrams.Core.Types.
instance TypeableFloat n => Backend Rasterific V2 n where
  newtype Render  Rasterific V2 n = R (RenderM n ())
  type Result  Rasterific V2 n = Image PixelRGBA8
  data Options Rasterific V2 n = RasterificOptions
          { Options Rasterific V2 n -> SizeSpec V2 n
_sizeSpec  :: SizeSpec V2 n -- ^ The requested size of the output
          }
    deriving (Int -> Options Rasterific V2 n -> ShowS
[Options Rasterific V2 n] -> ShowS
Options Rasterific V2 n -> String
(Int -> Options Rasterific V2 n -> ShowS)
-> (Options Rasterific V2 n -> String)
-> ([Options Rasterific V2 n] -> ShowS)
-> Show (Options Rasterific V2 n)
forall n. Show n => Int -> Options Rasterific V2 n -> ShowS
forall n. Show n => [Options Rasterific V2 n] -> ShowS
forall n. Show n => Options Rasterific V2 n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options Rasterific V2 n] -> ShowS
$cshowList :: forall n. Show n => [Options Rasterific V2 n] -> ShowS
show :: Options Rasterific V2 n -> String
$cshow :: forall n. Show n => Options Rasterific V2 n -> String
showsPrec :: Int -> Options Rasterific V2 n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> Options Rasterific V2 n -> ShowS
Show, Options Rasterific V2 n -> Options Rasterific V2 n -> Bool
(Options Rasterific V2 n -> Options Rasterific V2 n -> Bool)
-> (Options Rasterific V2 n -> Options Rasterific V2 n -> Bool)
-> Eq (Options Rasterific V2 n)
forall n.
Eq n =>
Options Rasterific V2 n -> Options Rasterific V2 n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options Rasterific V2 n -> Options Rasterific V2 n -> Bool
$c/= :: forall n.
Eq n =>
Options Rasterific V2 n -> Options Rasterific V2 n -> Bool
== :: Options Rasterific V2 n -> Options Rasterific V2 n -> Bool
$c== :: forall n.
Eq n =>
Options Rasterific V2 n -> Options Rasterific V2 n -> Bool
Eq)

  renderRTree :: Rasterific
-> Options Rasterific V2 n
-> RTree Rasterific V2 n Annotation
-> Result Rasterific V2 n
renderRTree Rasterific
_ Options Rasterific V2 n
opts RTree Rasterific V2 n Annotation
t =
    Int
-> Int -> PixelRGBA8 -> Drawing PixelRGBA8 () -> Image PixelRGBA8
forall px.
RenderablePixel px =>
Int -> Int -> px -> Drawing px () -> Image px
R.renderDrawing (n -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round n
w) (n -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round n
h) PixelRGBA8
bgColor Drawing PixelRGBA8 ()
r
    where
      r :: Drawing PixelRGBA8 ()
r       = RenderM n () -> Drawing PixelRGBA8 ()
forall n a. TypeableFloat n => RenderM n a -> RenderR a
runRenderM (RenderM n () -> Drawing PixelRGBA8 ())
-> (RTree Rasterific V2 n Annotation -> RenderM n ())
-> RTree Rasterific V2 n Annotation
-> Drawing PixelRGBA8 ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Render Rasterific V2 n -> RenderM n ()
forall n. Render Rasterific V2 n -> RenderM n ()
runR (Render Rasterific V2 n -> RenderM n ())
-> (RTree Rasterific V2 n Annotation -> Render Rasterific V2 n)
-> RTree Rasterific V2 n Annotation
-> RenderM n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTree Rasterific V2 n Annotation -> Render Rasterific V2 n
forall n.
TypeableFloat n =>
RTree Rasterific V2 n Annotation -> Render Rasterific V2 n
fromRTree (RTree Rasterific V2 n Annotation -> Drawing PixelRGBA8 ())
-> RTree Rasterific V2 n Annotation -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ RTree Rasterific V2 n Annotation
t
      V2 n
w n
h  = n -> SizeSpec V2 n -> V2 n
forall (v :: * -> *) n.
(Foldable v, Functor v, Num n, Ord n) =>
n -> SizeSpec v n -> v n
specToSize n
100 (Options Rasterific V2 n
optsOptions Rasterific V2 n
-> Getting
     (SizeSpec V2 n) (Options Rasterific V2 n) (SizeSpec V2 n)
-> SizeSpec V2 n
forall s a. s -> Getting a s a -> a
^.Getting (SizeSpec V2 n) (Options Rasterific V2 n) (SizeSpec V2 n)
forall n. Lens' (Options Rasterific V2 n) (SizeSpec V2 n)
sizeSpec)
      bgColor :: PixelRGBA8
bgColor = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
0 Pixel8
0 Pixel8
0 Pixel8
0

  adjustDia :: Rasterific
-> Options Rasterific V2 n
-> QDiagram Rasterific V2 n m
-> (Options Rasterific V2 n, Transformation V2 n,
    QDiagram Rasterific V2 n m)
adjustDia Rasterific
c Options Rasterific V2 n
opts QDiagram Rasterific V2 n m
d = Lens' (Options Rasterific V2 n) (SizeSpec V2 n)
-> Rasterific
-> Options Rasterific V2 n
-> QDiagram Rasterific V2 n m
-> (Options Rasterific V2 n, Transformation V2 n,
    QDiagram Rasterific V2 n m)
forall n m b.
(TypeableFloat n, Monoid' m) =>
Lens' (Options b V2 n) (SizeSpec V2 n)
-> b
-> Options b V2 n
-> QDiagram b V2 n m
-> (Options b V2 n, Transformation V2 n, QDiagram b V2 n m)
adjustDia2D forall n. Lens' (Options Rasterific V2 n) (SizeSpec V2 n)
Lens' (Options Rasterific V2 n) (SizeSpec V2 n)
sizeSpec Rasterific
c Options Rasterific V2 n
opts (QDiagram Rasterific V2 n m
d QDiagram Rasterific V2 n m
-> (QDiagram Rasterific V2 n m -> QDiagram Rasterific V2 n m)
-> QDiagram Rasterific V2 n m
forall a b. a -> (a -> b) -> b
# QDiagram Rasterific V2 n m -> QDiagram Rasterific V2 n m
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY)

fromRTree :: TypeableFloat n => RTree Rasterific V2 n Annotation -> Render Rasterific V2 n
fromRTree :: RTree Rasterific V2 n Annotation -> Render Rasterific V2 n
fromRTree (Node RNode Rasterific V2 n Annotation
n Forest (RNode Rasterific V2 n Annotation)
rs) = case RNode Rasterific V2 n Annotation
n of
  RPrim Prim Rasterific V2 n
p                 -> Rasterific
-> Prim Rasterific V2 n
-> Render
     Rasterific (V (Prim Rasterific V2 n)) (N (Prim Rasterific V2 n))
forall t b. Renderable t b => b -> t -> Render b (V t) (N t)
render Rasterific
Rasterific Prim Rasterific V2 n
p
  RStyle Style V2 n
sty              -> RenderM n () -> Render Rasterific V2 n
forall n. RenderM n () -> Render Rasterific V2 n
R (RenderM n () -> Render Rasterific V2 n)
-> RenderM n () -> Render Rasterific V2 n
forall a b. (a -> b) -> a -> b
$ Style V2 n -> RenderM n () -> RenderM n ()
forall n.
TypeableFloat n =>
Style V2 n -> RenderM n () -> RenderM n ()
clip Style V2 n
sty ((Style V2 n -> Style V2 n) -> RenderM n () -> RenderM n ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Style V2 n -> Style V2 n -> Style V2 n
forall a. Semigroup a => a -> a -> a
<> Style V2 n
sty) RenderM n ()
r)
  RAnnot (OpacityGroup Double
x) -> RenderM n () -> Render Rasterific V2 n
forall n. RenderM n () -> Render Rasterific V2 n
R (RenderM n () -> Render Rasterific V2 n)
-> RenderM n () -> Render Rasterific V2 n
forall a b. (a -> b) -> a -> b
$ (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> RenderM n () -> RenderM n ()
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (PixelBaseComponent PixelRGBA8
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px. PixelBaseComponent px -> Drawing px () -> Drawing px ()
R.withGroupOpacity (Double -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Pixel8) -> Double -> Pixel8
forall a b. (a -> b) -> a -> b
$ Double
255 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)) RenderM n ()
r
  RNode Rasterific V2 n Annotation
_                       -> RenderM n () -> Render Rasterific V2 n
forall n. RenderM n () -> Render Rasterific V2 n
R RenderM n ()
r
  where R r = (RTree Rasterific V2 n Annotation -> Render Rasterific V2 n)
-> Forest (RNode Rasterific V2 n Annotation)
-> Render Rasterific V2 n
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap RTree Rasterific V2 n Annotation -> Render Rasterific V2 n
forall n.
TypeableFloat n =>
RTree Rasterific V2 n Annotation -> Render Rasterific V2 n
fromRTree Forest (RNode Rasterific V2 n Annotation)
rs

-- | Clip a render using the Clip from the style.
clip :: TypeableFloat n => Style V2 n -> RenderM n () -> RenderM n ()
clip :: Style V2 n -> RenderM n () -> RenderM n ()
clip Style V2 n
sty RenderM n ()
r = [Path V2 n] -> RenderM n ()
go (Style V2 n
sty Style V2 n
-> Getting [Path V2 n] (Style V2 n) [Path V2 n] -> [Path V2 n]
forall s a. s -> Getting a s a -> a
^. Getting [Path V2 n] (Style V2 n) [Path V2 n]
forall n.
(Typeable n, OrderedField n) =>
Lens' (Style V2 n) [Path V2 n]
_clip)
  where
    go :: [Path V2 n] -> RenderM n ()
go []     = RenderM n ()
r
    go (Path V2 n
p:[Path V2 n]
ps) = (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> RenderM n () -> RenderM n ()
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((forall innerPixel. Drawing innerPixel ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px.
(forall innerPixel. Drawing innerPixel ())
-> Drawing px () -> Drawing px ()
R.withClipping ((forall innerPixel. Drawing innerPixel ())
 -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> (forall innerPixel. Drawing innerPixel ())
-> Drawing PixelRGBA8 ()
-> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ [[Primitive]] -> Drawing innerPixel ()
forall geom px. Geometry geom => geom -> Drawing px ()
R.fill (Path V2 n -> [[Primitive]]
forall n. TypeableFloat n => Path V2 n -> [[Primitive]]
renderPath Path V2 n
p)) ([Path V2 n] -> RenderM n ()
go [Path V2 n]
ps)

runR :: Render Rasterific V2 n -> RenderM n ()
runR :: Render Rasterific V2 n -> RenderM n ()
runR (R r) = RenderM n ()
r

instance Semigroup (Render Rasterific V2 n) where
  R rd1 <> :: Render Rasterific V2 n
-> Render Rasterific V2 n -> Render Rasterific V2 n
<> R rd2 = RenderM n () -> Render Rasterific V2 n
forall n. RenderM n () -> Render Rasterific V2 n
R (RenderM n ()
rd1 RenderM n () -> RenderM n () -> RenderM n ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RenderM n ()
rd2)

instance Monoid (Render Rasterific V2 n) where
  mempty :: Render Rasterific V2 n
mempty = RenderM n () -> Render Rasterific V2 n
forall n. RenderM n () -> Render Rasterific V2 n
R (RenderM n () -> Render Rasterific V2 n)
-> RenderM n () -> Render Rasterific V2 n
forall a b. (a -> b) -> a -> b
$ () -> RenderM n ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if !MIN_VERSION_base(4,11,0)
  mappend = (<>)
#endif

instance Hashable n => Hashable (Options Rasterific V2 n) where
  hashWithSalt :: Int -> Options Rasterific V2 n -> Int
hashWithSalt Int
s (RasterificOptions sz) = Int
s Int -> SizeSpec V2 n -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` SizeSpec V2 n
sz

sizeSpec :: Lens' (Options Rasterific V2 n) (SizeSpec V2 n)
sizeSpec :: (SizeSpec V2 n -> f (SizeSpec V2 n))
-> Options Rasterific V2 n -> f (Options Rasterific V2 n)
sizeSpec = (Options Rasterific V2 n -> SizeSpec V2 n)
-> (Options Rasterific V2 n
    -> SizeSpec V2 n -> Options Rasterific V2 n)
-> Lens
     (Options Rasterific V2 n)
     (Options Rasterific V2 n)
     (SizeSpec V2 n)
     (SizeSpec V2 n)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Options Rasterific V2 n -> SizeSpec V2 n
forall n. Options Rasterific V2 n -> SizeSpec V2 n
_sizeSpec (\Options Rasterific V2 n
o SizeSpec V2 n
s -> Options Rasterific V2 n
R:OptionsRasterificV2n n
o {_sizeSpec :: SizeSpec V2 n
_sizeSpec = SizeSpec V2 n
s})

rasterificStrokeStyle :: TypeableFloat n => Style v n
                     -> (n, R.Join, (R.Cap, R.Cap), Maybe (R.DashPattern, n))
rasterificStrokeStyle :: Style v n -> (n, Join, (Cap, Cap), Maybe (DashPattern, n))
rasterificStrokeStyle Style v n
s = (n
strokeWidth, Join
strokeJoin, (Cap
strokeCap, Cap
strokeCap), Maybe (DashPattern, n)
strokeDash)
  where
    strokeWidth :: n
strokeWidth = LensLike' (Const n) (Style v n) (Maybe n)
-> (Maybe n -> n) -> Style v n -> n
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const n) (Style v n) (Maybe n)
forall n (v :: * -> *). Typeable n => Lens' (Style v n) (Maybe n)
_lineWidthU (n -> Maybe n -> n
forall a. a -> Maybe a -> a
fromMaybe n
1) Style v n
s
    strokeJoin :: Join
strokeJoin  = LensLike' (Const Join) (Style v n) LineJoin
-> (LineJoin -> Join) -> Style v n -> Join
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const Join) (Style v n) LineJoin
forall (v :: * -> *) n. Lens' (Style v n) LineJoin
_lineJoin   LineJoin -> Join
fromLineJoin Style v n
s
    strokeCap :: Cap
strokeCap   = LensLike' (Const Cap) (Style v n) LineCap
-> (LineCap -> Cap) -> Style v n -> Cap
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const Cap) (Style v n) LineCap
forall (v :: * -> *) n. Lens' (Style v n) LineCap
_lineCap    LineCap -> Cap
fromLineCap Style v n
s
    strokeDash :: Maybe (DashPattern, n)
strokeDash  = LensLike'
  (Const (Maybe (DashPattern, n))) (Style v n) (Maybe (Dashing n))
-> (Maybe (Dashing n) -> Maybe (DashPattern, n))
-> Style v n
-> Maybe (DashPattern, n)
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike'
  (Const (Maybe (DashPattern, n))) (Style v n) (Maybe (Dashing n))
forall n (v :: * -> *).
Typeable n =>
Lens' (Style v n) (Maybe (Dashing n))
_dashingU   ((Dashing n -> (DashPattern, n))
-> Maybe (Dashing n) -> Maybe (DashPattern, n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dashing n -> (DashPattern, n)
forall n. Real n => Dashing n -> (DashPattern, n)
fromDashing) Style v n
s

fromLineCap :: LineCap -> R.Cap
fromLineCap :: LineCap -> Cap
fromLineCap LineCap
LineCapButt   = Float -> Cap
R.CapStraight Float
0
fromLineCap LineCap
LineCapRound  = Cap
R.CapRound
fromLineCap LineCap
LineCapSquare = Float -> Cap
R.CapStraight Float
1

fromLineJoin :: LineJoin -> R.Join
fromLineJoin :: LineJoin -> Join
fromLineJoin LineJoin
LineJoinMiter = Float -> Join
R.JoinMiter Float
0
fromLineJoin LineJoin
LineJoinRound = Join
R.JoinRound
fromLineJoin LineJoin
LineJoinBevel = Float -> Join
R.JoinMiter Float
1

fromDashing :: Real n => Dashing n -> (R.DashPattern, n)
fromDashing :: Dashing n -> (DashPattern, n)
fromDashing (Dashing [n]
ds n
d) = ((n -> Float) -> [n] -> DashPattern
forall a b. (a -> b) -> [a] -> [b]
map n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac [n]
ds, n
d)

fromFillRule :: FillRule -> R.FillMethod
fromFillRule :: FillRule -> FillMethod
fromFillRule FillRule
EvenOdd = FillMethod
R.FillEvenOdd
fromFillRule FillRule
_       = FillMethod
R.FillWinding

rasterificColor :: SomeColor -> Double -> PixelRGBA8
rasterificColor :: SomeColor -> Double -> PixelRGBA8
rasterificColor SomeColor
c Double
o = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
r Pixel8
g Pixel8
b Pixel8
a
  where
    (Pixel8
r, Pixel8
g, Pixel8
b, Pixel8
a) = (Double -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
int Double
r', Double -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
int Double
g', Double -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
int Double
b', Double -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
int (Double
o Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a'))
    (Double
r', Double
g', Double
b', Double
a') = AlphaColour Double -> (Double, Double, Double, Double)
forall c. Color c => c -> (Double, Double, Double, Double)
colorToSRGBA (SomeColor -> AlphaColour Double
forall c. Color c => c -> AlphaColour Double
toAlphaColour SomeColor
c)
    int :: a -> b
int a
x = a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (a
255 a -> a -> a
forall a. Num a => a -> a -> a
* a
x)

rasterificSpreadMethod :: SpreadMethod -> R.SamplerRepeat
rasterificSpreadMethod :: SpreadMethod -> SamplerRepeat
rasterificSpreadMethod SpreadMethod
GradPad     = SamplerRepeat
R.SamplerPad
rasterificSpreadMethod SpreadMethod
GradReflect = SamplerRepeat
R.SamplerReflect
rasterificSpreadMethod SpreadMethod
GradRepeat  = SamplerRepeat
R.SamplerRepeat

rasterificStops :: TypeableFloat n => [GradientStop n] -> Gradient PixelRGBA8
rasterificStops :: [GradientStop n] -> Gradient PixelRGBA8
rasterificStops = (GradientStop n -> (Float, PixelRGBA8))
-> [GradientStop n] -> Gradient PixelRGBA8
forall a b. (a -> b) -> [a] -> [b]
map GradientStop n -> (Float, PixelRGBA8)
forall a a.
(Real a, Fractional a) =>
GradientStop a -> (a, PixelRGBA8)
fromStop
  where
    fromStop :: GradientStop a -> (a, PixelRGBA8)
fromStop (GradientStop SomeColor
c a
v) = (a -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
v, SomeColor -> Double -> PixelRGBA8
rasterificColor SomeColor
c Double
1)

rasterificLinearGradient :: TypeableFloat n => LGradient n -> R.Texture PixelRGBA8
rasterificLinearGradient :: LGradient n -> Texture PixelRGBA8
rasterificLinearGradient LGradient n
g = Transformation -> Texture PixelRGBA8 -> Texture PixelRGBA8
forall px. Transformation -> Texture px -> Texture px
transformTexture Transformation
tr Texture PixelRGBA8
tx
  where
    tr :: Transformation
tr = T2 n -> Transformation
forall n. TypeableFloat n => T2 n -> Transformation
rasterificMatTransf (T2 n -> T2 n
forall (v :: * -> *) n.
(Functor v, Num n) =>
Transformation v n -> Transformation v n
inv (T2 n -> T2 n) -> T2 n -> T2 n
forall a b. (a -> b) -> a -> b
$ LGradient n
gLGradient n -> Getting (T2 n) (LGradient n) (T2 n) -> T2 n
forall s a. s -> Getting a s a -> a
^.Getting (T2 n) (LGradient n) (T2 n)
forall n. Lens' (LGradient n) (Transformation V2 n)
lGradTrans)
    tx :: Texture PixelRGBA8
tx = SamplerRepeat -> Texture PixelRGBA8 -> Texture PixelRGBA8
forall px. SamplerRepeat -> Texture px -> Texture px
withSampler SamplerRepeat
spreadMethod (Gradient PixelRGBA8 -> Point -> Point -> Texture PixelRGBA8
forall px. Gradient px -> Point -> Point -> Texture px
linearGradientTexture Gradient PixelRGBA8
gradDef Point
p0 Point
p1)
    spreadMethod :: SamplerRepeat
spreadMethod = SpreadMethod -> SamplerRepeat
rasterificSpreadMethod (LGradient n
gLGradient n
-> Getting SpreadMethod (LGradient n) SpreadMethod -> SpreadMethod
forall s a. s -> Getting a s a -> a
^.Getting SpreadMethod (LGradient n) SpreadMethod
forall n. Lens' (LGradient n) SpreadMethod
lGradSpreadMethod)
    gradDef :: Gradient PixelRGBA8
gradDef = [GradientStop n] -> Gradient PixelRGBA8
forall n.
TypeableFloat n =>
[GradientStop n] -> Gradient PixelRGBA8
rasterificStops (LGradient n
gLGradient n
-> Getting [GradientStop n] (LGradient n) [GradientStop n]
-> [GradientStop n]
forall s a. s -> Getting a s a -> a
^.Getting [GradientStop n] (LGradient n) [GradientStop n]
forall n. Lens' (LGradient n) [GradientStop n]
lGradStops)
    p0 :: Point
p0 = P2 n -> Point
forall n. Real n => P2 n -> Point
p2v2 (LGradient n
gLGradient n -> Getting (P2 n) (LGradient n) (P2 n) -> P2 n
forall s a. s -> Getting a s a -> a
^.Getting (P2 n) (LGradient n) (P2 n)
forall n. Lens' (LGradient n) (Point V2 n)
lGradStart)
    p1 :: Point
p1 = P2 n -> Point
forall n. Real n => P2 n -> Point
p2v2 (LGradient n
gLGradient n -> Getting (P2 n) (LGradient n) (P2 n) -> P2 n
forall s a. s -> Getting a s a -> a
^.Getting (P2 n) (LGradient n) (P2 n)
forall n. Lens' (LGradient n) (Point V2 n)
lGradEnd)

rasterificRadialGradient :: TypeableFloat n => RGradient n -> R.Texture PixelRGBA8
rasterificRadialGradient :: RGradient n -> Texture PixelRGBA8
rasterificRadialGradient RGradient n
g = Transformation -> Texture PixelRGBA8 -> Texture PixelRGBA8
forall px. Transformation -> Texture px -> Texture px
transformTexture Transformation
tr Texture PixelRGBA8
tx
  where
    tr :: Transformation
tr = T2 n -> Transformation
forall n. TypeableFloat n => T2 n -> Transformation
rasterificMatTransf (T2 n -> T2 n
forall (v :: * -> *) n.
(Functor v, Num n) =>
Transformation v n -> Transformation v n
inv (T2 n -> T2 n) -> T2 n -> T2 n
forall a b. (a -> b) -> a -> b
$ RGradient n
gRGradient n -> Getting (T2 n) (RGradient n) (T2 n) -> T2 n
forall s a. s -> Getting a s a -> a
^.Getting (T2 n) (RGradient n) (T2 n)
forall n. Lens' (RGradient n) (Transformation V2 n)
rGradTrans)
    tx :: Texture PixelRGBA8
tx = SamplerRepeat -> Texture PixelRGBA8 -> Texture PixelRGBA8
forall px. SamplerRepeat -> Texture px -> Texture px
withSampler SamplerRepeat
spreadMethod (Gradient PixelRGBA8
-> Point -> Float -> Point -> Texture PixelRGBA8
forall px. Gradient px -> Point -> Float -> Point -> Texture px
radialGradientWithFocusTexture Gradient PixelRGBA8
gradDef Point
c (n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac n
r1) Point
f)
    spreadMethod :: SamplerRepeat
spreadMethod = SpreadMethod -> SamplerRepeat
rasterificSpreadMethod (RGradient n
gRGradient n
-> Getting SpreadMethod (RGradient n) SpreadMethod -> SpreadMethod
forall s a. s -> Getting a s a -> a
^.Getting SpreadMethod (RGradient n) SpreadMethod
forall n. Lens' (RGradient n) SpreadMethod
rGradSpreadMethod)
    c :: Point
c = P2 n -> Point
forall n. Real n => P2 n -> Point
p2v2 (RGradient n
gRGradient n -> Getting (P2 n) (RGradient n) (P2 n) -> P2 n
forall s a. s -> Getting a s a -> a
^.Getting (P2 n) (RGradient n) (P2 n)
forall n. Lens' (RGradient n) (Point V2 n)
rGradCenter1)
    f :: Point
f = P2 n -> Point
forall n. Real n => P2 n -> Point
p2v2 (RGradient n
gRGradient n -> Getting (P2 n) (RGradient n) (P2 n) -> P2 n
forall s a. s -> Getting a s a -> a
^.Getting (P2 n) (RGradient n) (P2 n)
forall n. Lens' (RGradient n) (Point V2 n)
rGradCenter0)
    gradDef :: Gradient PixelRGBA8
gradDef = [GradientStop n] -> Gradient PixelRGBA8
forall n.
TypeableFloat n =>
[GradientStop n] -> Gradient PixelRGBA8
rasterificStops [GradientStop n]
ss

    -- Adjust the stops so that the gradient begins at the perimeter of
    -- the inner circle (center0, radius0) and ends at the outer circle.
    r0 :: n
r0 = RGradient n
gRGradient n -> Getting n (RGradient n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (RGradient n) n
forall n. Lens' (RGradient n) n
rGradRadius0
    r1 :: n
r1 = RGradient n
gRGradient n -> Getting n (RGradient n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (RGradient n) n
forall n. Lens' (RGradient n) n
rGradRadius1
    stopFracs :: [n]
stopFracs = n
r0 n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
r1 n -> [n] -> [n]
forall a. a -> [a] -> [a]
: (GradientStop n -> n) -> [GradientStop n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (\GradientStop n
s -> (n
r0 n -> n -> n
forall a. Num a => a -> a -> a
+ (GradientStop n
sGradientStop n -> Getting n (GradientStop n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (GradientStop n) n
forall n. Lens' (GradientStop n) n
stopFraction) n -> n -> n
forall a. Num a => a -> a -> a
* (n
r1 n -> n -> n
forall a. Num a => a -> a -> a
- n
r0)) n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
r1)
                (RGradient n
gRGradient n
-> Getting [GradientStop n] (RGradient n) [GradientStop n]
-> [GradientStop n]
forall s a. s -> Getting a s a -> a
^.Getting [GradientStop n] (RGradient n) [GradientStop n]
forall n. Lens' (RGradient n) [GradientStop n]
rGradStops)
    gradStops :: [GradientStop n]
gradStops = case RGradient n
gRGradient n
-> Getting [GradientStop n] (RGradient n) [GradientStop n]
-> [GradientStop n]
forall s a. s -> Getting a s a -> a
^.Getting [GradientStop n] (RGradient n) [GradientStop n]
forall n. Lens' (RGradient n) [GradientStop n]
rGradStops of
      []       -> []
      xs :: [GradientStop n]
xs@(GradientStop n
x:[GradientStop n]
_) -> GradientStop n
x GradientStop n -> [GradientStop n] -> [GradientStop n]
forall a. a -> [a] -> [a]
: [GradientStop n]
xs
    ss :: [GradientStop n]
ss = (GradientStop n -> n -> GradientStop n)
-> [GradientStop n] -> [n] -> [GradientStop n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\GradientStop n
gs n
sf -> GradientStop n
gs GradientStop n
-> (GradientStop n -> GradientStop n) -> GradientStop n
forall a b. a -> (a -> b) -> b
& (n -> Identity n) -> GradientStop n -> Identity (GradientStop n)
forall n. Lens' (GradientStop n) n
stopFraction ((n -> Identity n) -> GradientStop n -> Identity (GradientStop n))
-> n -> GradientStop n -> GradientStop n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
sf ) [GradientStop n]
gradStops [n]
stopFracs

-- Convert a diagrams @Texture@ and opacity to a rasterific texture.
rasterificTexture :: TypeableFloat n => Texture n -> Double -> R.Texture PixelRGBA8
rasterificTexture :: Texture n -> Double -> Texture PixelRGBA8
rasterificTexture (SC SomeColor
c) Double
o = PixelRGBA8 -> Texture PixelRGBA8
forall px. px -> Texture px
uniformTexture (PixelRGBA8 -> Texture PixelRGBA8)
-> PixelRGBA8 -> Texture PixelRGBA8
forall a b. (a -> b) -> a -> b
$ SomeColor -> Double -> PixelRGBA8
rasterificColor SomeColor
c Double
o
rasterificTexture (LG LGradient n
g) Double
_ = LGradient n -> Texture PixelRGBA8
forall n. TypeableFloat n => LGradient n -> Texture PixelRGBA8
rasterificLinearGradient LGradient n
g
rasterificTexture (RG RGradient n
g) Double
_ = RGradient n -> Texture PixelRGBA8
forall n. TypeableFloat n => RGradient n -> Texture PixelRGBA8
rasterificRadialGradient RGradient n
g

p2v2 :: Real n => P2 n -> R.Point
p2v2 :: P2 n -> Point
p2v2 (P V2 n
v) = V2 n -> Point
forall n. Real n => V2 n -> Point
r2v2 V2 n
v
{-# INLINE p2v2 #-}

r2v2 :: Real n => V2 n -> R.Point
r2v2 :: V2 n -> Point
r2v2 (V2 n
x n
y) = Float -> Float -> Point
forall a. a -> a -> V2 a
R.V2 (n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac n
x) (n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac n
y)
{-# INLINE r2v2 #-}

rv2 :: (Real n, Fractional n) => Iso' R.Point (P2 n)
rv2 :: Iso' Point (P2 n)
rv2 = (Point -> V2 n) -> (V2 n -> Point) -> Iso Point Point (V2 n) (V2 n)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(R.V2 Float
x Float
y) -> n -> n -> V2 n
forall a. a -> a -> V2 a
V2 (Float -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (Float -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y)) V2 n -> Point
forall n. Real n => V2 n -> Point
r2v2 (p (V2 n) (f (V2 n)) -> p Point (f Point))
-> (p (P2 n) (f (P2 n)) -> p (V2 n) (f (V2 n)))
-> p (P2 n) (f (P2 n))
-> p Point (f Point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso (P2 n) (P2 n) (V2 n) (V2 n)
-> Iso (V2 n) (V2 n) (P2 n) (P2 n)
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso (P2 n) (P2 n) (V2 n) (V2 n)
forall (f :: * -> *) a. Iso' (Point f a) (f a)
_Point
{-# INLINE rv2 #-}

rasterificPtTransf :: TypeableFloat n => T2 n -> R.Point -> R.Point
rasterificPtTransf :: T2 n -> Point -> Point
rasterificPtTransf T2 n
t = ASetter Point Point (Point V2 n) (Point V2 n)
-> (Point V2 n -> Point V2 n) -> Point -> Point
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Point Point (Point V2 n) (Point V2 n)
forall n. (Real n, Fractional n) => Iso' Point (P2 n)
rv2 (T2 n -> Point V2 n -> Point V2 n
forall (v :: * -> *) n.
(Additive v, Num n) =>
Transformation v n -> Point v n -> Point v n
papply T2 n
t)

rasterificMatTransf :: TypeableFloat n => T2 n -> R.Transformation
rasterificMatTransf :: T2 n -> Transformation
rasterificMatTransf T2 n
tr = Float
-> Float -> Float -> Float -> Float -> Float -> Transformation
R.Transformation Float
a Float
c Float
e Float
b Float
d Float
f
  where
    [[Float
a, Float
b], [Float
c, Float
d], [Float
e, Float
f]] = (n -> Float) -> [n] -> DashPattern
forall a b. (a -> b) -> [a] -> [b]
map n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac ([n] -> DashPattern) -> [[n]] -> [DashPattern]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> T2 n -> [[n]]
forall (v :: * -> *) n.
(Additive v, Traversable v, Num n) =>
Transformation v n -> [[n]]
matrixHomRep T2 n
tr

-- Note: Using view patterns confuses ghc to think there are missing patterns,
-- so we avoid them here.
renderSeg :: TypeableFloat n => Located (Segment Closed V2 n) -> R.Primitive
renderSeg :: Located (Segment Closed V2 n) -> Primitive
renderSeg Located (Segment Closed V2 n)
l =
  case Located (Segment Closed V2 n)
-> (Point (V (Segment Closed V2 n)) (N (Segment Closed V2 n)),
    Segment Closed V2 n)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc Located (Segment Closed V2 n)
l of
    (Point (V (Segment Closed V2 n)) (N (Segment Closed V2 n))
p, Linear (OffsetClosed V2 n
v)) ->
      Line -> Primitive
R.LinePrim (Line -> Primitive) -> Line -> Primitive
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Line
R.Line Point
p' (Point
p' Point -> Point -> Point
forall a. Num a => a -> a -> a
+ V2 n -> Point
forall n. Real n => V2 n -> Point
r2v2 V2 n
v)
      where
        p' :: Point
p' = P2 n -> Point
forall n. Real n => P2 n -> Point
p2v2 Point (V (Segment Closed V2 n)) (N (Segment Closed V2 n))
P2 n
p
    (Point (V (Segment Closed V2 n)) (N (Segment Closed V2 n))
p, Cubic V2 n
u1 V2 n
u2 (OffsetClosed V2 n
u3)) ->
      CubicBezier -> Primitive
R.CubicBezierPrim (CubicBezier -> Primitive) -> CubicBezier -> Primitive
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Point -> Point -> CubicBezier
R.CubicBezier Point
q0 Point
q1 Point
q2 Point
q3
      where
        (Point
q0, Point
q1, Point
q2, Point
q3) = (P2 n -> Point
forall n. Real n => P2 n -> Point
p2v2 Point (V (Segment Closed V2 n)) (N (Segment Closed V2 n))
P2 n
p, Point
q0 Point -> Point -> Point
forall a. Num a => a -> a -> a
+ V2 n -> Point
forall n. Real n => V2 n -> Point
r2v2 V2 n
u1, Point
q0 Point -> Point -> Point
forall a. Num a => a -> a -> a
+ V2 n -> Point
forall n. Real n => V2 n -> Point
r2v2 V2 n
u2, Point
q0 Point -> Point -> Point
forall a. Num a => a -> a -> a
+ V2 n -> Point
forall n. Real n => V2 n -> Point
r2v2 V2 n
u3)

renderPath :: TypeableFloat n => Path V2 n -> [[R.Primitive]]
renderPath :: Path V2 n -> [[Primitive]]
renderPath Path V2 n
p = (([Located (Segment Closed V2 n)] -> [Primitive])
-> [[Located (Segment Closed V2 n)]] -> [[Primitive]]
forall a b. (a -> b) -> [a] -> [b]
map (([Located (Segment Closed V2 n)] -> [Primitive])
 -> [[Located (Segment Closed V2 n)]] -> [[Primitive]])
-> ((Located (Segment Closed V2 n) -> Primitive)
    -> [Located (Segment Closed V2 n)] -> [Primitive])
-> (Located (Segment Closed V2 n) -> Primitive)
-> [[Located (Segment Closed V2 n)]]
-> [[Primitive]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located (Segment Closed V2 n) -> Primitive)
-> [Located (Segment Closed V2 n)] -> [Primitive]
forall a b. (a -> b) -> [a] -> [b]
map) Located (Segment Closed V2 n) -> Primitive
forall n.
TypeableFloat n =>
Located (Segment Closed V2 n) -> Primitive
renderSeg (Path V2 n -> [[Located (Segment Closed V2 n)]]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Path v n -> [[Located (Segment Closed v n)]]
pathLocSegments Path V2 n
p)

-- Stroke both dashed and solid lines.
mkStroke :: TypeableFloat n => n ->  R.Join -> (R.Cap, R.Cap) -> Maybe (R.DashPattern, n)
      -> [[R.Primitive]] -> RenderR ()
mkStroke :: n
-> Join
-> (Cap, Cap)
-> Maybe (DashPattern, n)
-> [[Primitive]]
-> Drawing PixelRGBA8 ()
mkStroke (n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> Float
l) Join
j (Cap, Cap)
c Maybe (DashPattern, n)
d [[Primitive]]
primList =
  Drawing PixelRGBA8 ()
-> ((DashPattern, n) -> Drawing PixelRGBA8 ())
-> Maybe (DashPattern, n)
-> Drawing PixelRGBA8 ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Float -> Join -> (Cap, Cap) -> [Primitive] -> Drawing PixelRGBA8 ()
forall geom px.
Geometry geom =>
Float -> Join -> (Cap, Cap) -> geom -> Drawing px ()
R.stroke Float
l Join
j (Cap, Cap)
c ([Primitive] -> Drawing PixelRGBA8 ())
-> [Primitive] -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ [[Primitive]] -> [Primitive]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Primitive]]
primList)
        (\(DashPattern
dsh, n
off) -> Float
-> DashPattern
-> Float
-> Join
-> (Cap, Cap)
-> [Primitive]
-> Drawing PixelRGBA8 ()
forall geom px.
Geometry geom =>
Float
-> DashPattern
-> Float
-> Join
-> (Cap, Cap)
-> geom
-> Drawing px ()
R.dashedStrokeWithOffset (n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac n
off) DashPattern
dsh Float
l Join
j (Cap, Cap)
c ([Primitive] -> Drawing PixelRGBA8 ())
-> [Primitive] -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ [[Primitive]] -> [Primitive]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Primitive]]
primList)
        Maybe (DashPattern, n)
d

instance TypeableFloat n => Renderable (Path V2 n) Rasterific where
  render :: Rasterific
-> Path V2 n -> Render Rasterific (V (Path V2 n)) (N (Path V2 n))
render Rasterific
_ Path V2 n
p = RenderM n () -> Render Rasterific V2 n
forall n. RenderM n () -> Render Rasterific V2 n
R (RenderM n () -> Render Rasterific V2 n)
-> RenderM n () -> Render Rasterific V2 n
forall a b. (a -> b) -> a -> b
$ do
    Style V2 n
sty <- ReaderT (Style V2 n) RenderR (Style V2 n)
forall r (m :: * -> *). MonadReader r m => m r
ask
    let f :: Texture n
f = Style V2 n
sty Style V2 n
-> Getting (Texture n) (Style V2 n) (Texture n) -> Texture n
forall s a. s -> Getting a s a -> a
^. Getting (Texture n) (Style V2 n) (Texture n)
forall n.
(Typeable n, Floating n) =>
Lens' (Style V2 n) (Texture n)
_fillTexture
        s :: Texture n
s = Style V2 n
sty Style V2 n
-> Getting (Texture n) (Style V2 n) (Texture n) -> Texture n
forall s a. s -> Getting a s a -> a
^. Getting (Texture n) (Style V2 n) (Texture n)
forall n.
(Floating n, Typeable n) =>
Lens' (Style V2 n) (Texture n)
_lineTexture
        o :: Double
o = Style V2 n
sty Style V2 n -> Getting Double (Style V2 n) Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double (Style V2 n) Double
forall (v :: * -> *) n. Lens' (Style v n) Double
_opacity
        r :: FillRule
r = Style V2 n
sty Style V2 n -> Getting FillRule (Style V2 n) FillRule -> FillRule
forall s a. s -> Getting a s a -> a
^. Getting FillRule (Style V2 n) FillRule
forall n. Lens' (Style V2 n) FillRule
_fillRule

        (n
l, Join
j, (Cap, Cap)
c, Maybe (DashPattern, n)
d) = Style V2 n -> (n, Join, (Cap, Cap), Maybe (DashPattern, n))
forall n (v :: * -> *).
TypeableFloat n =>
Style v n -> (n, Join, (Cap, Cap), Maybe (DashPattern, n))
rasterificStrokeStyle Style V2 n
sty
        canFill :: Bool
canFill      = Getting Any (Path V2 n) (Trail V2 n)
-> (Trail V2 n -> Bool) -> Path V2 n -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf ((Located (Trail V2 n) -> Const Any (Located (Trail V2 n)))
-> Path V2 n -> Const Any (Path V2 n)
forall s a. Cons s s a a => Traversal' s a
_head ((Located (Trail V2 n) -> Const Any (Located (Trail V2 n)))
 -> Path V2 n -> Const Any (Path V2 n))
-> ((Trail V2 n -> Const Any (Trail V2 n))
    -> Located (Trail V2 n) -> Const Any (Located (Trail V2 n)))
-> Getting Any (Path V2 n) (Trail V2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trail V2 n -> Const Any (Trail V2 n))
-> Located (Trail V2 n) -> Const Any (Located (Trail V2 n))
forall a b. SameSpace a b => Lens (Located a) (Located b) a b
located) Trail V2 n -> Bool
forall (v :: * -> *) n. Trail v n -> Bool
isLoop Path V2 n
p Bool -> Bool -> Bool
&& (Texture n
f Texture n
-> Getting
     (First (AlphaColour Double)) (Texture n) (AlphaColour Double)
-> Maybe (AlphaColour Double)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First (AlphaColour Double)) (Texture n) (AlphaColour Double)
forall n. Prism' (Texture n) (AlphaColour Double)
_AC) Maybe (AlphaColour Double) -> Maybe (AlphaColour Double) -> Bool
forall a. Eq a => a -> a -> Bool
/= AlphaColour Double -> Maybe (AlphaColour Double)
forall a. a -> Maybe a
Just AlphaColour Double
forall a. Num a => AlphaColour a
transparent
        rule :: FillMethod
rule         = FillRule -> FillMethod
fromFillRule FillRule
r

        -- For stroking we need to keep all of the contours separate.
        primList :: [[Primitive]]
primList = Path V2 n -> [[Primitive]]
forall n. TypeableFloat n => Path V2 n -> [[Primitive]]
renderPath Path V2 n
p

        -- For filling we need to concatenate them into a flat list.
        prms :: [Primitive]
prms = [[Primitive]] -> [Primitive]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Primitive]]
primList

    Bool -> RenderM n () -> RenderM n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
canFill (RenderM n () -> RenderM n ()) -> RenderM n () -> RenderM n ()
forall a b. (a -> b) -> a -> b
$
      Drawing PixelRGBA8 () -> RenderM n ()
forall a n. RenderR a -> RenderM n a
liftR (Texture PixelRGBA8
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px. Texture px -> Drawing px () -> Drawing px ()
R.withTexture (Texture n -> Double -> Texture PixelRGBA8
forall n.
TypeableFloat n =>
Texture n -> Double -> Texture PixelRGBA8
rasterificTexture Texture n
f Double
o) (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ FillMethod -> [Primitive] -> Drawing PixelRGBA8 ()
forall geom px.
Geometry geom =>
FillMethod -> geom -> Drawing px ()
R.fillWithMethod FillMethod
rule [Primitive]
prms)

    Drawing PixelRGBA8 () -> RenderM n ()
forall a n. RenderR a -> RenderM n a
liftR (Texture PixelRGBA8
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px. Texture px -> Drawing px () -> Drawing px ()
R.withTexture (Texture n -> Double -> Texture PixelRGBA8
forall n.
TypeableFloat n =>
Texture n -> Double -> Texture PixelRGBA8
rasterificTexture Texture n
s Double
o) (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ n
-> Join
-> (Cap, Cap)
-> Maybe (DashPattern, n)
-> [[Primitive]]
-> Drawing PixelRGBA8 ()
forall n.
TypeableFloat n =>
n
-> Join
-> (Cap, Cap)
-> Maybe (DashPattern, n)
-> [[Primitive]]
-> Drawing PixelRGBA8 ()
mkStroke n
l Join
j (Cap, Cap)
c Maybe (DashPattern, n)
d [[Primitive]]
primList)

instance TypeableFloat n => Renderable (Text n) Rasterific where
  render :: Rasterific -> Text n -> Render Rasterific (V (Text n)) (N (Text n))
render Rasterific
_ (Text T2 n
tr TextAlignment n
al String
str) = RenderM n () -> Render Rasterific V2 n
forall n. RenderM n () -> Render Rasterific V2 n
R (RenderM n () -> Render Rasterific V2 n)
-> RenderM n () -> Render Rasterific V2 n
forall a b. (a -> b) -> a -> b
$ do
    n
fs    <- LensLike' (Const n) (Style V2 n) (Maybe n)
-> (Maybe n -> n) -> ReaderT (Style V2 n) RenderR n
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const n) (Style V2 n) (Maybe n)
forall n (v :: * -> *). Typeable n => Lens' (Style v n) (Maybe n)
_fontSizeU (n -> Maybe n -> n
forall a. a -> Maybe a -> a
fromMaybe n
12)
    FontSlant
slant <- Getting FontSlant (Style V2 n) FontSlant
-> ReaderT (Style V2 n) RenderR FontSlant
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FontSlant (Style V2 n) FontSlant
forall (v :: * -> *) n. Lens' (Style v n) FontSlant
_fontSlant
    FontWeight
fw    <- Getting FontWeight (Style V2 n) FontWeight
-> ReaderT (Style V2 n) RenderR FontWeight
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FontWeight (Style V2 n) FontWeight
forall (v :: * -> *) n. Lens' (Style v n) FontWeight
_fontWeight
    Texture n
f     <- Getting (Texture n) (Style V2 n) (Texture n)
-> ReaderT (Style V2 n) RenderR (Texture n)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Texture n) (Style V2 n) (Texture n)
forall n.
(Typeable n, Floating n) =>
Lens' (Style V2 n) (Texture n)
_fillTexture
    Double
o     <- Getting Double (Style V2 n) Double
-> ReaderT (Style V2 n) RenderR Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Double (Style V2 n) Double
forall (v :: * -> *) n. Lens' (Style v n) Double
_opacity
    let fColor :: Texture PixelRGBA8
fColor = Texture n -> Double -> Texture PixelRGBA8
forall n.
TypeableFloat n =>
Texture n -> Double -> Texture PixelRGBA8
rasterificTexture Texture n
f Double
o
        fs' :: PointSize
fs'    = Float -> PointSize
R.PointSize (n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac n
fs)
        fnt :: Font
fnt    = FontSlant -> FontWeight -> Font
fromFontStyle FontSlant
slant FontWeight
fw
        bb :: BoundingBox V2 n
bb     = Font -> PointSize -> String -> BoundingBox V2 n
forall n.
RealFloat n =>
Font -> PointSize -> String -> BoundingBox V2 n
textBoundingBox Font
fnt PointSize
fs' String
str
        p :: Point
p      = case TextAlignment n
al of
          TextAlignment n
BaselineText         -> Float -> Float -> Point
forall a. a -> a -> V2 a
R.V2 Float
0 Float
0
          BoxAlignedText n
xt n
yt -> case BoundingBox V2 n -> Maybe (Point V2 n, Point V2 n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox V2 n
bb of
            Just (P (V2 n
xl n
yl), P (V2 n
xu n
yu)) -> Float -> Float -> Point
forall a. a -> a -> V2 a
R.V2 (-n -> n -> n -> Float
forall a b. (Real a, Fractional b) => a -> a -> a -> b
lerp' n
xt n
xu n
xl) (n -> n -> n -> Float
forall a b. (Real a, Fractional b) => a -> a -> a -> b
lerp' n
yt n
yu n
yl)
            Maybe (Point V2 n, Point V2 n)
Nothing                           -> Float -> Float -> Point
forall a. a -> a -> V2 a
R.V2 Float
0 Float
0
    Drawing PixelRGBA8 () -> RenderM n ()
forall a n. RenderR a -> RenderM n a
liftR (Transformation -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px. Transformation -> Drawing px () -> Drawing px ()
R.withTransformation (T2 n -> Transformation
forall n. TypeableFloat n => T2 n -> Transformation
rasterificMatTransf (T2 n
tr T2 n -> T2 n -> T2 n
forall a. Semigroup a => a -> a -> a
<> T2 n
forall (v :: * -> *) n.
(Additive v, R2 v, Num n) =>
Transformation v n
reflectionY))
          (Texture PixelRGBA8
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px. Texture px -> Drawing px () -> Drawing px ()
R.withTexture Texture PixelRGBA8
fColor (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ Font -> PointSize -> Point -> String -> Drawing PixelRGBA8 ()
forall px. Font -> PointSize -> Point -> String -> Drawing px ()
R.printTextAt Font
fnt PointSize
fs' Point
p String
str))
    where
      lerp' :: a -> a -> a -> b
lerp' a
t a
u a
v = a -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
t a -> a -> a
forall a. Num a => a -> a -> a
* a
u a -> a -> a
forall a. Num a => a -> a -> a
+ (a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
t) a -> a -> a
forall a. Num a => a -> a -> a
* a
v

toImageRGBA8 :: DynamicImage -> Image PixelRGBA8
toImageRGBA8 :: DynamicImage -> Image PixelRGBA8
toImageRGBA8 (ImageRGBA8 Image PixelRGBA8
i)  = Image PixelRGBA8
i
toImageRGBA8 (ImageRGB8 Image PixelRGB8
i)   = Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelRGB8
i
toImageRGBA8 (ImageYCbCr8 Image PixelYCbCr8
i) = Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelYCbCr8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelYCbCr8
i :: Image PixelRGB8)
toImageRGBA8 (ImageY8 Image Pixel8
i)     = Image Pixel8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image Pixel8
i
toImageRGBA8 (ImageYA8 Image PixelYA8
i)    = Image PixelYA8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelYA8
i
toImageRGBA8 (ImageCMYK8 Image PixelCMYK8
i)  = Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK8
i :: Image PixelRGB8)
toImageRGBA8 DynamicImage
_               = String -> Image PixelRGBA8
forall a. HasCallStack => String -> a
error String
"Unsupported Pixel type"

instance TypeableFloat n => Renderable (DImage n Embedded) Rasterific where
  render :: Rasterific
-> DImage n Embedded
-> Render
     Rasterific (V (DImage n Embedded)) (N (DImage n Embedded))
render Rasterific
_ (DImage ImageData Embedded
iD Int
w Int
h Transformation V2 n
tr) = RenderM n () -> Render Rasterific V2 n
forall n. RenderM n () -> Render Rasterific V2 n
R (RenderM n () -> Render Rasterific V2 n)
-> RenderM n () -> Render Rasterific V2 n
forall a b. (a -> b) -> a -> b
$ Drawing PixelRGBA8 () -> RenderM n ()
forall a n. RenderR a -> RenderM n a
liftR
                               (Transformation -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px. Transformation -> Drawing px () -> Drawing px ()
R.withTransformation
                               (Transformation V2 n -> Transformation
forall n. TypeableFloat n => T2 n -> Transformation
rasterificMatTransf (Transformation V2 n
tr Transformation V2 n -> Transformation V2 n -> Transformation V2 n
forall a. Semigroup a => a -> a -> a
<> Transformation V2 n
forall (v :: * -> *) n.
(Additive v, R2 v, Num n) =>
Transformation v n
reflectionY))
                               (Image PixelRGBA8 -> Float -> Point -> Drawing PixelRGBA8 ()
forall px. Image px -> Float -> Point -> Drawing px ()
R.drawImage Image PixelRGBA8
img Float
0 Point
p))
    where
      ImageRaster DynamicImage
dImg = ImageData Embedded
iD
      img :: Image PixelRGBA8
img = DynamicImage -> Image PixelRGBA8
toImageRGBA8 DynamicImage
dImg
      trl :: Transformation V2 n
trl = V2 n -> Transformation V2 n -> Transformation V2 n
forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, HasOrigin t) =>
v n -> t -> t
moveOriginBy ((n, n) -> V2 n
forall n. (n, n) -> V2 n
r2 (Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
2, Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
2 :: n)) Transformation V2 n
forall a. Monoid a => a
mempty
      p :: Point
p   = Transformation V2 n -> Point -> Point
forall n. TypeableFloat n => T2 n -> Point -> Point
rasterificPtTransf Transformation V2 n
trl (Float -> Float -> Point
forall a. a -> a -> V2 a
R.V2 Float
0 Float
0)

-- Saving files --------------------------------------------------------

-- | Render a 'Rasterific' diagram to a jpeg file with given quality
--   (between 0 and 100).
writeJpeg :: Word8 -> FilePath -> Result Rasterific V2 n -> IO ()
writeJpeg :: Pixel8 -> String -> Result Rasterific V2 n -> IO ()
writeJpeg Pixel8
quality String
outFile Result Rasterific V2 n
img = String -> ByteString -> IO ()
L.writeFile String
outFile ByteString
bs
  where
    bs :: ByteString
bs = Pixel8 -> Image PixelYCbCr8 -> ByteString
encodeJpegAtQuality Pixel8
quality ((PixelRGBA8 -> PixelYCbCr8)
-> Image PixelRGBA8 -> Image PixelYCbCr8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap (PixelRGB8 -> PixelYCbCr8
forall a b. ColorSpaceConvertible a b => a -> b
convertPixel (PixelRGB8 -> PixelYCbCr8)
-> (PixelRGBA8 -> PixelRGB8) -> PixelRGBA8 -> PixelYCbCr8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelRGBA8 -> PixelRGB8
forall a b. TransparentPixel a b => a -> b
dropTransparency) Image PixelRGBA8
Result Rasterific V2 n
img)


-- | Render a 'Rasterific' diagram to a pdf bytestring with given width,
-- height, & DPI.
renderPdfBSWithDPI
    :: TypeableFloat n
    => Int
    -> Int
    -> Dpi
    -> SizeSpec V2 n
    -> QDiagram Rasterific V2 n Any
    -> ByteString
renderPdfBSWithDPI :: Int
-> Int
-> Int
-> SizeSpec V2 n
-> QDiagram Rasterific V2 n Any
-> ByteString
renderPdfBSWithDPI Int
w Int
h Int
dpi SizeSpec V2 n
spec QDiagram Rasterific V2 n Any
d = ByteString
bs
  where
    bs :: ByteString
bs    = Int -> Int -> Int -> Drawing PixelRGBA8 () -> ByteString
R.renderDrawingAtDpiToPDF Int
w Int
h Int
dpi (RenderM n () -> Drawing PixelRGBA8 ()
forall n a. TypeableFloat n => RenderM n a -> RenderR a
runRenderM (RenderM n () -> Drawing PixelRGBA8 ())
-> (Render Rasterific V2 n -> RenderM n ())
-> Render Rasterific V2 n
-> Drawing PixelRGBA8 ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Render Rasterific V2 n -> RenderM n ()
forall n. Render Rasterific V2 n -> RenderM n ()
runR (Render Rasterific V2 n -> Drawing PixelRGBA8 ())
-> Render Rasterific V2 n -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ RTree Rasterific V2 n Annotation -> Render Rasterific V2 n
forall n.
TypeableFloat n =>
RTree Rasterific V2 n Annotation -> Render Rasterific V2 n
fromRTree RTree Rasterific V2 n Annotation
rtree)
    rtree :: RTree Rasterific V2 n Annotation
rtree = SizeSpec V2 n
-> QDiagram Rasterific V2 n Any -> RTree Rasterific V2 n Annotation
forall n.
TypeableFloat n =>
SizeSpec V2 n
-> QDiagram Rasterific V2 n Any -> RTree Rasterific V2 n Annotation
rTree SizeSpec V2 n
spec QDiagram Rasterific V2 n Any
d

-- | Render a 'Rasterific' diagram to a pdf bytestring with given width and height
renderPdfBS :: TypeableFloat n => Int -> Int -> SizeSpec V2 n
                             -> QDiagram Rasterific V2 n Any -> ByteString
renderPdfBS :: Int
-> Int
-> SizeSpec V2 n
-> QDiagram Rasterific V2 n Any
-> ByteString
renderPdfBS Int
w Int
h =
    Int
-> Int
-> Int
-> SizeSpec V2 n
-> QDiagram Rasterific V2 n Any
-> ByteString
forall n.
TypeableFloat n =>
Int
-> Int
-> Int
-> SizeSpec V2 n
-> QDiagram Rasterific V2 n Any
-> ByteString
renderPdfBSWithDPI Int
w Int
h Int
96

-- | Render a 'Rasterific' diagram to a pdf file with given width and height
renderPdf :: TypeableFloat n => Int -> Int -> FilePath -> SizeSpec V2 n
                             -> QDiagram Rasterific V2 n Any -> IO ()
renderPdf :: Int
-> Int
-> String
-> SizeSpec V2 n
-> QDiagram Rasterific V2 n Any
-> IO ()
renderPdf Int
w Int
h String
outFile SizeSpec V2 n
spec QDiagram Rasterific V2 n Any
d = String -> ByteString -> IO ()
L.writeFile String
outFile ByteString
bs
  where
    bs :: ByteString
bs = Int
-> Int
-> SizeSpec V2 n
-> QDiagram Rasterific V2 n Any
-> ByteString
forall n.
TypeableFloat n =>
Int
-> Int
-> SizeSpec V2 n
-> QDiagram Rasterific V2 n Any
-> ByteString
renderPdfBS Int
w Int
h SizeSpec V2 n
spec QDiagram Rasterific V2 n Any
d

rTree :: TypeableFloat n => SizeSpec V2 n -> QDiagram Rasterific V2 n Any
                         -> RTree Rasterific V2 n Annotation
rTree :: SizeSpec V2 n
-> QDiagram Rasterific V2 n Any -> RTree Rasterific V2 n Annotation
rTree SizeSpec V2 n
spec QDiagram Rasterific V2 n Any
d = Transformation V2 n
-> QDiagram Rasterific V2 n Any -> RTree Rasterific V2 n Annotation
forall (v :: * -> *) n m b.
(HasLinearMap v, Metric v, Typeable n, OrderedField n, Monoid m,
 Semigroup m) =>
Transformation v n -> QDiagram b v n m -> RTree b v n Annotation
toRTree Transformation V2 n
g2o QDiagram Rasterific V2 n Any
d'
  where
  (Options Rasterific V2 n
_, Transformation V2 n
g2o, QDiagram Rasterific V2 n Any
d') = Rasterific
-> Options Rasterific V2 n
-> QDiagram Rasterific V2 n Any
-> (Options Rasterific V2 n, Transformation V2 n,
    QDiagram Rasterific V2 n Any)
forall b (v :: * -> *) n m.
(Backend b v n, Additive v, Monoid' m, Num n) =>
b
-> Options b v n
-> QDiagram b v n m
-> (Options b v n, Transformation v n, QDiagram b v n m)
adjustDia Rasterific
Rasterific (SizeSpec V2 n -> Options Rasterific V2 n
forall n. SizeSpec V2 n -> Options Rasterific V2 n
RasterificOptions SizeSpec V2 n
spec) QDiagram Rasterific V2 n Any
d

-- | Render a 'Rasterific' diagram to a file with the given size. The
--   format is determined by the extension (@.png@, @.tif@, @.bmp@, @.jpg@ and
--   @.pdf@ supported. (jpeg quality is 80, use 'writeJpeg' to choose
--   quality).
renderRasterific :: TypeableFloat n => FilePath -> SizeSpec V2 n
                 -> QDiagram Rasterific V2 n Any -> IO ()
renderRasterific :: String -> SizeSpec V2 n -> QDiagram Rasterific V2 n Any -> IO ()
renderRasterific String
outFile SizeSpec V2 n
spec QDiagram Rasterific V2 n Any
d =
  case ShowS
takeExtension String
outFile of
    String
".png" -> String -> Image PixelRGBA8 -> IO ()
forall pixel. PngSavable pixel => String -> Image pixel -> IO ()
writePng String
outFile Image PixelRGBA8
Result Rasterific V2 n
img
    String
".tif" -> String -> Image PixelRGBA8 -> IO ()
forall pixel. TiffSaveable pixel => String -> Image pixel -> IO ()
writeTiff String
outFile Image PixelRGBA8
Result Rasterific V2 n
img
    String
".bmp" -> String -> Image PixelRGBA8 -> IO ()
forall pixel. BmpEncodable pixel => String -> Image pixel -> IO ()
writeBitmap String
outFile Image PixelRGBA8
Result Rasterific V2 n
img
    String
".jpg" -> Pixel8 -> String -> Result Rasterific V2 Any -> IO ()
forall n. Pixel8 -> String -> Result Rasterific V2 n -> IO ()
writeJpeg Pixel8
80 String
outFile Result Rasterific V2 n
Result Rasterific V2 Any
img
    -- pdfs need to be handle separately since rasterific makes them
    -- directely from drawings. i.e. they don't need to be converted to images.
    String
".pdf" -> Int
-> Int
-> String
-> SizeSpec V2 n
-> QDiagram Rasterific V2 n Any
-> IO ()
forall n.
TypeableFloat n =>
Int
-> Int
-> String
-> SizeSpec V2 n
-> QDiagram Rasterific V2 n Any
-> IO ()
renderPdf (n -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round n
w) (n -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round n
h) String
outFile SizeSpec V2 n
spec QDiagram Rasterific V2 n Any
d
    String
_      -> String -> Image PixelRGBA8 -> IO ()
forall pixel. PngSavable pixel => String -> Image pixel -> IO ()
writePng String
outFile Image PixelRGBA8
Result Rasterific V2 n
img
  where
    img :: Result Rasterific V2 n
img = Rasterific
-> Options Rasterific V2 n
-> QDiagram Rasterific V2 n Any
-> Result Rasterific V2 n
forall b (v :: * -> *) n m.
(Backend b v n, HasLinearMap v, Metric v, Typeable n,
 OrderedField n, Monoid' m) =>
b -> Options b v n -> QDiagram b v n m -> Result b v n
renderDia Rasterific
Rasterific (SizeSpec V2 n -> Options Rasterific V2 n
forall n. SizeSpec V2 n -> Options Rasterific V2 n
RasterificOptions SizeSpec V2 n
spec) QDiagram Rasterific V2 n Any
d
    (n
w, n
h) = n -> SizeSpec V2 n -> (n, n)
forall a. (Fractional a, Ord a) => a -> SizeSpec V2 a -> (a, a)
specToDims (QDiagram Rasterific V2 n Any -> N (QDiagram Rasterific V2 n Any)
forall a. (V a ~ V2, Enveloped a) => a -> N a
aspectRatio QDiagram Rasterific V2 n Any
d) SizeSpec V2 n
spec

aspectRatio :: (V a ~ V2, Enveloped a) => a -> N a
aspectRatio :: a -> N a
aspectRatio a
d = N a
h N a -> N a -> N a
forall a. Fractional a => a -> a -> a
/ N a
w
  where
    V2 N a
w N a
h = BoundingBox V2 (N a) -> V2 (N a)
forall (v :: * -> *) n.
(Additive v, Num n) =>
BoundingBox v n -> v n
boxExtents (a -> BoundingBox V2 (N a)
forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> BoundingBox v n
boundingBox a
d)

specToDims :: (Fractional a, Ord a) => a -> SizeSpec V2 a -> (a, a)
specToDims :: a -> SizeSpec V2 a -> (a, a)
specToDims a
ar SizeSpec V2 a
s =
  case SizeSpec V2 a -> V2 (Maybe a)
forall (v :: * -> *) n.
(Functor v, Num n, Ord n) =>
SizeSpec v n -> v (Maybe n)
getSpec SizeSpec V2 a
s of
    V2 (Just a
w) (Just a
h) -> (a
w, a
h)
    V2 (Just a
w) Maybe a
Nothing  -> (a
w, a
ar a -> a -> a
forall a. Num a => a -> a -> a
* a
w)
    V2 Maybe a
Nothing (Just a
h)  -> (a
h a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
ar, a
h)
    V2 Maybe a
Nothing Maybe a
Nothing   -> (a
100, a
100)


-- | Render a 'Rasterific' diagram to an animated gif with the given
--   size and uniform delay. Diagrams should be the same size.
animatedGif
  :: TypeableFloat n
  => FilePath
  -> SizeSpec V2 n
  -> GifLooping
  -> GifDelay -- ^ Delay in 100th of seconds ('Int')
  -> [QDiagram Rasterific V2 n Any] -> IO ()
animatedGif :: String
-> SizeSpec V2 n
-> GifLooping
-> Int
-> [QDiagram Rasterific V2 n Any]
-> IO ()
animatedGif String
outFile SizeSpec V2 n
sz GifLooping
gOpts Int
i [QDiagram Rasterific V2 n Any]
ds =
  case SizeSpec V2 n
-> GifLooping
-> PaletteOptions
-> [(QDiagram Rasterific V2 n Any, Int)]
-> Either String ByteString
forall n.
TypeableFloat n =>
SizeSpec V2 n
-> GifLooping
-> PaletteOptions
-> [(QDiagram Rasterific V2 n Any, Int)]
-> Either String ByteString
rasterGif SizeSpec V2 n
sz GifLooping
gOpts PaletteOptions
defaultPaletteOptions ((QDiagram Rasterific V2 n Any
 -> (QDiagram Rasterific V2 n Any, Int))
-> [QDiagram Rasterific V2 n Any]
-> [(QDiagram Rasterific V2 n Any, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (,Int
i) [QDiagram Rasterific V2 n Any]
ds) of
    Right ByteString
bs -> String -> ByteString -> IO ()
L.writeFile String
outFile ByteString
bs
    Left String
e   -> String -> IO ()
putStrLn String
e

-- Gifs ----------------------------------------------------------------

-- | Turn a list of diagrams into a gif.
rasterGif
  :: TypeableFloat n
  => SizeSpec V2 n            -- ^ Size of output (in pixels)
  -> GifLooping               -- ^ looping options
  -> PaletteOptions           -- ^ palette options
  -> [(QDiagram Rasterific V2 n Any, Int)]  -- ^ Diagram zipped with its delay (100th of seconds)
  -> Either String ByteString
rasterGif :: SizeSpec V2 n
-> GifLooping
-> PaletteOptions
-> [(QDiagram Rasterific V2 n Any, Int)]
-> Either String ByteString
rasterGif SizeSpec V2 n
sz GifLooping
gOpts PaletteOptions
pOpts [(QDiagram Rasterific V2 n Any, Int)]
ds = GifLooping
-> [(Image PixelRGB8, Int, Image Pixel8)]
-> Either String ByteString
encodeGifImages GifLooping
gOpts (((Image PixelRGB8, Int) -> (Image PixelRGB8, Int, Image Pixel8))
-> [(Image PixelRGB8, Int)]
-> [(Image PixelRGB8, Int, Image Pixel8)]
forall a b. (a -> b) -> [a] -> [b]
map (Image PixelRGB8, Int) -> (Image PixelRGB8, Int, Image Pixel8)
pal [(Image PixelRGB8, Int)]
imgs)
  where
    imgs :: [(Image PixelRGB8, Int)]
imgs = ASetter
  [(QDiagram Rasterific V2 n Any, Int)]
  [(Image PixelRGB8, Int)]
  (QDiagram Rasterific V2 n Any)
  (Image PixelRGB8)
-> (QDiagram Rasterific V2 n Any -> Image PixelRGB8)
-> [(QDiagram Rasterific V2 n Any, Int)]
-> [(Image PixelRGB8, Int)]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((QDiagram Rasterific V2 n Any, Int)
 -> Identity (Image PixelRGB8, Int))
-> [(QDiagram Rasterific V2 n Any, Int)]
-> Identity [(Image PixelRGB8, Int)]
forall s t a b. Each s t a b => Traversal s t a b
each (((QDiagram Rasterific V2 n Any, Int)
  -> Identity (Image PixelRGB8, Int))
 -> [(QDiagram Rasterific V2 n Any, Int)]
 -> Identity [(Image PixelRGB8, Int)])
-> ((QDiagram Rasterific V2 n Any -> Identity (Image PixelRGB8))
    -> (QDiagram Rasterific V2 n Any, Int)
    -> Identity (Image PixelRGB8, Int))
-> ASetter
     [(QDiagram Rasterific V2 n Any, Int)]
     [(Image PixelRGB8, Int)]
     (QDiagram Rasterific V2 n Any)
     (Image PixelRGB8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QDiagram Rasterific V2 n Any -> Identity (Image PixelRGB8))
-> (QDiagram Rasterific V2 n Any, Int)
-> Identity (Image PixelRGB8, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1) (SizeSpec V2 n -> QDiagram Rasterific V2 n Any -> Image PixelRGB8
forall n.
TypeableFloat n =>
SizeSpec V2 n -> QDiagram Rasterific V2 n Any -> Image PixelRGB8
rasterRgb8 SizeSpec V2 n
sz) [(QDiagram Rasterific V2 n Any, Int)]
ds
    pal :: (Image PixelRGB8, Int) -> (Image PixelRGB8, Int, Image Pixel8)
pal (PaletteOptions
-> Image PixelRGB8 -> (Image Pixel8, Image PixelRGB8)
palettize PaletteOptions
pOpts -> (Image Pixel8
img,Image PixelRGB8
p), Int
d) = (Image PixelRGB8
p, Int
d, Image Pixel8
img)

-- | Render a 'Rasterific' diagram without an alpha channel.
rasterRgb8 :: TypeableFloat n
           => SizeSpec V2 n
           -> QDiagram Rasterific V2 n Any
           -> Image PixelRGB8
rasterRgb8 :: SizeSpec V2 n -> QDiagram Rasterific V2 n Any -> Image PixelRGB8
rasterRgb8 SizeSpec V2 n
sz
  = (PixelRGBA8 -> PixelRGB8) -> Image PixelRGBA8 -> Image PixelRGB8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap PixelRGBA8 -> PixelRGB8
forall a b. TransparentPixel a b => a -> b
dropTransparency
  (Image PixelRGBA8 -> Image PixelRGB8)
-> (QDiagram Rasterific V2 n Any -> Image PixelRGBA8)
-> QDiagram Rasterific V2 n Any
-> Image PixelRGB8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rasterific
-> Options Rasterific V2 n
-> QDiagram Rasterific V2 n Any
-> Result Rasterific V2 n
forall b (v :: * -> *) n m.
(Backend b v n, HasLinearMap v, Metric v, Typeable n,
 OrderedField n, Monoid' m) =>
b -> Options b v n -> QDiagram b v n m -> Result b v n
renderDia Rasterific
Rasterific (SizeSpec V2 n -> Options Rasterific V2 n
forall n. SizeSpec V2 n -> Options Rasterific V2 n
RasterificOptions SizeSpec V2 n
sz)