packages feed

ihaskell-diagrams 0.3.2.1 → 0.4.0.0

raw patch · 3 files changed

+148/−71 lines, 3 filesdep +filepathdep +temporarydep ~basedep ~ihaskell

Dependencies added: filepath, temporary

Dependency ranges changed: base, ihaskell

Files

IHaskell/Display/Diagrams.hs view
@@ -4,10 +4,15 @@ module IHaskell.Display.Diagrams          ( diagram, animation          , ManuallySized, withSizeSpec, withImgWidth, withImgHeight+         , ManuallySampled, withAnimFps          ) where +import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as Char+import qualified Data.Text.Encoding as T.Encoding import           System.Directory+import           System.IO.Temp+import           System.FilePath ((</>)) import           Diagrams.Backend.Cairo import           Diagrams.Prelude import           IHaskell.Display@@ -22,25 +27,27 @@  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)+  -- We should not have to round-trip this ByteString to a temp file.+  -- https://github.com/IHaskell/IHaskell/issues/1248+  withSystemTempDirectory "ihaskell-diagram" $ \tmpdir -> do+    let path = case format of+          SVG -> tmpdir </> "ihaskell-diagram.svg"+          PNG -> tmpdir </> "ihaskell-diagram.png"+          _ -> error "Unreachable case" -  return value+    -- Write the image.+    renderCairo path (mkSizeSpec2D (Just imgWidth)+                                   (Just imgHeight)) renderable -  where-    extension SVG = "svg"-    extension PNG = "png"+    case format of+      PNG -> do+        -- Convert to base64.+        imgData <- Char.readFile path+        pure $ png (floor imgWidth) (floor imgHeight) $ base64 imgData+      SVG -> do+        imgData <- BS.readFile path+        pure $ svg (T.Encoding.decodeUtf8 imgData)+      _ -> error "Unreachable case"  -- Rendering hint. diagram :: Diagram Cairo -> Diagram Cairo
IHaskell/Display/Diagrams/Animation.hs view
@@ -1,73 +1,141 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE TypeFamilies                            #-}+{-# LANGUAGE DeriveFunctor, DeriveGeneric #-} -module IHaskell.Display.Diagrams.Animation (animation) where+module IHaskell.Display.Diagrams.Animation+         ( animation+         , ManuallySampled, withAnimFps+         ) where -import qualified Data.Text as T import qualified Data.ByteString.Char8 as CBS+import qualified Data.Text as T +import           GHC.Generics (Generic)+import           Data.Maybe (fromMaybe) import           Diagrams.Prelude import           Diagrams.Backend.Cairo import           Diagrams.Backend.Cairo.CmdLine (GifOpts(..)) import           Diagrams.Backend.CmdLine (DiagramOpts(..), mainRender)+import           System.IO.Temp+import           System.FilePath ((</>))  import           IHaskell.Display import           IHaskell.Display.Diagrams.ImgSize -instance IHaskellDisplay (ManuallySized (QAnimation Cairo V2 Double Any)) where++data ManuallySampled a = ManuallySampled+    { contentToSample :: a+    , signalManualSampleRate :: Maybe Rational+    } deriving (Show, Functor, Generic)++class ManuallySamplable a where+  withSamplingSpec :: Maybe Rational -> a -> ManuallySampled a+++defaultFps = 30++withAnimFps :: ManuallySamplable a => Rational -> a -> ManuallySampled a+withAnimFps fps = withSamplingSpec (Just fps)+++instance IHaskellDisplay (ManuallySized (ManuallySampled (QAnimation Cairo V2 Double Any))) where   display renderable = do     gif <- animationData renderable-    return $ Display [html $ "<img src=\"data:image/gif;base64,"-                             ++ gif ++ "\" />"]+    return $ Display [html' Nothing $ "<img src=\"data:image/gif;base64," ++ gif ++ "\" />"] -animationData :: ManuallySized (Animation Cairo V2 Double) -> IO String-animationData (ManuallySized renderable imgWidth imgHeight) = do-  switchToTmpDir -  -- Generate the frames-  let fps = 30-      animAdjusted = animEnvelope' fps renderable-      frames = simulate fps animAdjusted-      timediff = 100 `div` ceiling fps :: Int-      frameSet = map (\x -> (x # bg white, timediff)) frames+animationData :: ManuallySized (ManuallySampled (Animation Cairo V2 Double)) -> IO String+animationData (ManuallySized (ManuallySampled renderable fps) imgWidth imgHeight) = do+  -- We should not have to round-trip this ByteString to a temp file.+  -- https://github.com/IHaskell/IHaskell/issues/1248+  withSystemTempDirectory "ihaskell-diagram" $ \tmpdir -> do -  -- Write the image.-  let filename = ".ihaskell-diagram.gif"-      diagOpts = DiagramOpts-        { _width = Just . ceiling $ imgWidth-        , _height = Just . ceiling $ imgHeight-        , _output = filename-        }-      gifOpts = GifOpts { _dither = True, _noLooping = False, _loopRepeat = Nothing }-  mainRender (diagOpts, gifOpts) frameSet+    let path = tmpdir </> "ihaskell-diagram.gif" -  -- Convert to ascii represented base64 encoding-  imgData <- CBS.readFile filename-  return . T.unpack . base64 $ imgData+    -- Generate the frames+    let actualFps = fromMaybe defaultFps fps+        animAdjusted = animEnvelope' actualFps renderable+        frames = simulate actualFps animAdjusted+        timediff = 100 `div` ceiling actualFps :: Int+        frameSet = map (\x -> (x # bg white, timediff)) frames +    -- Write the image.+    let diagOpts = DiagramOpts+          { _width = Just . ceiling $ imgWidth+          , _height = Just . ceiling $ imgHeight+          , _output = path+          }+        gifOpts = GifOpts { _dither = True, _noLooping = False, _loopRepeat = Nothing }+    mainRender (diagOpts, gifOpts) frameSet++    -- Convert to ascii represented base64 encoding+    imgData <- CBS.readFile path+    return . T.unpack . base64 $ imgData++ -- Rendering hint. animation :: Animation Cairo V2 Double -> Animation Cairo V2 Double animation = id ++getImgSize renderable sizeSpec fps = out+  where+    actualFps = fromMaybe defaultFps fps+    shape = activeStart $ animEnvelope' actualFps renderable+    aspect = width shape / height shape+    out = case getSpec sizeSpec 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 (b ~ Cairo, v ~ V2, s ~ Double, m ~ Any)+              => ManuallySamplable (QAnimation b v s m) where+  withSamplingSpec fps renderable = ManuallySampled renderable fps++instance (b ~ Cairo, v ~ V2, s ~ Double, m ~ Any)+              => ManuallySamplable (ManuallySized (QAnimation b v s m)) where+  withSamplingSpec fps sizedRenderable = ManuallySampled sizedRenderable fps++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+      fps = Nothing+      V2 imgWidth imgHeight = getImgSize renderable spec fps +instance (b ~ Cairo, v ~ V2, s ~ Double, m ~ Any)+              => ManuallySizeable (ManuallySampled (QAnimation b v s m)) where+  withSizeSpec spec (ManuallySampled renderable fps) = out+    where+      out = ManuallySized (ManuallySampled renderable fps) w h+      V2 w h = getImgSize renderable spec fps + instance IHaskellDisplay (QAnimation Cairo V2 Double Any) where+  display = display . withSizeSpec (mkSizeSpec2D Nothing Nothing) . withSamplingSpec fps+    where+      fps = Nothing++instance IHaskellDisplay (ManuallySized (QAnimation Cairo V2 Double Any)) where+  display (ManuallySized renderable w h) = out+    where+      fps = Nothing+      sizeSpec = mkSizeSpec2D (Just w) (Just h)+      out = display . withSizeSpec sizeSpec $ withSamplingSpec fps renderable++instance IHaskellDisplay (ManuallySampled (QAnimation Cairo V2 Double Any)) where   display = display . withSizeSpec (mkSizeSpec2D Nothing Nothing)++instance IHaskellDisplay (ManuallySampled (ManuallySized (QAnimation Cairo V2 Double Any))) where+  display (ManuallySampled (ManuallySized renderable w h) fps) = out+    where+      sizeSpec = mkSizeSpec2D (Just w) (Just h)+      out = display . withSizeSpec sizeSpec $ withSamplingSpec fps renderable
ihaskell-diagrams.cabal view
@@ -1,19 +1,19 @@ -- The name of the package. name:                ihaskell-diagrams --- The package version.  See the Haskell package versioning policy (PVP) +-- The package version.  See the Haskell package versioning policy (PVP) -- for standards guiding when and how versions should be incremented. -- http://www.haskell.org/haskellwiki/Package_versioning_policy -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.3.2.1+version:             0.4.0.0  -- A short (one-line) description of the package. synopsis:            IHaskell display instances for diagram types  -- A longer description of the package.--- description:         +-- description:  -- URL for the project homepage or repository. homepage:            http://www.github.com/gibiansky/ihaskell@@ -27,49 +27,51 @@ -- The package author(s). author:              Andrew Gibiansky --- An email address to which users can send suggestions, bug reports, and +-- An email address to which users can send suggestions, bug reports, and -- patches. maintainer:          andrew.gibiansky@gmail.com  -- A copyright notice.--- copyright:           +-- copyright:  category:            Development  build-type:          Simple --- Extra files to be distributed with the package, such as examples or a +-- Extra files to be distributed with the package, such as examples or a -- README.--- extra-source-files:  +-- extra-source-files:  -- Constraint on the version of Cabal needed to build this package.-cabal-version:       >=1.16+cabal-version:       1.16   library   -- Modules exported by the library.   exposed-modules:     IHaskell.Display.Diagrams-  +   -- 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,+  build-depends:       base >=4.9 && <5,                        text,                        bytestring,                        directory,+                       temporary,+                       filepath,                        -- Use diagrams wrapper package to ensure all same versions of subpackages                        diagrams >= 1.3,                        diagrams-lib,                        diagrams-cairo,-                       ihaskell >= 0.6.2,+                       ihaskell >= 0.11,                         -- The active package, used to represent animations                        active >= 0.2    -- Directories containing source files.-  -- hs-source-dirs:      -  +  -- hs-source-dirs:+   -- Base language which the package is written in.   default-language:    Haskell2010