mirrors/IHaskell
1
0
Fork 0
mirror of https://github.com/IHaskell/IHaskell.git synced 2025-04-19 12:56:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

ihaskell-diagrams: make imgHeight configurable

Browse Source
This commit is contained in:
Vaibhav Sagar 2018-03-04 21:49:22 +08:00
parent 3d5cbb16fa
commit 1f852097f9
1 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
ihaskell-display/ihaskell-diagrams/IHaskell/Display/Diagrams.hs
View File

@ -1,10 +1,11 @@
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module IHaskell.Display.Diagrams (diagram, animation) where
module IHaskell.Display.Diagrams (diagram, animation, imgHeight) where
import qualified Data.ByteString.Char8 as Char
import System.Directory
import System.IO.Unsafe
import Data.IORef
import Diagrams.Backend.Cairo
import Diagrams.Prelude
import IHaskell.Display
@ -16,26 +17,31 @@ instance IHaskellDisplay (QDiagram Cairo V2 Double Any) where
svg <- diagramData renderable SVG
return $ Display [png, svg]
{-# NOINLINE imgHeight #-}
imgHeight :: IORef Double
imgHeight = unsafePerformIO (newIORef 300)
diagramData :: Diagram Cairo -> OutputType -> IO DisplayData
diagramData renderable format = do
switchToTmpDir
imgHeight' <- readIORef imgHeight
-- Compute width and height.
let w = width renderable
h = height renderable
aspect = w / h
imgHeight = 300
imgWidth = aspect * imgHeight
imgWidth = aspect * imgHeight'
-- Write the image.
let filename = ".ihaskell-diagram." ++ extension format
renderCairo filename (mkSizeSpec2D (Just imgWidth) (Just imgHeight)) renderable
renderCairo filename (mkSizeSpec2D (Just imgWidth) (Just imgHeight')) renderable
-- Convert to base64.
imgData <- Char.readFile filename
let value =
case format of
PNG -> png (floor imgWidth) (floor imgHeight) $ base64 imgData
PNG -> png (floor imgWidth) (floor imgHeight') $ base64 imgData
SVG -> svg (Char.unpack imgData)
return value