Merge pull request #174 from diagrams/image2

Image2

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,14 @@ module Diagrams.TwoD
        , fontSizeO, fontSizeL, fontSizeN, fontSizeG
 
          -- * Images
-       , Image, image
+       , DImage(..), ImageData(..)
+       , Embedded, External
+       , image
+       , loadImageEmb
+       , loadImageExt
+       , uncheckedImageRef
+       , raster
+       , fromRaster
 
          -- * 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          #-}
 -----------------------------------------------------------------------------
 -- |
@@ -11,76 +12,125 @@
 -- Maintainer  :  diagrams-discuss@googlegroups.com
 --
 -- Importing external images into diagrams.
---
+-- Usage: To create a diagram from an embedded image with width 1 and height
+--   set according to the aspect ratio: 'image img # scaleUToX 1`
+--   where 'img' is a 'DImage Embedded'
 -----------------------------------------------------------------------------
 
 module Diagrams.TwoD.Image
     (
-      Image(..), imgFile, imgSize, imgTransf
+      DImage(..), ImageData(..)
+    , Embedded, External
     , image
+    , loadImageEmb
+    , loadImageExt
+    , uncheckedImageRef
+    , raster
+    , fromRaster
     ) 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
-                   }
+data Embedded deriving Typeable
+data External deriving Typeable
+
+-- | '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
+
+-------------------------------------------------------------------------------
+-- | An image primitive, the two ints are width followed by height.
+--   Will typically be created by @loadImageEmb@ or @loadImageExt@ which,
+--   will handle setting the width and heigh to the actual width and height
+--   of the image.
+data DImage :: * -> * where
+  DImage :: ImageData t -> Int -> Int -> T2 -> DImage t
   deriving Typeable
 
-makeLenses ''Image
-
-type instance V Image = R2
+type instance V (DImage a) = R2
 
-instance Transformable Image where
-  transform t1 (Image file sz t2) = Image file sz (t1 <> t2)
+instance Transformable (DImage a) where
+  transform t1 (DImage iD w h t2) = DImage iD w h (t1 <> t2)
 
-instance HasOrigin Image where
+instance HasOrigin (DImage a) where
   moveOriginTo p = translate (origin .-. p)
 
-instance Renderable Image NullBackend where
+-- | 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
+
+-- | Use JuicyPixels to read an image in any format and wrap it in a 'DImage'.
+--   The width and height of the image are set to their actual values.
+loadImageEmb :: FilePath -> IO (Either String (DImage Embedded))
+loadImageEmb path = do
+    dImg <- readImage path
+    return $ case dImg of
+      Left msg  -> Left msg
+      Right img -> Right (DImage (ImageRaster img) w h mempty)
+        where
+          w = dynamicMap imageWidth img
+          h = dynamicMap imageHeight img
+
+-- | 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
+loadImageExt :: FilePath -> IO (Either String (DImage External))
+loadImageExt 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. Unless the aspect ratio of the external
+--   image is the w :: h, then the image will be distorted.
+uncheckedImageRef :: FilePath -> Int -> Int -> DImage External
+uncheckedImageRef path w h = DImage (ImageRef path) w h mempty
+
+-- | Crate a diagram from raw raster data.
+fromRaster :: Renderable (DImage Embedded) b
+          => (Int -> Int -> AlphaColour Double) -> Int -> Int -> Diagram b R2
+fromRaster f w h = image $ raster f w h
+
+-- | 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
-
--- 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
-
-{- ~~~~ Note [Image size specification]
-
-It's tempting to make 'image' take a SizeSpec2D instead of two
-Doubles.  For example, if I know I want the image to be x units wide
-but I don't know the original aspect ratio of the image, I'd like to
-be able to just say "make it x units wide".  The problem is that
-diagrams would then not know how tall the image is until rendering
-time (at least, not without unsafePerformIO yuckiness).  A more
-general solution will have to wait until we can specify constraints
-and solve them later.
-
--}