diff --git a/chart-tests/Chart-tests.cabal b/chart-tests/Chart-tests.cabal index 204d9ae7..3c5810ed 100644 --- a/chart-tests/Chart-tests.cabal +++ b/chart-tests/Chart-tests.cabal @@ -179,4 +179,32 @@ Executable ChartsTestDrawingDiagramsCairo Main-is: DiagramsCairo.hs Hs-Source-Dirs: tests/drawing Ghc-Options: -threaded + default-language: Haskell2010 + +Executable ChartsTestCompareFonts + if flag(cairo) && flag(diagrams) + Build-Depends: + base >= 3 && < 5, + old-locale, + array, + time, + mtl, + colour >= 2.2.1, + data-accessor == 0.2.*, + data-default-class < 0.1, + random >= 1.0, + containers >= 0.5, + old-time >= 1.0, + cairo >= 0.9.11, + Chart >= 0.17, + Chart-diagrams >= 0.1, + Chart-cairo >= 0.1, + diagrams-cairo >= 0.6.1, + diagrams-lib >= 0.6.1, + diagrams-core >= 0.6.1 + if !flag(cairo) || !flag(diagrams) + Buildable: False + Main-is: Compare.hs + Hs-Source-Dirs: tests/compare-font + Ghc-Options: -threaded default-language: Haskell2010 \ No newline at end of file diff --git a/chart-tests/tests/compare-font/Compare.hs b/chart-tests/tests/compare-font/Compare.hs new file mode 100644 index 00000000..84a74cff --- /dev/null +++ b/chart-tests/tests/compare-font/Compare.hs @@ -0,0 +1,96 @@ + +import Data.Colour +import Data.Colour.Names +import Data.Monoid +import Data.Default.Class + +import Graphics.Rendering.Chart.Backend +import Graphics.Rendering.Chart.Geometry +import Graphics.Rendering.Chart.Drawing +import qualified Graphics.Rendering.Chart.Backend.Diagrams as BD +import qualified Graphics.Rendering.Chart.Backend.Cairo as BC + +import Diagrams.Core.Types ( renderDia ) +import Diagrams.TwoD ( SizeSpec2D(..) ) +import Diagrams.Backend.Cairo hiding ( renderCairo ) +import Diagrams.Backend.Cairo.Internal + +import qualified Graphics.Rendering.Cairo as C +import qualified Graphics.Rendering.Cairo.Matrix as CM + +markLineStyle :: LineStyle +markLineStyle = def + { line_color_ = opaque red + , line_width_ = 1 + } + +-- Render a few lines and mark them appropriatly. +main :: IO () +main = render ("test.png") 1000 500 $ do + withTranslation (Point 10 10) $ do + (flip mapM_) [0 .. 5] $ \i -> do + let d = fromIntegral i + withTranslation (Point 0 (d * 70)) $ testDrawText (i * 10 + 10) + return () + +testDrawText :: Int -> ChartBackend () +testDrawText fontSize = + withFontStyle (def { font_size_ = fromIntegral fontSize, font_name_ = "Source Sans Pro" }) $ do + let text = "ÄÖÜ Testing " ++ show fontSize ++ "px" + -- Text metrics + ts <- textSize text + let a = textSizeAscent ts + d = textSizeDescent ts + -- Baseline and descent line: Red + withLineStyle markLineStyle $ do + p <- alignStrokePath $ moveTo' 0 a + <> lineTo' 500 a + <> moveTo' 0 (a + d) + <> lineTo' 500 (a + d) + strokePath p + -- Bounding lines: Green + withLineStyle (markLineStyle { line_color_ = opaque green }) $ do + p <- alignStrokePath $ moveTo' 0 0 + <> lineTo' 500 0 + <> moveTo' 0 (fromIntegral fontSize) + <> lineTo' 500 (fromIntegral fontSize) + <> moveTo' 0 0 + <> lineTo' 0 (fromIntegral fontSize) + + strokePath p + drawText (Point 0 a) text + +-- Render it side by side using cairo and diagrams cairo with SVGFonts. +render :: FilePath -> Int -> Int -> ChartBackend () -> IO () +render f w h m = do + rc <- renderCairo (w,h) m + rd <- renderDiagramsCairo (w,h) m + s <- C.createImageSurface C.FormatARGB32 w h + C.renderWith s $ do + C.setSourceRGB 1 1 1 + C.paint + C.setSourceRGB 0 0 0 + C.newPath + C.moveTo (fromIntegral w / 2) 0 + C.lineTo (fromIntegral w / 2) (fromIntegral h) + C.stroke + C.renderWith s $ do + C.rectangle 0 0 500 500 + C.clip + rc + C.renderWith s $ do + C.setMatrix (CM.translate (fromIntegral w/2) 0 CM.identity) + C.rectangle 0 0 500 500 + C.clip + rd + C.surfaceWriteToPNG s f + +renderCairo :: (Int, Int) -> ChartBackend () -> IO (C.Render ()) +renderCairo (w,h) m = do + return $ BC.runBackend (BC.defaultEnv bitmapAlignmentFns) m + +renderDiagramsCairo :: (Int, Int) -> ChartBackend () -> IO (C.Render ()) +renderDiagramsCairo (w,h) m = do + env <- BD.defaultEnv bitmapAlignmentFns + let (d, _) = BD.runBackend env m + return $ snd $ renderDia Cairo (CairoOptions "" (Dims (fromIntegral w) (fromIntegral h)) PNG True) d \ No newline at end of file diff --git a/chart-tests/tests/compare-font/test.png b/chart-tests/tests/compare-font/test.png new file mode 100644 index 00000000..bd334fea Binary files /dev/null and b/chart-tests/tests/compare-font/test.png differ