{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module Diagrams.Backend.Canvas
( Canvas(..)
, B
, Options(..)
, renderCanvas
) where
import Control.Lens hiding (transform, (#))
import Control.Monad (when)
import Control.Monad.State (State, evalState)
import qualified Control.Monad.StateStack as SS
import Control.Monad.Trans (lift)
import Data.Default
import qualified Data.Foldable as F
import Data.Maybe (catMaybes, isJust, fromJust, fromMaybe)
import Data.NumInstances ()
import qualified Data.Text as T
import Data.Tree (Tree(Node))
import Data.Typeable (Typeable)
import Data.Word (Word8)
import Diagrams.Attributes
import Diagrams.Prelude hiding (fillTexture, moveTo, stroke, size)
import Diagrams.TwoD.Adjust (adjustDia2D)
import Diagrams.TwoD.Attributes (splitTextureFills)
import Diagrams.TwoD.Path (Clip (Clip))
import Diagrams.TwoD.Text
import Diagrams.Core.Compile
import Diagrams.Core.Transform (matrixHomRep)
import Diagrams.Core.Types (Annotation (..))
import qualified Graphics.Blank as BC
import qualified Graphics.Blank.Style as S
data Canvas = Canvas
deriving (Canvas -> Canvas -> Bool
(Canvas -> Canvas -> Bool)
-> (Canvas -> Canvas -> Bool) -> Eq Canvas
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Canvas -> Canvas -> Bool
== :: Canvas -> Canvas -> Bool
$c/= :: Canvas -> Canvas -> Bool
/= :: Canvas -> Canvas -> Bool
Eq, Eq Canvas
Eq Canvas =>
(Canvas -> Canvas -> Ordering)
-> (Canvas -> Canvas -> Bool)
-> (Canvas -> Canvas -> Bool)
-> (Canvas -> Canvas -> Bool)
-> (Canvas -> Canvas -> Bool)
-> (Canvas -> Canvas -> Canvas)
-> (Canvas -> Canvas -> Canvas)
-> Ord Canvas
Canvas -> Canvas -> Bool
Canvas -> Canvas -> Ordering
Canvas -> Canvas -> Canvas
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
$ccompare :: Canvas -> Canvas -> Ordering
compare :: Canvas -> Canvas -> Ordering
$c< :: Canvas -> Canvas -> Bool
< :: Canvas -> Canvas -> Bool
$c<= :: Canvas -> Canvas -> Bool
<= :: Canvas -> Canvas -> Bool
$c> :: Canvas -> Canvas -> Bool
> :: Canvas -> Canvas -> Bool
$c>= :: Canvas -> Canvas -> Bool
>= :: Canvas -> Canvas -> Bool
$cmax :: Canvas -> Canvas -> Canvas
max :: Canvas -> Canvas -> Canvas
$cmin :: Canvas -> Canvas -> Canvas
min :: Canvas -> Canvas -> Canvas
Ord, ReadPrec [Canvas]
ReadPrec Canvas
Int -> ReadS Canvas
ReadS [Canvas]
(Int -> ReadS Canvas)
-> ReadS [Canvas]
-> ReadPrec Canvas
-> ReadPrec [Canvas]
-> Read Canvas
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Canvas
readsPrec :: Int -> ReadS Canvas
$creadList :: ReadS [Canvas]
readList :: ReadS [Canvas]
$creadPrec :: ReadPrec Canvas
readPrec :: ReadPrec Canvas
$creadListPrec :: ReadPrec [Canvas]
readListPrec :: ReadPrec [Canvas]
Read, Int -> Canvas -> ShowS
[Canvas] -> ShowS
Canvas -> String
(Int -> Canvas -> ShowS)
-> (Canvas -> String) -> ([Canvas] -> ShowS) -> Show Canvas
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Canvas -> ShowS
showsPrec :: Int -> Canvas -> ShowS
$cshow :: Canvas -> String
show :: Canvas -> String
$cshowList :: [Canvas] -> ShowS
showList :: [Canvas] -> ShowS
Show, Typeable)
type B = Canvas
type instance V Canvas = V2
type instance N Canvas = Double
data CanvasState = CanvasState { CanvasState -> Style V2 Double
_accumStyle :: Style V2 Double
, CanvasState -> (Double, Double)
_csPos :: (Double, Double) }
makeLenses ''CanvasState
instance Default CanvasState where
def :: CanvasState
def = CanvasState { _accumStyle :: Style V2 Double
_accumStyle = Style V2 Double
forall a. Monoid a => a
mempty
, _csPos :: (Double, Double)
_csPos = (Double
0,Double
0) }
type RenderM a = SS.StateStackT CanvasState BC.Canvas a
liftC :: BC.Canvas a -> RenderM a
liftC :: forall a. Canvas a -> RenderM a
liftC = Canvas a -> StateStackT CanvasState Canvas a
forall (m :: * -> *) a.
Monad m =>
m a -> StateStackT CanvasState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
runRenderM :: RenderM a -> BC.Canvas a
runRenderM :: forall a. RenderM a -> Canvas a
runRenderM = (RenderM a -> CanvasState -> Canvas a)
-> CanvasState -> RenderM a -> Canvas a
forall a b c. (a -> b -> c) -> b -> a -> c
flip RenderM a -> CanvasState -> Canvas a
forall (m :: * -> *) s a. Monad m => StateStackT s m a -> s -> m a
SS.evalStateStackT CanvasState
forall a. Default a => a
def
instance Semigroup (Render Canvas V2 Double) where
C RenderM ()
c1 <> :: Render Canvas V2 Double
-> Render Canvas V2 Double -> Render Canvas V2 Double
<> C RenderM ()
c2 = RenderM () -> Render Canvas V2 Double
C (RenderM ()
c1 RenderM () -> RenderM () -> RenderM ()
forall a b.
StateStackT CanvasState Canvas a
-> StateStackT CanvasState Canvas b
-> StateStackT CanvasState Canvas b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RenderM ()
c2)
instance Monoid (Render Canvas V2 Double) where
mempty :: Render Canvas V2 Double
mempty = RenderM () -> Render Canvas V2 Double
C (RenderM () -> Render Canvas V2 Double)
-> RenderM () -> Render Canvas V2 Double
forall a b. (a -> b) -> a -> b
$ () -> RenderM ()
forall a. a -> StateStackT CanvasState Canvas a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if !MIN_VERSION_base(4,11,0)
mappend = (<>)
#endif
instance Backend Canvas V2 Double where
data Render Canvas V2 Double = C (RenderM ())
type Result Canvas V2 Double = BC.Canvas ()
data Options Canvas V2 Double = CanvasOptions
{ Options Canvas V2 Double -> SizeSpec V2 Double
_canvasSize :: SizeSpec V2 Double
}
renderRTree :: Canvas -> Options Canvas V2 Double -> RTree Canvas V2 Double Annotation
-> Result Canvas V2 Double
renderRTree :: Canvas
-> Options Canvas V2 Double
-> RTree Canvas V2 Double Annotation
-> Result Canvas V2 Double
renderRTree Canvas
_ Options Canvas V2 Double
_ RTree Canvas V2 Double Annotation
rt = State CanvasRenderState (Canvas ())
-> CanvasRenderState -> Canvas ()
forall s a. State s a -> s -> a
evalState State CanvasRenderState (Canvas ())
canvasOutput CanvasRenderState
initialCanvasRenderState
where
canvasOutput :: State CanvasRenderState (BC.Canvas ())
canvasOutput :: State CanvasRenderState (Canvas ())
canvasOutput = do
let C RenderM ()
r = RTree Canvas V2 Double Annotation -> Render Canvas V2 Double
toRender RTree Canvas V2 Double Annotation
rt
Canvas () -> State CanvasRenderState (Canvas ())
forall a. a -> StateT CanvasRenderState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Canvas () -> State CanvasRenderState (Canvas ()))
-> Canvas () -> State CanvasRenderState (Canvas ())
forall a b. (a -> b) -> a -> b
$ RenderM () -> Canvas ()
forall a. RenderM a -> Canvas a
runRenderM (RenderM () -> Canvas ()) -> RenderM () -> Canvas ()
forall a b. (a -> b) -> a -> b
$ RenderM ()
r
adjustDia :: forall m.
(Additive V2, Monoid' m, Num Double) =>
Canvas
-> Options Canvas V2 Double
-> QDiagram Canvas V2 Double m
-> (Options Canvas V2 Double, Transformation V2 Double,
QDiagram Canvas V2 Double m)
adjustDia Canvas
c Options Canvas V2 Double
opts QDiagram Canvas V2 Double m
d = Lens' (Options Canvas V2 Double) (SizeSpec V2 Double)
-> Canvas
-> Options Canvas V2 Double
-> QDiagram Canvas V2 Double m
-> (Options Canvas V2 Double, Transformation V2 Double,
QDiagram Canvas V2 Double 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 (SizeSpec V2 Double -> f (SizeSpec V2 Double))
-> Options Canvas V2 Double -> f (Options Canvas V2 Double)
Lens' (Options Canvas V2 Double) (SizeSpec V2 Double)
size Canvas
c Options Canvas V2 Double
opts (QDiagram Canvas V2 Double m
d QDiagram Canvas V2 Double m
-> (QDiagram Canvas V2 Double m -> QDiagram Canvas V2 Double m)
-> QDiagram Canvas V2 Double m
forall a b. a -> (a -> b) -> b
# QDiagram Canvas V2 Double m -> QDiagram Canvas V2 Double m
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY)
runC :: Render Canvas V2 Double -> RenderM ()
runC :: Render Canvas V2 Double -> RenderM ()
runC (C RenderM ()
r) = RenderM ()
r
toRender :: RTree Canvas V2 Double Annotation -> Render Canvas V2 Double
toRender :: RTree Canvas V2 Double Annotation -> Render Canvas V2 Double
toRender = RTree Canvas V2 Double Annotation -> Render Canvas V2 Double
forall {b} {a}.
Renderable (Prim b V2 Double) Canvas =>
Tree (RNode b V2 Double a) -> Render Canvas V2 Double
fromRTree
(RTree Canvas V2 Double Annotation -> Render Canvas V2 Double)
-> (RTree Canvas V2 Double Annotation
-> RTree Canvas V2 Double Annotation)
-> RTree Canvas V2 Double Annotation
-> Render Canvas V2 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RNode Canvas V2 Double Annotation
-> [RTree Canvas V2 Double Annotation]
-> RTree Canvas V2 Double Annotation
forall a. a -> [Tree a] -> Tree a
Node (Style V2 Double -> RNode Canvas V2 Double Annotation
forall b (v :: * -> *) n a. Style v n -> RNode b v n a
RStyle (Style V2 Double
forall a. Monoid a => a
mempty Style V2 Double
-> (Style V2 Double -> Style V2 Double) -> Style V2 Double
forall a b. a -> (a -> b) -> b
# AlphaColour Double -> Style V2 Double -> Style V2 Double
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 :: AlphaColour Double)))
([RTree Canvas V2 Double Annotation]
-> RTree Canvas V2 Double Annotation)
-> (RTree Canvas V2 Double Annotation
-> [RTree Canvas V2 Double Annotation])
-> RTree Canvas V2 Double Annotation
-> RTree Canvas V2 Double Annotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RTree Canvas V2 Double Annotation
-> [RTree Canvas V2 Double Annotation]
-> [RTree Canvas V2 Double Annotation]
forall a. a -> [a] -> [a]
:[])
(RTree Canvas V2 Double Annotation
-> [RTree Canvas V2 Double Annotation])
-> (RTree Canvas V2 Double Annotation
-> RTree Canvas V2 Double Annotation)
-> RTree Canvas V2 Double Annotation
-> [RTree Canvas V2 Double Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTree Canvas V2 Double Annotation
-> RTree Canvas V2 Double Annotation
forall b (v :: * -> *) n a.
Typeable n =>
RTree b v n a -> RTree b v n a
splitTextureFills
where
fromRTree :: Tree (RNode b V2 Double a) -> Render Canvas V2 Double
fromRTree (Node (RPrim Prim b V2 Double
p) [Tree (RNode b V2 Double a)]
_) = Canvas
-> Prim b V2 Double
-> Render Canvas (V (Prim b V2 Double)) (N (Prim b V2 Double))
forall t b. Renderable t b => b -> t -> Render b (V t) (N t)
render Canvas
Canvas Prim b V2 Double
p
fromRTree (Node (RStyle Style V2 Double
sty) [Tree (RNode b V2 Double a)]
rs) = RenderM () -> Render Canvas V2 Double
C (RenderM () -> Render Canvas V2 Double)
-> RenderM () -> Render Canvas V2 Double
forall a b. (a -> b) -> a -> b
$ do
RenderM ()
save
Style V2 Double -> RenderM ()
forall (v :: * -> *). Style v Double -> RenderM ()
canvasStyle Style V2 Double
sty
(Style V2 Double -> Identity (Style V2 Double))
-> CanvasState -> Identity CanvasState
Lens' CanvasState (Style V2 Double)
accumStyle ((Style V2 Double -> Identity (Style V2 Double))
-> CanvasState -> Identity CanvasState)
-> (Style V2 Double -> Style V2 Double) -> RenderM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Style V2 Double -> Style V2 Double -> Style V2 Double
forall a. Semigroup a => a -> a -> a
<> Style V2 Double
sty)
Render Canvas V2 Double -> RenderM ()
runC (Render Canvas V2 Double -> RenderM ())
-> Render Canvas V2 Double -> RenderM ()
forall a b. (a -> b) -> a -> b
$ (Tree (RNode b V2 Double a) -> Render Canvas V2 Double)
-> [Tree (RNode b V2 Double a)] -> Render Canvas V2 Double
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap Tree (RNode b V2 Double a) -> Render Canvas V2 Double
fromRTree [Tree (RNode b V2 Double a)]
rs
RenderM ()
restore
fromRTree (Node RNode b V2 Double a
_ [Tree (RNode b V2 Double a)]
rs) = (Tree (RNode b V2 Double a) -> Render Canvas V2 Double)
-> [Tree (RNode b V2 Double a)] -> Render Canvas V2 Double
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap Tree (RNode b V2 Double a) -> Render Canvas V2 Double
fromRTree [Tree (RNode b V2 Double a)]
rs
data CanvasRenderState = CanvasRenderState
initialCanvasRenderState :: CanvasRenderState
initialCanvasRenderState :: CanvasRenderState
initialCanvasRenderState = CanvasRenderState
CanvasRenderState
getSize :: Options Canvas V2 Double -> SizeSpec V2 Double
getSize :: Options Canvas V2 Double -> SizeSpec V2 Double
getSize (CanvasOptions {_canvasSize :: Options Canvas V2 Double -> SizeSpec V2 Double
_canvasSize = SizeSpec V2 Double
s}) = SizeSpec V2 Double
s
setSize :: Options Canvas V2 Double -> (SizeSpec V2 Double) -> Options Canvas V2 Double
setSize :: Options Canvas V2 Double
-> SizeSpec V2 Double -> Options Canvas V2 Double
setSize Options Canvas V2 Double
o SizeSpec V2 Double
s = Options Canvas V2 Double
o {_canvasSize = s}
size :: Lens' (Options Canvas V2 Double)(SizeSpec V2 Double)
size :: Lens' (Options Canvas V2 Double) (SizeSpec V2 Double)
size = (Options Canvas V2 Double -> SizeSpec V2 Double)
-> (Options Canvas V2 Double
-> SizeSpec V2 Double -> Options Canvas V2 Double)
-> Lens' (Options Canvas V2 Double) (SizeSpec V2 Double)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Options Canvas V2 Double -> SizeSpec V2 Double
getSize Options Canvas V2 Double
-> SizeSpec V2 Double -> Options Canvas V2 Double
setSize
move :: (Double, Double) -> RenderM ()
move :: (Double, Double) -> RenderM ()
move (Double, Double)
p = do ((Double, Double) -> Identity (Double, Double))
-> CanvasState -> Identity CanvasState
Lens' CanvasState (Double, Double)
csPos (((Double, Double) -> Identity (Double, Double))
-> CanvasState -> Identity CanvasState)
-> (Double, Double) -> RenderM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Double, Double)
p
save :: RenderM ()
save :: RenderM ()
save = RenderM ()
forall s (m :: * -> *). MonadStateStack s m => m ()
SS.save RenderM () -> RenderM () -> RenderM ()
forall a b.
StateStackT CanvasState Canvas a
-> StateStackT CanvasState Canvas b
-> StateStackT CanvasState Canvas b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (() -> Canvas ()
BC.save ())
restore :: RenderM ()
restore :: RenderM ()
restore = Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (() -> Canvas ()
BC.restore ()) RenderM () -> RenderM () -> RenderM ()
forall a b.
StateStackT CanvasState Canvas a
-> StateStackT CanvasState Canvas b
-> StateStackT CanvasState Canvas b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RenderM ()
forall s (m :: * -> *). MonadStateStack s m => m ()
SS.restore
newPath :: RenderM ()
newPath :: RenderM ()
newPath = Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ()) -> Canvas () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ () -> Canvas ()
BC.beginPath ()
closePath :: RenderM ()
closePath :: RenderM ()
closePath = Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ()) -> Canvas () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ () -> Canvas ()
BC.closePath ()
moveTo :: Double -> Double -> RenderM ()
moveTo :: Double -> Double -> RenderM ()
moveTo Double
x Double
y = do
Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ()) -> Canvas () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ (Double, Double) -> Canvas ()
BC.moveTo (Double
x, Double
y)
(Double, Double) -> RenderM ()
move (Double
x, Double
y)
relLineTo :: Double -> Double -> RenderM ()
relLineTo :: Double -> Double -> RenderM ()
relLineTo Double
x Double
y = do
(Double, Double)
p <- Getting (Double, Double) CanvasState (Double, Double)
-> StateStackT CanvasState Canvas (Double, Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Double, Double) CanvasState (Double, Double)
Lens' CanvasState (Double, Double)
csPos
let p' :: (Double, Double)
p' = (Double, Double)
p (Double, Double) -> (Double, Double) -> (Double, Double)
forall a. Num a => a -> a -> a
+ (Double
x, Double
y)
Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ()) -> Canvas () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ (Double, Double) -> Canvas ()
BC.lineTo (Double, Double)
p'
(Double, Double) -> RenderM ()
move (Double, Double)
p'
relCurveTo :: Double -> Double -> Double -> Double -> Double -> Double -> RenderM ()
relCurveTo :: Double
-> Double -> Double -> Double -> Double -> Double -> RenderM ()
relCurveTo Double
ax Double
ay Double
bx Double
by Double
cx Double
cy = do
(Double, Double)
p <- Getting (Double, Double) CanvasState (Double, Double)
-> StateStackT CanvasState Canvas (Double, Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Double, Double) CanvasState (Double, Double)
Lens' CanvasState (Double, Double)
csPos
let [(Double
ax',Double
ay'),(Double
bx',Double
by'),(Double
cx',Double
cy')] = ((Double, Double) -> (Double, Double))
-> [(Double, Double)] -> [(Double, Double)]
forall a b. (a -> b) -> [a] -> [b]
map ((Double, Double)
p (Double, Double) -> (Double, Double) -> (Double, Double)
forall a. Num a => a -> a -> a
+) [(Double
ax,Double
ay),(Double
bx,Double
by),(Double
cx,Double
cy)]
Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ()) -> Canvas () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ (Double, Double, Double, Double, Double, Double) -> Canvas ()
BC.bezierCurveTo (Double
ax',Double
ay',Double
bx',Double
by',Double
cx',Double
cy')
(Double, Double) -> RenderM ()
move (Double
cx', Double
cy')
getStyleAttrib :: AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib :: forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib a -> b
f = ((a -> b) -> Maybe a -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Maybe a -> Maybe b)
-> (Style V2 Double -> Maybe a) -> Style V2 Double -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style V2 Double -> Maybe a
forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
getAttr) (Style V2 Double -> Maybe b)
-> StateStackT CanvasState Canvas (Style V2 Double)
-> StateStackT CanvasState Canvas (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Style V2 Double) CanvasState (Style V2 Double)
-> StateStackT CanvasState Canvas (Style V2 Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Style V2 Double) CanvasState (Style V2 Double)
Lens' CanvasState (Style V2 Double)
accumStyle
stroke :: RenderM ()
stroke :: RenderM ()
stroke = do
Double
w <- Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.5 (Maybe Double -> Double)
-> StateStackT CanvasState Canvas (Maybe Double)
-> StateStackT CanvasState Canvas Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LineWidth Double -> Double)
-> StateStackT CanvasState Canvas (Maybe Double)
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib LineWidth Double -> Double
forall n. LineWidth n -> n
getLineWidth
Bool -> RenderM () -> RenderM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> (Double
0 :: Double)) (Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ()) -> Canvas () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ () -> Canvas ()
BC.stroke ())
fill :: RenderM ()
fill :: RenderM ()
fill = Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ()) -> Canvas () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ () -> Canvas ()
BC.fill ()
clip :: RenderM ()
clip :: RenderM ()
clip = Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ()) -> Canvas () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ () -> Canvas ()
BC.clip ()
byteRange :: Double -> Word8
byteRange :: Double -> Word8
byteRange Double
d = Double -> Word8
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
255)
texture :: (forall a. S.Style a => a -> BC.Canvas ()) -> Texture Double -> Double -> RenderM()
texture :: (forall a. Style a => a -> Canvas ())
-> Texture Double -> Double -> RenderM ()
texture forall a. Style a => a -> Canvas ()
styleFn (SC (SomeColor c
c)) Double
o = Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ())
-> (Text -> Canvas ()) -> Text -> RenderM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Canvas ()
forall a. Style a => a -> Canvas ()
styleFn (Text -> RenderM ()) -> Text -> RenderM ()
forall a b. (a -> b) -> a -> b
$ Text
s
where s :: Text
s = c -> Double -> Text
forall c. Color c => c -> Double -> Text
showColorJS c
c Double
o
texture forall a. Style a => a -> Canvas ()
styleFn (LG LGradient Double
g) Double
_ = Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ()) -> Canvas () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ do
CanvasGradient
grd <- (Double, Double, Double, Double) -> Canvas CanvasGradient
BC.createLinearGradient (Double
x0, Double
y0, Double
x1, Double
y1)
((Double, Text) -> Canvas ()) -> [(Double, Text)] -> Canvas ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((Double, Text) -> CanvasGradient -> Canvas ())
-> CanvasGradient -> (Double, Text) -> Canvas ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Double, Text) -> CanvasGradient -> Canvas ()
BC.addColorStop (CanvasGradient -> (Double, Text) -> Canvas ())
-> CanvasGradient -> (Double, Text) -> Canvas ()
forall a b. (a -> b) -> a -> b
$ CanvasGradient
grd) [(Double, Text)]
stops
CanvasGradient -> Canvas ()
forall a. Style a => a -> Canvas ()
styleFn CanvasGradient
grd
where
(Double
x0, Double
y0) = P2 Double -> (Double, Double)
forall n. P2 n -> (n, n)
unp2 (P2 Double -> (Double, Double)) -> P2 Double -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ Transformation (V (P2 Double)) (N (P2 Double))
-> P2 Double -> P2 Double
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (LGradient Double
gLGradient Double
-> Getting
(Transformation V2 Double)
(LGradient Double)
(Transformation V2 Double)
-> Transformation V2 Double
forall s a. s -> Getting a s a -> a
^.Getting
(Transformation V2 Double)
(LGradient Double)
(Transformation V2 Double)
forall n (f :: * -> *).
Functor f =>
(Transformation V2 n -> f (Transformation V2 n))
-> LGradient n -> f (LGradient n)
lGradTrans) (LGradient Double
gLGradient Double
-> Getting (P2 Double) (LGradient Double) (P2 Double) -> P2 Double
forall s a. s -> Getting a s a -> a
^.Getting (P2 Double) (LGradient Double) (P2 Double)
forall n (f :: * -> *).
Functor f =>
(Point V2 n -> f (Point V2 n)) -> LGradient n -> f (LGradient n)
lGradStart)
(Double
x1, Double
y1) = P2 Double -> (Double, Double)
forall n. P2 n -> (n, n)
unp2 (P2 Double -> (Double, Double)) -> P2 Double -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ Transformation (V (P2 Double)) (N (P2 Double))
-> P2 Double -> P2 Double
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (LGradient Double
gLGradient Double
-> Getting
(Transformation V2 Double)
(LGradient Double)
(Transformation V2 Double)
-> Transformation V2 Double
forall s a. s -> Getting a s a -> a
^.Getting
(Transformation V2 Double)
(LGradient Double)
(Transformation V2 Double)
forall n (f :: * -> *).
Functor f =>
(Transformation V2 n -> f (Transformation V2 n))
-> LGradient n -> f (LGradient n)
lGradTrans) (LGradient Double
gLGradient Double
-> Getting (P2 Double) (LGradient Double) (P2 Double) -> P2 Double
forall s a. s -> Getting a s a -> a
^.Getting (P2 Double) (LGradient Double) (P2 Double)
forall n (f :: * -> *).
Functor f =>
(Point V2 n -> f (Point V2 n)) -> LGradient n -> f (LGradient n)
lGradEnd)
stops :: [(Double, Text)]
stops = (GradientStop Double -> (Double, Text))
-> [GradientStop Double] -> [(Double, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\GradientStop Double
s -> ( GradientStop Double
sGradientStop Double
-> Getting Double (GradientStop Double) Double -> Double
forall s a. s -> Getting a s a -> a
^.Getting Double (GradientStop Double) Double
forall n (f :: * -> *).
Functor f =>
(n -> f n) -> GradientStop n -> f (GradientStop n)
stopFraction , SomeColor -> Double -> Text
forall c. Color c => c -> Double -> Text
showColorJS (GradientStop Double
sGradientStop Double
-> Getting SomeColor (GradientStop Double) SomeColor -> SomeColor
forall s a. s -> Getting a s a -> a
^.Getting SomeColor (GradientStop Double) SomeColor
forall n (f :: * -> *).
Functor f =>
(SomeColor -> f SomeColor) -> GradientStop n -> f (GradientStop n)
stopColor) Double
1)) (LGradient Double
gLGradient Double
-> Getting
[GradientStop Double] (LGradient Double) [GradientStop Double]
-> [GradientStop Double]
forall s a. s -> Getting a s a -> a
^.Getting
[GradientStop Double] (LGradient Double) [GradientStop Double]
forall n (f :: * -> *).
Functor f =>
([GradientStop n] -> f [GradientStop n])
-> LGradient n -> f (LGradient n)
lGradStops)
texture forall a. Style a => a -> Canvas ()
styleFn (RG RGradient Double
g) Double
_ = Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ()) -> Canvas () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ do
CanvasGradient
grd <- (Double, Double, Double, Double, Double, Double)
-> Canvas CanvasGradient
BC.createRadialGradient (Double
x0, Double
y0, Double
r0, Double
x1, Double
y1, Double
r1)
((Double, Text) -> Canvas ()) -> [(Double, Text)] -> Canvas ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((Double, Text) -> CanvasGradient -> Canvas ())
-> CanvasGradient -> (Double, Text) -> Canvas ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Double, Text) -> CanvasGradient -> Canvas ()
BC.addColorStop (CanvasGradient -> (Double, Text) -> Canvas ())
-> CanvasGradient -> (Double, Text) -> Canvas ()
forall a b. (a -> b) -> a -> b
$ CanvasGradient
grd) [(Double, Text)]
stops
CanvasGradient -> Canvas ()
forall a. Style a => a -> Canvas ()
styleFn CanvasGradient
grd
where
(Double
r0, Double
r1) = (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* RGradient Double
gRGradient Double
-> Getting Double (RGradient Double) Double -> Double
forall s a. s -> Getting a s a -> a
^.Getting Double (RGradient Double) Double
forall n (f :: * -> *).
Functor f =>
(n -> f n) -> RGradient n -> f (RGradient n)
rGradRadius0, Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* RGradient Double
gRGradient Double
-> Getting Double (RGradient Double) Double -> Double
forall s a. s -> Getting a s a -> a
^.Getting Double (RGradient Double) Double
forall n (f :: * -> *).
Functor f =>
(n -> f n) -> RGradient n -> f (RGradient n)
rGradRadius1)
(Double
x0, Double
y0) = P2 Double -> (Double, Double)
forall n. P2 n -> (n, n)
unp2 (P2 Double -> (Double, Double)) -> P2 Double -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ Transformation (V (P2 Double)) (N (P2 Double))
-> P2 Double -> P2 Double
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (RGradient Double
gRGradient Double
-> Getting
(Transformation V2 Double)
(RGradient Double)
(Transformation V2 Double)
-> Transformation V2 Double
forall s a. s -> Getting a s a -> a
^.Getting
(Transformation V2 Double)
(RGradient Double)
(Transformation V2 Double)
forall n (f :: * -> *).
Functor f =>
(Transformation V2 n -> f (Transformation V2 n))
-> RGradient n -> f (RGradient n)
rGradTrans) (RGradient Double
gRGradient Double
-> Getting (P2 Double) (RGradient Double) (P2 Double) -> P2 Double
forall s a. s -> Getting a s a -> a
^.Getting (P2 Double) (RGradient Double) (P2 Double)
forall n (f :: * -> *).
Functor f =>
(Point V2 n -> f (Point V2 n)) -> RGradient n -> f (RGradient n)
rGradCenter0)
(Double
x1, Double
y1) = P2 Double -> (Double, Double)
forall n. P2 n -> (n, n)
unp2 (P2 Double -> (Double, Double)) -> P2 Double -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ Transformation (V (P2 Double)) (N (P2 Double))
-> P2 Double -> P2 Double
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (RGradient Double
gRGradient Double
-> Getting
(Transformation V2 Double)
(RGradient Double)
(Transformation V2 Double)
-> Transformation V2 Double
forall s a. s -> Getting a s a -> a
^.Getting
(Transformation V2 Double)
(RGradient Double)
(Transformation V2 Double)
forall n (f :: * -> *).
Functor f =>
(Transformation V2 n -> f (Transformation V2 n))
-> RGradient n -> f (RGradient n)
rGradTrans) (RGradient Double
gRGradient Double
-> Getting (P2 Double) (RGradient Double) (P2 Double) -> P2 Double
forall s a. s -> Getting a s a -> a
^.Getting (P2 Double) (RGradient Double) (P2 Double)
forall n (f :: * -> *).
Functor f =>
(Point V2 n -> f (Point V2 n)) -> RGradient n -> f (RGradient n)
rGradCenter1)
stops :: [(Double, Text)]
stops = (GradientStop Double -> (Double, Text))
-> [GradientStop Double] -> [(Double, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\GradientStop Double
st -> ( GradientStop Double
stGradientStop Double
-> Getting Double (GradientStop Double) Double -> Double
forall s a. s -> Getting a s a -> a
^.Getting Double (GradientStop Double) Double
forall n (f :: * -> *).
Functor f =>
(n -> f n) -> GradientStop n -> f (GradientStop n)
stopFraction , SomeColor -> Double -> Text
forall c. Color c => c -> Double -> Text
showColorJS (GradientStop Double
stGradientStop Double
-> Getting SomeColor (GradientStop Double) SomeColor -> SomeColor
forall s a. s -> Getting a s a -> a
^.Getting SomeColor (GradientStop Double) SomeColor
forall n (f :: * -> *).
Functor f =>
(SomeColor -> f SomeColor) -> GradientStop n -> f (GradientStop n)
stopColor) Double
1)) (RGradient Double
gRGradient Double
-> Getting
[GradientStop Double] (RGradient Double) [GradientStop Double]
-> [GradientStop Double]
forall s a. s -> Getting a s a -> a
^.Getting
[GradientStop Double] (RGradient Double) [GradientStop Double]
forall n (f :: * -> *).
Functor f =>
([GradientStop n] -> f [GradientStop n])
-> RGradient n -> f (RGradient n)
rGradStops)
s :: Double
s = Transformation V2 Double -> Double
forall (v :: * -> *) n.
(Additive v, Traversable v, Floating n) =>
Transformation v n -> n
avgScale (Transformation V2 Double -> Double)
-> Transformation V2 Double -> Double
forall a b. (a -> b) -> a -> b
$ RGradient Double
gRGradient Double
-> Getting
(Transformation V2 Double)
(RGradient Double)
(Transformation V2 Double)
-> Transformation V2 Double
forall s a. s -> Getting a s a -> a
^.Getting
(Transformation V2 Double)
(RGradient Double)
(Transformation V2 Double)
forall n (f :: * -> *).
Functor f =>
(Transformation V2 n -> f (Transformation V2 n))
-> RGradient n -> f (RGradient n)
rGradTrans
showColorJS :: (Color c) => c -> Double -> T.Text
showColorJS :: forall c. Color c => c -> Double -> Text
showColorJS c
c Double
o = [Text] -> Text
T.concat
[ Text
"rgba("
, Double -> Text
s (Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
r), Text
","
, Double -> Text
s (Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
g), Text
","
, Double -> Text
s (Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
b), Text
","
, String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ (Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
a) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
o)
, Text
")"
]
where s :: Double -> T.Text
s :: Double -> Text
s = String -> Text
T.pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> String
forall a. Show a => a -> String
show (Word8 -> String) -> (Double -> Word8) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word8
byteRange
(Double
r,Double
g,Double
b,Double
a) = AlphaColour Double -> (Double, Double, Double, Double)
forall c. Color c => c -> (Double, Double, Double, Double)
colorToSRGBA (AlphaColour Double -> (Double, Double, Double, Double))
-> (c -> AlphaColour Double)
-> c
-> (Double, Double, Double, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> AlphaColour Double
forall c. Color c => c -> AlphaColour Double
toAlphaColour (c -> (Double, Double, Double, Double))
-> c -> (Double, Double, Double, Double)
forall a b. (a -> b) -> a -> b
$ c
c
canvasTransform :: T2 Double -> RenderM ()
canvasTransform :: Transformation V2 Double -> RenderM ()
canvasTransform Transformation V2 Double
tr = Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ()) -> Canvas () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ (Double, Double, Double, Double, Double, Double) -> Canvas ()
BC.transform (Double, Double, Double, Double, Double, Double)
vs
where
[[Double
ax, Double
ay], [Double
bx, Double
by], [Double
tx, Double
ty]] = Transformation V2 Double -> [[Double]]
forall (v :: * -> *) n.
(Additive v, Traversable v, Num n) =>
Transformation v n -> [[n]]
matrixHomRep Transformation V2 Double
tr
vs :: (Double, Double, Double, Double, Double, Double)
vs = (Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
ax,Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
ay
,Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
bx,Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
by
,Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
tx,Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
ty)
strokeTexture :: Texture Double -> Double -> RenderM ()
strokeTexture :: Texture Double -> Double -> RenderM ()
strokeTexture = (forall a. Style a => a -> Canvas ())
-> Texture Double -> Double -> RenderM ()
texture a -> Canvas ()
forall a. Style a => a -> Canvas ()
S.strokeStyle
fillTexture :: Texture Double -> Double -> RenderM ()
fillTexture :: Texture Double -> Double -> RenderM ()
fillTexture = (forall a. Style a => a -> Canvas ())
-> Texture Double -> Double -> RenderM ()
texture a -> Canvas ()
forall a. Style a => a -> Canvas ()
S.fillStyle
fromLineCap :: LineCap -> BC.LineEndCap
fromLineCap :: LineCap -> LineEndCap
fromLineCap LineCap
LineCapRound = LineEndCap
BC.RoundCap
fromLineCap LineCap
LineCapSquare = LineEndCap
BC.SquareCap
fromLineCap LineCap
_ = LineEndCap
BC.ButtCap
fromLineJoin :: LineJoin -> BC.LineJoinCorner
fromLineJoin :: LineJoin -> LineJoinCorner
fromLineJoin LineJoin
LineJoinRound = LineJoinCorner
BC.RoundCorner
fromLineJoin LineJoin
LineJoinBevel = LineJoinCorner
BC.BevelCorner
fromLineJoin LineJoin
_ = LineJoinCorner
BC.MiterCorner
showFontJS :: FontWeight -> FontSlant -> Double -> String -> T.Text
showFontJS :: FontWeight -> FontSlant -> Double -> String -> Text
showFontJS FontWeight
wgt FontSlant
slant Double
sz String
fnt = [Text] -> Text
T.concat [Text
a, Text
" ", Text
b, Text
" ", Text
c, Text
" ", Text
d]
where
a :: Text
a = case FontWeight
wgt of
FontWeight
FontWeightNormal -> Text
""
FontWeight
FontWeightBold -> Text
"bold"
FontWeight
_ -> Text
""
b :: Text
b = case FontSlant
slant of
FontSlant
FontSlantNormal -> Text
""
FontSlant
FontSlantItalic -> Text
"italic"
FontSlant
FontSlantOblique -> Text
"oblique"
c :: Text
c = [Text] -> Text
T.concat [String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
sz, Text
"pt"]
d :: Text
d = String -> Text
T.pack String
fnt
renderC :: (Renderable a Canvas, V a ~ V2, N a ~ Double) => a -> RenderM ()
renderC :: forall a.
(Renderable a Canvas, V a ~ V2, N a ~ Double) =>
a -> RenderM ()
renderC a
a = case (Canvas -> a -> Render Canvas (V a) (N a)
forall t b. Renderable t b => b -> t -> Render b (V t) (N t)
render Canvas
Canvas a
a) of C RenderM ()
r -> RenderM ()
r
canvasStyle :: Style v Double -> RenderM ()
canvasStyle :: forall (v :: * -> *). Style v Double -> RenderM ()
canvasStyle Style v Double
s = [RenderM ()] -> RenderM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
([RenderM ()] -> RenderM ())
-> ([Maybe (RenderM ())] -> [RenderM ()])
-> [Maybe (RenderM ())]
-> RenderM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (RenderM ())] -> [RenderM ()]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (RenderM ())] -> RenderM ())
-> [Maybe (RenderM ())] -> RenderM ()
forall a b. (a -> b) -> a -> b
$ [ (Clip Double -> RenderM ()) -> Maybe (RenderM ())
forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle Clip Double -> RenderM ()
clip'
, (LineWidth Double -> RenderM ()) -> Maybe (RenderM ())
forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle LineWidth Double -> RenderM ()
lWidth
, (LineCap -> RenderM ()) -> Maybe (RenderM ())
forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle LineCap -> RenderM ()
lCap
, (LineJoin -> RenderM ()) -> Maybe (RenderM ())
forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle LineJoin -> RenderM ()
lJoin
]
where handle :: (AttributeClass a) => (a -> RenderM ()) -> Maybe (RenderM ())
handle :: forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle a -> RenderM ()
f = a -> RenderM ()
f (a -> RenderM ()) -> Maybe a -> Maybe (RenderM ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Style v Double -> Maybe a
forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
getAttr Style v Double
s
clip' :: Clip Double -> RenderM ()
clip' = (Path V2 Double -> RenderM ()) -> [Path V2 Double] -> RenderM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Path V2 Double
p -> Path V2 Double -> RenderM ()
canvasPath Path V2 Double
p RenderM () -> RenderM () -> RenderM ()
forall a b.
StateStackT CanvasState Canvas a
-> StateStackT CanvasState Canvas b
-> StateStackT CanvasState Canvas b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RenderM ()
clip) ([Path V2 Double] -> RenderM ())
-> (Clip Double -> [Path V2 Double]) -> Clip Double -> RenderM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unwrapped (Clip Double) -> Clip Double)
-> Clip Double -> Unwrapped (Clip Double)
forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op [Path V2 Double] -> Clip Double
Unwrapped (Clip Double) -> Clip Double
forall n. [Path V2 n] -> Clip n
Clip
lWidth :: LineWidth Double -> RenderM ()
lWidth = Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ())
-> (LineWidth Double -> Canvas ())
-> LineWidth Double
-> RenderM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Canvas ()
BC.lineWidth (Double -> Canvas ())
-> (LineWidth Double -> Double) -> LineWidth Double -> Canvas ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineWidth Double -> Double
forall n. LineWidth n -> n
getLineWidth
lCap :: LineCap -> RenderM ()
lCap = Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ())
-> (LineCap -> Canvas ()) -> LineCap -> RenderM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineEndCap -> Canvas ()
BC.lineCap (LineEndCap -> Canvas ())
-> (LineCap -> LineEndCap) -> LineCap -> Canvas ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineCap -> LineEndCap
fromLineCap (LineCap -> LineEndCap)
-> (LineCap -> LineCap) -> LineCap -> LineEndCap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineCap -> LineCap
getLineCap
lJoin :: LineJoin -> RenderM ()
lJoin = Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ())
-> (LineJoin -> Canvas ()) -> LineJoin -> RenderM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineJoinCorner -> Canvas ()
BC.lineJoin (LineJoinCorner -> Canvas ())
-> (LineJoin -> LineJoinCorner) -> LineJoin -> Canvas ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineJoin -> LineJoinCorner
fromLineJoin (LineJoin -> LineJoinCorner)
-> (LineJoin -> LineJoin) -> LineJoin -> LineJoinCorner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineJoin -> LineJoin
getLineJoin
instance Renderable (Segment Closed V2 Double) Canvas where
render :: Canvas
-> Segment Closed V2 Double
-> Render
Canvas
(V (Segment Closed V2 Double))
(N (Segment Closed V2 Double))
render Canvas
_ (Linear (OffsetClosed (V2 Double
x Double
y))) = RenderM () -> Render Canvas V2 Double
C (RenderM () -> Render Canvas V2 Double)
-> RenderM () -> Render Canvas V2 Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> RenderM ()
relLineTo Double
x Double
y
render Canvas
_ (Cubic (V2 Double
x1 Double
y1)
(V2 Double
x2 Double
y2)
(OffsetClosed (V2 Double
x3 Double
y3)))
= RenderM () -> Render Canvas V2 Double
C (RenderM () -> Render Canvas V2 Double)
-> RenderM () -> Render Canvas V2 Double
forall a b. (a -> b) -> a -> b
$ Double
-> Double -> Double -> Double -> Double -> Double -> RenderM ()
relCurveTo Double
x1 Double
y1 Double
x2 Double
y2 Double
x3 Double
y3
instance Renderable (Trail V2 Double) Canvas where
render :: Canvas
-> Trail V2 Double
-> Render Canvas (V (Trail V2 Double)) (N (Trail V2 Double))
render Canvas
_ = (Trail' Line V2 Double -> Render Canvas V2 Double)
-> (Trail' Loop V2 Double -> Render Canvas V2 Double)
-> Trail V2 Double
-> Render Canvas V2 Double
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail Trail' Line V2 Double -> Render Canvas V2 Double
renderLine Trail' Loop V2 Double -> Render Canvas V2 Double
renderLoop
where
renderLine :: Trail' Line V2 Double -> Render Canvas V2 Double
renderLine Trail' Line V2 Double
ln = RenderM () -> Render Canvas V2 Double
C (RenderM () -> Render Canvas V2 Double)
-> RenderM () -> Render Canvas V2 Double
forall a b. (a -> b) -> a -> b
$ do
(Segment Closed V2 Double -> RenderM ())
-> [Segment Closed V2 Double] -> RenderM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Segment Closed V2 Double -> RenderM ()
forall a.
(Renderable a Canvas, V a ~ V2, N a ~ Double) =>
a -> RenderM ()
renderC (Trail' Line V2 Double -> [Segment Closed V2 Double]
forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments Trail' Line V2 Double
ln)
renderLoop :: Trail' Loop V2 Double -> Render Canvas V2 Double
renderLoop Trail' Loop V2 Double
lp = RenderM () -> Render Canvas V2 Double
C (RenderM () -> Render Canvas V2 Double)
-> RenderM () -> Render Canvas V2 Double
forall a b. (a -> b) -> a -> b
$ do
case Trail' Loop V2 Double
-> ([Segment Closed V2 Double], Segment Open V2 Double)
forall (v :: * -> *) n.
Trail' Loop v n -> ([Segment Closed v n], Segment Open v n)
loopSegments Trail' Loop V2 Double
lp of
([Segment Closed V2 Double]
segs, Linear Offset Open V2 Double
_) -> (Segment Closed V2 Double -> RenderM ())
-> [Segment Closed V2 Double] -> RenderM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Segment Closed V2 Double -> RenderM ()
forall a.
(Renderable a Canvas, V a ~ V2, N a ~ Double) =>
a -> RenderM ()
renderC [Segment Closed V2 Double]
segs
([Segment Closed V2 Double], Segment Open V2 Double)
_ -> (Segment Closed V2 Double -> RenderM ())
-> [Segment Closed V2 Double] -> RenderM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Segment Closed V2 Double -> RenderM ()
forall a.
(Renderable a Canvas, V a ~ V2, N a ~ Double) =>
a -> RenderM ()
renderC (Trail' Line V2 Double -> [Segment Closed V2 Double]
forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments (Trail' Line V2 Double -> [Segment Closed V2 Double])
-> (Trail' Loop V2 Double -> Trail' Line V2 Double)
-> Trail' Loop V2 Double
-> [Segment Closed V2 Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop V2 Double -> Trail' Line V2 Double
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop (Trail' Loop V2 Double -> [Segment Closed V2 Double])
-> Trail' Loop V2 Double -> [Segment Closed V2 Double]
forall a b. (a -> b) -> a -> b
$ Trail' Loop V2 Double
lp)
RenderM ()
closePath
instance Renderable (Path V2 Double) Canvas where
render :: Canvas
-> Path V2 Double
-> Render Canvas (V (Path V2 Double)) (N (Path V2 Double))
render Canvas
_ Path V2 Double
p = RenderM () -> Render Canvas V2 Double
C (RenderM () -> Render Canvas V2 Double)
-> RenderM () -> Render Canvas V2 Double
forall a b. (a -> b) -> a -> b
$ do
Path V2 Double -> RenderM ()
canvasPath Path V2 Double
p
Maybe (Texture Double)
f <- (FillTexture Double -> Texture Double)
-> RenderM (Maybe (Texture Double))
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib FillTexture Double -> Texture Double
forall n. FillTexture n -> Texture n
getFillTexture
Maybe (Texture Double)
s <- (LineTexture Double -> Texture Double)
-> RenderM (Maybe (Texture Double))
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib LineTexture Double -> Texture Double
forall n. LineTexture n -> Texture n
getLineTexture
Double
o <- Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1 (Maybe Double -> Double)
-> StateStackT CanvasState Canvas (Maybe Double)
-> StateStackT CanvasState Canvas Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Opacity -> Double)
-> StateStackT CanvasState Canvas (Maybe Double)
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib Opacity -> Double
getOpacity
RenderM ()
save
Bool -> RenderM () -> RenderM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Texture Double) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Texture Double)
f) (Texture Double -> Double -> RenderM ()
fillTexture (Maybe (Texture Double) -> Texture Double
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Texture Double)
f) (Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
o) RenderM () -> RenderM () -> RenderM ()
forall a b.
StateStackT CanvasState Canvas a
-> StateStackT CanvasState Canvas b
-> StateStackT CanvasState Canvas b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RenderM ()
fill)
Texture Double -> Double -> RenderM ()
strokeTexture (Texture Double -> Maybe (Texture Double) -> Texture Double
forall a. a -> Maybe a -> a
fromMaybe (SomeColor -> Texture Double
forall n. SomeColor -> Texture n
SC (Colour Double -> SomeColor
forall c. Color c => c -> SomeColor
SomeColor (Colour Double
forall a. Num a => Colour a
black :: Colour Double))) Maybe (Texture Double)
s) (Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
o)
RenderM ()
stroke
RenderM ()
restore
canvasPath :: Path V2 Double -> RenderM ()
canvasPath :: Path V2 Double -> RenderM ()
canvasPath (Path [Located (Trail V2 Double)]
trs) = do
RenderM ()
newPath
(Located (Trail V2 Double) -> RenderM ())
-> [Located (Trail V2 Double)] -> RenderM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ Located (Trail V2 Double) -> RenderM ()
forall {a}.
(V a ~ V2, N a ~ Double, Renderable a Canvas) =>
Located a -> RenderM ()
renderTrail [Located (Trail V2 Double)]
trs
where
renderTrail :: Located a -> RenderM ()
renderTrail (Located a -> (Point (V a) (N a), a)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc -> (Point (V a) (N a) -> (Double, Double)
P2 Double -> (Double, Double)
forall n. P2 n -> (n, n)
unp2 -> (Double, Double)
p, a
tr)) = do
(Double -> Double -> RenderM ()) -> (Double, Double) -> RenderM ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> RenderM ()
moveTo (Double, Double)
p
a -> RenderM ()
forall a.
(Renderable a Canvas, V a ~ V2, N a ~ Double) =>
a -> RenderM ()
renderC a
tr
instance Renderable (Text Double) Canvas where
render :: Canvas
-> Text Double -> Render Canvas (V (Text Double)) (N (Text Double))
render Canvas
_ (Text Transformation V2 Double
tr TextAlignment Double
al String
str) = RenderM () -> Render Canvas V2 Double
C (RenderM () -> Render Canvas V2 Double)
-> RenderM () -> Render Canvas V2 Double
forall a b. (a -> b) -> a -> b
$ do
String
tf <- String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"Calibri" (Maybe String -> String)
-> StateStackT CanvasState Canvas (Maybe String)
-> StateStackT CanvasState Canvas String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Font -> String) -> StateStackT CanvasState Canvas (Maybe String)
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib Font -> String
getFont
Double
sz <- Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
12 (Maybe Double -> Double)
-> StateStackT CanvasState Canvas (Maybe Double)
-> StateStackT CanvasState Canvas Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FontSize Double -> Double)
-> StateStackT CanvasState Canvas (Maybe Double)
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib FontSize Double -> Double
forall n. FontSize n -> n
getFontSize
FontSlant
slant <- FontSlant -> Maybe FontSlant -> FontSlant
forall a. a -> Maybe a -> a
fromMaybe FontSlant
FontSlantNormal (Maybe FontSlant -> FontSlant)
-> StateStackT CanvasState Canvas (Maybe FontSlant)
-> StateStackT CanvasState Canvas FontSlant
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FontSlant -> FontSlant)
-> StateStackT CanvasState Canvas (Maybe FontSlant)
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib FontSlant -> FontSlant
getFontSlant
FontWeight
fw <- FontWeight -> Maybe FontWeight -> FontWeight
forall a. a -> Maybe a -> a
fromMaybe FontWeight
FontWeightNormal (Maybe FontWeight -> FontWeight)
-> StateStackT CanvasState Canvas (Maybe FontWeight)
-> StateStackT CanvasState Canvas FontWeight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FontWeight -> FontWeight)
-> StateStackT CanvasState Canvas (Maybe FontWeight)
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib FontWeight -> FontWeight
getFontWeight
Texture Double
tx <- Texture Double -> Maybe (Texture Double) -> Texture Double
forall a. a -> Maybe a -> a
fromMaybe (SomeColor -> Texture Double
forall n. SomeColor -> Texture n
SC (Colour Double -> SomeColor
forall c. Color c => c -> SomeColor
SomeColor (Colour Double
forall a. Num a => Colour a
black :: Colour Double)))
(Maybe (Texture Double) -> Texture Double)
-> RenderM (Maybe (Texture Double))
-> StateStackT CanvasState Canvas (Texture Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FillTexture Double -> Texture Double)
-> RenderM (Maybe (Texture Double))
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib FillTexture Double -> Texture Double
forall n. FillTexture n -> Texture n
getFillTexture
Double
o <- Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1 (Maybe Double -> Double)
-> StateStackT CanvasState Canvas (Maybe Double)
-> StateStackT CanvasState Canvas Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Opacity -> Double)
-> StateStackT CanvasState Canvas (Maybe Double)
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib Opacity -> Double
getOpacity
let fSize :: Double
fSize = Transformation V2 Double -> Double
forall (v :: * -> *) n.
(Additive v, Traversable v, Floating n) =>
Transformation v n -> n
avgScale Transformation V2 Double
tr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sz
fnt :: Text
fnt = FontWeight -> FontSlant -> Double -> String -> Text
showFontJS FontWeight
fw FontSlant
slant Double
fSize String
tf
vAlign :: TextBaselineAlignment
vAlign = case TextAlignment Double
al of
TextAlignment Double
BaselineText -> TextBaselineAlignment
BC.AlphabeticBaseline
BoxAlignedText Double
_ Double
h -> case Double
h of
Double
h' | Double
h' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.25 -> TextBaselineAlignment
BC.BottomBaseline
Double
h' | Double
h' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0.75 -> TextBaselineAlignment
BC.TopBaseline
Double
_ -> TextBaselineAlignment
BC.MiddleBaseline
hAlign :: TextAnchorAlignment
hAlign = case TextAlignment Double
al of
TextAlignment Double
BaselineText -> TextAnchorAlignment
BC.StartAnchor
BoxAlignedText Double
w Double
_ -> case Double
w of
Double
w' | Double
w' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.25 -> TextAnchorAlignment
BC.StartAnchor
Double
w' | Double
w' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0.75 -> TextAnchorAlignment
BC.EndAnchor
Double
_ -> TextAnchorAlignment
BC.CenterAnchor
RenderM ()
save
Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ()) -> Canvas () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ TextBaselineAlignment -> Canvas ()
BC.textBaseline TextBaselineAlignment
vAlign
Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ()) -> Canvas () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ TextAnchorAlignment -> Canvas ()
BC.textAlign TextAnchorAlignment
hAlign
Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ()) -> Canvas () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ Text -> Canvas ()
BC.font Text
fnt
Texture Double -> Double -> RenderM ()
fillTexture Texture Double
tx (Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
o)
Transformation V2 Double -> RenderM ()
canvasTransform (Transformation V2 Double
tr Transformation V2 Double
-> Transformation V2 Double -> Transformation V2 Double
forall a. Semigroup a => a -> a -> a
<> Transformation V2 Double
forall (v :: * -> *) n.
(Additive v, R2 v, Num n) =>
Transformation v n
reflectionY)
Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ()) -> Canvas () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ (Text, Double, Double) -> Canvas ()
BC.fillText (String -> Text
T.pack String
str, Double
0, Double
0)
RenderM ()
restore
instance Renderable (DImage Double External) Canvas where
render :: Canvas
-> DImage Double External
-> Render
Canvas (V (DImage Double External)) (N (DImage Double External))
render Canvas
_ (DImage ImageData External
path Int
w Int
h Transformation V2 Double
tr) = RenderM () -> Render Canvas V2 Double
C (RenderM () -> Render Canvas V2 Double)
-> RenderM () -> Render Canvas V2 Double
forall a b. (a -> b) -> a -> b
$ do
let ImageRef String
file = ImageData External
path
RenderM ()
save
Transformation V2 Double -> RenderM ()
canvasTransform (Transformation V2 Double
tr Transformation V2 Double
-> Transformation V2 Double -> Transformation V2 Double
forall a. Semigroup a => a -> a -> a
<> Transformation V2 Double
forall (v :: * -> *) n.
(Additive v, R2 v, Num n) =>
Transformation v n
reflectionY)
CanvasImage
img <- Canvas CanvasImage -> RenderM CanvasImage
forall a. Canvas a -> RenderM a
liftC (Canvas CanvasImage -> RenderM CanvasImage)
-> Canvas CanvasImage -> RenderM CanvasImage
forall a b. (a -> b) -> a -> b
$ Text -> Canvas CanvasImage
BC.newImage (String -> Text
T.pack String
file)
Canvas () -> RenderM ()
forall a. Canvas a -> RenderM a
liftC (Canvas () -> RenderM ()) -> Canvas () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ (CanvasImage, [Double]) -> Canvas ()
forall image. Image image => (image, [Double]) -> Canvas ()
BC.drawImage (CanvasImage
img, [Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (-Int
w) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (-Int
h) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h])
RenderM ()
restore
renderCanvas :: Int -> SizeSpec V2 Double -> QDiagram Canvas V2 Double Any -> IO ()
renderCanvas :: Int -> SizeSpec V2 Double -> QDiagram Canvas V2 Double Any -> IO ()
renderCanvas Int
port SizeSpec V2 Double
sizeSpec QDiagram Canvas V2 Double Any
d = Options -> (DeviceContext -> IO ()) -> IO ()
BC.blankCanvas (Int -> Options
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
port) ((DeviceContext -> IO ()) -> IO ())
-> (Result Canvas V2 Double -> DeviceContext -> IO ())
-> Result Canvas V2 Double
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeviceContext -> Canvas () -> IO ())
-> Canvas () -> DeviceContext -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip DeviceContext -> Canvas () -> IO ()
forall a. DeviceContext -> Canvas a -> IO a
BC.send (Result Canvas V2 Double -> IO ())
-> Result Canvas V2 Double -> IO ()
forall a b. (a -> b) -> a -> b
$ Result Canvas V2 Double
img
where
img :: Result Canvas V2 Double
img = Canvas
-> Options Canvas V2 Double
-> QDiagram Canvas V2 Double Any
-> Result Canvas V2 Double
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 Canvas
Canvas (SizeSpec V2 Double -> Options Canvas V2 Double
CanvasOptions SizeSpec V2 Double
sizeSpec) QDiagram Canvas V2 Double Any
d