diff --git a/diagrams-rasterific.cabal b/diagrams-rasterific.cabal --- a/diagrams-rasterific.cabal +++ b/diagrams-rasterific.cabal @@ -1,5 +1,5 @@ name: diagrams-rasterific -version: 1.3.1.0 +version: 1.3.1.1 synopsis: Rasterific backend for diagrams. description: A full-featured backend for rendering diagrams using the Rasterific rendering engine. @@ -22,13 +22,14 @@ library exposed-modules: Diagrams.Backend.Rasterific Diagrams.Backend.Rasterific.CmdLine + Diagrams.Backend.Rasterific.Text hs-source-dirs: src other-modules: Paths_diagrams_rasterific build-depends: base >= 4.2 && < 4.9, diagrams-core >= 1.3 && < 1.4, diagrams-lib >= 1.3 && < 1.4, hashable >= 1.1 && < 1.3, - Rasterific >= 0.5.2 && < 0.6, + Rasterific >= 0.6.1 && < 0.7, FontyFruity >= 0.5 && < 0.6, JuicyPixels >= 3.1.5 && < 3.3, lens >= 4.0 && < 4.10, diff --git a/src/Diagrams/Backend/Rasterific.hs b/src/Diagrams/Backend/Rasterific.hs --- a/src/Diagrams/Backend/Rasterific.hs +++ b/src/Diagrams/Backend/Rasterific.hs @@ -76,6 +76,9 @@ , writeJpeg + , texterific + , texterific' + ) where import Diagrams.Core.Compile @@ -83,7 +86,7 @@ import Diagrams.Core.Types -import Diagrams.Prelude hiding (opacity, local) +import Diagrams.Prelude hiding (local, opacity) import Diagrams.TwoD.Adjust (adjustDia2D) import Diagrams.TwoD.Text hiding (Font) @@ -102,10 +105,8 @@ import qualified Graphics.Rasterific.Transformations as R -import Graphics.Text.TrueType - - import Control.Monad.Reader +import Diagrams.Backend.Rasterific.Text import qualified Data.ByteString.Lazy as L (writeFile) import qualified Data.Foldable as F @@ -115,9 +116,7 @@ import Data.Typeable import Data.Word (Word8) -import Paths_diagrams_rasterific (getDataFileName) import System.FilePath (takeExtension) -import System.IO.Unsafe (unsafePerformIO) -------------------------------------------------------------------------------- -- | This data declaration is simply used as a token to distinguish @@ -340,43 +339,6 @@ liftR (R.withTexture (rasterificTexture s o) $ mkStroke l j c d primList) --- read only of static data (safe) -ro :: FilePath -> FilePath -ro = unsafePerformIO . getDataFileName - -openSansRegular :: Font -openSansRegular = fnt - where - Right fnt = unsafePerformIO . loadFontFile $ ro "fonts/OpenSans-Regular.ttf" - -openSansBold :: Font -openSansBold = fnt - where - Right fnt = unsafePerformIO . loadFontFile $ ro "fonts/OpenSans-Bold.ttf" - -openSansItalic :: Font -openSansItalic = fnt - where - Right fnt = unsafePerformIO . loadFontFile $ ro "fonts/OpenSans-Italic.ttf" - -openSansBoldItalic :: Font -openSansBoldItalic = fnt - where - Right fnt = unsafePerformIO . loadFontFile $ ro "fonts/OpenSans-BoldItalic.ttf" - -fromFontStyle :: FontSlant -> FontWeight -> Font -fromFontStyle FontSlantItalic FontWeightBold = openSansBoldItalic -fromFontStyle FontSlantOblique FontWeightBold = openSansBoldItalic -fromFontStyle FontSlantNormal FontWeightBold = openSansBold -fromFontStyle FontSlantItalic FontWeightNormal = openSansItalic -fromFontStyle FontSlantOblique FontWeightNormal = openSansItalic -fromFontStyle _ _ = openSansRegular - -textBox :: Font -> R.PointSize -> String -> (Float, Float) -textBox f p s = (_xMax bb - _xMin bb, _yMax bb - _yMin bb) - where - bb = stringBoundingBox f 96 p s - instance TypeableFloat n => Renderable (Text n) Rasterific where render _ (Text tr al str) = R $ do fs <- views _fontSizeU (fromMaybe 12) @@ -385,15 +347,18 @@ f <- view _fillTexture o <- view _opacity let fColor = rasterificTexture f o - fs' = R.PointSize (realToFrac fs) - fnt = fromFontStyle slant fw - (x, y) = textBox fnt fs' str - (refX, refY) = case al of - BaselineText -> (0, 0) - BoxAlignedText xt yt -> (x * realToFrac xt, -y * realToFrac yt) - p = rasterificPtTransf (moveOriginBy (r2 (refX, refY)) mempty) (R.V2 0 0) + fs' = R.PointSize (realToFrac fs) + fnt = fromFontStyle slant fw + bb = textBoundingBox fnt fs' str + p = case al of + BaselineText -> R.V2 0 0 + BoxAlignedText xt yt -> case getCorners bb of + Just (P (V2 xl yl), P (V2 xu yu)) -> R.V2 (-lerp' xt xu xl) (lerp' yt yu yl) + Nothing -> R.V2 0 0 liftR (R.withTransformation (rasterificMatTransf (tr <> reflectionY)) (R.withTexture fColor $ R.printTextAt fnt fs' p str)) + where + lerp' t u v = realToFrac $ t * u + (1 - t) * v toImageRGBA8 :: DynamicImage -> Image PixelRGBA8 toImageRGBA8 (ImageRGBA8 i) = i diff --git a/src/Diagrams/Backend/Rasterific/Text.hs b/src/Diagrams/Backend/Rasterific/Text.hs new file mode 100644 --- /dev/null +++ b/src/Diagrams/Backend/Rasterific/Text.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} + +------------------------------------------------------------------------------- +-- | +-- Module : Diagrams.Backend.Rasterific.Text +-- Copyright : (c) 2015 diagrams-rasterific team (see LICENSE) +-- License : BSD-style (see LICENSE) +-- Maintainer : diagrams-discuss@googlegroups.com +-- +-- Experimental module to create text with an envelope and trace. The +-- texterifc functions build diagrams with text size of @'local' 1@ and +-- a s specified slant and weight. The size should be changed only with +-- the scale functions and changing the slant and/or weight after the +-- text has benn created can result in an slightly incorrect envelope. +------------------------------------------------------------------------------- +module Diagrams.Backend.Rasterific.Text + ( texterific' + , texterific + , fromFontStyle + , textBoundingBox + ) where + +import Graphics.Text.TrueType hiding (BoundingBox) + +import Diagrams.Prelude +import Diagrams.TwoD.Text hiding (Font) + +import Paths_diagrams_rasterific (getDataFileName) +import System.IO.Unsafe (unsafePerformIO) + +-- | Get the 'BoundingBox' for some font with the origin at the start of +-- the baseline. +textBoundingBox :: RealFloat n => Font -> PointSize -> String -> BoundingBox V2 n +textBoundingBox f p s = fromCorners + (mkP2 (2*r2f _xMin bb) (r2f _yMin bb)) + (mkP2 (r2f _xMax bb + r2f _xMin bb) (r2f _yMax bb)) + where + r2f = fmap realToFrac + bb = stringBoundingBox f 96 p s + +-- | Create a primitive text diagram from the given 'FontSlant', +-- 'FontWeight', and string, with baseline alignment, envelope and trace +-- based on the 'BoundingBox' of the text. +texterific' :: (TypeableFloat n, Renderable (Text n) b) + => FontSlant -> FontWeight -> String -> QDiagram b V2 n Any +texterific' fs fw s = recommendFillColor black . fontSizeL 1 + . fontSlant fs . fontWeight fw + $ mkQD (Prim $ Text mempty BaselineText s) + (getEnvelope bb) + (getTrace bb) + mempty + (boundingBoxQuery bb) + where + bb = textBoundingBox fnt (PointSize 1) s + fnt = fromFontStyle fs fw + +-- | Create a primitive text diagram from the given string, with +-- baseline alignment, envelope and trace based on the 'BoundingBox' +-- of the text. Designed to be a replacement for the function 'text' +-- in Diagrams.TwoD.Text. +texterific :: (TypeableFloat n, Renderable (Text n) b) => String -> QDiagram b V2 n Any +texterific s = texterific' FontSlantNormal FontWeightNormal s + +-- | Get an OpenSans font with the given 'FontSlant' and 'FontWeight'. +fromFontStyle :: FontSlant -> FontWeight -> Font +fromFontStyle FontSlantItalic FontWeightBold = openSansBoldItalic +fromFontStyle FontSlantOblique FontWeightBold = openSansBoldItalic +fromFontStyle FontSlantNormal FontWeightBold = openSansBold +fromFontStyle FontSlantItalic FontWeightNormal = openSansItalic +fromFontStyle FontSlantOblique FontWeightNormal = openSansItalic +fromFontStyle _ _ = openSansRegular + +-- Read a static font file which is included with the package. This +-- should be safe as long as it will installed properly. +staticFont :: String -> Font +staticFont nm = + case unsafePerformIO $ getDataFileName nm >>= loadFontFile of + Right f -> f + Left e -> error e + +openSansRegular :: Font +openSansRegular = staticFont "fonts/OpenSans-Regular.ttf" + +openSansBold :: Font +openSansBold = staticFont "fonts/OpenSans-Bold.ttf" + +openSansItalic :: Font +openSansItalic = staticFont "fonts/OpenSans-Italic.ttf" + +openSansBoldItalic :: Font +openSansBoldItalic = staticFont "fonts/OpenSans-BoldItalic.ttf" +