{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
module Graphics.Rendering.Chart.Backend.Diagrams
( runBackend
, runBackendR
, runBackendWithGlyphs
, defaultEnv
, createEnv
, DEnv(..)
, FileFormat(..)
, FileOptions(..)
, fo_size
, fo_format
, fo_fonts
, renderableToFile
, toFile
, cBackendToFile
, loadSansSerifFonts
, loadCommonFonts
, FontSelector
) where
import Data.Default.Class
import Data.Colour
import Data.Colour.SRGB
import Data.List (unfoldr)
import Data.Monoid
import Data.Traversable
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Lazy as BS
import qualified Data.Text as T
#if MIN_VERSION_diagrams_postscript(1,5,0)
import qualified Data.ByteString.Builder as B
import System.IO (IOMode (..), hPutStr, withFile)
#endif
import Control.Lens(makeLenses)
import Control.Monad.Operational
import Control.Monad.State.Lazy
import Control.Monad
import Diagrams.Core.Transform ( Transformation(..) )
import Diagrams.Prelude
( Diagram
, V2, P2, T2
, r2, p2, unr2, unp2
, rad, (@@)
, Trail(..), Segment
, (.+^), (<->), (~~)
)
import qualified Diagrams.Prelude as D
import qualified Diagrams.TwoD as D2
import Diagrams (N, V)
import Diagrams.TwoD (V2)
import qualified Diagrams.TwoD.Arc as D2
import qualified Diagrams.TwoD.Text as D2
import qualified Diagrams.Backend.Postscript as DEPS
import qualified Diagrams.Backend.SVG as DSVG
import qualified Graphics.Svg as Svg
import qualified Text.Blaze.Renderer.Text as B
import qualified Graphics.SVGFonts as F
import qualified Graphics.SVGFonts.CharReference as F
import qualified Graphics.SVGFonts.ReadFont as F
import Graphics.SVGFonts.WriteFont ( makeSvgFont )
import Graphics.Rendering.Chart.Backend as G
import Graphics.Rendering.Chart.Backend.Impl
import Graphics.Rendering.Chart.Backend.Types
import Graphics.Rendering.Chart.Geometry as G
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Renderable
import Graphics.Rendering.Chart.State(EC, execEC)
import Paths_Chart_diagrams ( getDataFileName )
import System.IO.Unsafe (unsafePerformIO)
data FileFormat = EPS
| SVG
| SVG_EMBEDDED
data FileOptions = FileOptions {
FileOptions -> (Double, Double)
_fo_size :: (Double,Double),
FileOptions -> FileFormat
_fo_format :: FileFormat,
FileOptions -> IO (FontSelector Double)
_fo_fonts :: IO (FontSelector Double)
}
instance Default FileOptions where
def :: FileOptions
def = (Double, Double)
-> FileFormat -> IO (FontSelector Double) -> FileOptions
FileOptions (Double
800,Double
600) FileFormat
SVG forall n. (RealFloat n, Read n) => IO (FontSelector n)
loadSansSerifFonts
renderableToFile :: FileOptions -> FilePath -> Renderable a -> IO (PickFn a)
renderableToFile :: forall a. FileOptions -> FilePath -> Renderable a -> IO (PickFn a)
renderableToFile FileOptions
fo FilePath
path Renderable a
r = forall a. FileOptions -> BackendProgram a -> FilePath -> IO a
cBackendToFile FileOptions
fo BackendProgram (PickFn a)
cb FilePath
path
where
cb :: BackendProgram (PickFn a)
cb = forall a.
Renderable a -> (Double, Double) -> BackendProgram (PickFn a)
render Renderable a
r (FileOptions -> (Double, Double)
_fo_size FileOptions
fo)
toFile :: (Default r,ToRenderable r) => FileOptions -> FilePath -> EC r () -> IO ()
toFile :: forall r.
(Default r, ToRenderable r) =>
FileOptions -> FilePath -> EC r () -> IO ()
toFile FileOptions
fo FilePath
path EC r ()
ec = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. FileOptions -> FilePath -> Renderable a -> IO (PickFn a)
renderableToFile FileOptions
fo FilePath
path (forall a. ToRenderable a => a -> Renderable ()
toRenderable (forall l a. Default l => EC l a -> l
execEC EC r ()
ec))
cBackendToFile :: FileOptions -> BackendProgram a -> FilePath -> IO a
cBackendToFile :: forall a. FileOptions -> BackendProgram a -> FilePath -> IO a
cBackendToFile FileOptions
fo BackendProgram a
cb FilePath
path = do
FontSelector Double
fontSelector <- FileOptions -> IO (FontSelector Double)
_fo_fonts FileOptions
fo
let env :: DEnv Double
env = forall n.
(Read n, RealFloat n) =>
AlignmentFns -> n -> n -> FontSelector n -> DEnv n
createEnv AlignmentFns
vectorAlignmentFns Double
w Double
h FontSelector Double
fontSelector
case FileOptions -> FileFormat
_fo_format FileOptions
fo of
FileFormat
EPS -> do
let (QDiagram Postscript V2 (N Postscript) Any
d, a
a) = forall b a.
(Backend b V2 (N b), Renderable (Path V2 (N b)) b,
TypeableFloat (N b), Metric (V b)) =>
DEnv (N b) -> BackendProgram a -> (QDiagram b V2 (N b) Any, a)
runBackend DEnv Double
env BackendProgram a
cb
opts :: Options Postscript V2 Double
opts = FilePath
-> SizeSpec V2 Double
-> OutputFormat
-> Options Postscript V2 Double
DEPS.PostscriptOptions FilePath
path (forall n. n -> n -> SizeSpec V2 n
D2.dims2D Double
w Double
h) OutputFormat
DEPS.EPS
#if MIN_VERSION_diagrams_postscript(1,5,0)
eps :: Result Postscript V2 Double
eps = 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
D.renderDia Postscript
DEPS.Postscript Options Postscript V2 Double
opts QDiagram Postscript V2 (N Postscript) Any
d
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile (Options Postscript V2 Double
opts forall s a. s -> Getting a s a -> a
D.^. Lens' (Options Postscript V2 Double) FilePath
DEPS.psfileName) IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
h ->
Handle -> Builder -> IO ()
B.hPutBuilder Handle
h Result Postscript V2 Double
eps
#else
D.renderDia DEPS.Postscript opts d
#endif
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
FileFormat
SVG -> do
let (QDiagram SVG V2 (N SVG) Any
d, a
a) = forall b a.
(Backend b V2 (N b), Renderable (Path V2 (N b)) b,
TypeableFloat (N b), Metric (V b)) =>
DEnv (N b) -> BackendProgram a -> (QDiagram b V2 (N b) Any, a)
runBackend DEnv Double
env BackendProgram a
cb
opts :: Options SVG V2 Double
opts = forall n.
SizeSpec V2 n
-> Maybe Element -> Text -> [Attribute] -> Bool -> Options SVG V2 n
DSVG.SVGOptions (forall n. n -> n -> SizeSpec V2 n
D2.dims2D Double
w Double
h) forall a. Maybe a
Nothing Text
T.empty [] Bool
True
svg :: Result SVG V2 Double
svg = 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
D.renderDia SVG
DSVG.SVG Options SVG V2 Double
opts QDiagram SVG V2 (N SVG) Any
d
FilePath -> Element -> IO ()
Svg.renderToFile FilePath
path Result SVG V2 Double
svg
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
FileFormat
SVG_EMBEDDED -> do
let
(QDiagram SVG V2 (N SVG) Any
d, a
a, Map (FilePath, FontSlant, FontWeight) (Set FilePath)
gs) = forall b a.
(Backend b V2 (N b), Renderable (Path V2 (N b)) b,
Renderable (Text (N b)) b, TypeableFloat (N b), Metric (V b)) =>
DEnv (N b)
-> BackendProgram a
-> (QDiagram b V2 (N b) Any, a,
Map (FilePath, FontSlant, FontWeight) (Set FilePath))
runBackendWithGlyphs DEnv Double
env BackendProgram a
cb
fontDefs :: Maybe Element
fontDefs = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToElement a => a -> Element
Svg.toElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markup -> Text
B.renderMarkup
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.toList Map (FilePath, FontSlant, FontWeight) (Set FilePath)
gs) forall a b. (a -> b) -> a -> b
$ \((FilePath
fFam, FontSlant
fSlant, FontWeight
fWeight), Set FilePath
usedGs) -> do
let fs :: FontStyle
fs = forall n. DEnv n -> FontStyle
envFontStyle DEnv Double
env
let font :: PreparedFont Double
font = forall n. DEnv n -> FontSelector n
envSelectFont DEnv Double
env forall a b. (a -> b) -> a -> b
$ FontStyle
fs { _font_name :: FilePath
_font_name = FilePath
fFam
, _font_slant :: FontSlant
_font_slant = FontSlant
fSlant
, _font_weight :: FontWeight
_font_weight = FontWeight
fWeight
}
forall n.
(Show n, ToValue n) =>
PreparedFont n -> Set FilePath -> Markup
makeSvgFont PreparedFont Double
font Set FilePath
usedGs
svg :: Result SVG V2 Double
svg = 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
D.renderDia SVG
DSVG.SVG (forall n.
SizeSpec V2 n
-> Maybe Element -> Text -> [Attribute] -> Bool -> Options SVG V2 n
DSVG.SVGOptions (forall n. n -> n -> SizeSpec V2 n
D2.dims2D Double
w Double
h) Maybe Element
fontDefs Text
T.empty [] Bool
True) QDiagram SVG V2 (N SVG) Any
d
FilePath -> Element -> IO ()
Svg.renderToFile FilePath
path Result SVG V2 Double
svg
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
where
(Double
w,Double
h) = FileOptions -> (Double, Double)
_fo_size FileOptions
fo
data DEnv n = DEnv
{ forall n. DEnv n -> AlignmentFns
envAlignmentFns :: AlignmentFns
, forall n. DEnv n -> FontStyle
envFontStyle :: FontStyle
, forall n. DEnv n -> FontSelector n
envSelectFont :: FontSelector n
, forall n. DEnv n -> (n, n)
envOutputSize :: (n,n)
, forall n.
DEnv n -> Map (FilePath, FontSlant, FontWeight) (Set FilePath)
envUsedGlyphs :: M.Map (String, FontSlant, FontWeight) (S.Set String)
}
type DState n a = State (DEnv n) a
type FontSelector n = FontStyle -> F.PreparedFont n
loadSansSerifFonts :: forall n. (RealFloat n, Read n)
=> IO (FontSelector n)
loadSansSerifFonts :: forall n. (RealFloat n, Read n) => IO (FontSelector n)
loadSansSerifFonts = do
PreparedFont n
sansR <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceSansPro_R.svg" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
PreparedFont n
sansRB <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceSansPro_RB.svg" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
PreparedFont n
sansRBI <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceSansPro_RBI.svg" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
PreparedFont n
sansRI <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceSansPro_RI.svg" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
let selectFont :: FontStyle -> F.PreparedFont n
selectFont :: FontSelector n
selectFont FontStyle
fs = case (FontStyle -> FilePath
_font_name FontStyle
fs, FontStyle -> FontSlant
_font_slant FontStyle
fs, FontStyle -> FontWeight
_font_weight FontStyle
fs) of
(FilePath
_, FontSlant
FontSlantNormal , FontWeight
FontWeightNormal) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansR
(FilePath
_, FontSlant
FontSlantNormal , FontWeight
FontWeightBold ) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRB
(FilePath
_, FontSlant
FontSlantItalic , FontWeight
FontWeightNormal) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRI
(FilePath
_, FontSlant
FontSlantOblique, FontWeight
FontWeightNormal) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRI
(FilePath
_, FontSlant
FontSlantItalic , FontWeight
FontWeightBold ) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRBI
(FilePath
_, FontSlant
FontSlantOblique, FontWeight
FontWeightBold ) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRBI
forall (m :: * -> *) a. Monad m => a -> m a
return FontSelector n
selectFont
loadCommonFonts :: forall n. (RealFloat n, Read n) => IO (FontSelector n)
loadCommonFonts :: forall n. (RealFloat n, Read n) => IO (FontSelector n)
loadCommonFonts = do
PreparedFont n
serifR <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/LinLibertine_R.svg" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
PreparedFont n
serifRB <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/LinLibertine_RB.svg" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
PreparedFont n
serifRBI <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/LinLibertine_RBI.svg" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
PreparedFont n
serifRI <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/LinLibertine_RI.svg" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
PreparedFont n
sansR <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceSansPro_R.svg" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
PreparedFont n
sansRB <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceSansPro_RB.svg" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
PreparedFont n
sansRBI <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceSansPro_RBI.svg" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
PreparedFont n
sansRI <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceSansPro_RI.svg" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
PreparedFont n
monoR <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceCodePro_R.svg" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
PreparedFont n
monoRB <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceCodePro_RB.svg" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
let selectFont :: FontStyle -> F.PreparedFont n
selectFont :: FontSelector n
selectFont FontStyle
fs = case (FontStyle -> FilePath
_font_name FontStyle
fs, FontStyle -> FontSlant
_font_slant FontStyle
fs, FontStyle -> FontWeight
_font_weight FontStyle
fs) of
(FilePath
"serif", FontSlant
FontSlantNormal , FontWeight
FontWeightNormal) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"serif" PreparedFont n
serifR
(FilePath
"serif", FontSlant
FontSlantNormal , FontWeight
FontWeightBold ) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"serif" PreparedFont n
serifRB
(FilePath
"serif", FontSlant
FontSlantItalic , FontWeight
FontWeightNormal) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"serif" PreparedFont n
serifRI
(FilePath
"serif", FontSlant
FontSlantOblique, FontWeight
FontWeightNormal) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"serif" PreparedFont n
serifRI
(FilePath
"serif", FontSlant
FontSlantItalic , FontWeight
FontWeightBold ) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"serif" PreparedFont n
serifRBI
(FilePath
"serif", FontSlant
FontSlantOblique, FontWeight
FontWeightBold ) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"serif" PreparedFont n
serifRBI
(FilePath
"sans-serif", FontSlant
FontSlantNormal , FontWeight
FontWeightNormal) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansR
(FilePath
"sans-serif", FontSlant
FontSlantNormal , FontWeight
FontWeightBold ) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRB
(FilePath
"sans-serif", FontSlant
FontSlantItalic , FontWeight
FontWeightNormal) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRI
(FilePath
"sans-serif", FontSlant
FontSlantOblique, FontWeight
FontWeightNormal) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRI
(FilePath
"sans-serif", FontSlant
FontSlantItalic , FontWeight
FontWeightBold ) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRBI
(FilePath
"sans-serif", FontSlant
FontSlantOblique, FontWeight
FontWeightBold ) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRBI
(FilePath
"monospace", FontSlant
_, FontWeight
FontWeightNormal) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"monospace" PreparedFont n
monoR
(FilePath
"monospace", FontSlant
_, FontWeight
FontWeightBold ) -> forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"monospace" PreparedFont n
monoRB
(FilePath
fam, FontSlant
FontSlantNormal , FontWeight
FontWeightNormal) | FilePath
fam forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
serifR -> PreparedFont n
serifR
(FilePath
fam, FontSlant
FontSlantNormal , FontWeight
FontWeightBold ) | FilePath
fam forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
serifRB -> PreparedFont n
serifRB
(FilePath
fam, FontSlant
FontSlantItalic , FontWeight
FontWeightNormal) | FilePath
fam forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
serifRI -> PreparedFont n
serifRI
(FilePath
fam, FontSlant
FontSlantOblique, FontWeight
FontWeightNormal) | FilePath
fam forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
serifRI -> PreparedFont n
serifRI
(FilePath
fam, FontSlant
FontSlantItalic , FontWeight
FontWeightBold ) | FilePath
fam forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
serifRBI -> PreparedFont n
serifRBI
(FilePath
fam, FontSlant
FontSlantOblique, FontWeight
FontWeightBold ) | FilePath
fam forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
serifRBI -> PreparedFont n
serifRBI
(FilePath
fam, FontSlant
FontSlantNormal , FontWeight
FontWeightNormal) | FilePath
fam forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
sansR -> PreparedFont n
sansR
(FilePath
fam, FontSlant
FontSlantNormal , FontWeight
FontWeightBold ) | FilePath
fam forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
sansRB -> PreparedFont n
sansRB
(FilePath
fam, FontSlant
FontSlantItalic , FontWeight
FontWeightNormal) | FilePath
fam forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
sansRI -> PreparedFont n
sansRI
(FilePath
fam, FontSlant
FontSlantOblique, FontWeight
FontWeightNormal) | FilePath
fam forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
sansRI -> PreparedFont n
sansRI
(FilePath
fam, FontSlant
FontSlantItalic , FontWeight
FontWeightBold ) | FilePath
fam forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
sansRBI -> PreparedFont n
sansRBI
(FilePath
fam, FontSlant
FontSlantOblique, FontWeight
FontWeightBold ) | FilePath
fam forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
sansRBI -> PreparedFont n
sansRBI
(FilePath
fam, FontSlant
_, FontWeight
FontWeightNormal) | FilePath
fam forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
monoR -> PreparedFont n
monoR
(FilePath
fam, FontSlant
_, FontWeight
FontWeightBold ) | FilePath
fam forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
monoRB -> PreparedFont n
monoRB
(FilePath
_, FontSlant
slant, FontWeight
weight) -> FontSelector n
selectFont (FontStyle
fs { _font_name :: FilePath
_font_name = FilePath
"sans-serif" })
forall (m :: * -> *) a. Monad m => a -> m a
return FontSelector n
selectFont
alterFontFamily :: String -> F.PreparedFont n -> F.PreparedFont n
alterFontFamily :: forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
n (FontData n
fd, OutlineMap n
om) = (FontData n
fd { fontDataFamily :: FilePath
F.fontDataFamily = FilePath
n }, OutlineMap n
om)
isFontFamily :: String -> F.PreparedFont n -> Bool
isFontFamily :: forall n. FilePath -> PreparedFont n -> Bool
isFontFamily FilePath
n (FontData n
fd, OutlineMap n
_) = FilePath
n forall a. Eq a => a -> a -> Bool
== forall n. FontData n -> FilePath
F.fontDataFamily FontData n
fd
createEnv :: (Read n, RealFloat n)
=> AlignmentFns
-> n
-> n
-> FontSelector n -> DEnv n
createEnv :: forall n.
(Read n, RealFloat n) =>
AlignmentFns -> n -> n -> FontSelector n -> DEnv n
createEnv AlignmentFns
alignFns n
w n
h FontSelector n
fontSelector = DEnv
{ envAlignmentFns :: AlignmentFns
envAlignmentFns = AlignmentFns
alignFns
, envFontStyle :: FontStyle
envFontStyle = forall a. Default a => a
def
, envSelectFont :: FontSelector n
envSelectFont = FontSelector n
fontSelector
, envOutputSize :: (n, n)
envOutputSize = (n
w,n
h)
, envUsedGlyphs :: Map (FilePath, FontSlant, FontWeight) (Set FilePath)
envUsedGlyphs = forall k a. Map k a
M.empty
}
defaultEnv :: (Read n, RealFloat n)
=> AlignmentFns
-> n
-> n
-> IO (DEnv n)
defaultEnv :: forall n.
(Read n, RealFloat n) =>
AlignmentFns -> n -> n -> IO (DEnv n)
defaultEnv AlignmentFns
alignFns n
w n
h = do
FontSelector n
fontSelector <- forall n. (RealFloat n, Read n) => IO (FontSelector n)
loadSansSerifFonts
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n.
(Read n, RealFloat n) =>
AlignmentFns -> n -> n -> FontSelector n -> DEnv n
createEnv AlignmentFns
alignFns n
w n
h FontSelector n
fontSelector)
runBackendR :: ( D.Backend b V2 (N b), D.Renderable (D.Path V2 (N b)) b
, D.TypeableFloat (N b), D.Metric (V b))
=> DEnv (N b)
-> Renderable a
-> (D.QDiagram b V2 (N b) Any, PickFn a)
runBackendR :: forall b a.
(Backend b V2 (N b), Renderable (Path V2 (N b)) b,
TypeableFloat (N b), Metric (V b)) =>
DEnv (N b) -> Renderable a -> (QDiagram b V2 (N b) Any, PickFn a)
runBackendR DEnv (N b)
env Renderable a
r =
let cb :: BackendProgram (PickFn a)
cb = forall a.
Renderable a -> (Double, Double) -> BackendProgram (PickFn a)
render Renderable a
r (forall a b. (Real a, Fractional b) => a -> b
realToFrac N b
w, forall a b. (Real a, Fractional b) => a -> b
realToFrac N b
h)
(N b
w,N b
h) = forall n. DEnv n -> (n, n)
envOutputSize DEnv (N b)
env
in forall b a.
(Backend b V2 (N b), Renderable (Path V2 (N b)) b,
TypeableFloat (N b), Metric (V b)) =>
DEnv (N b) -> BackendProgram a -> (QDiagram b V2 (N b) Any, a)
runBackend DEnv (N b)
env BackendProgram (PickFn a)
cb
runBackend :: ( D.Backend b V2 (N b), D.Renderable (D.Path V2 (N b)) b
, D.TypeableFloat (N b), D.Metric (V b))
=> DEnv (N b)
-> BackendProgram a
-> (D.QDiagram b V2 (N b) Any, a)
runBackend :: forall b a.
(Backend b V2 (N b), Renderable (Path V2 (N b)) b,
TypeableFloat (N b), Metric (V b)) =>
DEnv (N b) -> BackendProgram a -> (QDiagram b V2 (N b) Any, a)
runBackend DEnv (N b)
env BackendProgram a
m =
let (QDiagram b V2 (N b) Any
d, a
x) = forall s a. State s a -> s -> a
evalState (forall b t a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> BackendProgram a -> DState (N b) (QDiagram b V2 (N b) Any, a)
runBackend' forall b. TextRender b (Path V2 (N b))
TextRenderSvg forall a b. (a -> b) -> a -> b
$ forall a. BackendProgram a -> BackendProgram a
withDefaultStyle BackendProgram a
m) DEnv (N b)
env
in (forall b.
(Backend b V2 (N b), RealFloat (N b)) =>
DEnv (N b) -> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
adjustOutputDiagram DEnv (N b)
env QDiagram b V2 (N b) Any
d, a
x)
runBackendWithGlyphs :: ( D.Backend b V2 (N b)
, D.Renderable (D.Path V2 (N b)) b
, D.Renderable (D2.Text (N b)) b
, D.TypeableFloat (N b), D.Metric (V b))
=> DEnv (N b)
-> BackendProgram a
-> ( D.QDiagram b V2 (N b) Any, a
, M.Map (String, FontSlant, FontWeight) (S.Set String))
runBackendWithGlyphs :: forall b a.
(Backend b V2 (N b), Renderable (Path V2 (N b)) b,
Renderable (Text (N b)) b, TypeableFloat (N b), Metric (V b)) =>
DEnv (N b)
-> BackendProgram a
-> (QDiagram b V2 (N b) Any, a,
Map (FilePath, FontSlant, FontWeight) (Set FilePath))
runBackendWithGlyphs DEnv (N b)
env BackendProgram a
m =
let ((QDiagram b V2 (N b) Any
d, a
x), DEnv (N b)
env') = forall s a. State s a -> s -> (a, s)
runState (forall b t a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> BackendProgram a -> DState (N b) (QDiagram b V2 (N b) Any, a)
runBackend' forall b. TextRender b (Text (N b))
TextRenderNative forall a b. (a -> b) -> a -> b
$ forall a. BackendProgram a -> BackendProgram a
withDefaultStyle BackendProgram a
m) DEnv (N b)
env
in (forall b.
(Backend b V2 (N b), RealFloat (N b)) =>
DEnv (N b) -> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
adjustOutputDiagram DEnv (N b)
env QDiagram b V2 (N b) Any
d, a
x, forall n.
DEnv n -> Map (FilePath, FontSlant, FontWeight) (Set FilePath)
envUsedGlyphs DEnv (N b)
env')
data TextRender b a where
TextRenderNative :: TextRender b (D2.Text (N b))
TextRenderSvg :: TextRender b (D.Path V2 (N b))
runBackend' :: (D.Renderable (D.Path V2 (N b)) b, D.Renderable t b, D.TypeableFloat (N b))
=> TextRender b t -> BackendProgram a
-> DState (N b) (D.QDiagram b V2 (N b) Any, a)
runBackend' :: forall b t a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> BackendProgram a -> DState (N b) (QDiagram b V2 (N b) Any, a)
runBackend' TextRender b t
tr BackendProgram a
m = forall b t a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> ProgramView ChartBackendInstr a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
eval TextRender b t
tr forall a b. (a -> b) -> a -> b
$ forall (instr :: * -> *) a. Program instr a -> ProgramView instr a
view forall a b. (a -> b) -> a -> b
$ BackendProgram a
m
where
eval :: (D.Renderable (D.Path V2 (N b)) b, D.Renderable t b, D.TypeableFloat (N b))
=> TextRender b t -> ProgramView ChartBackendInstr a
-> DState (N b) (D.QDiagram b V2 (N b) Any, a)
eval :: forall b t a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> ProgramView ChartBackendInstr a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
eval TextRender b t
tr (Return a
v) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a
mempty, a
v)
eval TextRender b t
tr (StrokePath Path
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = forall b.
(Renderable (Path V2 (N b)) b, TypeableFloat (N b)) =>
Path -> DState (N b) (QDiagram b V2 (N b) Any)
dStrokePath Path
p forall (s :: * -> *) m a.
(Monad s, Monoid m) =>
s m -> (() -> s (m, a)) -> s (m, a)
<># forall b t v a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> (v -> BackendProgram a)
-> v
-> DState (N b) (QDiagram b V2 (N b) Any, a)
step TextRender b t
tr b -> ProgramT ChartBackendInstr Identity a
f
eval TextRender b t
tr (FillPath Path
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = forall b.
(Renderable (Path V2 (N b)) b, TypeableFloat (N b)) =>
Path -> DState (N b) (QDiagram b V2 (N b) Any)
dFillPath Path
p forall (s :: * -> *) m a.
(Monad s, Monoid m) =>
s m -> (() -> s (m, a)) -> s (m, a)
<># forall b t v a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> (v -> BackendProgram a)
-> v
-> DState (N b) (QDiagram b V2 (N b) Any, a)
step TextRender b t
tr b -> ProgramT ChartBackendInstr Identity a
f
eval tr :: TextRender b t
tr@TextRender b t
TextRenderSvg (DrawText Point
p FilePath
s :>>= b -> ProgramT ChartBackendInstr Identity a
f) = forall b.
(Renderable (Path V2 (N b)) b, TypeableFloat (N b)) =>
Point -> FilePath -> DState (N b) (QDiagram b V2 (N b) Any)
dDrawTextSvg Point
p FilePath
s forall (s :: * -> *) m a.
(Monad s, Monoid m) =>
s m -> (() -> s (m, a)) -> s (m, a)
<># forall b t v a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> (v -> BackendProgram a)
-> v
-> DState (N b) (QDiagram b V2 (N b) Any, a)
step TextRender b t
tr b -> ProgramT ChartBackendInstr Identity a
f
eval tr :: TextRender b t
tr@TextRender b t
TextRenderNative (DrawText Point
p FilePath
s :>>= b -> ProgramT ChartBackendInstr Identity a
f) = forall b.
(Renderable (Text (N b)) b, TypeableFloat (N b)) =>
Point -> FilePath -> DState (N b) (QDiagram b V2 (N b) Any)
dDrawTextNative Point
p FilePath
s forall (s :: * -> *) m a.
(Monad s, Monoid m) =>
s m -> (() -> s (m, a)) -> s (m, a)
<># forall b t v a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> (v -> BackendProgram a)
-> v
-> DState (N b) (QDiagram b V2 (N b) Any, a)
step TextRender b t
tr b -> ProgramT ChartBackendInstr Identity a
f
eval TextRender b t
tr (GetTextSize FilePath
s :>>= b -> ProgramT ChartBackendInstr Identity a
f) = forall b.
(Renderable (Path V2 (N b)) b, TypeableFloat (N b)) =>
FilePath -> DState (N b) (QDiagram b V2 (N b) Any, TextSize)
dTextSize FilePath
s forall (s :: * -> *) m a b.
(Monad s, Monoid m) =>
s (m, a) -> (a -> s (m, b)) -> s (m, b)
<>= forall b t v a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> (v -> BackendProgram a)
-> v
-> DState (N b) (QDiagram b V2 (N b) Any, a)
step TextRender b t
tr b -> ProgramT ChartBackendInstr Identity a
f
eval TextRender b t
tr (ChartBackendInstr b
GetAlignments :>>= b -> ProgramT ChartBackendInstr Identity a
f) = forall b.
(Renderable (Path V2 (N b)) b, RealFloat (N b)) =>
DState (N b) (QDiagram b V2 (N b) Any, AlignmentFns)
dAlignmentFns forall (s :: * -> *) m a b.
(Monad s, Monoid m) =>
s (m, a) -> (a -> s (m, b)) -> s (m, b)
<>= forall b t v a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> (v -> BackendProgram a)
-> v
-> DState (N b) (QDiagram b V2 (N b) Any, a)
step TextRender b t
tr b -> ProgramT ChartBackendInstr Identity a
f
eval TextRender b t
tr (WithTransform Matrix
m Program ChartBackendInstr b
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = forall b t a.
(TypeableFloat (N b), Renderable (Path V2 (N b)) b,
Renderable t b) =>
TextRender b t
-> Matrix
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWithTransform TextRender b t
tr Matrix
m Program ChartBackendInstr b
p forall (s :: * -> *) m a b.
(Monad s, Monoid m) =>
s (m, a) -> (a -> s (m, b)) -> s (m, b)
<>= forall b t v a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> (v -> BackendProgram a)
-> v
-> DState (N b) (QDiagram b V2 (N b) Any, a)
step TextRender b t
tr b -> ProgramT ChartBackendInstr Identity a
f
eval TextRender b t
tr (WithFontStyle FontStyle
fs Program ChartBackendInstr b
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = forall b t a.
(TypeableFloat (N b), Renderable (Path V2 (N b)) b,
Renderable t b) =>
TextRender b t
-> FontStyle
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWithFontStyle TextRender b t
tr FontStyle
fs Program ChartBackendInstr b
p forall (s :: * -> *) m a b.
(Monad s, Monoid m) =>
s (m, a) -> (a -> s (m, b)) -> s (m, b)
<>= forall b t v a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> (v -> BackendProgram a)
-> v
-> DState (N b) (QDiagram b V2 (N b) Any, a)
step TextRender b t
tr b -> ProgramT ChartBackendInstr Identity a
f
eval TextRender b t
tr (WithFillStyle FillStyle
fs Program ChartBackendInstr b
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = forall b t a.
(TypeableFloat (N b), Renderable (Path V2 (N b)) b,
Renderable t b) =>
TextRender b t
-> FillStyle
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWithFillStyle TextRender b t
tr FillStyle
fs Program ChartBackendInstr b
p forall (s :: * -> *) m a b.
(Monad s, Monoid m) =>
s (m, a) -> (a -> s (m, b)) -> s (m, b)
<>= forall b t v a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> (v -> BackendProgram a)
-> v
-> DState (N b) (QDiagram b V2 (N b) Any, a)
step TextRender b t
tr b -> ProgramT ChartBackendInstr Identity a
f
eval TextRender b t
tr (WithLineStyle LineStyle
ls Program ChartBackendInstr b
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = forall b t a.
(TypeableFloat (N b), Renderable (Path V2 (N b)) b,
Renderable t b) =>
TextRender b t
-> LineStyle
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWithLineStyle TextRender b t
tr LineStyle
ls Program ChartBackendInstr b
p forall (s :: * -> *) m a b.
(Monad s, Monoid m) =>
s (m, a) -> (a -> s (m, b)) -> s (m, b)
<>= forall b t v a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> (v -> BackendProgram a)
-> v
-> DState (N b) (QDiagram b V2 (N b) Any, a)
step TextRender b t
tr b -> ProgramT ChartBackendInstr Identity a
f
eval TextRender b t
tr (WithClipRegion Rect
r Program ChartBackendInstr b
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = forall b t a.
(TypeableFloat (N b), Renderable (Path V2 (N b)) b,
Renderable t b) =>
TextRender b t
-> Rect
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWithClipRegion TextRender b t
tr Rect
r Program ChartBackendInstr b
p forall (s :: * -> *) m a b.
(Monad s, Monoid m) =>
s (m, a) -> (a -> s (m, b)) -> s (m, b)
<>= forall b t v a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> (v -> BackendProgram a)
-> v
-> DState (N b) (QDiagram b V2 (N b) Any, a)
step TextRender b t
tr b -> ProgramT ChartBackendInstr Identity a
f
step :: (D.Renderable (D.Path V2 (N b)) b, D.Renderable t b, D.TypeableFloat (N b))
=> TextRender b t -> (v -> BackendProgram a) -> v
-> DState (N b) (D.QDiagram b V2 (N b) Any, a)
step :: forall b t v a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> (v -> BackendProgram a)
-> v
-> DState (N b) (QDiagram b V2 (N b) Any, a)
step TextRender b t
tr v -> BackendProgram a
f v
v = forall b t a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> BackendProgram a -> DState (N b) (QDiagram b V2 (N b) Any, a)
runBackend' TextRender b t
tr (v -> BackendProgram a
f v
v)
(<>#) :: (Monad s, Monoid m) => s m -> (() -> s (m, a)) -> s (m, a)
<># :: forall (s :: * -> *) m a.
(Monad s, Monoid m) =>
s m -> (() -> s (m, a)) -> s (m, a)
(<>#) s m
m () -> s (m, a)
f = do
m
ma <- s m
m
forall (m :: * -> *) a. Monad m => a -> m a
return (m
ma, ()) forall (s :: * -> *) m a b.
(Monad s, Monoid m) =>
s (m, a) -> (a -> s (m, b)) -> s (m, b)
<>= () -> s (m, a)
f
(<>=) :: (Monad s, Monoid m) => s (m, a) -> (a -> s (m, b)) -> s (m, b)
<>= :: forall (s :: * -> *) m a b.
(Monad s, Monoid m) =>
s (m, a) -> (a -> s (m, b)) -> s (m, b)
(<>=) s (m, a)
m a -> s (m, b)
f = do
(m
ma, a
a) <- s (m, a)
m
(m
mb, b
b) <- a -> s (m, b)
f a
a
forall (m :: * -> *) a. Monad m => a -> m a
return (m
mb forall a. Semigroup a => a -> a -> a
<> m
ma, b
b)
dLocal :: DState n a -> DState n a
dLocal :: forall n a. DState n a -> DState n a
dLocal DState n a
m = do
DEnv n
env <- forall s (m :: * -> *). MonadState s m => m s
get
a
x <- DState n a
m
DEnv n
env' <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ DEnv n
env { envUsedGlyphs :: Map (FilePath, FontSlant, FontWeight) (Set FilePath)
envUsedGlyphs = forall n.
DEnv n -> Map (FilePath, FontSlant, FontWeight) (Set FilePath)
envUsedGlyphs DEnv n
env' }
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
dStrokePath :: (D.Renderable (D.Path V2 (N b)) b, D.TypeableFloat (N b))
=> Path -> DState (N b) (D.QDiagram b V2 (N b) Any)
dStrokePath :: forall b.
(Renderable (Path V2 (N b)) b, TypeableFloat (N b)) =>
Path -> DState (N b) (QDiagram b V2 (N b) Any)
dStrokePath Path
p = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
FillStyle -> a -> a
applyFillStyle FillStyle
noFillStyle forall a b. (a -> b) -> a -> b
$ forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
D.stroke forall a b. (a -> b) -> a -> b
$ forall n. (RealFloat n, Ord n) => Bool -> Path -> Path V2 n
convertPath Bool
False Path
p
dFillPath :: (D.Renderable (D.Path V2 (N b)) b, D.TypeableFloat (N b))
=> Path -> DState (N b) (D.QDiagram b V2 (N b) Any)
dFillPath :: forall b.
(Renderable (Path V2 (N b)) b, TypeableFloat (N b)) =>
Path -> DState (N b) (QDiagram b V2 (N b) Any)
dFillPath Path
p = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
LineStyle -> a -> a
applyLineStyle LineStyle
noLineStyle forall a b. (a -> b) -> a -> b
$ forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
D.stroke forall a b. (a -> b) -> a -> b
$ forall n. (RealFloat n, Ord n) => Bool -> Path -> Path V2 n
convertPath Bool
True Path
p
dTextSize :: (D.Renderable (D.Path V2 (N b)) b, D.TypeableFloat (N b))
=> String -> DState (N b) (D.QDiagram b V2 (N b) Any, TextSize)
dTextSize :: forall b.
(Renderable (Path V2 (N b)) b, TypeableFloat (N b)) =>
FilePath -> DState (N b) (QDiagram b V2 (N b) Any, TextSize)
dTextSize FilePath
text = do
DEnv (N b)
env <- forall s (m :: * -> *). MonadState s m => m s
get
let fs :: FontStyle
fs = forall n. DEnv n -> FontStyle
envFontStyle DEnv (N b)
env
let (N b
scaledH, N b
scaledA, N b
scaledD, N b
scaledYB) = forall n. RealFloat n => DEnv n -> (n, n, n, n)
calcFontMetrics DEnv (N b)
env
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a
mempty, TextSize
{ textSizeWidth :: Double
textSizeWidth = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ forall n a. (InSpace V2 n a, Enveloped a) => a -> n
D2.width
forall a b. (a -> b) -> a -> b
$ forall n. RealFloat n => PathInRect n -> Path V2 n
F.drop_rect
forall a b. (a -> b) -> a -> b
$ forall n. RealFloat n => n -> PathInRect n -> PathInRect n
F.fit_height N b
scaledH
forall a b. (a -> b) -> a -> b
$ forall n. RealFloat n => TextOpts n -> FilePath -> PathInRect n
F.svgText (forall n. RealFloat n => DEnv n -> TextOpts n
fontStyleToTextOpts DEnv (N b)
env) FilePath
text
, textSizeAscent :: Double
textSizeAscent = forall a b. (Real a, Fractional b) => a -> b
realToFrac N b
scaledA
, textSizeDescent :: Double
textSizeDescent = forall a b. (Real a, Fractional b) => a -> b
realToFrac N b
scaledD
, textSizeYBearing :: Double
textSizeYBearing = forall a b. (Real a, Fractional b) => a -> b
realToFrac N b
scaledYB
, textSizeHeight :: Double
textSizeHeight = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ FontStyle -> Double
_font_size FontStyle
fs
})
dAlignmentFns :: (D.Renderable (D.Path V2 (N b)) b, RealFloat (N b))
=> DState (N b) (D.QDiagram b V2 (N b) Any, AlignmentFns)
dAlignmentFns :: forall b.
(Renderable (Path V2 (N b)) b, RealFloat (N b)) =>
DState (N b) (QDiagram b V2 (N b) Any, AlignmentFns)
dAlignmentFns = do
DEnv (N b)
env <- forall s (m :: * -> *). MonadState s m => m s
get
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a
mempty, forall n. DEnv n -> AlignmentFns
envAlignmentFns DEnv (N b)
env)
dDrawTextSvg :: (D.Renderable (D.Path V2 (N b)) b, D.TypeableFloat (N b))
=> Point -> String -> DState (N b) (D.QDiagram b V2 (N b) Any)
dDrawTextSvg :: forall b.
(Renderable (Path V2 (N b)) b, TypeableFloat (N b)) =>
Point -> FilePath -> DState (N b) (QDiagram b V2 (N b) Any)
dDrawTextSvg (Point Double
x Double
y) FilePath
text = do
DEnv (N b)
env <- forall s (m :: * -> *). MonadState s m => m s
get
let (N b
scaledH, N b
_, N b
_, N b
_) = forall n. RealFloat n => DEnv n -> (n, n, n, n)
calcFontMetrics DEnv (N b)
env
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall t. Transformable t => Transformation (V t) (N t) -> t -> t
D.transform (forall n. RealFloat n => Matrix -> T2 n
toTransformation forall a b. (a -> b) -> a -> b
$ Vector -> Matrix -> Matrix
translate (Double -> Double -> Vector
Vector Double
x Double
y) Matrix
1)
forall a b. (a -> b) -> a -> b
$ forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
FontStyle -> a -> a
applyFontStyleSVG (forall n. DEnv n -> FontStyle
envFontStyle DEnv (N b)
env)
forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
D2.scaleY (-N b
1)
forall a b. (a -> b) -> a -> b
$ forall b n.
(TypeableFloat n, Renderable (Path V2 n) b) =>
PathInRect n -> QDiagram b V2 n Any
F.set_envelope
forall a b. (a -> b) -> a -> b
$ forall n. RealFloat n => n -> PathInRect n -> PathInRect n
F.fit_height N b
scaledH
forall a b. (a -> b) -> a -> b
$ forall n. RealFloat n => TextOpts n -> FilePath -> PathInRect n
F.svgText (forall n. RealFloat n => DEnv n -> TextOpts n
fontStyleToTextOpts DEnv (N b)
env) FilePath
text
dDrawTextNative :: (D.Renderable (D2.Text (N b)) b, D.TypeableFloat (N b))
=> Point -> String -> DState (N b) (D.QDiagram b V2 (N b) Any)
dDrawTextNative :: forall b.
(Renderable (Text (N b)) b, TypeableFloat (N b)) =>
Point -> FilePath -> DState (N b) (QDiagram b V2 (N b) Any)
dDrawTextNative (Point Double
x Double
y) FilePath
text = do
DEnv (N b)
env <- forall s (m :: * -> *). MonadState s m => m s
get
forall n. FilePath -> DState n ()
addGlyphsOfString FilePath
text
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall t. Transformable t => Transformation (V t) (N t) -> t -> t
D.transform (forall n. RealFloat n => Matrix -> T2 n
toTransformation forall a b. (a -> b) -> a -> b
$ Vector -> Matrix -> Matrix
translate (Double -> Double -> Vector
Vector Double
x Double
y) Matrix
1)
forall a b. (a -> b) -> a -> b
$ forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
FontStyle -> a -> a
applyFontStyleText (forall n. DEnv n -> FontStyle
envFontStyle DEnv (N b)
env)
forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
D2.scaleY (-N b
1)
forall a b. (a -> b) -> a -> b
$ forall n b.
(TypeableFloat n, Renderable (Text n) b) =>
FilePath -> QDiagram b V2 n Any
D2.baselineText FilePath
text
dWith :: ( D.TypeableFloat (N b), D.Metric V2
, D.Renderable (D.Path V2 (N b)) b, D.Renderable t b)
=> TextRender b t -> (DEnv (N b) -> DEnv (N b))
-> (D.QDiagram b V2 (N b) Any -> D.QDiagram b V2 (N b) Any)
-> BackendProgram a -> DState (N b) (D.QDiagram b V2 (N b) Any, a)
dWith :: forall b t a.
(TypeableFloat (N b), Metric V2, Renderable (Path V2 (N b)) b,
Renderable t b) =>
TextRender b t
-> (DEnv (N b) -> DEnv (N b))
-> (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWith TextRender b t
tr DEnv (N b) -> DEnv (N b)
envF QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
dF BackendProgram a
m = forall n a. DState n a -> DState n a
dLocal forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify DEnv (N b) -> DEnv (N b)
envF
(QDiagram b V2 (N b) Any
ma, a
a) <- forall b t a.
(Renderable (Path V2 (N b)) b, Renderable t b,
TypeableFloat (N b)) =>
TextRender b t
-> BackendProgram a -> DState (N b) (QDiagram b V2 (N b) Any, a)
runBackend' TextRender b t
tr BackendProgram a
m
forall (m :: * -> *) a. Monad m => a -> m a
return (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
dF QDiagram b V2 (N b) Any
ma, a
a)
dWithTransform :: (D.TypeableFloat (N b), D.Renderable (D.Path V2 (N b)) b, D.Renderable t b)
=> TextRender b t -> Matrix -> BackendProgram a -> DState (N b) (D.QDiagram b V2 (N b) Any, a)
dWithTransform :: forall b t a.
(TypeableFloat (N b), Renderable (Path V2 (N b)) b,
Renderable t b) =>
TextRender b t
-> Matrix
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWithTransform TextRender b t
tr Matrix
t = forall b t a.
(TypeableFloat (N b), Metric V2, Renderable (Path V2 (N b)) b,
Renderable t b) =>
TextRender b t
-> (DEnv (N b) -> DEnv (N b))
-> (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWith TextRender b t
tr forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall t. Transformable t => Transformation (V t) (N t) -> t -> t
D.transform (forall n. RealFloat n => Matrix -> T2 n
toTransformation Matrix
t)
dWithLineStyle :: (D.TypeableFloat (N b), D.Renderable (D.Path V2 (N b)) b, D.Renderable t b)
=> TextRender b t -> LineStyle -> BackendProgram a -> DState (N b) (D.QDiagram b V2 (N b) Any, a)
dWithLineStyle :: forall b t a.
(TypeableFloat (N b), Renderable (Path V2 (N b)) b,
Renderable t b) =>
TextRender b t
-> LineStyle
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWithLineStyle TextRender b t
tr LineStyle
ls = forall b t a.
(TypeableFloat (N b), Metric V2, Renderable (Path V2 (N b)) b,
Renderable t b) =>
TextRender b t
-> (DEnv (N b) -> DEnv (N b))
-> (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWith TextRender b t
tr forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
LineStyle -> a -> a
applyLineStyle LineStyle
ls
dWithFillStyle :: (D.TypeableFloat (N b), D.Renderable (D.Path V2 (N b)) b, D.Renderable t b)
=> TextRender b t -> FillStyle -> BackendProgram a -> DState (N b) (D.QDiagram b V2 (N b) Any, a)
dWithFillStyle :: forall b t a.
(TypeableFloat (N b), Renderable (Path V2 (N b)) b,
Renderable t b) =>
TextRender b t
-> FillStyle
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWithFillStyle TextRender b t
tr FillStyle
fs = forall b t a.
(TypeableFloat (N b), Metric V2, Renderable (Path V2 (N b)) b,
Renderable t b) =>
TextRender b t
-> (DEnv (N b) -> DEnv (N b))
-> (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWith TextRender b t
tr forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
FillStyle -> a -> a
applyFillStyle FillStyle
fs
dWithFontStyle :: (D.TypeableFloat (N b), D.Renderable (D.Path V2 (N b)) b, D.Renderable t b)
=> TextRender b t -> FontStyle -> BackendProgram a -> DState (N b) (D.QDiagram b V2 (N b) Any, a)
dWithFontStyle :: forall b t a.
(TypeableFloat (N b), Renderable (Path V2 (N b)) b,
Renderable t b) =>
TextRender b t
-> FontStyle
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWithFontStyle TextRender b t
tr FontStyle
fs = forall b t a.
(TypeableFloat (N b), Metric V2, Renderable (Path V2 (N b)) b,
Renderable t b) =>
TextRender b t
-> (DEnv (N b) -> DEnv (N b))
-> (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWith TextRender b t
tr (\DEnv (N b)
e -> DEnv (N b)
e { envFontStyle :: FontStyle
envFontStyle = FontStyle
fs }) forall a b. (a -> b) -> a -> b
$ forall a. a -> a
id
dWithClipRegion :: (D.TypeableFloat (N b), D.Renderable (D.Path V2 (N b)) b, D.Renderable t b)
=> TextRender b t -> Rect -> BackendProgram a -> DState (N b) (D.QDiagram b V2 (N b) Any, a)
dWithClipRegion :: forall b t a.
(TypeableFloat (N b), Renderable (Path V2 (N b)) b,
Renderable t b) =>
TextRender b t
-> Rect
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWithClipRegion TextRender b t
tr Rect
clip = forall b t a.
(TypeableFloat (N b), Metric V2, Renderable (Path V2 (N b)) b,
Renderable t b) =>
TextRender b t
-> (DEnv (N b) -> DEnv (N b))
-> (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWith TextRender b t
tr forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a n.
(HasStyle a, V a ~ V2, N a ~ n, TypeableFloat n) =>
Path V2 n -> a -> a
D2.clipBy (forall n. (RealFloat n, Ord n) => Bool -> Path -> Path V2 n
convertPath Bool
True forall a b. (a -> b) -> a -> b
$ Rect -> Path
rectPath Rect
clip)
addGlyphsOfString :: String -> DState n ()
addGlyphsOfString :: forall n. FilePath -> DState n ()
addGlyphsOfString FilePath
s = do
DEnv n
env <- forall s (m :: * -> *). MonadState s m => m s
get
let fs :: FontStyle
fs = forall n. DEnv n -> FontStyle
envFontStyle DEnv n
env
let fontData :: FontData n
fontData = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall n. DEnv n -> FontSelector n
envSelectFont DEnv n
env FontStyle
fs
let ligatures :: [FilePath]
ligatures = (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
>Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [k]
M.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. FontData n -> SvgGlyphs n
F.fontDataGlyphs) FontData n
fontData
let glyphs :: [FilePath]
glyphs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> [Text]
F.characterStrings FilePath
s [FilePath]
ligatures
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \DEnv n
env ->
let gKey :: (FilePath, FontSlant, FontWeight)
gKey = (FontStyle -> FilePath
_font_name FontStyle
fs, FontStyle -> FontSlant
_font_slant FontStyle
fs, FontStyle -> FontWeight
_font_weight FontStyle
fs)
gMap :: Map (FilePath, FontSlant, FontWeight) (Set FilePath)
gMap = forall n.
DEnv n -> Map (FilePath, FontSlant, FontWeight) (Set FilePath)
envUsedGlyphs DEnv n
env
entry :: Set FilePath
entry = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (FilePath, FontSlant, FontWeight)
gKey Map (FilePath, FontSlant, FontWeight) (Set FilePath)
gMap of
Maybe (Set FilePath)
Nothing -> forall a. Ord a => [a] -> Set a
S.fromList [FilePath]
glyphs
Just Set FilePath
gs -> Set FilePath
gs forall a. Ord a => Set a -> Set a -> Set a
`S.union` forall a. Ord a => [a] -> Set a
S.fromList [FilePath]
glyphs
in DEnv n
env { envUsedGlyphs :: Map (FilePath, FontSlant, FontWeight) (Set FilePath)
envUsedGlyphs = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (FilePath, FontSlant, FontWeight)
gKey Set FilePath
entry Map (FilePath, FontSlant, FontWeight) (Set FilePath)
gMap }
forall (m :: * -> *) a. Monad m => a -> m a
return ()
pointToP2 :: RealFrac n => Point -> P2 n
pointToP2 :: forall n. RealFrac n => Point -> P2 n
pointToP2 (Point Double
x Double
y) = forall n. (n, n) -> P2 n
p2 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x, forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
y)
adjustOutputDiagram :: (D.Backend b V2 (N b), RealFloat (N b))
=> DEnv (N b) -> D.QDiagram b V2 (N b) Any -> D.QDiagram b V2 (N b) Any
adjustOutputDiagram :: forall b.
(Backend b V2 (N b), RealFloat (N b)) =>
DEnv (N b) -> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
adjustOutputDiagram DEnv (N b)
env QDiagram b V2 (N b) Any
d = forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
D2.reflectY forall a b. (a -> b) -> a -> b
$ forall b n m.
(OrderedField n, Monoid' m) =>
Point V2 n -> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
D.rectEnvelope (forall n. (n, n) -> P2 n
p2 (N b
0,N b
0)) (forall n. (n, n) -> V2 n
r2 (forall n. DEnv n -> (n, n)
envOutputSize DEnv (N b)
env)) QDiagram b V2 (N b) Any
d
noLineStyle :: LineStyle
noLineStyle :: LineStyle
noLineStyle = forall a. Default a => a
def
{ _line_width :: Double
_line_width = Double
0
, _line_color :: AlphaColour Double
_line_color = forall a. Num a => AlphaColour a
transparent
}
noFillStyle :: FillStyle
noFillStyle :: FillStyle
noFillStyle = AlphaColour Double -> FillStyle
solidFillStyle forall a. Num a => AlphaColour a
transparent
toTransformation :: RealFloat n => Matrix -> T2 n
toTransformation :: forall n. RealFloat n => Matrix -> T2 n
toTransformation Matrix
m = forall (v :: * -> *) n.
(v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
Transformation
(forall n. RealFloat n => Matrix -> V2 n -> V2 n
applyWithoutTrans Matrix
m forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> forall n. RealFloat n => Matrix -> V2 n -> V2 n
applyWithoutTrans (Matrix -> Matrix
invert Matrix
m))
(forall n. RealFloat n => Matrix -> V2 n -> V2 n
applyWithoutTrans (Matrix -> Matrix
transpose Matrix
m) forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> forall n. RealFloat n => Matrix -> V2 n -> V2 n
applyWithoutTrans (Matrix -> Matrix
transpose (Matrix -> Matrix
invert Matrix
m)))
(forall n. (n, n) -> V2 n
r2 (forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ Matrix -> Double
x0 Matrix
m, forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ Matrix -> Double
y0 Matrix
m))
transpose :: Matrix -> Matrix
transpose :: Matrix -> Matrix
transpose (Matrix Double
xx Double
yx Double
xy Double
yy Double
_ Double
_) = Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix Double
xx Double
xy Double
yx Double
yy Double
0 Double
0
applyTransformation :: RealFloat n => Matrix -> P2 n -> P2 n
applyTransformation :: forall n. RealFloat n => Matrix -> P2 n -> P2 n
applyTransformation Matrix
m P2 n
p =
let (n
x,n
y) = forall n. P2 n -> (n, n)
D2.unp2 P2 n
p
get :: RealFloat n => (Matrix -> Double) -> n
get :: forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
f = forall a b. (Real a, Fractional b) => a -> b
realToFrac (Matrix -> Double
f Matrix
m)
in forall n. (n, n) -> P2 n
p2 ( forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
xx forall a. Num a => a -> a -> a
* n
x forall a. Num a => a -> a -> a
+ forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
xy forall a. Num a => a -> a -> a
* n
y forall a. Num a => a -> a -> a
+ forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
x0
, forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
yx forall a. Num a => a -> a -> a
* n
x forall a. Num a => a -> a -> a
+ forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
yy forall a. Num a => a -> a -> a
* n
y forall a. Num a => a -> a -> a
+ forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
y0
)
applyWithoutTrans :: RealFloat n => Matrix -> V2 n -> V2 n
applyWithoutTrans :: forall n. RealFloat n => Matrix -> V2 n -> V2 n
applyWithoutTrans Matrix
m V2 n
v =
let (n
x,n
y) = forall n. V2 n -> (n, n)
D2.unr2 V2 n
v
get :: RealFloat n => (Matrix -> Double) -> n
get :: forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
f = forall a b. (Real a, Fractional b) => a -> b
realToFrac (Matrix -> Double
f Matrix
m)
in forall n. (n, n) -> V2 n
r2 ( forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
xx forall a. Num a => a -> a -> a
* n
x forall a. Num a => a -> a -> a
+ forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
xy forall a. Num a => a -> a -> a
* n
y
, forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
yx forall a. Num a => a -> a -> a
* n
x forall a. Num a => a -> a -> a
+ forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
yy forall a. Num a => a -> a -> a
* n
y
)
applyLineStyle :: (D.TypeableFloat (N a), D.V a ~ V2, D.HasStyle a) => LineStyle -> a -> a
applyLineStyle :: forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
LineStyle -> a -> a
applyLineStyle LineStyle
ls = forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
D.lineWidth (forall n. Num n => n -> Measure n
D.global forall a b. (a -> b) -> a -> b
$ forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ LineStyle -> Double
_line_width LineStyle
ls)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n a c.
(InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) =>
c -> a -> a
D.lineColor (LineStyle -> AlphaColour Double
_line_color LineStyle
ls)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasStyle a => LineCap -> a -> a
D.lineCap (LineCap -> LineCap
convertLineCap forall a b. (a -> b) -> a -> b
$ LineStyle -> LineCap
_line_cap LineStyle
ls)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasStyle a => LineJoin -> a -> a
D.lineJoin (LineJoin -> LineJoin
convertLineJoin forall a b. (a -> b) -> a -> b
$ LineStyle -> LineJoin
_line_join LineStyle
ls)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
[Measure n] -> Measure n -> a -> a
D.dashing (forall a b. (a -> b) -> [a] -> [b]
map (forall n. Num n => n -> Measure n
D.global forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac) forall a b. (a -> b) -> a -> b
$ LineStyle -> [Double]
_line_dashes LineStyle
ls) (forall n. Num n => n -> Measure n
D.global N a
0)
applyFillStyle :: (D.TypeableFloat (N a), V a ~ V2, D.HasStyle a) => FillStyle -> a -> a
applyFillStyle :: forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
FillStyle -> a -> a
applyFillStyle FillStyle
fs = case FillStyle
fs of
FillStyleSolid AlphaColour Double
cl -> forall n a c.
(InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) =>
c -> a -> a
D.fillColor AlphaColour Double
cl
applyFontStyleSVG :: (D.TypeableFloat (N a), D.V a ~ V2, D.HasStyle a) => FontStyle -> a -> a
applyFontStyleSVG :: forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
FontStyle -> a -> a
applyFontStyleSVG FontStyle
fs = forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
LineStyle -> a -> a
applyLineStyle LineStyle
noLineStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
FillStyle -> a -> a
applyFillStyle (AlphaColour Double -> FillStyle
solidFillStyle forall a b. (a -> b) -> a -> b
$ FontStyle -> AlphaColour Double
_font_color FontStyle
fs)
applyFontStyleText :: (D.TypeableFloat (N a), D.V a ~ V2, D.HasStyle a) => FontStyle -> a -> a
applyFontStyleText :: forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
FontStyle -> a -> a
applyFontStyleText FontStyle
fs = forall a. HasStyle a => FilePath -> a -> a
D2.font (FontStyle -> FilePath
_font_name FontStyle
fs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a n.
(N a ~ n, Typeable n, HasStyle a) =>
Measure n -> a -> a
D2.fontSize (forall n. Num n => n -> Measure n
D.global forall a b. (a -> b) -> a -> b
$ forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ FontStyle -> Double
_font_size FontStyle
fs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasStyle a => FontSlant -> a -> a
D2.fontSlant (FontSlant -> FontSlant
convertFontSlant forall a b. (a -> b) -> a -> b
$ FontStyle -> FontSlant
_font_slant FontStyle
fs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasStyle a => FontWeight -> a -> a
D2.fontWeight (FontWeight -> FontWeight
convertFontWeight forall a b. (a -> b) -> a -> b
$ FontStyle -> FontWeight
_font_weight FontStyle
fs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n a c.
(InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) =>
c -> a -> a
D.fillColor (FontStyle -> AlphaColour Double
_font_color FontStyle
fs)
calcFontMetrics :: RealFloat n => DEnv n -> (n, n, n, n)
calcFontMetrics :: forall n. RealFloat n => DEnv n -> (n, n, n, n)
calcFontMetrics DEnv n
env =
let fs :: FontStyle
fs = forall n. DEnv n -> FontStyle
envFontStyle DEnv n
env
font :: PreparedFont n
font@(FontData n
fontData,OutlineMap n
_) = forall n. DEnv n -> FontSelector n
envSelectFont DEnv n
env FontStyle
fs
bbox :: [n]
bbox = forall n. FontData n -> [n]
F.fontDataBoundingBox FontData n
fontData
capHeight :: n
capHeight = forall n. FontData n -> n
F.fontDataCapHeight FontData n
fontData
a :: n
a = [n]
bbox forall a. [a] -> Int -> a
!! Int
3
d :: n
d = -[n]
bbox forall a. [a] -> Int -> a
!! Int
1
h :: n
h = n
unscaledH
a' :: n
a' = n
unscaledH
d' :: n
d' = (n
d forall a. Fractional a => a -> a -> a
/ n
h) forall a. Num a => a -> a -> a
* n
h'
h' :: n
h' = (n
a forall a. Num a => a -> a -> a
+ n
d) forall a. Fractional a => a -> a -> a
/ (n
1 forall a. Num a => a -> a -> a
- n
d forall a. Fractional a => a -> a -> a
/ n
h)
unscaledH :: n
unscaledH = forall n. RealFloat n => FontData n -> n
F.bbox_dy forall a b. (a -> b) -> a -> b
$ FontData n
fontData
scaledHeight :: n
scaledHeight = forall a b. (Real a, Fractional b) => a -> b
realToFrac (FontStyle -> Double
_font_size FontStyle
fs) forall a. Num a => a -> a -> a
* (n
h' forall a. Fractional a => a -> a -> a
/ n
h)
scaledAscent :: n
scaledAscent = n
scaledHeight forall a. Num a => a -> a -> a
* (n
a' forall a. Fractional a => a -> a -> a
/ n
h')
scaledDescent :: n
scaledDescent = n
scaledHeight forall a. Num a => a -> a -> a
* (n
d' forall a. Fractional a => a -> a -> a
/ n
h')
scaledMaxHAdv :: n
scaledMaxHAdv = -n
scaledHeight forall a. Num a => a -> a -> a
* (n
capHeight forall a. Fractional a => a -> a -> a
/ n
h)
in (n
scaledHeight, n
scaledAscent, n
scaledDescent, n
scaledMaxHAdv)
fontStyleToTextOpts :: RealFloat n => DEnv n -> F.TextOpts n
fontStyleToTextOpts :: forall n. RealFloat n => DEnv n -> TextOpts n
fontStyleToTextOpts DEnv n
env =
let fs :: FontStyle
fs = forall n. DEnv n -> FontStyle
envFontStyle DEnv n
env
font :: PreparedFont n
font = forall n. DEnv n -> FontSelector n
envSelectFont DEnv n
env FontStyle
fs
in F.TextOpts
{ textFont :: PreparedFont n
F.textFont = PreparedFont n
font
, spacing :: Spacing
F.spacing = Spacing
F.KERN
, underline :: Bool
F.underline = Bool
False
}
convertLineCap :: LineCap -> D.LineCap
convertLineCap :: LineCap -> LineCap
convertLineCap LineCap
cap = case LineCap
cap of
LineCap
LineCapButt -> LineCap
D.LineCapButt
LineCap
LineCapRound -> LineCap
D.LineCapRound
LineCap
LineCapSquare -> LineCap
D.LineCapSquare
convertLineJoin :: LineJoin -> D.LineJoin
convertLineJoin :: LineJoin -> LineJoin
convertLineJoin LineJoin
join = case LineJoin
join of
LineJoin
LineJoinMiter -> LineJoin
D.LineJoinMiter
LineJoin
LineJoinRound -> LineJoin
D.LineJoinRound
LineJoin
LineJoinBevel -> LineJoin
D.LineJoinBevel
convertFontSlant :: FontSlant -> D2.FontSlant
convertFontSlant :: FontSlant -> FontSlant
convertFontSlant FontSlant
fs = case FontSlant
fs of
FontSlant
FontSlantNormal -> FontSlant
D2.FontSlantNormal
FontSlant
FontSlantItalic -> FontSlant
D2.FontSlantItalic
FontSlant
FontSlantOblique -> FontSlant
D2.FontSlantOblique
convertFontWeight :: FontWeight -> D2.FontWeight
convertFontWeight :: FontWeight -> FontWeight
convertFontWeight FontWeight
fw = case FontWeight
fw of
FontWeight
FontWeightBold -> FontWeight
D2.FontWeightBold
FontWeight
FontWeightNormal -> FontWeight
D2.FontWeightNormal
convertPath :: (RealFloat n, Ord n) => Bool -> Path -> D.Path V2 n
convertPath :: forall n. (RealFloat n, Ord n) => Bool -> Path -> Path V2 n
convertPath Bool
closeAll Path
path =
let (Point V2 n
start, Trail V2 n
t, Maybe Path
restM) = forall n.
RealFloat n =>
Bool -> Point -> Path -> (Point V2 n, Trail V2 n, Maybe Path)
pathToTrail Bool
closeAll (Double -> Double -> Point
Point Double
0 Double
0) forall a b. (a -> b) -> a -> b
$ Path -> Path
makeLinesExplicit Path
path
in forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Point v n -> Path v n
D.pathFromTrailAt Trail V2 n
t Point V2 n
start forall a. Semigroup a => a -> a -> a
<> case Maybe Path
restM of
Maybe Path
Nothing -> forall a. Monoid a => a
mempty
Just Path
rest -> forall n. (RealFloat n, Ord n) => Bool -> Path -> Path V2 n
convertPath Bool
closeAll Path
rest
pathToTrail :: (RealFloat n)
=> Bool -> Point -> Path
-> (D.Point V2 n, Trail V2 n, Maybe Path)
pathToTrail :: forall n.
RealFloat n =>
Bool -> Point -> Path -> (Point V2 n, Trail V2 n, Maybe Path)
pathToTrail Bool
closeAll Point
_ (MoveTo Point
p0 Path
path) =
let (Trail' Line V2 n
t, Bool
close, Maybe Path
rest) = forall n.
RealFloat n =>
Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
pathToTrail' Bool
closeAll Path
path Point
p0
in (forall n. RealFrac n => Point -> P2 n
pointToP2 Point
p0, forall n. Bool -> Trail' Line V2 n -> Trail V2 n
makeTrail Bool
close Trail' Line V2 n
t, Maybe Path
rest)
pathToTrail Bool
closeAll Point
_ path :: Path
path@(Arc Point
c Double
r Double
s Double
_ Path
_) =
let p0 :: Point
p0 = Vector -> Point -> Point
translateP (Point -> Vector
pointToVec Point
c) forall a b. (a -> b) -> a -> b
$ Double -> Point -> Point
rotateP Double
s forall a b. (a -> b) -> a -> b
$ Double -> Double -> Point
Point Double
r Double
0
(Trail' Line V2 n
t, Bool
close, Maybe Path
rest) = forall n.
RealFloat n =>
Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
pathToTrail' Bool
closeAll Path
path Point
p0
in (forall n. RealFrac n => Point -> P2 n
pointToP2 Point
p0, forall n. Bool -> Trail' Line V2 n -> Trail V2 n
makeTrail Bool
close Trail' Line V2 n
t, Maybe Path
rest)
pathToTrail Bool
closeAll Point
_ path :: Path
path@(ArcNeg Point
c Double
r Double
s Double
_ Path
_) =
let p0 :: Point
p0 = Vector -> Point -> Point
translateP (Point -> Vector
pointToVec Point
c) forall a b. (a -> b) -> a -> b
$ Double -> Point -> Point
rotateP Double
s forall a b. (a -> b) -> a -> b
$ Double -> Double -> Point
Point Double
r Double
0
(Trail' Line V2 n
t, Bool
close, Maybe Path
rest) = forall n.
RealFloat n =>
Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
pathToTrail' Bool
closeAll Path
path Point
p0
in (forall n. RealFrac n => Point -> P2 n
pointToP2 Point
p0, forall n. Bool -> Trail' Line V2 n -> Trail V2 n
makeTrail Bool
close Trail' Line V2 n
t, Maybe Path
rest)
pathToTrail Bool
closeAll Point
start Path
path =
let (Trail' Line V2 n
t, Bool
close, Maybe Path
rest) = forall n.
RealFloat n =>
Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
pathToTrail' Bool
closeAll Path
path Point
start
in (forall n. RealFrac n => Point -> P2 n
pointToP2 Point
start, forall n. Bool -> Trail' Line V2 n -> Trail V2 n
makeTrail Bool
close Trail' Line V2 n
t, Maybe Path
rest)
makeTrail :: Bool -> D.Trail' D.Line V2 n -> Trail V2 n
makeTrail :: forall n. Bool -> Trail' Line V2 n -> Trail V2 n
makeTrail Bool
True Trail' Line V2 n
t = forall l (v :: * -> *) n. Trail' l v n -> Trail v n
D.wrapTrail forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. Trail' Line v n -> Trail' Loop v n
D.closeLine Trail' Line V2 n
t
makeTrail Bool
False Trail' Line V2 n
t = forall l (v :: * -> *) n. Trail' l v n -> Trail v n
D.wrapTrail forall a b. (a -> b) -> a -> b
$ Trail' Line V2 n
t
angleToDirection :: RealFloat n => Double -> D.Direction V2 n
angleToDirection :: forall n. RealFloat n => Double -> Direction V2 n
angleToDirection Double
a = forall (v :: * -> *) n. v n -> Direction v n
D.direction forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
D2.V2 (forall a. Floating a => a -> a
cos Double
a) (forall a. Floating a => a -> a
sin Double
a)
pathToTrail' :: (RealFloat n)
=> Bool -> Path -> Point -> (D.Trail' D.Line V2 n, Bool, Maybe Path)
pathToTrail' :: forall n.
RealFloat n =>
Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
pathToTrail' Bool
closeAll p :: Path
p@(MoveTo Point
_ Path
_) Point
_ = (forall a. Monoid a => a
mempty, Bool
False Bool -> Bool -> Bool
|| Bool
closeAll, forall a. a -> Maybe a
Just Path
p)
pathToTrail' Bool
closeAll (LineTo Point
p1 Path
path) Point
p0 =
let (Trail' Line V2 n
t, Bool
c, Maybe Path
rest) = forall n.
RealFloat n =>
Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
pathToTrail' Bool
closeAll Path
path Point
p1
in ( (forall n. RealFrac n => Point -> P2 n
pointToP2 Point
p0 forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t) =>
Point v n -> Point v n -> t
~~ forall n. RealFrac n => Point -> P2 n
pointToP2 Point
p1) forall a. Semigroup a => a -> a -> a
<> Trail' Line V2 n
t, Bool
c Bool -> Bool -> Bool
|| Bool
closeAll, Maybe Path
rest )
pathToTrail' Bool
closeAll (Arc Point
p0 Double
r Double
s Double
e Path
path) Point
_ =
let endP :: Point
endP = Vector -> Point -> Point
translateP (Point -> Vector
pointToVec Point
p0) forall a b. (a -> b) -> a -> b
$ Double -> Point -> Point
rotateP Double
e forall a b. (a -> b) -> a -> b
$ Double -> Double -> Point
Point Double
r Double
0
(Trail' Line V2 n
t, Bool
c, Maybe Path
rest) = forall n.
RealFloat n =>
Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
pathToTrail' Bool
closeAll Path
path Point
endP
arcTrail :: Trail' Line V2 n
arcTrail = forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
D2.scale (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
r) forall a b. (a -> b) -> a -> b
$ forall n t.
(InSpace V2 n t, RealFloat n, TrailLike t) =>
Direction V2 n -> Direction V2 n -> t
D2.arcCCW (forall n. RealFloat n => Double -> Direction V2 n
angleToDirection Double
s) (forall n. RealFloat n => Double -> Direction V2 n
angleToDirection Double
e)
in ( Trail' Line V2 n
arcTrail forall a. Semigroup a => a -> a -> a
<> Trail' Line V2 n
t, Bool
c Bool -> Bool -> Bool
|| Bool
closeAll, Maybe Path
rest )
pathToTrail' Bool
closeAll (ArcNeg Point
p0 Double
r Double
s Double
e Path
path) Point
_ =
let endP :: Point
endP = Vector -> Point -> Point
translateP (Point -> Vector
pointToVec Point
p0) forall a b. (a -> b) -> a -> b
$ Double -> Point -> Point
rotateP Double
e forall a b. (a -> b) -> a -> b
$ Double -> Double -> Point
Point Double
r Double
0
(Trail' Line V2 n
t, Bool
c, Maybe Path
rest) = forall n.
RealFloat n =>
Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
pathToTrail' Bool
closeAll Path
path Point
endP
arcTrail :: Trail' Line V2 n
arcTrail = forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
D2.scale (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
r) forall a b. (a -> b) -> a -> b
$ forall n t.
(InSpace V2 n t, RealFloat n, TrailLike t) =>
Direction V2 n -> Direction V2 n -> t
D2.arcCW (forall n. RealFloat n => Double -> Direction V2 n
angleToDirection Double
s) (forall n. RealFloat n => Double -> Direction V2 n
angleToDirection Double
e)
in ( Trail' Line V2 n
arcTrail forall a. Semigroup a => a -> a -> a
<> Trail' Line V2 n
t, Bool
c Bool -> Bool -> Bool
|| Bool
closeAll, Maybe Path
rest )
pathToTrail' Bool
closeAll Path
End Point
_ = (forall a. Monoid a => a
mempty, Bool
False Bool -> Bool -> Bool
|| Bool
closeAll, forall a. Maybe a
Nothing)
pathToTrail' Bool
closeAll Path
Close Point
_ = (forall a. Monoid a => a
mempty, Bool
True Bool -> Bool -> Bool
|| Bool
closeAll, forall a. Maybe a
Nothing)
$( makeLenses ''FileOptions )