-
Notifications
You must be signed in to change notification settings - Fork 63
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Image #173
Image #173
Changes from 3 commits
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,7 +1,8 @@ | ||
{-# LANGUAGE DeriveDataTypeable #-} | ||
{-# LANGUAGE EmptyDataDecls #-} | ||
{-# LANGUAGE FlexibleContexts #-} | ||
{-# LANGUAGE GADTs #-} | ||
{-# LANGUAGE MultiParamTypeClasses #-} | ||
{-# LANGUAGE TemplateHaskell #-} | ||
{-# LANGUAGE TypeFamilies #-} | ||
----------------------------------------------------------------------------- | ||
-- | | ||
|
@@ -16,61 +17,123 @@ | |
|
||
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. | ||
data DImage :: * -> * where | ||
DImage :: ImageData t -> Int -> Int -> T2 -> DImage t | ||
-- ^ width, height, applied transformation | ||
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 | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. What would you say about simply getting rid of this function? Its name is uninformative, we don't particularly want to encourage its use, and it's just a simple composition of two other functions. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. That's fine with me. |
||
=> 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] | ||
|
||
|
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Maybe you have to put this comment above
DImage
, using-- |
?