{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}

-- | The backend to render charts with the diagrams library.
module Graphics.Rendering.Chart.Backend.Diagrams
  ( runBackend
  , runBackendR
  , runBackendWithGlyphs
  , defaultEnv
  , createEnv
  , DEnv(..)

  -- * File Output Functons
  , FileFormat(..)
  , FileOptions(..)
  , fo_size
  , fo_format
  , fo_fonts
  , renderableToFile
  , toFile
  , cBackendToFile

  -- * Fonts
  , 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 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)

-- -----------------------------------------------------------------------
-- General purpose file output function
-- -----------------------------------------------------------------------


-- | The file output format:
--     EPS -> Embedded Postscript
--     SVG -> SVG with text rendered as stroked paths
--     SVG -> SVG with embedded font information and text rendered as text operations
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 IO (FontSelector Double)
forall n. (RealFloat n, Read n) => IO (FontSelector n)
loadSansSerifFonts

-- | Generate an image file for the given renderable, at the specified path. Size, format,
-- and text rendering mode are all set through the `FileOptions` parameter.
renderableToFile :: FileOptions -> FilePath -> Renderable a -> IO (PickFn a)
renderableToFile :: FileOptions -> FilePath -> Renderable a -> IO (PickFn a)
renderableToFile FileOptions
fo FilePath
path Renderable a
r = FileOptions
-> BackendProgram (PickFn a) -> FilePath -> IO (PickFn a)
forall a. FileOptions -> BackendProgram a -> FilePath -> IO a
cBackendToFile FileOptions
fo BackendProgram (PickFn a)
cb FilePath
path
  where
    cb :: BackendProgram (PickFn a)
cb = Renderable a -> (Double, Double) -> BackendProgram (PickFn a)
forall a.
Renderable a -> (Double, Double) -> BackendProgram (PickFn a)
render Renderable a
r (FileOptions -> (Double, Double)
_fo_size FileOptions
fo)

-- | Generate an image file from from the state content of an EC
-- computation. The state may have any type that is an instance of
-- `ToRenderable`
toFile :: (Default r,ToRenderable r) => FileOptions -> FilePath -> EC r () -> IO ()
toFile :: FileOptions -> FilePath -> EC r () -> IO ()
toFile FileOptions
fo FilePath
path EC r ()
ec = IO (PickFn ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (PickFn ()) -> IO ()) -> IO (PickFn ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ FileOptions -> FilePath -> Renderable () -> IO (PickFn ())
forall a. FileOptions -> FilePath -> Renderable a -> IO (PickFn a)
renderableToFile FileOptions
fo FilePath
path (r -> Renderable ()
forall a. ToRenderable a => a -> Renderable ()
toRenderable (EC r () -> r
forall l a. Default l => EC l a -> l
execEC EC r ()
ec))

-- | Generate an image file for the given drawing instructions, at the specified path. Size and
-- format are set through the `FileOptions` parameter.
cBackendToFile :: FileOptions -> BackendProgram a -> FilePath -> IO a
cBackendToFile :: 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 = AlignmentFns
-> Double -> Double -> FontSelector Double -> DEnv Double
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 Double Any
d, a
a) = DEnv (N Postscript)
-> BackendProgram a
-> (QDiagram Postscript V2 (N Postscript) Any, 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
DEnv (N Postscript)
env BackendProgram a
cb
          opts :: Options Postscript V2 Double
opts = FilePath
-> SizeSpec V2 Double
-> OutputFormat
-> Options Postscript V2 Double
DEPS.PostscriptOptions FilePath
path (Double -> Double -> SizeSpec V2 Double
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 = Postscript
-> Options Postscript V2 Double
-> QDiagram Postscript V2 Double Any
-> Result Postscript 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
D.renderDia Postscript
DEPS.Postscript Options Postscript V2 Double
opts QDiagram Postscript V2 Double Any
d
      FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile (Options Postscript V2 Double
opts Options Postscript V2 Double
-> Getting FilePath (Options Postscript V2 Double) FilePath
-> FilePath
forall s a. s -> Getting a s a -> a
D.^. Getting FilePath (Options Postscript V2 Double) FilePath
Lens' (Options Postscript V2 Double) FilePath
DEPS.psfileName) IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
        Handle -> Builder -> IO ()
B.hPutBuilder Handle
h Builder
Result Postscript V2 Double
eps
#else
      D.renderDia DEPS.Postscript opts d
#endif
      a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    FileFormat
SVG -> do
      let (QDiagram SVG V2 Double Any
d, a
a) = DEnv (N SVG)
-> BackendProgram a -> (QDiagram SVG V2 (N SVG) Any, 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
DEnv (N SVG)
env BackendProgram a
cb
          opts :: Options SVG V2 Double
opts = SizeSpec V2 Double
-> Maybe Element
-> Text
-> [Attribute]
-> Bool
-> Options SVG V2 Double
forall n.
SizeSpec V2 n
-> Maybe Element -> Text -> [Attribute] -> Bool -> Options SVG V2 n
DSVG.SVGOptions (Double -> Double -> SizeSpec V2 Double
forall n. n -> n -> SizeSpec V2 n
D2.dims2D Double
w Double
h) Maybe Element
forall a. Maybe a
Nothing Text
T.empty [] Bool
True
          svg :: Result SVG V2 Double
svg = SVG
-> Options SVG V2 Double
-> QDiagram SVG V2 Double Any
-> Result SVG 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
D.renderDia SVG
DSVG.SVG Options SVG V2 Double
opts QDiagram SVG V2 Double Any
d
      FilePath -> Element -> IO ()
Svg.renderToFile FilePath
path Result SVG V2 Double
Element
svg
      a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    FileFormat
SVG_EMBEDDED -> do
      let
        (QDiagram SVG V2 Double Any
d, a
a, Map (FilePath, FontSlant, FontWeight) (Set FilePath)
gs) = DEnv (N SVG)
-> BackendProgram a
-> (QDiagram SVG V2 (N SVG) Any, a,
    Map (FilePath, FontSlant, FontWeight) (Set FilePath))
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
DEnv (N SVG)
env BackendProgram a
cb
        fontDefs :: Maybe Element
fontDefs = Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element)
-> (Markup -> Element) -> Markup -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Element
forall a. ToElement a => a -> Element
Svg.toElement (Text -> Element) -> (Markup -> Text) -> Markup -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markup -> Text
B.renderMarkup
                   (Markup -> Maybe Element) -> Markup -> Maybe Element
forall a b. (a -> b) -> a -> b
$ [((FilePath, FontSlant, FontWeight), Set FilePath)]
-> (((FilePath, FontSlant, FontWeight), Set FilePath) -> Markup)
-> Markup
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map (FilePath, FontSlant, FontWeight) (Set FilePath)
-> [((FilePath, FontSlant, FontWeight), Set FilePath)]
forall k a. Map k a -> [(k, a)]
M.toList Map (FilePath, FontSlant, FontWeight) (Set FilePath)
gs) ((((FilePath, FontSlant, FontWeight), Set FilePath) -> Markup)
 -> Markup)
-> (((FilePath, FontSlant, FontWeight), Set FilePath) -> Markup)
-> Markup
forall a b. (a -> b) -> a -> b
$ \((FilePath
fFam, FontSlant
fSlant, FontWeight
fWeight), Set FilePath
usedGs) -> do
                       let fs :: FontStyle
fs = DEnv Double -> FontStyle
forall n. DEnv n -> FontStyle
envFontStyle DEnv Double
env
                       let font :: PreparedFont Double
font = DEnv Double -> FontSelector Double
forall n. DEnv n -> FontSelector n
envSelectFont DEnv Double
env FontSelector Double -> FontSelector Double
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
                                                         }
                       PreparedFont Double -> Set FilePath -> Markup
forall n.
(Show n, ToValue n) =>
PreparedFont n -> Set FilePath -> Markup
makeSvgFont PreparedFont Double
font Set FilePath
usedGs
        svg :: Result SVG V2 Double
svg = SVG
-> Options SVG V2 Double
-> QDiagram SVG V2 Double Any
-> Result SVG 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
D.renderDia SVG
DSVG.SVG (SizeSpec V2 Double
-> Maybe Element
-> Text
-> [Attribute]
-> Bool
-> Options SVG V2 Double
forall n.
SizeSpec V2 n
-> Maybe Element -> Text -> [Attribute] -> Bool -> Options SVG V2 n
DSVG.SVGOptions (Double -> Double -> SizeSpec V2 Double
forall n. n -> n -> SizeSpec V2 n
D2.dims2D Double
w Double
h) Maybe Element
fontDefs Text
T.empty [] Bool
True) QDiagram SVG V2 Double Any
d
      FilePath -> Element -> IO ()
Svg.renderToFile FilePath
path Result SVG V2 Double
Element
svg
      a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  where
    (Double
w,Double
h) = FileOptions -> (Double, Double)
_fo_size FileOptions
fo

-- -----------------------------------------------------------------------
-- Backend
-- -----------------------------------------------------------------------

