ihaskell-diagrams 0.3.1.1 → 0.3.2.1
raw patch · 4 files changed
+85/−25 lines, 4 files
Files
- IHaskell/Display/Diagrams.hs +31/−13
- IHaskell/Display/Diagrams/Animation.hs +28/−11
- IHaskell/Display/Diagrams/ImgSize.hs +24/−0
- ihaskell-diagrams.cabal +2/−1
IHaskell/Display/Diagrams.hs view
@@ -1,35 +1,33 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-} -module IHaskell.Display.Diagrams (diagram, animation) where+module IHaskell.Display.Diagrams+ ( diagram, animation+ , ManuallySized, withSizeSpec, withImgWidth, withImgHeight+ ) where import qualified Data.ByteString.Char8 as Char import System.Directory-import System.IO.Unsafe import Diagrams.Backend.Cairo import Diagrams.Prelude import IHaskell.Display import IHaskell.Display.Diagrams.Animation+import IHaskell.Display.Diagrams.ImgSize -instance IHaskellDisplay (QDiagram Cairo V2 Double Any) where+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 :: Diagram Cairo -> OutputType -> IO DisplayData-diagramData renderable format = do+diagramData :: ManuallySized (Diagram Cairo) -> OutputType -> IO DisplayData+diagramData (ManuallySized renderable imgWidth imgHeight) format = do switchToTmpDir - -- Compute width and height.- let w = width renderable- h = height renderable- aspect = w / h- imgHeight = 300- 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@@ -47,3 +45,23 @@ -- 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)
IHaskell/Display/Diagrams/Animation.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-} module IHaskell.Display.Diagrams.Animation (animation) where @@ -11,15 +12,16 @@ import Diagrams.Backend.CmdLine (DiagramOpts(..), mainRender) import IHaskell.Display+import IHaskell.Display.Diagrams.ImgSize -instance IHaskellDisplay (QAnimation Cairo V2 Double Any) where+instance IHaskellDisplay (ManuallySized (QAnimation Cairo V2 Double Any)) where display renderable = do gif <- animationData renderable return $ Display [html $ "<img src=\"data:image/gif;base64," ++ gif ++ "\" />"] -animationData :: Animation Cairo V2 Double -> IO String-animationData renderable = do+animationData :: ManuallySized (Animation Cairo V2 Double) -> IO String+animationData (ManuallySized renderable imgWidth imgHeight) = do switchToTmpDir -- Generate the frames@@ -29,14 +31,6 @@ timediff = 100 `div` ceiling fps :: Int frameSet = map (\x -> (x # bg white, timediff)) frames - -- Compute width and height.- let shape = activeStart animAdjusted- w = width shape- h = height shape- aspect = w / h- imgHeight = 300- imgWidth = aspect * imgHeight- -- Write the image. let filename = ".ihaskell-diagram.gif" diagOpts = DiagramOpts@@ -54,3 +48,26 @@ -- Rendering hint. animation :: Animation Cairo V2 Double -> Animation Cairo V2 Double animation = id++instance (b ~ Cairo, v ~ V2, s ~ Double, m ~ Any)+ => ManuallySizeable (QAnimation b v s m) where+ withSizeSpec spec renderable = ManuallySized renderable imgWidth imgHeight+ where+ fps = 30+ shape = activeStart $ animEnvelope' fps renderable+ aspect = width shape / height shape+ 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 (QAnimation Cairo V2 Double Any) where+ display = display . withSizeSpec (mkSizeSpec2D Nothing Nothing)
+ IHaskell/Display/Diagrams/ImgSize.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE DeriveFunctor, DeriveGeneric #-}++module IHaskell.Display.Diagrams.ImgSize where++import GHC.Generics (Generic)+import Diagrams.Prelude (SizeSpec, mkSizeSpec2D, V2)++data ManuallySized a = ManuallySized+ { contentToDisplay :: a+ , imgManualWidth :: Double+ , imgManualHeight :: Double+ } deriving (Show, Functor, Generic)++class ManuallySizeable a where+ withSizeSpec :: SizeSpec V2 Double -> a -> ManuallySized a++withImgWidth :: ManuallySizeable a => Int -> a -> ManuallySized a+withImgWidth imgWidth = withSizeSpec $ mkSizeSpec2D (Just $ fromIntegral imgWidth)+ Nothing++withImgHeight :: ManuallySizeable a => Int -> a -> ManuallySized a+withImgHeight imgHeight = withSizeSpec $ mkSizeSpec2D Nothing+ (Just $ fromIntegral imgHeight)+
ihaskell-diagrams.cabal view
@@ -7,7 +7,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.3.1.1+version: 0.3.2.1 -- A short (one-line) description of the package. synopsis: IHaskell display instances for diagram types@@ -52,6 +52,7 @@ -- Modules included in this library but not exported. other-modules: IHaskell.Display.Diagrams.Animation+ IHaskell.Display.Diagrams.ImgSize -- Other library packages from which modules are imported. build-depends: base >=4.6 && <5,