Diagrams.hs

{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
{-# LANGUAGE TypeFamilies                            #-}

module IHaskell.Display.Diagrams
         ( diagram, animation
         , ManuallySized, withSizeSpec, withImgWidth, withImgHeight
         ) where

import qualified Data.ByteString.Char8 as Char
import           System.Directory
import           Diagrams.Backend.Cairo
import           Diagrams.Prelude
import           IHaskell.Display
import           IHaskell.Display.Diagrams.Animation
import           IHaskell.Display.Diagrams.ImgSize

instance IHaskellDisplay (ManuallySized (QDiagram Cairo V2 Double Any)) where
  display renderable = do
    png <- diagramData renderable PNG
    svg <- diagramData renderable SVG
    return $ Display [png, svg]

diagramData :: ManuallySized (Diagram Cairo) -> OutputType -> IO DisplayData
diagramData (ManuallySized renderable imgWidth imgHeight) format = do
  switchToTmpDir

  -- Write the image.
  let filename = ".ihaskell-diagram." ++ extension format
  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
          SVG -> svg (Char.unpack imgData)

  return value

  where
    extension SVG = "svg"
    extension PNG = "png"

-- Rendering hint.
diagram :: Diagram Cairo -> Diagram Cairo
diagram = id

instance (b ~ Cairo, v ~ V2, s ~ Double, m ~ Any)
              => ManuallySizeable (QDiagram a v s m) where
  withSizeSpec spec renderable = ManuallySized renderable imgWidth imgHeight
    where
       aspect = width renderable / height renderable
       V2 imgWidth imgHeight = case getSpec spec of
         V2 (Just w) (Just h) -> V2 w h
         V2 (Just w) Nothing  -> V2 w (w/aspect)
         V2 Nothing (Just h)  -> V2 (aspect*h) h
         V2 Nothing Nothing   -> (defaultDiagonal / sqrt (1 + aspect^2))
                                    *^ V2 aspect 1
                                 -- w^2 + h^2 = defaultDiagonal^2 / (1+aspect^2)
                                 --                * (aspect^2 + 1)
                                 --           = defaultDiagonal^2
                                 -- w/h = aspect/1 = aspect
       defaultDiagonal = 500

instance IHaskellDisplay (QDiagram Cairo V2 Double Any) where
  display = display . withSizeSpec (mkSizeSpec2D Nothing Nothing)