Image

diagrams-lib.cabal

@@ -111,6 +111,7 @@ Library
                        optparse-applicative >= 0.7 && < 0.9,
                        filepath,
                        safe >= 0.2 && < 0.4,
+                       JuicyPixels >= 3.1.5 && < 3.2,
                        hashable >= 1.1 && < 1.3
   if impl(ghc < 7.6)
     Build-depends: ghc-prim

src/Diagrams/TwoD.hs

@@ -164,7 +164,15 @@ module Diagrams.TwoD
        , fontSizeO, fontSizeL, fontSizeN, fontSizeG
 
          -- * Images
-       , Image, image
+       , DImage(..), ImageData(..)
+       , Embedded, External
+       , image
+       , imageRef
+       , mkImageRaster
+       , mkImageRef
+       , uncheckedImageRef
+       , loadImage
+       , raster
 
          -- * Transformations
          -- ** Rotation

src/Diagrams/TwoD/Image.hs

@@ -1,7 +1,8 @@
 {-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE EmptyDataDecls        #-}
 {-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE GADTs                 #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE TypeFamilies          #-}
 -----------------------------------------------------------------------------
 -- |
@@ -16,61 +17,122 @@
 
 module Diagrams.TwoD.Image
     (
-      Image(..), imgFile, imgSize, imgTransf
+      DImage(..), ImageData(..)
+    , Embedded, External
     , image
+    , imageRef
+    , mkImageRaster
+    , mkImageRef
+    , uncheckedImageRef
+    , loadImage
+    , raster
     ) where
 
-import           Control.Lens         (makeLenses)
+
+import           Codec.Picture
+import           Codec.Picture.Types  (dynamicMap)
+
 import           Data.Typeable
+import           Data.Colour          (AlphaColour)
 
 import           Diagrams.Core
 
+import           Diagrams.Attributes  (colorToSRGBA)
 import           Diagrams.Path
 import           Diagrams.TwoD.Path
 import           Diagrams.TwoD.Shapes
-import           Diagrams.TwoD.Size   (SizeSpec2D (..))
 import           Diagrams.TwoD.Types
 
 import           Data.AffineSpace     ((.-.))
-
 import           Data.Semigroup
 
--- | An external image primitive, representing an image the backend
---   should import from another file when rendering.
-data Image = Image { _imgFile   :: FilePath
-                   , _imgSize   :: SizeSpec2D
-                   , _imgTransf :: T2
-                   }
-  deriving Typeable
+data Embedded deriving Typeable
+data External deriving Typeable
 
-makeLenses ''Image
+-- | 'ImageData' is either a JuicyPixels @DynamicImage@ tagged as 'Embedded' or
+--   a reference tagged as 'External'.
+data ImageData :: * -> * where
+  ImageRaster :: DynamicImage -> ImageData Embedded
+  ImageRef :: FilePath -> ImageData External
 
-type instance V Image = R2
+-------------------------------------------------------------------------------
+-- | An image primitive, the two ints are width followed by height.
+data DImage :: * -> * where
+  DImage :: ImageData t -> Int -> Int -> T2 -> DImage t
+  deriving Typeable
 
-instance Transformable Image where
-  transform t1 (Image file sz t2) = Image file sz (t1 <> t2)
+type instance V (DImage a) = R2
 
-instance HasOrigin Image where
-  moveOriginTo p = translate (origin .-. p)
+instance Transformable (DImage a) where
+  transform t1 (DImage iD w h t2) = DImage iD w h (t1 <> t2)
 
-instance Renderable Image NullBackend where
-  render _ _ = mempty
+instance HasOrigin (DImage a) where
+  moveOriginTo p = translate (origin .-. p)
 
+-- | Use JuicyPixels to read an image in any format.
+loadImage :: FilePath -> IO (Either String (DImage Embedded))
+loadImage path = do
+    dImg <- readImage path
+    return $ case dImg of
+      Left msg  -> Left msg
+      Right img -> Right (DImage (ImageRaster img) 1 1 mempty)
+
+-- | Make a 'DImage' into a 'Diagram'.
+image :: (Typeable a, Renderable (DImage a) b) => DImage a -> Diagram b R2
+image img = mkQD (Prim (img)) (getEnvelope r) (getTrace r) mempty
+                  (Query $ \p -> Any (isInsideEvenOdd p r))
+  where
+    r :: Path R2
+    r = rect (fromIntegral w) (fromIntegral h)
+    DImage _ w h _ = img
 -- See Note [Image size specification]
 
--- | Take an external image from the specified file and turn it into a
---   diagram with the specified width and height, centered at the
---   origin.  Note that the image's aspect ratio will be preserved; if
---   the specified width and height have a different ratio than the
---   image's aspect ratio, there will be extra space in one dimension.
-image :: (Renderable Image b) => FilePath -> Double -> Double -> Diagram b R2
-image file w h = mkQD (Prim (Image file (Dims w h) mempty))
-                      (getEnvelope r)
-                      (getTrace r)
-                      mempty
-                      (Query $ \p -> Any (isInsideEvenOdd p r))
-  where r :: Path R2
-        r = rect w h
+-- | Make a@DynamicImage@ into a 'Diagram', i.e a primitive of type 'DImage Embedded'.
+mkImageRaster :: Renderable (DImage Embedded) b
+              => DynamicImage -> Int -> Int -> Diagram b R2
+mkImageRaster dImg w h = image $ DImage (ImageRaster dImg) w h mempty
+
+-- | Make a file path into a 'Diagram', i.e a primitive of type 'DImage External'.
+--   This function calls @uncheckedImageRef@ and provides no guarantee that
+--   the image file exists.
+mkImageRef :: Renderable (DImage External) b
+              => FilePath -> Int -> Int -> Diagram b R2
+mkImageRef path w h = image $ uncheckedImageRef path w h
+
+-- | Check that a file exists, and use JuicyPixels to figure out
+--   the right size, but save a reference to the image instead
+--   of the raster data
+imageRef :: FilePath -> IO (Either String (DImage External))
+imageRef path = do
+  dImg <- readImage path
+  return $ case dImg of
+    Left msg  -> Left msg
+    Right img -> Right $ DImage (ImageRef path) w h mempty
+      where
+        w = dynamicMap imageWidth img
+        h = dynamicMap imageHeight img
+
+-- | Make an "unchecked" image reference; have to specify a
+--   width and height.
+uncheckedImageRef :: FilePath -> Int -> Int -> DImage External
+uncheckedImageRef path w h = DImage (ImageRef path) w h mempty
+
+-- | Create an image "from scratch" by specifying the pixel data
+raster :: (Int -> Int -> AlphaColour Double) -> Int -> Int -> DImage Embedded
+raster f w h = DImage (ImageRaster (ImageRGBA8 img)) w h mempty
+  where
+    img = generateImage g w h
+    g x y = fromAlphaColour $ f x y
+
+fromAlphaColour :: AlphaColour Double -> PixelRGBA8
+fromAlphaColour c = PixelRGBA8 r g b a
+  where
+    (r, g, b, a) = (int r', int g', int b', int a')
+    (r', g', b', a') = colorToSRGBA c
+    int x = round (255 * x)
+
+instance Renderable (DImage a) NullBackend where
+  render _ _ = mempty
 
 {- ~~~~ Note [Image size specification]