-- | The diagrams backend environement.
data DEnv n = DEnv
  { DEnv n -> AlignmentFns
envAlignmentFns :: AlignmentFns -- ^ The used alignment functions.
  , DEnv n -> FontStyle
envFontStyle :: FontStyle       -- ^ The current/initial font style.
  , DEnv n -> FontSelector n
envSelectFont :: FontSelector n -- ^ The font selection function.
  , DEnv n -> (n, n)
envOutputSize :: (n,n)          -- ^ The size of the rendered output.
  , DEnv n -> Map (FilePath, FontSlant, FontWeight) (Set FilePath)
envUsedGlyphs :: M.Map (String, FontSlant, FontWeight) (S.Set String)
    -- ^ The map of all glyphs that are used from a specific font.
  }

type DState n a = State (DEnv n) a

type FontSelector n = FontStyle -> F.PreparedFont n

-- | Load sans-serif fonts only

loadSansSerifFonts :: forall n. (RealFloat n, Read n)
             => IO (FontSelector n)
loadSansSerifFonts :: IO (FontSelector n)
loadSansSerifFonts = do
  PreparedFont n
sansR    <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceSansPro_R.svg" IO FilePath
-> (FilePath -> IO (PreparedFont n)) -> IO (PreparedFont n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (PreparedFont n)
forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
  PreparedFont n
sansRB   <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceSansPro_RB.svg" IO FilePath
-> (FilePath -> IO (PreparedFont n)) -> IO (PreparedFont n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (PreparedFont n)
forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
  PreparedFont n
sansRBI  <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceSansPro_RBI.svg" IO FilePath
-> (FilePath -> IO (PreparedFont n)) -> IO (PreparedFont n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (PreparedFont n)
forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
  PreparedFont n
sansRI   <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceSansPro_RI.svg" IO FilePath
-> (FilePath -> IO (PreparedFont n)) -> IO (PreparedFont n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (PreparedFont n)
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) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansR
        (FilePath
_, FontSlant
FontSlantNormal , FontWeight
FontWeightBold  ) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRB
        (FilePath
_, FontSlant
FontSlantItalic , FontWeight
FontWeightNormal) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRI
        (FilePath
_, FontSlant
FontSlantOblique, FontWeight
FontWeightNormal) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRI
        (FilePath
_, FontSlant
FontSlantItalic , FontWeight
FontWeightBold  ) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRBI
        (FilePath
_, FontSlant
FontSlantOblique, FontWeight
FontWeightBold  ) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRBI

  FontSelector n -> IO (FontSelector n)
forall (m :: * -> *) a. Monad m => a -> m a
return FontSelector n
selectFont


-- | Load serif, sans-serif and monospace fonts.
loadCommonFonts :: forall n. (RealFloat n, Read n) => IO (FontSelector n)
loadCommonFonts :: IO (FontSelector n)
loadCommonFonts = do
  PreparedFont n
serifR   <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/LinLibertine_R.svg" IO FilePath
-> (FilePath -> IO (PreparedFont n)) -> IO (PreparedFont n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (PreparedFont n)
forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
  PreparedFont n
serifRB  <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/LinLibertine_RB.svg" IO FilePath
-> (FilePath -> IO (PreparedFont n)) -> IO (PreparedFont n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (PreparedFont n)
forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
  PreparedFont n
serifRBI <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/LinLibertine_RBI.svg" IO FilePath
-> (FilePath -> IO (PreparedFont n)) -> IO (PreparedFont n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (PreparedFont n)
forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
  PreparedFont n
serifRI  <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/LinLibertine_RI.svg" IO FilePath
-> (FilePath -> IO (PreparedFont n)) -> IO (PreparedFont n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (PreparedFont n)
forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
  PreparedFont n
sansR    <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceSansPro_R.svg" IO FilePath
-> (FilePath -> IO (PreparedFont n)) -> IO (PreparedFont n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (PreparedFont n)
forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
  PreparedFont n
sansRB   <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceSansPro_RB.svg" IO FilePath
-> (FilePath -> IO (PreparedFont n)) -> IO (PreparedFont n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (PreparedFont n)
forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
  PreparedFont n
sansRBI  <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceSansPro_RBI.svg" IO FilePath
-> (FilePath -> IO (PreparedFont n)) -> IO (PreparedFont n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (PreparedFont n)
forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
  PreparedFont n
sansRI   <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceSansPro_RI.svg" IO FilePath
-> (FilePath -> IO (PreparedFont n)) -> IO (PreparedFont n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (PreparedFont n)
forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
  PreparedFont n
monoR    <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceCodePro_R.svg" IO FilePath
-> (FilePath -> IO (PreparedFont n)) -> IO (PreparedFont n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (PreparedFont n)
forall n. (Read n, RealFloat n) => FilePath -> IO (PreparedFont n)
F.loadFont
  PreparedFont n
monoRB   <- FilePath -> IO FilePath
getDataFileName FilePath
"fonts/SourceCodePro_RB.svg" IO FilePath
-> (FilePath -> IO (PreparedFont n)) -> IO (PreparedFont n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (PreparedFont n)
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) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"serif" PreparedFont n
serifR
        (FilePath
"serif", FontSlant
FontSlantNormal , FontWeight
FontWeightBold  ) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"serif" PreparedFont n
serifRB
        (FilePath
"serif", FontSlant
FontSlantItalic , FontWeight
FontWeightNormal) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"serif" PreparedFont n
serifRI
        (FilePath
"serif", FontSlant
FontSlantOblique, FontWeight
FontWeightNormal) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"serif" PreparedFont n
serifRI
        (FilePath
"serif", FontSlant
FontSlantItalic , FontWeight
FontWeightBold  ) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"serif" PreparedFont n
serifRBI
        (FilePath
"serif", FontSlant
FontSlantOblique, FontWeight
FontWeightBold  ) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"serif" PreparedFont n
serifRBI

        (FilePath
"sans-serif", FontSlant
FontSlantNormal , FontWeight
FontWeightNormal) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansR
        (FilePath
"sans-serif", FontSlant
FontSlantNormal , FontWeight
FontWeightBold  ) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRB
        (FilePath
"sans-serif", FontSlant
FontSlantItalic , FontWeight
FontWeightNormal) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRI
        (FilePath
"sans-serif", FontSlant
FontSlantOblique, FontWeight
FontWeightNormal) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRI
        (FilePath
"sans-serif", FontSlant
FontSlantItalic , FontWeight
FontWeightBold  ) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRBI
        (FilePath
"sans-serif", FontSlant
FontSlantOblique, FontWeight
FontWeightBold  ) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"sans-serif" PreparedFont n
sansRBI

        (FilePath
"monospace", FontSlant
_, FontWeight
FontWeightNormal) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"monospace" PreparedFont n
monoR
        (FilePath
"monospace", FontSlant
_, FontWeight
FontWeightBold  ) -> FilePath -> PreparedFont n -> PreparedFont n
forall n. FilePath -> PreparedFont n -> PreparedFont n
alterFontFamily FilePath
"monospace" PreparedFont n
monoRB

        (FilePath
fam, FontSlant
FontSlantNormal , FontWeight
FontWeightNormal) | FilePath
fam FilePath -> PreparedFont n -> Bool
forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
serifR   -> PreparedFont n
serifR
        (FilePath
fam, FontSlant
FontSlantNormal , FontWeight
FontWeightBold  ) | FilePath
fam FilePath -> PreparedFont n -> Bool
forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
serifRB  -> PreparedFont n
serifRB
        (FilePath
fam, FontSlant
FontSlantItalic , FontWeight
FontWeightNormal) | FilePath
fam FilePath -> PreparedFont n -> Bool
forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
serifRI  -> PreparedFont n
serifRI
        (FilePath
fam, FontSlant
FontSlantOblique, FontWeight
FontWeightNormal) | FilePath
fam FilePath -> PreparedFont n -> Bool
forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
serifRI  -> PreparedFont n
serifRI
        (FilePath
fam, FontSlant
FontSlantItalic , FontWeight
FontWeightBold  ) | FilePath
fam FilePath -> PreparedFont n -> Bool
forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
serifRBI -> PreparedFont n
serifRBI
        (FilePath
fam, FontSlant
FontSlantOblique, FontWeight
FontWeightBold  ) | FilePath
fam FilePath -> PreparedFont n -> Bool
forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
serifRBI -> PreparedFont n
serifRBI

        (FilePath
fam, FontSlant
FontSlantNormal , FontWeight
FontWeightNormal) | FilePath
fam FilePath -> PreparedFont n -> Bool
forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
sansR   -> PreparedFont n
sansR
        (FilePath
fam, FontSlant
FontSlantNormal , FontWeight
FontWeightBold  ) | FilePath
fam FilePath -> PreparedFont n -> Bool
forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
sansRB  -> PreparedFont n
sansRB
        (FilePath
fam, FontSlant
FontSlantItalic , FontWeight
FontWeightNormal) | FilePath
fam FilePath -> PreparedFont n -> Bool
forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
sansRI  -> PreparedFont n
sansRI
        (FilePath
fam, FontSlant
FontSlantOblique, FontWeight
FontWeightNormal) | FilePath
fam FilePath -> PreparedFont n -> Bool
forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
sansRI  -> PreparedFont n
sansRI
        (FilePath
fam, FontSlant
FontSlantItalic , FontWeight
FontWeightBold  ) | FilePath
fam FilePath -> PreparedFont n -> Bool
forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
sansRBI -> PreparedFont n
sansRBI
        (FilePath
fam, FontSlant
FontSlantOblique, FontWeight
FontWeightBold  ) | FilePath
fam FilePath -> PreparedFont n -> Bool
forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
sansRBI -> PreparedFont n
sansRBI

        (FilePath
fam, FontSlant
_, FontWeight
FontWeightNormal) | FilePath
fam FilePath -> PreparedFont n -> Bool
forall n. FilePath -> PreparedFont n -> Bool
`isFontFamily` PreparedFont n
monoR  -> PreparedFont n
monoR
        (FilePath
fam, FontSlant
_, FontWeight
FontWeightBold  ) | FilePath
fam FilePath -> PreparedFont n -> Bool
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" })

  FontSelector n -> IO (FontSelector n)
forall (m :: * -> *) a. Monad m => a -> m a
return FontSelector n
selectFont


alterFontFamily :: String -> F.PreparedFont n -> F.PreparedFont n
alterFontFamily :: 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 :: FilePath -> PreparedFont n -> Bool
isFontFamily FilePath
n (FontData n
fd, OutlineMap n
_) = FilePath
n FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FontData n -> FilePath
forall n. FontData n -> FilePath
F.fontDataFamily FontData n
fd

-- | Produce an environment with a custom set of fonts.
--   The defult fonts are still loaded as fall back.
createEnv :: (Read n, RealFloat n)
              => AlignmentFns     -- ^ Alignment functions to use.
              -> n -- ^ The output image width in backend coordinates.
              -> n -- ^ The output image height in backend coordinates.
              -> FontSelector n -> DEnv n
createEnv :: AlignmentFns -> n -> n -> FontSelector n -> DEnv n
createEnv AlignmentFns
alignFns n
w n
h FontSelector n
fontSelector = DEnv :: forall n.
AlignmentFns
-> FontStyle
-> FontSelector n
-> (n, n)
-> Map (FilePath, FontSlant, FontWeight) (Set FilePath)
-> DEnv n
DEnv
    { envAlignmentFns :: AlignmentFns
envAlignmentFns = AlignmentFns
alignFns
    , envFontStyle :: FontStyle
envFontStyle = FontStyle
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 = Map (FilePath, FontSlant, FontWeight) (Set FilePath)
forall k a. Map k a
M.empty
    }

-- | Produce a default environment with just the sans-serif fonts.

defaultEnv :: (Read n, RealFloat n)
           => AlignmentFns -- ^ Alignment functions to use.
           -> n -- ^ The output image width in backend coordinates.
           -> n -- ^ The output image height in backend coordinates.
           -> IO (DEnv n)
defaultEnv :: AlignmentFns -> n -> n -> IO (DEnv n)
defaultEnv AlignmentFns
alignFns n
w n
h = do
  FontSelector n
fontSelector <- IO (FontSelector n)
forall n. (RealFloat n, Read n) => IO (FontSelector n)
loadSansSerifFonts
  DEnv n -> IO (DEnv n)
forall (m :: * -> *) a. Monad m => a -> m a
return (AlignmentFns -> n -> n -> FontSelector n -> DEnv n
forall n.
(Read n, RealFloat n) =>
AlignmentFns -> n -> n -> FontSelector n -> DEnv n
createEnv AlignmentFns
alignFns n
w n
h FontSelector n
fontSelector)

-- | Run this backends renderer.
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)   -- ^ Environment to start rendering with.
           -> Renderable a -- ^ Chart render code.
           -> (D.QDiagram b V2 (N b) Any, PickFn a) -- ^ The diagram.
runBackendR :: 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 = Renderable a -> (Double, Double) -> BackendProgram (PickFn a)
forall a.
Renderable a -> (Double, Double) -> BackendProgram (PickFn a)
render Renderable a
r (N b -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac N b
w, N b -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac N b
h)
      (N b
w,N b
h) = DEnv (N b) -> (N b, N b)
forall n. DEnv n -> (n, n)
envOutputSize DEnv (N b)
env
  in DEnv (N b)
-> BackendProgram (PickFn a) -> (QDiagram b V2 (N b) Any, PickFn 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 (N b)
env BackendProgram (PickFn a)
cb

-- | Run this backends renderer.
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)        -- ^ Environment to start rendering with.
           -> BackendProgram a    -- ^ Chart render code.
           -> (D.QDiagram b V2 (N b) Any, a)    -- ^ The diagram.
runBackend :: 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) = State (DEnv (N b)) (QDiagram b V2 (N b) Any, a)
-> DEnv (N b) -> (QDiagram b V2 (N b) Any, a)
forall s a. State s a -> s -> a
evalState (TextRender b (Path V2 (N b))
-> BackendProgram a
-> State (DEnv (N b)) (QDiagram b V2 (N b) Any, 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 (Path V2 (N b))
forall b. TextRender b (Path V2 (N b))
TextRenderSvg (BackendProgram a
 -> State (DEnv (N b)) (QDiagram b V2 (N b) Any, a))
-> BackendProgram a
-> State (DEnv (N b)) (QDiagram b V2 (N b) Any, a)
forall a b. (a -> b) -> a -> b
$ BackendProgram a -> BackendProgram a
forall a. BackendProgram a -> BackendProgram a
withDefaultStyle BackendProgram a
m) DEnv (N b)
env
  in (DEnv (N b) -> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
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)

-- | Run this backends renderer.
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)        -- ^ Environment to start rendering with.
                     -> BackendProgram a    -- ^ Chart render code.
                     -> ( D.QDiagram b V2 (N b) Any, a
                        , M.Map (String, FontSlant, FontWeight) (S.Set String))
runBackendWithGlyphs :: 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') = State (DEnv (N b)) (QDiagram b V2 (N b) Any, a)
-> DEnv (N b) -> ((QDiagram b V2 (N b) Any, a), DEnv (N b))
forall s a. State s a -> s -> (a, s)
runState (TextRender b (Text (N b))
-> BackendProgram a
-> State (DEnv (N b)) (QDiagram b V2 (N b) Any, 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 (Text (N b))
forall b. TextRender b (Text (N b))
TextRenderNative (BackendProgram a
 -> State (DEnv (N b)) (QDiagram b V2 (N b) Any, a))
-> BackendProgram a
-> State (DEnv (N b)) (QDiagram b V2 (N b) Any, a)
forall a b. (a -> b) -> a -> b
$ BackendProgram a -> BackendProgram a
forall a. BackendProgram a -> BackendProgram a
withDefaultStyle BackendProgram a
m) DEnv (N b)
env
  in (DEnv (N b) -> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
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, DEnv (N b) -> Map (FilePath, FontSlant, FontWeight) (Set FilePath)
forall n.
DEnv n -> Map (FilePath, FontSlant, FontWeight) (Set FilePath)
envUsedGlyphs DEnv (N b)
env')

-- | Flag to decide which technique should ne used to render text.
--   The type parameter is the primitive that has to be supported by
--   a backend when rendering text using this technique.
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' :: TextRender b t
-> BackendProgram a -> DState (N b) (QDiagram b V2 (N b) Any, a)
runBackend' TextRender b t
tr BackendProgram a
m = TextRender b t
-> ProgramView ChartBackendInstr a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
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 (ProgramView ChartBackendInstr a
 -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> ProgramView ChartBackendInstr a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall a b. (a -> b) -> a -> b
$ BackendProgram a -> ProgramView ChartBackendInstr a
forall (instr :: * -> *) a. Program instr a -> ProgramView instr a
view (BackendProgram a -> ProgramView ChartBackendInstr a)
-> BackendProgram a -> ProgramView ChartBackendInstr a
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 :: TextRender b t
-> ProgramView ChartBackendInstr a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
eval TextRender b t
tr (Return a
v) = (QDiagram b V2 (N b) Any, a)
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (QDiagram b V2 (N b) Any
forall a. Monoid a => a
mempty, a
v)
    eval TextRender b t
tr (StrokePath Path
p   :>>= b -> ProgramT ChartBackendInstr Identity a
f) = Path -> StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any)
forall b.
(Renderable (Path V2 (N b)) b, TypeableFloat (N b)) =>
Path -> DState (N b) (QDiagram b V2 (N b) Any)
dStrokePath  Path
p   StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any)
-> (() -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall (s :: * -> *) m a.
(Monad s, Monoid m) =>
s m -> (() -> s (m, a)) -> s (m, a)
<># TextRender b t
-> (b -> ProgramT ChartBackendInstr Identity a)
-> b
-> DState (N b) (QDiagram b V2 (N b) Any, 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) = Path -> StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any)
forall b.
(Renderable (Path V2 (N b)) b, TypeableFloat (N b)) =>
Path -> DState (N b) (QDiagram b V2 (N b) Any)
dFillPath    Path
p   StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any)
-> (() -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall (s :: * -> *) m a.
(Monad s, Monoid m) =>
s m -> (() -> s (m, a)) -> s (m, a)
<># TextRender b t
-> (b -> ProgramT ChartBackendInstr Identity a)
-> b
-> DState (N b) (QDiagram b V2 (N b) Any, 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) = Point
-> FilePath
-> StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any)
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 StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any)
-> (() -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall (s :: * -> *) m a.
(Monad s, Monoid m) =>
s m -> (() -> s (m, a)) -> s (m, a)
<># TextRender b t
-> (b -> ProgramT ChartBackendInstr Identity a)
-> b
-> DState (N b) (QDiagram b V2 (N b) Any, 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) = Point
-> FilePath
-> StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any)
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 StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any)
-> (() -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall (s :: * -> *) m a.
(Monad s, Monoid m) =>
s m -> (() -> s (m, a)) -> s (m, a)
<># TextRender b t
-> (b -> ProgramT ChartBackendInstr Identity a)
-> b
-> DState (N b) (QDiagram b V2 (N b) Any, 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) = FilePath
-> StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any, TextSize)
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 StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any, TextSize)
-> (TextSize -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall (s :: * -> *) m a b.
(Monad s, Monoid m) =>
s (m, a) -> (a -> s (m, b)) -> s (m, b)
<>= TextRender b t
-> (b -> ProgramT ChartBackendInstr Identity a)
-> b
-> DState (N b) (QDiagram b V2 (N b) Any, 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 (ChartBackendInstr b
GetAlignments  :>>= b -> ProgramT ChartBackendInstr Identity a
f) = StateT
  (DEnv (N b)) Identity (QDiagram b V2 (N b) Any, AlignmentFns)
forall b.
(Renderable (Path V2 (N b)) b, RealFloat (N b)) =>
DState (N b) (QDiagram b V2 (N b) Any, AlignmentFns)
dAlignmentFns    StateT
  (DEnv (N b)) Identity (QDiagram b V2 (N b) Any, AlignmentFns)
-> (AlignmentFns -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall (s :: * -> *) m a b.
(Monad s, Monoid m) =>
s (m, a) -> (a -> s (m, b)) -> s (m, b)
<>= TextRender b t
-> (b -> ProgramT ChartBackendInstr Identity a)
-> b
-> DState (N b) (QDiagram b V2 (N b) Any, 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 (WithTransform Matrix
m Program ChartBackendInstr b
p :>>= b -> ProgramT ChartBackendInstr Identity a
f)  = TextRender b t
-> Matrix
-> Program ChartBackendInstr b
-> StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any, b)
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 StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any, b)
-> (b -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall (s :: * -> *) m a b.
(Monad s, Monoid m) =>
s (m, a) -> (a -> s (m, b)) -> s (m, b)
<>= TextRender b t
-> (b -> ProgramT ChartBackendInstr Identity a)
-> b
-> DState (N b) (QDiagram b V2 (N b) Any, 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 (WithFontStyle FontStyle
fs Program ChartBackendInstr b
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = TextRender b t
-> FontStyle
-> Program ChartBackendInstr b
-> StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any, b)
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 StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any, b)
-> (b -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall (s :: * -> *) m a b.
(Monad s, Monoid m) =>
s (m, a) -> (a -> s (m, b)) -> s (m, b)
<>= TextRender b t
-> (b -> ProgramT ChartBackendInstr Identity a)
-> b
-> DState (N b) (QDiagram b V2 (N b) Any, 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 (WithFillStyle FillStyle
fs Program ChartBackendInstr b
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = TextRender b t
-> FillStyle
-> Program ChartBackendInstr b
-> StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any, b)
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 StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any, b)
-> (b -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall (s :: * -> *) m a b.
(Monad s, Monoid m) =>
s (m, a) -> (a -> s (m, b)) -> s (m, b)
<>= TextRender b t
-> (b -> ProgramT ChartBackendInstr Identity a)
-> b
-> DState (N b) (QDiagram b V2 (N b) Any, 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 (WithLineStyle LineStyle
ls Program ChartBackendInstr b
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = TextRender b t
-> LineStyle
-> Program ChartBackendInstr b
-> StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any, b)
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 StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any, b)
-> (b -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall (s :: * -> *) m a b.
(Monad s, Monoid m) =>
s (m, a) -> (a -> s (m, b)) -> s (m, b)
<>= TextRender b t
-> (b -> ProgramT ChartBackendInstr Identity a)
-> b
-> DState (N b) (QDiagram b V2 (N b) Any, 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 (WithClipRegion Rect
r Program ChartBackendInstr b
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = TextRender b t
-> Rect
-> Program ChartBackendInstr b
-> StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any, b)
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 StateT (DEnv (N b)) Identity (QDiagram b V2 (N b) Any, b)
-> (b -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall (s :: * -> *) m a b.
(Monad s, Monoid m) =>
s (m, a) -> (a -> s (m, b)) -> s (m, b)
<>= TextRender b t
-> (b -> ProgramT ChartBackendInstr Identity a)
-> b
-> DState (N b) (QDiagram b V2 (N b) Any, 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

    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 :: 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 = TextRender b t
-> BackendProgram a -> DState (N b) (QDiagram b V2 (N b) Any, 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 (v -> BackendProgram a
f v
v)

    (<>#) :: (Monad s, Monoid m) => s m -> (() -> s (m, a)) -> s (m, a)
    <># :: s m -> (() -> s (m, a)) -> s (m, a)
(<>#) s m
m () -> s (m, a)
f = do
      m
ma <- s m
m
      (m, ()) -> s (m, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (m
ma, ()) s (m, ()) -> (() -> s (m, a)) -> s (m, a)
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)
    <>= :: 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
      (m, b) -> s (m, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (m
mb m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
ma, b
b)

-- | Executes the given state locally, but preserves the changes to the 'envUsedGlyphs'
--   map. Assumes that values are never removed from the map inbetween.
dLocal :: DState n a -> DState n a
dLocal :: DState n a -> DState n a
dLocal DState n a
m = do
  DEnv n
env <- StateT (DEnv n) Identity (DEnv n)
forall s (m :: * -> *). MonadState s m => m s
get
  a
x <- DState n a
m
  DEnv n
env' <- StateT (DEnv n) Identity (DEnv n)
forall s (m :: * -> *). MonadState s m => m s
get
  DEnv n -> StateT (DEnv n) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (DEnv n -> StateT (DEnv n) Identity ())
-> DEnv n -> StateT (DEnv n) Identity ()
forall a b. (a -> b) -> a -> b
$ DEnv n
env { envUsedGlyphs :: Map (FilePath, FontSlant, FontWeight) (Set FilePath)
envUsedGlyphs = DEnv n -> Map (FilePath, FontSlant, FontWeight) (Set FilePath)
forall n.
DEnv n -> Map (FilePath, FontSlant, FontWeight) (Set FilePath)
envUsedGlyphs DEnv n
env' }
  a -> DState n a
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 :: Path -> DState (N b) (QDiagram b V2 (N b) Any)
dStrokePath Path
p = QDiagram b V2 (N b) Any -> DState (N b) (QDiagram b V2 (N b) Any)
forall (m :: * -> *) a. Monad m => a -> m a
return (QDiagram b V2 (N b) Any -> DState (N b) (QDiagram b V2 (N b) Any))
-> QDiagram b V2 (N b) Any
-> DState (N b) (QDiagram b V2 (N b) Any)
forall a b. (a -> b) -> a -> b
$ FillStyle -> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
FillStyle -> a -> a
applyFillStyle FillStyle
noFillStyle (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall a b. (a -> b) -> a -> b
$ Path V2 (N b) -> QDiagram b V2 (N b) Any
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 (Path V2 (N b) -> QDiagram b V2 (N b) Any)
-> Path V2 (N b) -> QDiagram b V2 (N b) Any
forall a b. (a -> b) -> a -> b
$ Bool -> Path -> Path V2 (N 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 :: Path -> DState (N b) (QDiagram b V2 (N b) Any)
dFillPath Path
p = QDiagram b V2 (N b) Any -> DState (N b) (QDiagram b V2 (N b) Any)
forall (m :: * -> *) a. Monad m => a -> m a
return (QDiagram b V2 (N b) Any -> DState (N b) (QDiagram b V2 (N b) Any))
-> QDiagram b V2 (N b) Any
-> DState (N b) (QDiagram b V2 (N b) Any)
forall a b. (a -> b) -> a -> b
$ LineStyle -> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
LineStyle -> a -> a
applyLineStyle LineStyle
noLineStyle (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall a b. (a -> b) -> a -> b
$ Path V2 (N b) -> QDiagram b V2 (N b) Any
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 (Path V2 (N b) -> QDiagram b V2 (N b) Any)
-> Path V2 (N b) -> QDiagram b V2 (N b) Any
forall a b. (a -> b) -> a -> b
$ Bool -> Path -> Path V2 (N 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 :: FilePath -> DState (N b) (QDiagram b V2 (N b) Any, TextSize)
dTextSize FilePath
text = do
  DEnv (N b)
env <- StateT (DEnv (N b)) Identity (DEnv (N b))
forall s (m :: * -> *). MonadState s m => m s
get
  let fs :: FontStyle
fs = DEnv (N b) -> FontStyle
forall n. DEnv n -> FontStyle
envFontStyle DEnv (N b)
env
  let (N b
scaledH, N b
scaledA, N b
scaledD, N b
scaledYB) = DEnv (N b) -> (N b, N b, N b, N b)
forall n. RealFloat n => DEnv n -> (n, n, n, n)
calcFontMetrics DEnv (N b)
env
  (QDiagram b V2 (N b) Any, TextSize)
-> DState (N b) (QDiagram b V2 (N b) Any, TextSize)
forall (m :: * -> *) a. Monad m => a -> m a
return (QDiagram b V2 (N b) Any
forall a. Monoid a => a
mempty, TextSize :: Double -> Double -> Double -> Double -> Double -> TextSize
TextSize
                { textSizeWidth :: Double
textSizeWidth = N b -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (N b -> Double) -> N b -> Double
forall a b. (a -> b) -> a -> b
$ Path V2 (N b) -> N b
forall n a. (InSpace V2 n a, Enveloped a) => a -> n
D2.width
                              (Path V2 (N b) -> N b) -> Path V2 (N b) -> N b
forall a b. (a -> b) -> a -> b
$ PathInRect (N b) -> Path V2 (N b)
forall n. RealFloat n => PathInRect n -> Path V2 n
F.drop_rect
                              (PathInRect (N b) -> Path V2 (N b))
-> PathInRect (N b) -> Path V2 (N b)
forall a b. (a -> b) -> a -> b
$ N b -> PathInRect (N b) -> PathInRect (N b)
forall n. RealFloat n => n -> PathInRect n -> PathInRect n
F.fit_height N b
scaledH
                              (PathInRect (N b) -> PathInRect (N b))
-> PathInRect (N b) -> PathInRect (N b)
forall a b. (a -> b) -> a -> b
$ TextOpts (N b) -> FilePath -> PathInRect (N b)
forall n. RealFloat n => TextOpts n -> FilePath -> PathInRect n
F.svgText (DEnv (N b) -> TextOpts (N b)
forall n. RealFloat n => DEnv n -> TextOpts n
fontStyleToTextOpts DEnv (N b)
env) FilePath
text
                , textSizeAscent :: Double
textSizeAscent = N b -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac N b
scaledA -- scaledH * (a' / h') -- ascent
                , textSizeDescent :: Double
textSizeDescent = N b -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac N b
scaledD -- scaledH * (d' / h') -- descent
                , textSizeYBearing :: Double
textSizeYBearing = N b -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac N b
scaledYB -- -scaledH * (capHeight / h)
                , textSizeHeight :: Double
textSizeHeight = Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Double) -> Double -> Double
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 :: DState (N b) (QDiagram b V2 (N b) Any, AlignmentFns)
dAlignmentFns = do
  DEnv (N b)
env <- StateT (DEnv (N b)) Identity (DEnv (N b))
forall s (m :: * -> *). MonadState s m => m s
get
  (QDiagram b V2 (N b) Any, AlignmentFns)
-> DState (N b) (QDiagram b V2 (N b) Any, AlignmentFns)
forall (m :: * -> *) a. Monad m => a -> m a
return (QDiagram b V2 (N b) Any
forall a. Monoid a => a
mempty, DEnv (N b) -> AlignmentFns
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 :: Point -> FilePath -> DState (N b) (QDiagram b V2 (N b) Any)
dDrawTextSvg (Point Double
x Double
y) FilePath
text = do
  DEnv (N b)
env <- StateT (DEnv (N b)) Identity (DEnv (N b))
forall s (m :: * -> *). MonadState s m => m s
get
  let (N b
scaledH, N b
_, N b
_, N b
_) = DEnv (N b) -> (N b, N b, N b, N b)
forall n. RealFloat n => DEnv n -> (n, n, n, n)
calcFontMetrics DEnv (N b)
env
  QDiagram b V2 (N b) Any -> DState (N b) (QDiagram b V2 (N b) Any)
forall (m :: * -> *) a. Monad m => a -> m a
return (QDiagram b V2 (N b) Any -> DState (N b) (QDiagram b V2 (N b) Any))
-> QDiagram b V2 (N b) Any
-> DState (N b) (QDiagram b V2 (N b) Any)
forall a b. (a -> b) -> a -> b
$ Transformation
  (V (QDiagram b V2 (N b) Any)) (N (QDiagram b V2 (N b) Any))
-> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
D.transform (Matrix -> T2 (N b)
forall n. RealFloat n => Matrix -> T2 n
toTransformation (Matrix -> T2 (N b)) -> Matrix -> T2 (N b)
forall a b. (a -> b) -> a -> b
$ Vector -> Matrix -> Matrix
translate (Double -> Double -> Vector
Vector Double
x Double
y) Matrix
1)
         (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall a b. (a -> b) -> a -> b
$ FontStyle -> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
FontStyle -> a -> a
applyFontStyleSVG (DEnv (N b) -> FontStyle
forall n. DEnv n -> FontStyle
envFontStyle DEnv (N b)
env)
         (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall a b. (a -> b) -> a -> b
$ N b -> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
D2.scaleY (-N b
1)
         (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall a b. (a -> b) -> a -> b
$ PathInRect (N b) -> QDiagram b V2 (N b) Any
forall b n.
(TypeableFloat n, Renderable (Path V2 n) b) =>
PathInRect n -> QDiagram b V2 n Any
F.set_envelope
         (PathInRect (N b) -> QDiagram b V2 (N b) Any)
-> PathInRect (N b) -> QDiagram b V2 (N b) Any
forall a b. (a -> b) -> a -> b
$ N b -> PathInRect (N b) -> PathInRect (N b)
forall n. RealFloat n => n -> PathInRect n -> PathInRect n
F.fit_height N b
scaledH
         (PathInRect (N b) -> PathInRect (N b))
-> PathInRect (N b) -> PathInRect (N b)
forall a b. (a -> b) -> a -> b
$ TextOpts (N b) -> FilePath -> PathInRect (N b)
forall n. RealFloat n => TextOpts n -> FilePath -> PathInRect n
F.svgText (DEnv (N b) -> TextOpts (N b)
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 :: Point -> FilePath -> DState (N b) (QDiagram b V2 (N b) Any)
dDrawTextNative (Point Double
x Double
y) FilePath
text = do
  DEnv (N b)
env <- StateT (DEnv (N b)) Identity (DEnv (N b))
forall s (m :: * -> *). MonadState s m => m s
get
  FilePath -> DState (N b) ()
forall n. FilePath -> DState n ()
addGlyphsOfString FilePath
text
  QDiagram b V2 (N b) Any -> DState (N b) (QDiagram b V2 (N b) Any)
forall (m :: * -> *) a. Monad m => a -> m a
return (QDiagram b V2 (N b) Any -> DState (N b) (QDiagram b V2 (N b) Any))
-> QDiagram b V2 (N b) Any
-> DState (N b) (QDiagram b V2 (N b) Any)
forall a b. (a -> b) -> a -> b
$ Transformation
  (V (QDiagram b V2 (N b) Any)) (N (QDiagram b V2 (N b) Any))
-> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
D.transform (Matrix -> T2 (N b)
forall n. RealFloat n => Matrix -> T2 n
toTransformation (Matrix -> T2 (N b)) -> Matrix -> T2 (N b)
forall a b. (a -> b) -> a -> b
$ Vector -> Matrix -> Matrix
translate (Double -> Double -> Vector
Vector Double
x Double
y) Matrix
1)
         (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall a b. (a -> b) -> a -> b
$ FontStyle -> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
FontStyle -> a -> a
applyFontStyleText (DEnv (N b) -> FontStyle
forall n. DEnv n -> FontStyle
envFontStyle DEnv (N b)
env)
         (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall a b. (a -> b) -> a -> b
$ N b -> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
D2.scaleY (-N b
1)
         (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall a b. (a -> b) -> a -> b
$ FilePath -> QDiagram b V2 (N b) Any
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 :: 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 = DState (N b) (QDiagram b V2 (N b) Any, a)
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall n a. DState n a -> DState n a
dLocal (DState (N b) (QDiagram b V2 (N b) Any, a)
 -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> DState (N b) (QDiagram b V2 (N b) Any, a)
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall a b. (a -> b) -> a -> b
$ do
  (DEnv (N b) -> DEnv (N b)) -> StateT (DEnv (N b)) Identity ()
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) <- TextRender b t
-> BackendProgram a -> DState (N b) (QDiagram b V2 (N b) Any, 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
  (QDiagram b V2 (N b) Any, a)
-> DState (N b) (QDiagram b V2 (N b) Any, a)
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 :: TextRender b t
-> Matrix
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWithTransform TextRender b t
tr Matrix
t = 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)
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)
forall a. a -> a
id ((QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
 -> BackendProgram a -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall a b. (a -> b) -> a -> b
$ Transformation
  (V (QDiagram b V2 (N b) Any)) (N (QDiagram b V2 (N b) Any))
-> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
D.transform (Matrix -> T2 (N b)
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 :: TextRender b t
-> LineStyle
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWithLineStyle TextRender b t
tr LineStyle
ls = 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)
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)
forall a. a -> a
id ((QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
 -> BackendProgram a -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall a b. (a -> b) -> a -> b
$ LineStyle -> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
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 :: TextRender b t
-> FillStyle
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWithFillStyle TextRender b t
tr FillStyle
fs = 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)
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)
forall a. a -> a
id ((QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
 -> BackendProgram a -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall a b. (a -> b) -> a -> b
$ FillStyle -> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
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 :: TextRender b t
-> FontStyle
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWithFontStyle TextRender b t
tr FontStyle
fs = 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)
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 }) ((QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
 -> BackendProgram a -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall a b. (a -> b) -> a -> b
$ QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
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 :: TextRender b t
-> Rect
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
dWithClipRegion TextRender b t
tr Rect
clip = 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)
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)
forall a. a -> a
id ((QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
 -> BackendProgram a -> DState (N b) (QDiagram b V2 (N b) Any, a))
-> (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> BackendProgram a
-> DState (N b) (QDiagram b V2 (N b) Any, a)
forall a b. (a -> b) -> a -> b
$ Path V2 (N b) -> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall a n.
(HasStyle a, V a ~ V2, N a ~ n, TypeableFloat n) =>
Path V2 n -> a -> a
D2.clipBy (Bool -> Path -> Path V2 (N b)
forall n. (RealFloat n, Ord n) => Bool -> Path -> Path V2 n
convertPath Bool
True (Path -> Path V2 (N b)) -> Path -> Path V2 (N b)
forall a b. (a -> b) -> a -> b
$ Rect -> Path
rectPath Rect
clip)

-- -----------------------------------------------------------------------
-- Converions Helpers
-- -----------------------------------------------------------------------

addGlyphsOfString :: String -> DState n ()
addGlyphsOfString :: FilePath -> DState n ()
addGlyphsOfString FilePath
s = do
  DEnv n
env <- StateT (DEnv n) Identity (DEnv n)
forall s (m :: * -> *). MonadState s m => m s
get
  let fs :: FontStyle
fs = DEnv n -> FontStyle
forall n. DEnv n -> FontStyle
envFontStyle DEnv n
env
  let fontData :: FontData n
fontData = (FontData n, OutlineMap n) -> FontData n
forall a b. (a, b) -> a
fst ((FontData n, OutlineMap n) -> FontData n)
-> (FontData n, OutlineMap n) -> FontData n
forall a b. (a -> b) -> a -> b
$ DEnv n -> FontSelector n
forall n. DEnv n -> FontSelector n
envSelectFont DEnv n
env FontStyle
fs
  let ligatures :: [FilePath]
ligatures = ((FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
1) (Int -> Bool) -> (FilePath -> Int) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([FilePath] -> [FilePath])
-> (FontData n -> [FilePath]) -> FontData n -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map FilePath (FilePath, n, FilePath) -> [FilePath]
forall k a. Map k a -> [k]
M.keys (Map FilePath (FilePath, n, FilePath) -> [FilePath])
-> (FontData n -> Map FilePath (FilePath, n, FilePath))
-> FontData n
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontData n -> Map FilePath (FilePath, n, FilePath)
forall n. FontData n -> SvgGlyphs n
F.fontDataGlyphs) FontData n
fontData
  let glyphs :: [FilePath]
glyphs = (Text -> FilePath) -> [Text] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
T.unpack ([Text] -> [FilePath]) -> [Text] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> [Text]
F.characterStrings FilePath
s [FilePath]
ligatures
  (DEnv n -> DEnv n) -> DState n ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DEnv n -> DEnv n) -> DState n ())
-> (DEnv n -> DEnv n) -> DState n ()
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 = DEnv n -> Map (FilePath, FontSlant, FontWeight) (Set FilePath)
forall n.
DEnv n -> Map (FilePath, FontSlant, FontWeight) (Set FilePath)
envUsedGlyphs DEnv n
env
        entry :: Set FilePath
entry = case (FilePath, FontSlant, FontWeight)
-> Map (FilePath, FontSlant, FontWeight) (Set FilePath)
-> Maybe (Set FilePath)
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 -> [FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
S.fromList [FilePath]
glyphs
          Just Set FilePath
gs -> Set FilePath
gs Set FilePath -> Set FilePath -> Set FilePath
forall a. Ord a => Set a -> Set a -> Set a
`S.union` [FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
S.fromList [FilePath]
glyphs
    in DEnv n
env { envUsedGlyphs :: Map (FilePath, FontSlant, FontWeight) (Set FilePath)
envUsedGlyphs = (FilePath, FontSlant, FontWeight)
-> Set FilePath
-> Map (FilePath, FontSlant, FontWeight) (Set FilePath)
-> Map (FilePath, FontSlant, FontWeight) (Set FilePath)
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 }
  () -> DState n ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

pointToP2 :: RealFrac n => Point -> P2 n
pointToP2 :: Point -> P2 n
pointToP2 (Point Double
x Double
y) = (n, n) -> P2 n
forall n. (n, n) -> P2 n
p2 (Double -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x, Double -> n
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 :: 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 = QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
D2.reflectY (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall a b. (a -> b) -> a -> b
$ Point V2 (N b)
-> V2 (N b) -> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
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 ((N b, N b) -> Point V2 (N b)
forall n. (n, n) -> P2 n
p2 (N b
0,N b
0)) ((N b, N b) -> V2 (N b)
forall n. (n, n) -> V2 n
r2 (DEnv (N b) -> (N b, N b)
forall n. DEnv n -> (n, n)
envOutputSize DEnv (N b)
env)) QDiagram b V2 (N b) Any
d

noLineStyle :: LineStyle
noLineStyle :: LineStyle
noLineStyle = LineStyle
forall a. Default a => a
def
  { _line_width :: Double
_line_width = Double
0
  , _line_color :: AlphaColour Double
_line_color = AlphaColour Double
forall a. Num a => AlphaColour a
transparent
  }

noFillStyle :: FillStyle
noFillStyle :: FillStyle
noFillStyle = AlphaColour Double -> FillStyle
solidFillStyle AlphaColour Double
forall a. Num a => AlphaColour a
transparent

toTransformation :: RealFloat n => Matrix -> T2 n
toTransformation :: Matrix -> T2 n
toTransformation Matrix
m = (V2 n :-: V2 n) -> (V2 n :-: V2 n) -> V2 n -> T2 n
forall (v :: * -> *) n.
(v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
Transformation
  (Matrix -> V2 n -> V2 n
forall n. RealFloat n => Matrix -> V2 n -> V2 n
applyWithoutTrans Matrix
m (V2 n -> V2 n) -> (V2 n -> V2 n) -> V2 n :-: V2 n
forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> Matrix -> V2 n -> V2 n
forall n. RealFloat n => Matrix -> V2 n -> V2 n
applyWithoutTrans (Matrix -> Matrix
invert Matrix
m))
  (Matrix -> V2 n -> V2 n
forall n. RealFloat n => Matrix -> V2 n -> V2 n
applyWithoutTrans (Matrix -> Matrix
transpose Matrix
m) (V2 n -> V2 n) -> (V2 n -> V2 n) -> V2 n :-: V2 n
forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> Matrix -> V2 n -> V2 n
forall n. RealFloat n => Matrix -> V2 n -> V2 n
applyWithoutTrans (Matrix -> Matrix
transpose (Matrix -> Matrix
invert Matrix
m)))
  ((n, n) -> V2 n
forall n. (n, n) -> V2 n
r2 (Double -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> n) -> Double -> n
forall a b. (a -> b) -> a -> b
$ Matrix -> Double
x0 Matrix
m, Double -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> n) -> Double -> n
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

-- | Apply a given affine transformation to a vector.
applyTransformation :: RealFloat n => Matrix -> P2 n -> P2 n
applyTransformation :: Matrix -> P2 n -> P2 n
applyTransformation Matrix
m P2 n
p =
  let (n
x,n
y) = P2 n -> (n, n)
forall n. P2 n -> (n, n)
D2.unp2 P2 n
p
      get :: RealFloat n => (Matrix -> Double) -> n
      get :: (Matrix -> Double) -> n
get Matrix -> Double
f = Double -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Matrix -> Double
f Matrix
m)
  in (n, n) -> P2 n
forall n. (n, n) -> P2 n
p2 ( (Matrix -> Double) -> n
forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
xx n -> n -> n
forall a. Num a => a -> a -> a
* n
x n -> n -> n
forall a. Num a => a -> a -> a
+ (Matrix -> Double) -> n
forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
xy n -> n -> n
forall a. Num a => a -> a -> a
* n
y n -> n -> n
forall a. Num a => a -> a -> a
+ (Matrix -> Double) -> n
forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
x0
        , (Matrix -> Double) -> n
forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
yx n -> n -> n
forall a. Num a => a -> a -> a
* n
x n -> n -> n
forall a. Num a => a -> a -> a
+ (Matrix -> Double) -> n
forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
yy n -> n -> n
forall a. Num a => a -> a -> a
* n
y n -> n -> n
forall a. Num a => a -> a -> a
+ (Matrix -> Double) -> n
forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
y0
        )

-- | Apply a given affine transformation to a vector.
applyWithoutTrans :: RealFloat n => Matrix -> V2 n -> V2 n
applyWithoutTrans :: Matrix -> V2 n -> V2 n
applyWithoutTrans Matrix
m V2 n
v =
  let (n
x,n
y) = V2 n -> (n, n)
forall n. V2 n -> (n, n)
D2.unr2 V2 n
v
      get :: RealFloat n => (Matrix -> Double) -> n
      get :: (Matrix -> Double) -> n
get Matrix -> Double
f = Double -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Matrix -> Double
f Matrix
m)
  in (n, n) -> V2 n
forall n. (n, n) -> V2 n
r2 ( (Matrix -> Double) -> n
forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
xx n -> n -> n
forall a. Num a => a -> a -> a
* n
x n -> n -> n
forall a. Num a => a -> a -> a
+ (Matrix -> Double) -> n
forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
xy n -> n -> n
forall a. Num a => a -> a -> a
* n
y
        , (Matrix -> Double) -> n
forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
yx n -> n -> n
forall a. Num a => a -> a -> a
* n
x n -> n -> n
forall a. Num a => a -> a -> a
+ (Matrix -> Double) -> n
forall n. RealFloat n => (Matrix -> Double) -> n
get Matrix -> Double
yy n -> n -> n
forall a. Num a => a -> a -> a
* n
y
        )

-- | Apply the Chart line style to a diagram.
applyLineStyle :: (D.TypeableFloat (N a), D.V a ~ V2, D.HasStyle a) => LineStyle -> a -> a
applyLineStyle :: LineStyle -> a -> a
applyLineStyle LineStyle
ls = Measure (N a) -> a -> a
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
D.lineWidth (N a -> Measure (N a)
forall n. Num n => n -> Measure n
D.global (N a -> Measure (N a)) -> N a -> Measure (N a)
forall a b. (a -> b) -> a -> b
$ Double -> N a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> N a) -> Double -> N a
forall a b. (a -> b) -> a -> b
$ LineStyle -> Double
_line_width LineStyle
ls)
                  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlphaColour Double -> a -> a
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)
                  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineCap -> a -> a
forall a. HasStyle a => LineCap -> a -> a
D.lineCap (LineCap -> LineCap
convertLineCap (LineCap -> LineCap) -> LineCap -> LineCap
forall a b. (a -> b) -> a -> b
$ LineStyle -> LineCap
_line_cap LineStyle
ls)
                  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineJoin -> a -> a
forall a. HasStyle a => LineJoin -> a -> a
D.lineJoin (LineJoin -> LineJoin
convertLineJoin (LineJoin -> LineJoin) -> LineJoin -> LineJoin
forall a b. (a -> b) -> a -> b
$ LineStyle -> LineJoin
_line_join LineStyle
ls)
                  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Measure (N a)] -> Measure (N a) -> a -> a
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
[Measure n] -> Measure n -> a -> a
D.dashing ((Double -> Measure (N a)) -> [Double] -> [Measure (N a)]
forall a b. (a -> b) -> [a] -> [b]
map (N a -> Measure (N a)
forall n. Num n => n -> Measure n
D.global (N a -> Measure (N a))
-> (Double -> N a) -> Double -> Measure (N a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> N a
forall a b. (Real a, Fractional b) => a -> b
realToFrac) ([Double] -> [Measure (N a)]) -> [Double] -> [Measure (N a)]
forall a b. (a -> b) -> a -> b
$ LineStyle -> [Double]
_line_dashes LineStyle
ls) (N a -> Measure (N a)
forall n. Num n => n -> Measure n
D.global N a
0)

-- | Apply the Chart fill style to a diagram.
applyFillStyle :: (D.TypeableFloat (N a), V a ~ V2, D.HasStyle a) => FillStyle -> a -> a
applyFillStyle :: FillStyle -> a -> a
applyFillStyle FillStyle
fs = case FillStyle
fs of
  FillStyleSolid AlphaColour Double
cl -> AlphaColour Double -> a -> a
forall n a c.
(InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) =>
c -> a -> a
D.fillColor AlphaColour Double
cl

-- | Apply all pure diagrams properties from the font style.
applyFontStyleSVG :: (D.TypeableFloat (N a), D.V a ~ V2, D.HasStyle a) => FontStyle -> a -> a
applyFontStyleSVG :: FontStyle -> a -> a
applyFontStyleSVG FontStyle
fs = LineStyle -> a -> a
forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
LineStyle -> a -> a
applyLineStyle LineStyle
noLineStyle
                     (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FillStyle -> a -> a
forall a.
(TypeableFloat (N a), V a ~ V2, HasStyle a) =>
FillStyle -> a -> a
applyFillStyle (AlphaColour Double -> FillStyle
solidFillStyle (AlphaColour Double -> FillStyle)
-> AlphaColour Double -> FillStyle
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 :: FontStyle -> a -> a
applyFontStyleText FontStyle
fs = FilePath -> a -> a
forall a. HasStyle a => FilePath -> a -> a
D2.font (FontStyle -> FilePath
_font_name FontStyle
fs)
                      (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measure (N a) -> a -> a
forall a n.
(N a ~ n, Typeable n, HasStyle a) =>
Measure n -> a -> a
D2.fontSize (N a -> Measure (N a)
forall n. Num n => n -> Measure n
D.global (N a -> Measure (N a)) -> N a -> Measure (N a)
forall a b. (a -> b) -> a -> b
$ Double -> N a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> N a) -> Double -> N a
forall a b. (a -> b) -> a -> b
$ FontStyle -> Double
_font_size FontStyle
fs)
                      (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontSlant -> a -> a
forall a. HasStyle a => FontSlant -> a -> a
D2.fontSlant (FontSlant -> FontSlant
convertFontSlant (FontSlant -> FontSlant) -> FontSlant -> FontSlant
forall a b. (a -> b) -> a -> b
$ FontStyle -> FontSlant
_font_slant FontStyle
fs)
                      (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontWeight -> a -> a
forall a. HasStyle a => FontWeight -> a -> a
D2.fontWeight (FontWeight -> FontWeight
convertFontWeight (FontWeight -> FontWeight) -> FontWeight -> FontWeight
forall a b. (a -> b) -> a -> b
$ FontStyle -> FontWeight
_font_weight FontStyle
fs)
                      (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlphaColour Double -> a -> a
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)

-- | Calculate the font metrics for the currently set font style.
--   The returned value will be @(height, ascent, descent, ybearing)@.
calcFontMetrics :: RealFloat n => DEnv n -> (n, n, n, n)
calcFontMetrics :: DEnv n -> (n, n, n, n)
calcFontMetrics DEnv n
env =
  let fs :: FontStyle
fs = DEnv n -> FontStyle
forall n. DEnv n -> FontStyle
envFontStyle DEnv n
env
      font :: (FontData n, OutlineMap n)
font@(FontData n
fontData,OutlineMap n
_) = DEnv n -> FontSelector n
forall n. DEnv n -> FontSelector n
envSelectFont DEnv n
env FontStyle
fs
      bbox :: [n]
bbox = FontData n -> [n]
forall n. FontData n -> [n]
F.fontDataBoundingBox FontData n
fontData
      capHeight :: n
capHeight = FontData n -> n
forall n. FontData n -> n
F.fontDataCapHeight FontData n
fontData
      a :: n
a = [n]
bbox [n] -> Int -> n
forall a. [a] -> Int -> a
!! Int
3
      d :: n
d = -[n]
bbox [n] -> Int -> n
forall a. [a] -> Int -> a
!! Int
1
      h :: n
h = n
unscaledH
      a' :: n
a' = n
unscaledH
      d' :: n
d' = (n
d n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
h) n -> n -> n
forall a. Num a => a -> a -> a
* n
h'
      h' :: n
h' = (n
a n -> n -> n
forall a. Num a => a -> a -> a
+ n
d) n -> n -> n
forall a. Fractional a => a -> a -> a
/ (n
1 n -> n -> n
forall a. Num a => a -> a -> a
- n
d n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
h)
      unscaledH :: n
unscaledH = FontData n -> n
forall n. RealFloat n => FontData n -> n
F.bbox_dy (FontData n -> n) -> FontData n -> n
forall a b. (a -> b) -> a -> b
$ FontData n
fontData
      scaledHeight :: n
scaledHeight  = Double -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac (FontStyle -> Double
_font_size FontStyle
fs) n -> n -> n
forall a. Num a => a -> a -> a
* (n
h' n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
h)
      scaledAscent :: n
scaledAscent  = n
scaledHeight n -> n -> n
forall a. Num a => a -> a -> a
* (n
a' n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
h')
      scaledDescent :: n
scaledDescent = n
scaledHeight n -> n -> n
forall a. Num a => a -> a -> a
* (n
d' n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
h')
      scaledMaxHAdv :: n
scaledMaxHAdv = -n
scaledHeight n -> n -> n
forall a. Num a => a -> a -> a
* (n
capHeight n -> n -> n
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 :: DEnv n -> TextOpts n
fontStyleToTextOpts DEnv n
env =
  let fs :: FontStyle
fs = DEnv n -> FontStyle
forall n. DEnv n -> FontStyle
envFontStyle DEnv n
env
      font :: PreparedFont n
font = DEnv n -> FontSelector n
forall n. DEnv n -> FontSelector n
envSelectFont DEnv n
env FontStyle
fs
  in TextOpts :: forall n. PreparedFont n -> Spacing -> Bool -> TextOpts n
F.TextOpts
      { textFont :: PreparedFont n
F.textFont = PreparedFont n
font
      , spacing :: Spacing
F.spacing = Spacing
F.KERN
      , underline :: Bool
F.underline = Bool
False
      }

-- | Convert line caps.
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

-- | Convert line joins.
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

-- | Convert paths. The boolean says wether all trails
--   of the path shall be closed or remain open.
convertPath :: (RealFloat n, Ord n) => Bool -> Path -> D.Path V2 n
convertPath :: Bool -> Path -> Path V2 n
convertPath Bool
closeAll Path
path =
  let (Point V2 n
start, Trail V2 n
t, Maybe Path
restM) = Bool -> Point -> Path -> (Point V2 n, Trail V2 n, Maybe Path)
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) (Path -> (Point V2 n, Trail V2 n, Maybe Path))
-> Path -> (Point V2 n, Trail V2 n, Maybe Path)
forall a b. (a -> b) -> a -> b
$ Path -> Path
makeLinesExplicit Path
path
  in Trail V2 n -> Point V2 n -> Path V2 n
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 Path V2 n -> Path V2 n -> Path V2 n
forall a. Semigroup a => a -> a -> a
<> case Maybe Path
restM of
    Maybe Path
Nothing -> Path V2 n
forall a. Monoid a => a
mempty
    Just Path
rest -> Bool -> Path -> Path V2 n
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 :: 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) = Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
forall n.
RealFloat n =>
Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
pathToTrail' Bool
closeAll Path
path Point
p0
  in (Point -> Point V2 n
forall n. RealFrac n => Point -> P2 n
pointToP2 Point
p0, Bool -> Trail' Line V2 n -> Trail V2 n
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) (Point -> Point) -> Point -> Point
forall a b. (a -> b) -> a -> b
$ Double -> Point -> Point
rotateP Double
s (Point -> Point) -> Point -> Point
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) = Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
forall n.
RealFloat n =>
Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
pathToTrail' Bool
closeAll Path
path Point
p0
  in (Point -> Point V2 n
forall n. RealFrac n => Point -> P2 n
pointToP2 Point
p0, Bool -> Trail' Line V2 n -> Trail V2 n
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) (Point -> Point) -> Point -> Point
forall a b. (a -> b) -> a -> b
$ Double -> Point -> Point
rotateP Double
s (Point -> Point) -> Point -> Point
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) = Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
forall n.
RealFloat n =>
Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
pathToTrail' Bool
closeAll Path
path Point
p0
  in (Point -> Point V2 n
forall n. RealFrac n => Point -> P2 n
pointToP2 Point
p0, Bool -> Trail' Line V2 n -> Trail V2 n
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) = Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
forall n.
RealFloat n =>
Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
pathToTrail' Bool
closeAll Path
path Point
start
  in (Point -> Point V2 n
forall n. RealFrac n => Point -> P2 n
pointToP2 Point
start, Bool -> Trail' Line V2 n -> Trail V2 n
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 :: Bool -> Trail' Line V2 n -> Trail V2 n
makeTrail Bool
True  Trail' Line V2 n
t = Trail' Loop V2 n -> Trail V2 n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
D.wrapTrail (Trail' Loop V2 n -> Trail V2 n) -> Trail' Loop V2 n -> Trail V2 n
forall a b. (a -> b) -> a -> b
$ Trail' Line V2 n -> Trail' Loop V2 n
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 = Trail' Line V2 n -> Trail V2 n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
D.wrapTrail (Trail' Line V2 n -> Trail V2 n) -> Trail' Line V2 n -> Trail V2 n
forall a b. (a -> b) -> a -> b
$ Trail' Line V2 n
t

angleToDirection :: RealFloat n => Double -> D.Direction V2 n
angleToDirection :: Double -> Direction V2 n
angleToDirection Double
a = V2 n -> Direction V2 n
forall (v :: * -> *) n. v n -> Direction v n
D.direction (V2 n -> Direction V2 n) -> V2 n -> Direction V2 n
forall a b. (a -> b) -> a -> b
$ (Double -> n) -> V2 Double -> V2 n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac (V2 Double -> V2 n) -> V2 Double -> V2 n
forall a b. (a -> b) -> a -> b
$ Double -> Double -> V2 Double
forall a. a -> a -> V2 a
D2.V2 (Double -> Double
forall a. Floating a => a -> a
cos Double
a) (Double -> Double
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' :: Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
pathToTrail' Bool
closeAll p :: Path
p@(MoveTo Point
_ Path
_) Point
_ = (Trail' Line V2 n
forall a. Monoid a => a
mempty, Bool
False Bool -> Bool -> Bool
|| Bool
closeAll, Path -> Maybe Path
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) = Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
forall n.
RealFloat n =>
Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
pathToTrail' Bool
closeAll Path
path Point
p1
  in ( (Point -> P2 n
forall n. RealFrac n => Point -> P2 n
pointToP2 Point
p0 P2 n -> P2 n -> Trail' Line V2 n
forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t) =>
Point v n -> Point v n -> t
~~ Point -> P2 n
forall n. RealFrac n => Point -> P2 n
pointToP2 Point
p1) Trail' Line V2 n -> Trail' Line V2 n -> Trail' Line V2 n
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) (Point -> Point) -> Point -> Point
forall a b. (a -> b) -> a -> b
$ Double -> Point -> Point
rotateP Double
e (Point -> Point) -> Point -> Point
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) = Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
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 = n -> Trail' Line V2 n -> Trail' Line V2 n
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
D2.scale (Double -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
r) (Trail' Line V2 n -> Trail' Line V2 n)
-> Trail' Line V2 n -> Trail' Line V2 n
forall a b. (a -> b) -> a -> b
$ Direction V2 n -> Direction V2 n -> Trail' Line V2 n
forall n t.
(InSpace V2 n t, RealFloat n, TrailLike t) =>
Direction V2 n -> Direction V2 n -> t
D2.arcCCW (Double -> Direction V2 n
forall n. RealFloat n => Double -> Direction V2 n
angleToDirection Double
s) (Double -> Direction V2 n
forall n. RealFloat n => Double -> Direction V2 n
angleToDirection Double
e)
  in ( Trail' Line V2 n
arcTrail Trail' Line V2 n -> Trail' Line V2 n -> Trail' Line V2 n
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) (Point -> Point) -> Point -> Point
forall a b. (a -> b) -> a -> b
$ Double -> Point -> Point
rotateP Double
e (Point -> Point) -> Point -> Point
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) = Bool -> Path -> Point -> (Trail' Line V2 n, Bool, Maybe Path)
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 = n -> Trail' Line V2 n -> Trail' Line V2 n
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
D2.scale (Double -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
r) (Trail' Line V2 n -> Trail' Line V2 n)
-> Trail' Line V2 n -> Trail' Line V2 n
forall a b. (a -> b) -> a -> b
$ Direction V2 n -> Direction V2 n -> Trail' Line V2 n
forall n t.
(InSpace V2 n t, RealFloat n, TrailLike t) =>
Direction V2 n -> Direction V2 n -> t
D2.arcCW (Double -> Direction V2 n
forall n. RealFloat n => Double -> Direction V2 n
angleToDirection Double
s) (Double -> Direction V2 n
forall n. RealFloat n => Double -> Direction V2 n
angleToDirection Double
e)
  in ( Trail' Line V2 n
arcTrail Trail' Line V2 n -> Trail' Line V2 n -> Trail' Line V2 n
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
_ = (Trail' Line V2 n
forall a. Monoid a => a
mempty, Bool
False Bool -> Bool -> Bool
|| Bool
closeAll, Maybe Path
forall a. Maybe a
Nothing)
pathToTrail' Bool
closeAll Path
Close Point
_ = (Trail' Line V2 n
forall a. Monoid a => a
mempty, Bool
True Bool -> Bool -> Bool
|| Bool
closeAll, Maybe Path
forall a. Maybe a
Nothing)

----------------------------------------------------------------------

$( makeLenses ''FileOptions )