hip 1.0.0.0 → 1.0.1

raw patch · 32 files changed

+1027/−396 lines, 32 filesdep +Chartdep +Chart-cairodep +colourdep −vector-th-unboxdep ~vectorbinary-addedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: Chart, Chart-cairo, colour

Dependencies removed: vector-th-unbox

Dependency ranges changed: vector

API changes (from Hackage documentation)

Files

• hip.cabal +10/−8
• images/frog_histogram.png binary
• src/Graphics/Image.hs +42/−27
• src/Graphics/Image/ColorSpace.hs +49/−42
• src/Graphics/Image/ColorSpace/Binary.hs +13/−2
• src/Graphics/Image/ColorSpace/CMYK.hs +41/−9
• src/Graphics/Image/ColorSpace/Complex.hs +9/−1
• src/Graphics/Image/ColorSpace/Gray.hs +28/−10
• src/Graphics/Image/ColorSpace/HSI.hs +48/−15
• src/Graphics/Image/ColorSpace/Luma.hs +42/−7
• src/Graphics/Image/ColorSpace/RGB.hs +35/−6
• src/Graphics/Image/ColorSpace/YCbCr.hs +45/−13
• src/Graphics/Image/IO.hs +23/−76
• src/Graphics/Image/IO/Base.hs +37/−3
• src/Graphics/Image/IO/External.hs +8/−0
• src/Graphics/Image/IO/External/JuicyPixels.hs +26/−13
• src/Graphics/Image/IO/External/Netpbm.hs +24/−13
• src/Graphics/Image/IO/Histogram.hs +119/−0
• src/Graphics/Image/Interface.hs +76/−37
• src/Graphics/Image/Interface/Repa.hs +20/−3
• src/Graphics/Image/Interface/Repa/Internal.hs +28/−21
• src/Graphics/Image/Interface/Vector.hs +29/−4
• src/Graphics/Image/Interface/Vector/Unboxed.hs +36/−42
• src/Graphics/Image/Interface/Vector/Unboxing.hs +123/−0
• src/Graphics/Image/Processing.hs +12/−1
• src/Graphics/Image/Processing/Binary.hs +8/−0
• src/Graphics/Image/Processing/Complex.hs +17/−6
• src/Graphics/Image/Processing/Complex/Fourier.hs +18/−5
• src/Graphics/Image/Processing/Convolution.hs +8/−25
• src/Graphics/Image/Processing/Geometric.hs +13/−1
• src/Graphics/Image/Processing/Interpolation.hs +20/−6
• src/Graphics/Image/Types.hs +20/−0

@@ -1,5 +1,5 @@ Name:              hip-Version:           1.0.0.0+Version:           1.0.1 License:           BSD3 License-File:      LICENSE Author:            Alexey Kuleshevich@@ -13,7 +13,7 @@             .             Processing can be done sequentially as well as in parallel, with an inherited fusion capabily, all through <https://hackage.haskell.org/package/repa repa> and <https://hackage.haskell.org/package/vector vector> packages. It is highly extendable, with an ability to add custom color spaces or use some other underlying data structure.             .-            It is capable of reading and writing a number of popular image formats by using <https://hackage.haskell.org/package/JuicyPixels JuciyPixels> and <https://hackage.haskell.org/package/netpbm netpbm> packages. Being a pure Haskell library it does not require any external programs, but it can display images using a program of your choice.+            It is capable of reading and writing a number of popular image formats by using <https://hackage.haskell.org/package/JuicyPixels JuciyPixels> and <https://hackage.haskell.org/package/netpbm netpbm> packages. Being a pure Haskell library it does not require any external programs, although it can display images using a program of your choice. Homepage:          https://github.com/lehins/hip Bug-Reports:       https://github.com/lehins/hip/issues Cabal-Version:     >= 1.10@@ -27,27 +27,26 @@   Build-Depends: base            >= 4.5     && < 5                , bytestring      >= 0.9.0.4                , deepseq         >= 1.1---               , easyplot        >= 1.0                , filepath        >= 1.0                , JuicyPixels     >= 3.2.7                , netpbm          >= 1.0.1+               , Chart           >= 1.5+               , Chart-cairo     >= 1.5+               , colour          >= 2.3.3                , primitive       >= 0.4                , process         >= 1.1.0.0                , repa            >= 3.2.1.1 && < 4                , temporary       >= 1.1.1-               , vector          >= 0.9     && < 0.11-               , vector-th-unbox >= 0.2.1.0+               , vector          >= 0.10    && < 0.11 	     Other-Extensions: BangPatterns                   , ConstraintKinds-                  , GADTs+                  , CPP                   , FlexibleContexts                   , FlexibleInstances                   , FunctionalDependencies                   , MultiParamTypeClasses-                  , MultiWayIf                   , ScopedTypeVariables-                  , TemplateHaskell                   , TypeFamilies                   , UndecidableInstances                   , ViewPatterns@@ -56,12 +55,14 @@                  , Graphics.Image.ColorSpace                  , Graphics.Image.IO                  , Graphics.Image.IO.External+                 , Graphics.Image.IO.Histogram                  , Graphics.Image.Interface                  , Graphics.Image.Interface.Repa                  , Graphics.Image.Interface.Vector                  , Graphics.Image.Processing                  , Graphics.Image.Processing.Binary                  , Graphics.Image.Processing.Complex+                 , Graphics.Image.Types                       Other-Modules:   Graphics.Image.ColorSpace.Binary                  , Graphics.Image.ColorSpace.CMYK@@ -76,6 +77,7 @@                  , Graphics.Image.IO.External.Netpbm                  , Graphics.Image.Interface.Repa.Internal                  , Graphics.Image.Interface.Vector.Unboxed+                 , Graphics.Image.Interface.Vector.Unboxing                  , Graphics.Image.Processing.Convolution                  , Graphics.Image.Processing.Complex.Fourier                  , Graphics.Image.Processing.Geometric

binary file changed (absent → 42457 bytes)

@@ -1,23 +1,22 @@ {-# OPTIONS_GHC -fno-warn-unused-imports #-}-{-# LANGUAGE BangPatterns, FlexibleContexts #-}+{-# LANGUAGE CPP, BangPatterns, FlexibleContexts #-} -- |--- Module      : Graphics.Image.Unboxed+-- Module      : Graphics.Image -- Copyright   : (c) Alexey Kuleshevich 2016--- License     : MIT---+-- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental -- Portability : non-portable -- -- Haskell Image Processing (HIP) library is a wrapper around any array like -- data structure and is fully agnostic to the underlying representation. All of--- the functionality in this library relies on few type classes that those--- representations implement:+-- the functionality in this library relies on few type classes that+-- corresponding representation types are instances of: ----- * @__`Array` arr cs e__@ - this is a base class for every __@`Image`@ @arr@ @cs@ @e@__,--- where @__arr__@ stands for an underlying array representation, @__cs__@ is the--- `ColorSpace` of an image and @__e__@ is the type denoting precision of an--- image.+-- * @__`Graphics.Image.Types.Array` arr cs e__@ - this is a base class for every+-- __@`Graphics.Image.Types.Image`@ @arr@ @cs@ @e@__, where @__arr__@ stands for an underlying array+-- representation, @__cs__@ is the `ColorSpace` of an image and @__e__@ is the+-- type denoting precision of an image. -- -- * @__`ManifestArray` arr cs e__@ - is a kind of array that is represented by an -- actual data in memory.@@ -43,16 +42,30 @@ -- representation should be used for fusing computation together, and later -- changed to `RS` or `RP` using `exchange`, which in turn performs the fused -- computation.--- +--+-- Just as it is mentioned above, Vector representation is a default one, so in+-- order to create images with Repa representation+-- "Graphics.Image.Interface.Repa" module can be used. It should be imported as+-- qualified, since it contains image generating functions with same names as+-- here.+--+-- Many of the function names exported by this module will clash with the ones+-- from "Prelude", hence it can be more convenient to import it qualified and+-- all relevenat types import using "Graphics.Image.Types" module:+--+-- @+-- import qualified Graphics.Image as I+-- import Graphics.Image.Types+-- @+-- module Graphics.Image (   -- * Color Space   -- $colorspace-  module Graphics.Image.ColorSpace,    -- * Creation   --   -- If it is necessary to create an image in an other representation-  -- or with some specific 'Pixel' precision, you can use 'makeImage' from+  -- or with some specific 'Pixel' precision, you can use 'make' from   -- "Graphics.Image.Interface" module and manually specifying function's output   -- type, ex:   --@@ -87,31 +100,33 @@   exchange,   VU(..), RD(..), RS(..), RP(..),   ) where++#if MIN_VERSION_base(4,8,0)+import Prelude hiding (map, zipWith, sum, product, maximum, minimum, traverse)+#else import Prelude hiding (map, zipWith, sum, product, maximum, minimum)+#endif import qualified Data.Foldable as F import Graphics.Image.ColorSpace import Graphics.Image.IO-import Graphics.Image.Interface+import Graphics.Image.Interface hiding (makeImage, fromLists) import Graphics.Image.Interface.Vector import Graphics.Image.Interface.Repa (RD(..), RS(..), RP(..)) ---import Graphics.Image.Processing---import Graphics.Image.Processing.Complex++import Graphics.Image.Processing+import Graphics.Image.Processing.Complex --import Graphics.Image.Processing.Binary+import Graphics.Image.IO.Histogram   -------------------------------------------------------------------------------------- Creation and Transformation -------------------------------------------------------------------------------------------------------------------------------- -- -- | Get the number of rows in an image. -- -- >>> frog <- readImageRGB "images/frog.jpg" -- >>> frog--- <Image RepaDelayed RGB: 200x320>+-- <Image VectorUnboxed RGB (Double): 200x320> -- >>> rows frog -- 200 --@@ -124,7 +139,7 @@ -- -- >>> frog <- readImageRGB "images/frog.jpg" -- >>> frog--- <Image RepaDelayed RGB: 200x320>+-- <Image VectorUnboxed RGB (Double): 200x320> -- >>> cols frog -- 320 --@@ -166,7 +181,7 @@   where     !(PixelGray l, PixelGray s) = (maximum $ map (PixelGray . F.maximum) img,                                    minimum $ map (PixelGray . F.minimum) img)-    normalizer !px = (px - pure s) / (pure (l - s))+    normalizer !px = (px - pure s) / pure (l - s)     {-# INLINE normalizer #-} {-# INLINE normalize #-} @@ -187,12 +202,12 @@ --     * __'Pixel' 'YCbCrA' e = PixelYCbCrA e__ - YCbCr with alpha. --       ------------------------------------------------------------------------------------------ --     * __'Pixel' 'Binary' 'Bit'     = 'on' | 'off'__ - Bi-tonal.---     * __'Pixel' 'Gray' e         = PixelGray e__ - Used for separating channels from other color spaces. --     * __'Pixel' cs ('Complex' e) = ('Pixel' cs e) '+:' ('Pixel' cs e)__ - Complex pixels with any color space.+--     * __'Pixel' 'Gray' e         = PixelGray e__ - Used for separating channels from other color spaces. -- @ -- -- Every 'Pixel' is an instance of 'Functor', 'Applicative', 'F.Foldable' and -- 'Num', as well as 'Floating' and 'Fractional' if __e__ is also an instance. ----- All of the functionality related to every 'ColorSpace' is re-exported from here--- for convenience.+-- All of the functionality related to every 'ColorSpace' is re-exported by+-- "Graphics.Image.Types" module.

@@ -1,9 +1,16 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE BangPatterns, FlexibleContexts, FlexibleInstances,-             MultiParamTypeClasses, MultiWayIf, ViewPatterns #-}+{-# LANGUAGE BangPatterns, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}+-- |+-- Module      : Graphics.Image.ColorSpace+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.ColorSpace (   -- * ColorSpace-  ColorSpace(..), Alpha(..),+  ColorSpace, Pixel(..), Alpha, Opaque, Elevator(..),   -- * Luma   module Graphics.Image.ColorSpace.Luma,   -- * RGB@@ -22,13 +29,10 @@   -- * Complex   module Graphics.Image.ColorSpace.Complex,   -- * Re-exports-  Applicative(..), (<$>), (<$), (<**>), liftA, liftA2, liftA3,   Word8, Word16, Word32, Word64   ) where  --import Control.Applicative import Data.Word import GHC.Float import Graphics.Image.Interface hiding (map)@@ -44,30 +48,31 @@   - -- Binary: -+-- | Convert any pixel to binary pixel. toPixelBinary :: (ColorSpace cs, Eq (Pixel cs e), Num e) => Pixel cs e -> Pixel Binary Bit toPixelBinary px = if px == 0 then on else off {-# INLINE toPixelBinary #-} -+-- | Convert a Binary pixel to Luma pixel fromPixelBinary :: Pixel Binary Bit -> Pixel Y Word8 fromPixelBinary b = PixelY $ if isOn b then minBound else maxBound {-# INLINE fromPixelBinary #-}  +-- | Convert any image to binary image. toImageBinary :: (Array arr cs e, Array arr Binary Bit, Eq (Pixel cs e)) =>-              Image arr cs e-           -> Image arr Binary Bit+                 Image arr cs e+              -> Image arr Binary Bit toImageBinary = I.map toPixelBinary {-# INLINE toImageBinary #-}  +-- | Convert a Binary image to Luma image fromImageBinary :: (Array arr Binary Bit, Array arr Y Word8) =>-                Image arr Binary Bit-             -> Image arr Y Word8+                   Image arr Binary Bit+                -> Image arr Y Word8 fromImageBinary = I.map fromPixelBinary {-# INLINE fromImageBinary #-} @@ -110,26 +115,28 @@ instance ToRGBA YA where  instance ToRGB HSI where-  toPixelRGB (PixelHSI h s i) = -    let !is = i*s-        !second = i - is-        getFirst !a !b = i + is*cos a/cos b-        {-# INLINE getFirst #-}-        getThird !v1 !v2 = i + 2*is + v1 - v2-        {-# INLINE getThird #-}-    in if | h < 2*pi/3 -> let !r = getFirst h (pi/3 - h)-                              !b = second-                              !g = getThird b r-                          in PixelRGB r g b-          | h < 4*pi/3 -> let !g = getFirst (h - 2*pi/3) (h + pi)-                              !r = second-                              !b = getThird r g-                          in PixelRGB r g b-          | h < 2*pi   -> let !b = getFirst (h - 4*pi/3) (2*pi - pi/3 - h)-                              !g = second-                              !r = getThird g b-                          in PixelRGB r g b-          | otherwise  -> error ("HSI pixel is not properly scaled, Hue: "++show h)+  toPixelRGB (PixelHSI h' s i) = getRGB (h'*2*pi) where+    !is = i*s+    !second = i - is+    getFirst !a !b = i + is*cos a/cos b+    {-# INLINE getFirst #-}+    getThird !v1 !v2 = i + 2*is + v1 - v2+    {-# INLINE getThird #-}+    getRGB h+      | h < 2*pi/3 = let !r = getFirst h (pi/3 - h)+                         !b = second+                         !g = getThird b r+                     in PixelRGB r g b+      | h < 4*pi/3 = let !g = getFirst (h - 2*pi/3) (h + pi)+                         !r = second+                         !b = getThird r g+                     in PixelRGB r g b+      | h < 2*pi   = let !b = getFirst (h - 4*pi/3) (2*pi - pi/3 - h)+                         !g = second+                         !r = getThird g b+                     in PixelRGB r g b+      | otherwise  = error ("HSI pixel is not properly scaled, Hue: "++show h')+    {-# INLINE getRGB #-}   {-# INLINE toPixelRGB #-}  instance ToRGBA HSIA where@@ -165,7 +172,7 @@ instance ToHSI RGB where   toPixelHSI (PixelRGB r g b) = PixelHSI h s i where     !h' = atan2 y x-    !h = if h' < 0 then h' + 2*pi else h'+    !h = (if h' < 0 then h' + 2*pi else h') / (2*pi)     !s = if i == 0 then 0 else 1 - minimum [r, g, b] / i     !i = (r + g + b) / 3     !x = (2*r - g - b) / 2.449489742783178@@ -219,12 +226,12 @@   {-# INLINE toWord64 #-}    toFloat = liftA toFloat' where-    toFloat' !e = fromIntegral e / (fromIntegral (maxBound :: Word8))+    toFloat' !e = fromIntegral e / fromIntegral (maxBound :: Word8)     {-# INLINE toFloat' #-}   {-# INLINE toFloat #-}    toDouble = liftA toDouble' where-    toDouble' !e = fromIntegral e / (fromIntegral (maxBound :: Word8))+    toDouble' !e = fromIntegral e / fromIntegral (maxBound :: Word8)     {-# INLINE toDouble' #-}   {-# INLINE toDouble #-} @@ -255,12 +262,12 @@   {-# INLINE toWord64 #-}    toFloat = liftA toFloat' where-    toFloat' !e = fromIntegral e / (fromIntegral (maxBound :: Word16))+    toFloat' !e = fromIntegral e / fromIntegral (maxBound :: Word16)     {-# INLINE toFloat' #-}   {-# INLINE toFloat #-}    toDouble = liftA toDouble' where-    toDouble' !e = fromIntegral e / (fromIntegral (maxBound :: Word16))+    toDouble' !e = fromIntegral e / fromIntegral (maxBound :: Word16)     {-# INLINE toDouble' #-}   {-# INLINE toDouble #-} @@ -292,12 +299,12 @@   {-# INLINE toWord64 #-}    toFloat = liftA toFloat' where-    toFloat' !e = fromIntegral e / (fromIntegral (maxBound :: Word32))+    toFloat' !e = fromIntegral e / fromIntegral (maxBound :: Word32)     {-# INLINE toFloat' #-}   {-# INLINE toFloat #-}    toDouble = liftA toDouble' where-    toDouble' !e = fromIntegral e / (fromIntegral (maxBound :: Word32))+    toDouble' !e = fromIntegral e / fromIntegral (maxBound :: Word32)     {-# INLINE toDouble' #-}   {-# INLINE toDouble #-} @@ -330,12 +337,12 @@   {-# INLINE toWord64 #-}    toFloat = liftA toFloat' where-    toFloat' !e = fromIntegral e / (fromIntegral (maxBound :: Word64))+    toFloat' !e = fromIntegral e / fromIntegral (maxBound :: Word64)     {-# INLINE toFloat' #-}   {-# INLINE toFloat #-}    toDouble = liftA toDouble' where-    toDouble' !e = fromIntegral e / (fromIntegral (maxBound :: Word64))+    toDouble' !e = fromIntegral e / fromIntegral (maxBound :: Word64)     {-# INLINE toDouble' #-}   {-# INLINE toDouble #-} 

@@ -1,5 +1,13 @@ {-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleContexts, FlexibleInstances,              TypeFamilies #-}+-- |+-- Module      : Graphics.Image.ColorSpace.Binary+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.ColorSpace.Binary (   Binary(..), Bit(..), on, off, isOn, isOff, fromBool, complement   ) where@@ -8,7 +16,8 @@ import Data.Word (Word8) import Graphics.Image.Interface import Data.Typeable (Typeable)-import Data.Monoid (mappend, mempty)+import qualified Data.Monoid as M (mappend, mempty)+import qualified Data.Colour as C  -- | This is a Binary colorspace, pixel's of which can be created using -- these __/constructors/__:@@ -110,8 +119,10 @@   chApp (PixelBinary f) (PixelBinary b) = PixelBinary (f b)   {-# INLINE chApp #-} -  pxFoldMap f (PixelBinary b) = f b `mappend` mempty+  pxFoldMap f (PixelBinary b) = f b `M.mappend` M.mempty   {-# INLINE pxFoldMap #-}++  csColour _ = C.opaque C.black   instance Show (Pixel Binary Bit) where

@@ -1,5 +1,13 @@ {-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleContexts, FlexibleInstances,              TypeFamilies #-}+-- |+-- Module      : Graphics.Image.ColorSpace.CMYK+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.ColorSpace.CMYK (   CMYK(..), CMYKA(..), Pixel(..),    ToCMYK(..), ToCMYKA(..)@@ -8,26 +16,33 @@ import Prelude hiding (map) import Graphics.Image.Interface import Data.Typeable (Typeable)-import Data.Monoid (mappend)+import qualified Data.Monoid as M (mappend)+import qualified Data.Colour as C+import qualified Data.Colour.Names as C +-- | Cyan, Magenta, Yellow and Black color space. data CMYK = CyanCMYK -- ^ Cyan-          | MagCMYK  -- ^ Mahenta+          | MagCMYK  -- ^ Magenta           | YelCMYK  -- ^ Yellow           | KeyCMYK  -- ^ Key (Black)           deriving (Eq, Enum, Typeable) +-- | Cyan, Magenta, Yellow and Black color space with Alpha channel. data CMYKA = CyanCMYKA  -- ^ Cyan-           | MagCMYKA   -- ^ Mahenta+           | MagCMYKA   -- ^ Magenta            | YelCMYKA   -- ^ Yellow            | KeyCMYKA   -- ^ Key (Black)            | AlphaCMYKA -- ^ Alpha             deriving (Eq, Enum, Typeable)  +-- | Conversion to `CMYK` color space. class ColorSpace cs => ToCMYK cs where +  -- | Convert to a `CMYK` pixel.   toPixelCMYK :: Pixel cs Double -> Pixel CMYK Double +  -- | Convert to a `CMYK` image.   toImageCMYK :: (Array arr cs Double, Array arr CMYK Double) =>                  Image arr cs Double               -> Image arr CMYK Double@@ -35,11 +50,15 @@   {-# INLINE toImageCMYK #-}  +-- | Conversion to `CMYKA` from another color space with Alpha channel. class (ToCMYK (Opaque cs), Alpha cs) => ToCMYKA cs where +  -- | Convert to a `CMYKA` pixel.   toPixelCMYKA :: Pixel cs Double -> Pixel CMYKA Double   toPixelCMYKA px = addAlpha (getAlpha px) (toPixelCMYK (dropAlpha px))+  {-# INLINE toPixelCMYKA #-} +  -- | Convert to a `CMYKA` image.   toImageCMYKA :: (Array arr cs Double, Array arr CMYKA Double) =>                   Image arr cs Double                -> Image arr CMYKA Double@@ -76,9 +95,13 @@   chApp (PixelCMYK fc fm fy fk) (PixelCMYK c m y k) = PixelCMYK (fc c) (fm m) (fy y) (fk k)   {-# INLINE chApp #-} -  pxFoldMap f (PixelCMYK c m y k) = f c `mappend` f m `mappend` f y `mappend` f k+  pxFoldMap f (PixelCMYK c m y k) = f c `M.mappend` f m `M.mappend` f y `M.mappend` f k   {-# INLINE pxFoldMap #-} +  csColour CyanCMYK = C.opaque C.cyan+  csColour MagCMYK  = C.opaque C.magenta+  csColour YelCMYK  = C.opaque C.yellow+  csColour KeyCMYK  = C.opaque C.black   instance ColorSpace CMYKA where@@ -112,10 +135,14 @@     PixelCMYKA (fc c) (fm m) (fy y) (fk k) (fa a)   {-# INLINE chApp #-} -  pxFoldMap f (PixelCMYKA c m y k a) = f c `mappend` f m `mappend` f y `mappend` f k `mappend` f a+  pxFoldMap f (PixelCMYKA c m y k a) =+    f c `M.mappend` f m `M.mappend` f y `M.mappend` f k `M.mappend` f a   {-# INLINE pxFoldMap #-} +  csColour AlphaCMYKA = C.opaque C.grey+  csColour ch         = csColour $ opaque ch + instance Alpha CMYKA where   type Opaque CMYKA = CMYK @@ -128,6 +155,12 @@   dropAlpha (PixelCMYKA c m y k _) = PixelCMYK c m y k   {-# INLINE dropAlpha #-} +  opaque CyanCMYKA  = CyanCMYK+  opaque MagCMYKA   = MagCMYK+  opaque YelCMYKA   = YelCMYK+  opaque KeyCMYKA   = KeyCMYK+  opaque AlphaCMYKA = error "Data.Image.ColorSpace.CMYK (Alpha.opaque)"+    instance Show CMYK where   show CyanCMYK = "Cyan"@@ -135,12 +168,11 @@   show YelCMYK  = "Yellow"   show KeyCMYK  = "Black" + instance Show CMYKA where-  show CyanCMYKA  = "Cyan"-  show MagCMYKA   = "Magenta"-  show YelCMYKA   = "Yellow"-  show KeyCMYKA   = "Black"   show AlphaCMYKA = "Alpha"+  show ch         = show $ opaque ch+    instance Show e => Show (Pixel CMYK e) where   show (PixelCMYK c m y k) = "<CMYK:("++show c++"|"++show m++"|"++show y++"|"++show k++")>"

@@ -1,4 +1,12 @@ {-# LANGUAGE BangPatterns #-}+-- |+-- Module      : Graphics.Image.ColorSpace.Complex+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.ColorSpace.Complex (   -- ** Rectangular form   Complex(..), (+:), realPart, imagPart,@@ -17,7 +25,7 @@  infix 6 +: --- | Constrcut a complex pixel from two pixels containing real and imaginary parts.+-- | Constrcut a complex pixel from two pixels representing real and imaginary parts. -- -- @ PixelRGB 4 8 6 '+:' PixelRGB 7 1 1 __==__ PixelRGB (4 ':+' 7) (8 ':+' 1) (6 ':+' 1) @ --

@@ -1,5 +1,13 @@ {-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleContexts, FlexibleInstances,              ScopedTypeVariables, TypeFamilies #-}+-- |+-- Module      : Graphics.Image.ColorSpace.Gray+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.ColorSpace.Gray (   Gray(..), Pixel(..), toGrayImages, fromGrayImages   ) where@@ -8,7 +16,9 @@ import qualified Prelude as P (map) import Graphics.Image.Interface import Data.Typeable (Typeable)-import Data.Monoid (mappend, mempty)+import qualified Data.Monoid as M (mappend, mempty)+import qualified Data.Colour as C+import qualified Data.Colour.Names as C  -- ^ This is a signgle channel colorspace, that is designed to hold any channel -- from any other colorspace, hence it is not convertible to and from, but@@ -53,14 +63,13 @@ -- fromGrayImages :: forall arr cs e . (Array arr Gray e, Array arr cs e) =>                   [Image arr Gray e] -> [cs] -> Image arr cs e-fromGrayImages imgs chs =-  fromGrays (singleton (fromChannel 0)) imgs chs where-    updateCh ch px (PixelGray e) = chOp (\ !ch' !e' -> if ch' == ch then e else e') px-    {-# INLINE updateCh #-}-    fromGrays img []     _      = img-    fromGrays img _      []     = img-    fromGrays img (i:is) (c:cs) = fromGrays (zipWith (updateCh c) img i) is cs-    {-# INLINE fromGrays #-}+fromGrayImages = fromGrays (singleton (fromChannel 0)) where+  updateCh ch px (PixelGray e) = chOp (\ !ch' !e' -> if ch' == ch then e else e') px+  {-# INLINE updateCh #-}+  fromGrays img []     _      = img+  fromGrays img _      []     = img+  fromGrays img (i:is) (c:cs) = fromGrays (zipWith (updateCh c) img i) is cs+  {-# INLINE fromGrays #-} {-# INLINE fromGrayImages #-}  @@ -89,11 +98,20 @@   chApp (PixelGray f) (PixelGray g) = PixelGray (f g)   {-# INLINE chApp #-} -  pxFoldMap f (PixelGray g) = f g `mappend` mempty+  pxFoldMap f (PixelGray g) = f g `M.mappend` M.mempty   {-# INLINE pxFoldMap #-} +  csColour _ = C.opaque C.gray+    instance Show e => Show (Pixel Gray e) where   show (PixelGray g) = "<Gray:("++show g++")>"  +instance Monad (Pixel Gray) where++  return = PixelGray+  {-# INLINE return #-}++  (>>=) (PixelGray g) f = f g+  {-# INLINE (>>=) #-}

@@ -1,5 +1,13 @@ {-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleContexts, FlexibleInstances,              TypeFamilies #-}+-- |+-- Module      : Graphics.Image.ColorSpace.HSI+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.ColorSpace.HSI (   HSI(..), HSIA(..), Pixel(..),    ToHSI(..), ToHSIA(..)@@ -8,34 +16,47 @@ import Prelude hiding (map) import Graphics.Image.Interface import Data.Typeable (Typeable)-import Data.Monoid (mappend)+import qualified Data.Monoid as M (mappend)+import qualified Data.Colour as C+import qualified Data.Colour.Names as C -data HSI = HueHSI-         | SatHSI-         | IntHSI deriving (Eq, Enum, Typeable)+-- | Hue, Saturation and Intensity color space.+data HSI = HueHSI -- ^ Hue+         | SatHSI -- ^ Saturation +         | IntHSI -- ^ Intensity+         deriving (Eq, Enum, Typeable) -data HSIA = HueHSIA-          | SatHSIA-          | IntHSIA-          | AlphaHSIA deriving (Eq, Enum, Typeable)+-- | Hue, Saturation and Intensity color space with Alpha channel.+data HSIA = HueHSIA   -- ^ Hue+          | SatHSIA   -- ^ Saturation+          | IntHSIA   -- ^ Intensity+          | AlphaHSIA -- ^ Alpha+          deriving (Eq, Enum, Typeable)  +-- | Conversion to `HSI` color space. class ColorSpace cs => ToHSI cs where +  -- | Convert to an `HSI` pixel.   toPixelHSI :: Pixel cs Double -> Pixel HSI Double +  -- | Convert to an `HSI` image.   toImageHSI :: (Array arr cs Double, Array arr HSI Double) =>                 Image arr cs Double              -> Image arr HSI Double   toImageHSI = map toPixelHSI   {-# INLINE toImageHSI #-}-+   +-- | Conversion to `HSIA` from another color space with Alpha channel. class (ToHSI (Opaque cs), Alpha cs) => ToHSIA cs where +  -- | Convert to an `HSIA` pixel.   toPixelHSIA :: Pixel cs Double -> Pixel HSIA Double   toPixelHSIA px = addAlpha (getAlpha px) (toPixelHSI (dropAlpha px))+  {-# INLINE toPixelHSIA #-} +  -- | Convert to an `HSIA` image.   toImageHSIA :: (Array arr cs Double, Array arr HSIA Double) =>                  Image arr cs Double               -> Image arr HSIA Double@@ -70,11 +91,15 @@   chApp (PixelHSI fh fs fi) (PixelHSI h s i) = PixelHSI (fh h) (fs s) (fi i)   {-# INLINE chApp #-} -  pxFoldMap f (PixelHSI h s i) = f h `mappend` f s `mappend` f i +  pxFoldMap f (PixelHSI h s i) = f h `M.mappend` f s `M.mappend` f i    {-# INLINE pxFoldMap #-} +  csColour HueHSI = C.opaque C.purple+  csColour SatHSI = C.opaque C.orange+  csColour IntHSI = C.opaque C.darkblue  + instance ColorSpace HSIA where   type PixelElt HSIA e = (e, e, e, e)   data Pixel HSIA e = PixelHSIA !e !e !e !e deriving Eq@@ -104,9 +129,12 @@   chApp (PixelHSIA fh fs fi fa) (PixelHSIA h s i a) = PixelHSIA (fh h) (fs s) (fi i) (fa a)   {-# INLINE chApp #-} -  pxFoldMap f (PixelHSIA h s i a) = f h `mappend` f s `mappend` f i `mappend` f a+  pxFoldMap f (PixelHSIA h s i a) = f h `M.mappend` f s `M.mappend` f i `M.mappend` f a   {-# INLINE pxFoldMap #-} +  csColour AlphaHSIA = C.opaque C.gray+  csColour ch        = csColour $ opaque ch+    instance Alpha HSIA where   type Opaque HSIA = HSI@@ -120,18 +148,23 @@   dropAlpha (PixelHSIA h s i _) = PixelHSI h s i   {-# INLINE dropAlpha #-} +  opaque HueHSIA = HueHSI+  opaque SatHSIA = SatHSI+  opaque IntHSIA = IntHSI+  opaque _       = error "Data.Image.ColorSpace.HSI (Alpha.opaque)" + instance Show HSI where   show HueHSI = "Hue"   show SatHSI = "Saturation"   show IntHSI = "Intensity"+    instance Show HSIA where-  show HueHSIA   = "Hue"-  show SatHSIA   = "Saturation"-  show IntHSIA   = "Intensity"   show AlphaHSIA = "Alpha"- +  show ch        = show $ opaque ch++   instance Show e => Show (Pixel HSI e) where   show (PixelHSI h s i) = "<HSI:("++show h++"|"++show s++"|"++show i++")>" 

@@ -1,5 +1,13 @@ {-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleContexts, FlexibleInstances,              TypeFamilies #-}+-- |+-- Module      : Graphics.Image.ColorSpace.Luma+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.ColorSpace.Luma (   Y(..), YA(..), Pixel(..),    ToY(..), ToYA(..)@@ -8,32 +16,43 @@ import Prelude hiding (map) import Graphics.Image.Interface import Data.Typeable (Typeable)-import Data.Monoid (mappend, mempty)+import qualified Data.Monoid as M (mappend, mempty)+import qualified Data.Colour as C+import qualified Data.Colour.Names as C  -- | Luma or brightness, that is usually denoted as @Y'@. data Y = Y deriving (Eq, Enum, Typeable) + -- | Luma with Alpha channel.-data YA = YA-        | AlphaYA deriving (Eq, Enum, Typeable)+data YA = YA      -- ^ Luma+        | AlphaYA -- ^ Alpha channel+        deriving (Eq, Enum, Typeable)  +-- | Conversion to Luma color space. class ColorSpace cs => ToY cs where +  -- | Convert a pixel to Luma pixel.   toPixelY :: Pixel cs Double -> Pixel Y Double +  -- | Convert an image to Luma image.   toImageY :: (Array arr cs Double, Array arr Y Double) =>               Image arr cs Double            -> Image arr Y Double   toImageY = map toPixelY   {-# INLINE toImageY #-}-   +  +-- | Conversion to Luma from another color space with Alpha channel. class (ToY (Opaque cs), Alpha cs) => ToYA cs where +  -- | Convert a pixel to Luma pixel with Alpha.   toPixelYA :: Pixel cs Double -> Pixel YA Double   toPixelYA px = addAlpha (getAlpha px) (toPixelY (dropAlpha px))+  {-# INLINE toPixelYA #-} +  -- | Convert an image to Luma image with Alpha.   toImageYA :: (Array arr cs Double, Array arr YA Double) =>                Image arr cs Double             -> Image arr YA Double@@ -66,9 +85,11 @@   chApp (PixelY fy) (PixelY y) = PixelY (fy y)   {-# INLINE chApp #-} -  pxFoldMap f (PixelY y) = f y `mappend` mempty+  pxFoldMap f (PixelY y) = f y `M.mappend` M.mempty   {-# INLINE pxFoldMap #-} +  csColour _ = C.opaque C.darkgray+    instance ColorSpace YA where   type PixelElt YA e = (e, e)@@ -96,9 +117,13 @@   chApp (PixelYA fy fa) (PixelYA y a) = PixelYA (fy y) (fa a)   {-# INLINE chApp #-} -  pxFoldMap f (PixelYA y a) = f y `mappend` f a+  pxFoldMap f (PixelYA y a) = f y `M.mappend` f a   {-# INLINE pxFoldMap #-}++  csColour AlphaYA = C.opaque C.gray+  csColour ch      = csColour $ opaque ch   +   instance Alpha YA where   type Opaque YA = Y @@ -111,14 +136,17 @@   dropAlpha (PixelYA g _) = PixelY g   {-# INLINE dropAlpha #-} +  opaque YA = Y+  opaque _  = error "Data.Image.ColorSpace.Luma (Alpha.opaque)" + instance Show Y where   show Y = "Luma"     instance Show YA where-  show YA  = "Luma"   show AlphaYA = "Alpha"+  show ch      = show $ opaque ch     instance Show e => Show (Pixel Y e) where@@ -129,3 +157,10 @@   show (PixelYA g a) = "<LumaA:("++show g++"|"++show a++")>"  +instance Monad (Pixel Y) where++  return = PixelY+  {-# INLINE return #-}++  (>>=) (PixelY y) f = f y+  {-# INLINE (>>=) #-}

@@ -1,5 +1,13 @@ {-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleContexts, FlexibleInstances,              TypeFamilies #-}+-- |+-- Module      : Graphics.Image.ColorSpace.RGB+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.ColorSpace.RGB (   RGB(..), RGBA(..), Pixel(..),    ToRGB(..), ToRGBA(..)@@ -8,23 +16,30 @@ import Prelude hiding (map) import Graphics.Image.Interface import Data.Typeable (Typeable)-import Data.Monoid (mappend)+import qualified Data.Monoid as M (mappend)+import qualified Data.Colour as C+import qualified Data.Colour.Names as C  +-- | Red, Green and Blue color space. data RGB = RedRGB          | GreenRGB          | BlueRGB deriving (Eq, Enum, Typeable) +-- | Red, Green and Blue color space with Alpha channel. data RGBA = RedRGBA           | GreenRGBA           | BlueRGBA           | AlphaRGBA deriving (Eq, Enum, Typeable)  +-- | Conversion to `RGB` color space. class ColorSpace cs => ToRGB cs where +  -- | Convert to an `RGB` pixel.   toPixelRGB :: Pixel cs Double -> Pixel RGB Double +  -- | Convert to an `RGB` image.   toImageRGB :: (Array arr cs Double, Array arr RGB Double) =>                 Image arr cs Double              -> Image arr RGB Double@@ -32,11 +47,15 @@   {-# INLINE toImageRGB #-}  +-- | Conversion to `RGBA` from another color space with Alpha channel. class (ToRGB (Opaque cs), Alpha cs) => ToRGBA cs where +  -- | Convert to an `RGBA` pixel.   toPixelRGBA :: Pixel cs Double -> Pixel RGBA Double   toPixelRGBA px = addAlpha (getAlpha px) (toPixelRGB (dropAlpha px))+  {-# INLINE toPixelRGBA #-} +  -- | Convert to an `RGBA` image.   toImageRGBA :: (Array arr cs Double, Array arr RGBA Double) =>                 Image arr cs Double              -> Image arr RGBA Double@@ -71,9 +90,13 @@   chApp (PixelRGB fr fg fb) (PixelRGB r g b) = PixelRGB (fr r) (fg g) (fb b)   {-# INLINE chApp #-} -  pxFoldMap f (PixelRGB r g b) = f r `mappend` f g `mappend` f b+  pxFoldMap f (PixelRGB r g b) = f r `M.mappend` f g `M.mappend` f b   {-# INLINE pxFoldMap #-} +  csColour RedRGB   = C.opaque C.red+  csColour GreenRGB = C.opaque C.green+  csColour BlueRGB  = C.opaque C.blue+    instance ColorSpace RGBA where   type PixelElt RGBA e = (e, e, e, e)@@ -104,10 +127,13 @@   chApp (PixelRGBA fr fg fb fa) (PixelRGBA r g b a) = PixelRGBA (fr r) (fg g) (fb b) (fa a)   {-# INLINE chApp #-} -  pxFoldMap f (PixelRGBA r g b a) = f r `mappend` f g `mappend` f b `mappend` f a+  pxFoldMap f (PixelRGBA r g b a) = f r `M.mappend` f g `M.mappend` f b `M.mappend` f a   {-# INLINE pxFoldMap #-} +  csColour AlphaRGBA = C.opaque C.gray+  csColour ch        = csColour $ opaque ch + instance Alpha RGBA where   type Opaque RGBA = RGB @@ -120,7 +146,12 @@   dropAlpha (PixelRGBA r g b _) = PixelRGB r g b   {-# INLINE dropAlpha #-} +  opaque RedRGBA   = RedRGB+  opaque GreenRGBA = GreenRGB+  opaque BlueRGBA  = BlueRGB+  opaque AlphaRGBA = error "Data.Image.ColorSpace.RGB (Alpha.opaque)" + instance Show RGB where   show RedRGB   = "Red"   show GreenRGB = "Green"@@ -128,10 +159,8 @@   instance Show RGBA where-  show RedRGBA   = "Red"-  show GreenRGBA = "Green"-  show BlueRGBA  = "Blue"   show AlphaRGBA = "Alpha"+  show ch        = show $ opaque ch    instance Show e => Show (Pixel RGB e) where

@@ -1,5 +1,13 @@ {-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleContexts, FlexibleInstances,              TypeFamilies #-}+-- |+-- Module      : Graphics.Image.ColorSpace.YCbCr+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.ColorSpace.YCbCr (   YCbCr(..), YCbCrA(..), Pixel(..),    ToYCbCr(..), ToYCbCrA(..)@@ -8,23 +16,33 @@ import Prelude hiding (map) import Graphics.Image.Interface import Data.Typeable (Typeable)-import Data.Monoid (mappend)+import qualified Data.Monoid as M (mappend)+import qualified Data.Colour as C+import qualified Data.Colour.Names as C -data YCbCr = LumaYCbCr-           | CBlueYCbCr-           | CRedYCbCr deriving (Eq, Enum, Typeable) +-- | Color space is used to encode RGB information and is used in JPEG compression.+data YCbCr = LumaYCbCr  -- ^ Luma component (commonly denoted as __Y'__)+           | CBlueYCbCr -- ^ Blue difference chroma component+           | CRedYCbCr  -- ^ Red difference chroma component+           deriving (Eq, Enum, Typeable) -data YCbCrA = LumaYCbCrA-            | CBlueYCbCrA-            | CRedYCbCrA-            | AlphaYCbCrA deriving (Eq, Enum, Typeable) +-- | YCbCr color space with Alpha channel.+data YCbCrA = LumaYCbCrA  -- ^ Luma component (commonly denoted as __Y'__)+            | CBlueYCbCrA -- ^ Blue difference chroma component+            | CRedYCbCrA  -- ^ Red difference chroma component+            | AlphaYCbCrA -- ^ Alpha component.+            deriving (Eq, Enum, Typeable) ++-- | Conversion to `YCbCr` color space. class ColorSpace cs => ToYCbCr cs where +  -- | Convert to an `YCbCr` pixel.   toPixelYCbCr :: Pixel cs Double -> Pixel YCbCr Double +  -- | Convert to an `YCbCr` image.   toImageYCbCr :: (Array arr cs Double, Array arr YCbCr Double) =>                   Image arr cs Double                -> Image arr YCbCr Double@@ -32,11 +50,15 @@   {-# INLINE toImageYCbCr #-}  +-- | Conversion to `YCbCrA` from another color space with Alpha channel. class (ToYCbCr (Opaque cs), Alpha cs) => ToYCbCrA cs where +  -- | Convert to an `YCbCrA` pixel.   toPixelYCbCrA :: Pixel cs Double -> Pixel YCbCrA Double   toPixelYCbCrA px = addAlpha (getAlpha px) (toPixelYCbCr (dropAlpha px))+  {-# INLINE toPixelYCbCrA #-} +  -- | Convert to an `YCbCrA` image.   toImageYCbCrA :: (Array arr cs Double, Array arr YCbCrA Double) =>                    Image arr cs Double                 -> Image arr YCbCrA Double@@ -71,9 +93,13 @@   chApp (PixelYCbCr fy fb fr) (PixelYCbCr y b r) = PixelYCbCr (fy y) (fb b) (fr r)   {-# INLINE chApp #-} -  pxFoldMap f (PixelYCbCr y b r) = f y `mappend` f b `mappend` f r+  pxFoldMap f (PixelYCbCr y b r) = f y `M.mappend` f b `M.mappend` f r   {-# INLINE pxFoldMap #-} +  csColour LumaYCbCr  = C.opaque C.darkgray+  csColour CBlueYCbCr = C.opaque C.darkblue+  csColour CRedYCbCr  = C.opaque C.darkred+    instance ColorSpace YCbCrA where   type PixelElt YCbCrA e = (e, e, e, e)@@ -104,10 +130,13 @@   chApp (PixelYCbCrA fy fb fr fa) (PixelYCbCrA y b r a) = PixelYCbCrA (fy y) (fb b) (fr r) (fa a)   {-# INLINE chApp #-} -  pxFoldMap f (PixelYCbCrA y b r a) = f y `mappend` f b `mappend` f r `mappend` f a+  pxFoldMap f (PixelYCbCrA y b r a) = f y `M.mappend` f b `M.mappend` f r `M.mappend` f a   {-# INLINE pxFoldMap #-} +  csColour AlphaYCbCrA = C.opaque C.gray+  csColour ch          = csColour $ opaque ch + instance Alpha YCbCrA where   type Opaque YCbCrA = YCbCr @@ -120,7 +149,12 @@   dropAlpha (PixelYCbCrA y b r _) = PixelYCbCr y b r   {-# INLINE dropAlpha #-} +  opaque LumaYCbCrA  = LumaYCbCr+  opaque CBlueYCbCrA = CBlueYCbCr+  opaque CRedYCbCrA  = CRedYCbCr+  opaque AlphaYCbCrA = error "Data.Image.ColorSpace.YCbCr (Alpha.opaque)" + instance Show YCbCr where   show LumaYCbCr  = "Luma"   show CBlueYCbCr = "Blue Chroma"@@ -128,10 +162,8 @@   instance Show YCbCrA where-  show LumaYCbCrA  = "Luma"-  show CBlueYCbCrA = "Blue Chroma"-  show CRedYCbCrA  = "Red Chroma"   show AlphaYCbCrA = "Alpha"+  show ch          = show $ opaque ch    instance Show e => Show (Pixel YCbCr e) where

@@ -1,5 +1,13 @@ {-# OPTIONS_GHC -fno-warn-unused-imports #-}-{-# LANGUAGE BangPatterns, FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts #-}+-- |+-- Module      : Graphics.Image.IO+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.IO (   -- * Reading   readImage, readImageExact,@@ -7,7 +15,6 @@   writeImage, writeImageExact,   -- * Displaying   displayImage, setDisplayProgram, -  --displayImageHistograms, displayHistograms, writeHistograms,   -- * Supported Image Formats   module Graphics.Image.IO.External   @@ -17,24 +24,21 @@  import Prelude as P hiding (readFile, writeFile) import qualified Control.Monad as M (foldM)-import Control.Concurrent -- (forkIO, ThreadId)+import Control.Concurrent (forkIO, ThreadId) import Data.Char (toLower)+import Data.Maybe (fromMaybe) import Data.IORef import Data.ByteString (readFile)---import Graphics.EasyPlot hiding (TerminalType(..))---import qualified Graphics.EasyPlot as Plot (TerminalType(PNG)) import Graphics.Image.ColorSpace import Graphics.Image.Interface import Graphics.Image.IO.Base import Graphics.Image.IO.External---import HIP.Histogram import qualified Data.ByteString.Lazy as BL (writeFile, hPut) import System.Exit (ExitCode(ExitSuccess)) import System.FilePath (takeExtension) import System.IO (Handle, hFlush) import System.IO.Temp (withSystemTempFile)-import System.IO.Unsafe (unsafePerformIO)-import System.Process (spawnProcess, waitForProcess, showCommandForUser)+import System.Process (waitForProcess, showCommandForUser)   guessFormat :: (ImageFormat f, Enum f) => FilePath -> Maybe f@@ -57,9 +61,9 @@           -> IO (Either String (Image arr cs Double)) readImage path = do   imgstr <- readFile path-  let maybeFormat = (guessFormat path :: Maybe InputFormat)+  let maybeFormat = guessFormat path :: Maybe InputFormat       formats = enumFrom . toEnum $ 0-      orderedFormats = maybe formats (\f -> f:(filter (/=f) formats)) maybeFormat+      orderedFormats = maybe formats (\f -> f:filter (/=f) formats) maybeFormat       reader (Left err) format =          return $ either (Left . ((err++"\n")++)) Right (decode format imgstr)       reader img         _     = return img@@ -72,7 +76,7 @@ -- representation. -- -- >>> readImageExact JPG "images/frog.jpg" :: IO (Either String (Image RP YCbCr Word8))--- Right <Image RepaDelayed YCbCr: 200x320>+-- Right <Image RepaParallel YCbCr (Word8): 200x320> -- -- The drawback here is that colorspace and precision has to match exactly, -- otherwise it will return an error:@@ -107,11 +111,15 @@            -> Image arr cs Double -- ^ An image to write.             -> IO () writeImage path = BL.writeFile path . encode format [] where-  format = maybe (error ("Could not guess output format. Use 'writeImageExact' "+++  format = fromMaybe (error ("Could not guess output format. Use 'writeImageExact' "++                          "or supply a filename with supported format."))-           id (guessFormat path :: Maybe OutputFormat)+           (guessFormat path :: Maybe OutputFormat) -  ++-- | Write an image in a specific format, while supplying any format specific+-- options. Precision and color space that an image will be written is decided+-- from image's type. Attempt to write image file in a format that does not+-- support color space and precision combination will result in a compile error. writeImageExact :: Writable img format =>                    format                    -- ^ A file format that an image should be saved in. See@@ -138,11 +146,6 @@ setDisplayProgram = writeIORef displayProgram   -displayProgram :: IORef (String, Bool)-displayProgram = unsafePerformIO . newIORef $ ("gpicview", False)-{-# NOINLINE displayProgram #-}-- {- | Makes a call to the current display program, which can be changed using 'setDisplayProgram'. An image is written as a @.tiff@ file into an operating system's temporary directory and passed as an argument to the display@@ -168,7 +171,7 @@   let displayAction = withSystemTempFile "tmp-img.tiff" (displayUsing img program)   if block     then displayAction >> return Nothing-    else forkIO displayAction >>= (return . Just)+    else Just <$> forkIO displayAction   displayUsing :: (ManifestArray arr cs e, Writable (Image arr cs e) TIF) =>@@ -255,59 +258,3 @@  -} --{--displayImageHistograms :: (Strategy strat img (Channel px), AImage img px,-                           Enum (Channel px), RealFrac (Channel px)) =>-                          strat img (Channel px)-                       -> Int -                       -> img px-                       -> IO ()-displayImageHistograms strat steps img = displayHistograms $ getHistograms strat steps img----- | Displays a list of 'Histogram's supplied using an external program that can--- be changed with 'setDisplayProgram'.------ >>> centaurus <- readImageRGB "images/centaurus.jpg"--- >>> cluster <- readImageRGB "images/cluster.jpg" --- >>> displayHistograms ((getHistograms 255 centaurus)++(getHistograms 255 cluster))------ <<images/centaurus_cluster_histogram.png>>----displayHistograms :: (Show a, Num a, Fractional a, Enum a) => [Histogram a] -> IO ()-displayHistograms hists = do-  program <- readIORef displayProgram-  withSystemTempDirectory "hip_" (displayHistogramsUsing hists program)---displayHistogramsUsing :: (Show a, Num a, Fractional a, Enum a) =>-                          [Histogram a] -> String -> FilePath -> IO ()-displayHistogramsUsing hists program tmpDir = do-  let path = tmpDir </> "tmp-hist.png"-  wrote <- writeHistograms path hists-  if wrote-    then do ph <- runCommand (program ++ " " ++ path)-            e <- waitForProcess ph-            let printExit ExitSuccess = return ()-                printExit exitCode = print exitCode-            printExit e-    else print "Was unsuccessfull in using gnuplot."----- | Writes histograms into a PNG file image.------ >>> centaurus <- readImageRGB "images/centaurus.jpg"--- >>> cluster <- readImageRGB "images/cluster.jpg"--- >>> let histograms = ((getHistograms 255 centaurus)++(getHistograms 255 cluster)) --- >>> writeHistograms "images/centaurus_cluster_histogram.png" histograms--- True----writeHistograms :: (Show a, Num a, Fractional a, Enum a) =>-                   FilePath -- ^ PNG image file name.-                -> [Histogram a] -- ^ List of histograms to be plotted.-                -> IO Bool -- ^ Returns 'True' in case of success.-writeHistograms path = plot (Plot.PNG path)-  -  --}

@@ -1,36 +1,70 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}+-- |+-- Module      : Graphics.Image.IO.Base+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.IO.Base (-  ImageFormat(..), Readable(..), Writable(..), Convertible(..)+  ImageFormat(..), Readable(..), Writable(..), Convertible(..),+  displayProgram, spawnProcess   ) where  import qualified Data.ByteString as B (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString)+import Data.IORef+import System.IO.Unsafe (unsafePerformIO)+import System.Process (proc, createProcess, ProcessHandle)  +-- | Used during converting pixels between libraries. class Convertible a b where   convert :: a -> b -+-- | Image file format. Helps in guessing image format using a file extension,+-- as well as supplying format specific options during saving an image. class ImageFormat format where+  -- | Options that can be used during writing an image in this format.   data SaveOption format +  -- | Default file extension for this image format.   ext :: format -> String +  -- | Known extensions for this image format.   exts :: format -> [String]   exts f = [ext f] +  -- | Returns `True` if a file extension (ex. @".png"@) corresponds to this format.   isFormat :: String -> format -> Bool-  isFormat e f = e `elem` (exts f)+  isFormat e f = e `elem` exts f  +-- | Image formats that can be read from file. class ImageFormat format => Readable img format where +  -- | Decode an image from `BL.ByteString`.   decode :: format -> B.ByteString -> Either String img  +-- | Image formats that can be written to file. class ImageFormat format => Writable img format where +  -- | Encode an image to `BL.ByteString`.   encode :: format -> [SaveOption format] -> img -> BL.ByteString ++-- | Global variable for setting display program.+displayProgram :: IORef (String, Bool)+displayProgram = unsafePerformIO . newIORef $ ("gpicview", False)+{-# NOINLINE displayProgram #-}+++-- | Implemented here for backwards compatibility with `process < 1.2.0.0`+spawnProcess :: FilePath -> [String] -> IO ProcessHandle+spawnProcess cmd args = do+    (_,_,_,p) <- createProcess (proc cmd args)+    return p  

@@ -1,5 +1,13 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,              TypeFamilies, UndecidableInstances #-}+-- |+-- Module      : Graphics.Image.IO.External+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.IO.External (   module Graphics.Image.IO.External.JuicyPixels,   module Graphics.Image.IO.External.Netpbm,

@@ -1,6 +1,14 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE BangPatterns, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,              TypeFamilies, ViewPatterns #-}+-- |+-- Module      : Graphics.Image.IO.External.JuicyPixels+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.IO.External.JuicyPixels (   BMP(..),   GIF(..), JP.GifDelay, JP.GifLooping(..), JP.PaletteOptions(..), JP.PaletteCreationMethod(..),@@ -9,7 +17,7 @@  import GHC.Float import Data.Either-import Data.Monoid (mempty)+import qualified Data.Monoid as M (mempty) import Graphics.Image.ColorSpace import Graphics.Image.Interface hiding (map) import Graphics.Image.IO.Base@@ -21,7 +29,8 @@ import qualified Codec.Picture.ColorQuant as JP  -data BMP = BMP -- ^ Bitmap image with @.bmp@ extension.+-- | Bitmap image with @.bmp@ extension.+data BMP = BMP  instance ImageFormat BMP where   data SaveOption BMP@@ -29,7 +38,8 @@   ext _ = ".bmp"  -data GIF = GIF -- ^ Graphics Interchange Format image with @.gif@ extension.+-- | Graphics Interchange Format image with @.gif@ extension.+data GIF = GIF  instance ImageFormat GIF where   data SaveOption GIF = GIFPalette JP.PaletteOptions@@ -42,7 +52,8 @@    ext _ = ext GIF -data HDR = HDR -- ^ High-dynamic-range image with @.hdr@ extension.+-- | High-dynamic-range image with @.hdr@ or @.pic@ extension.+data HDR = HDR  instance ImageFormat HDR where   data SaveOption HDR@@ -52,8 +63,8 @@   exts _ = [".hdr", ".pic"]  -data JPG = JPG -- ^ Joint Photographic Experts Group image with @.jpg@ or-               -- @.jpeg@ extension.+-- | Joint Photographic Experts Group image with @.jpg@ or @.jpeg@ extension.+data JPG = JPG  instance ImageFormat JPG where   data SaveOption JPG = JPGQuality Word8@@ -63,7 +74,8 @@   exts _ = [".jpg", ".jpeg"]  -data PNG = PNG -- ^ Portable Network Graphics image with @.png@ extension.+-- | Portable Network Graphics image with @.png@ extension.+data PNG = PNG  instance ImageFormat PNG where   data SaveOption PNG@@ -71,7 +83,8 @@   ext _ = ".png"  -data TGA = TGA -- ^ Truevision Graphics Adapter image with .tga extension.+-- | Truevision Graphics Adapter image with .tga extension.+data TGA = TGA  instance ImageFormat TGA where   data SaveOption TGA@@ -79,8 +92,8 @@   ext _ = ".tga"  -data TIF = TIF -- ^ Tagged Image File Format image with @.tif@ or @.tiff@-               -- extension.+-- | Tagged Image File Format image with @.tif@ or @.tiff@ extension.+data TIF = TIF  instance ImageFormat TIF where   data SaveOption TIF  @@ -613,7 +626,7 @@  jpImageToImage :: (Array arr cs e, Convertible jpx (Pixel cs e), JP.Pixel jpx) =>                   JP.Image jpx -> Image arr cs e-jpImageToImage jimg = make (JP.imageHeight jimg, JP.imageWidth jimg) getPx+jpImageToImage jimg = makeImage (JP.imageHeight jimg, JP.imageWidth jimg) getPx   where getPx (y, x) = convert $ JP.pixelAt jimg x y  @@ -884,9 +897,9 @@ encodeJPG :: (JP.JpgEncodable px, ManifestArray arr cs e) =>              [SaveOption JPG] -> (Pixel cs e -> px) -> Image arr cs e -> BL.ByteString encodeJPG []               conv =-  JP.encodeDirectJpegAtQualityWithMetadata 100 mempty . imageToJPImage conv+  JP.encodeDirectJpegAtQualityWithMetadata 100 M.mempty . imageToJPImage conv encodeJPG (JPGQuality q:_) conv =-  JP.encodeDirectJpegAtQualityWithMetadata q mempty . imageToJPImage conv+  JP.encodeDirectJpegAtQualityWithMetadata q M.mempty . imageToJPImage conv   instance ManifestArray arr Y Word8 => Writable (Image arr Y Word8) JPG where

@@ -1,5 +1,13 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}+-- |+-- Module      : Graphics.Image.IO.External.Netpbm+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.IO.External.Netpbm (   PBM(..), PGM(..), PPM(..)   ) where@@ -14,7 +22,8 @@ import qualified Data.Vector.Storable as VS ((!), Vector)  -data PBM = PBM -- ^ Netpbm: portable bitmap image with .pbm extension.+-- | Netpbm: portable bitmap image with @.pbm@ extension.+data PBM = PBM  instance ImageFormat PBM where   data SaveOption PBM@@ -22,7 +31,8 @@   ext _ = ".pbm"  -data PGM = PGM -- ^ Netpbm: portable graymap image with .pgm extension.+-- | Netpbm: portable graymap image with @.pgm@ extension.+data PGM = PGM  instance ImageFormat PGM where   data SaveOption PGM@@ -30,7 +40,8 @@   ext _ = ".pgm"  -data PPM = PPM -- ^ Netpbm: portable pixmap image with .ppm extension.+-- | Netpbm: portable pixmap image with @.ppm@ extension.+data PPM = PPM  instance ImageFormat PPM where   data SaveOption PPM@@ -222,36 +233,36 @@                    Convertible PNM.PgmPixel16 px, Convertible PNM.PgmPixel8 px,                    Convertible PNM.PpmPixelRGB16 px, Convertible PNM.PpmPixelRGB8 px) =>                   (px -> Pixel cs e) -> Int -> Int -> PNM.PpmPixelData -> Image arr cs e-pnmDataToImage conv w h (PNM.PbmPixelData v)      = make (h, w) (conv . getPx v w)-pnmDataToImage conv w h (PNM.PgmPixelData8 v)     = make (h, w) (conv . getPx v w)-pnmDataToImage conv w h (PNM.PgmPixelData16 v)    = make (h, w) (conv . getPx v w)-pnmDataToImage conv w h (PNM.PpmPixelDataRGB8 v)  = make (h, w) (conv . getPx v w)-pnmDataToImage conv w h (PNM.PpmPixelDataRGB16 v) = make (h, w) (conv . getPx v w)+pnmDataToImage conv w h (PNM.PbmPixelData v)      = makeImage (h, w) (conv . getPx v w)+pnmDataToImage conv w h (PNM.PgmPixelData8 v)     = makeImage (h, w) (conv . getPx v w)+pnmDataToImage conv w h (PNM.PgmPixelData16 v)    = makeImage (h, w) (conv . getPx v w)+pnmDataToImage conv w h (PNM.PpmPixelDataRGB8 v)  = makeImage (h, w) (conv . getPx v w)+pnmDataToImage conv w h (PNM.PpmPixelDataRGB16 v) = makeImage (h, w) (conv . getPx v w)   pnmDataPBMToImage :: (Array arr cs e, Convertible PNM.PbmPixel (Pixel cs e)) =>                      Int -> Int -> PNM.PpmPixelData -> Either String (Image arr cs e)-pnmDataPBMToImage w h (PNM.PbmPixelData v) = Right $ make (h, w) (getPx v w)+pnmDataPBMToImage w h (PNM.PbmPixelData v) = Right $ makeImage (h, w) (getPx v w) pnmDataPBMToImage _ _ d                    = pnmCSError "Binary (Pixel Binary Bit)" d  pnmDataPGM8ToImage :: (Array arr cs e, Convertible PNM.PgmPixel8 (Pixel cs e)) =>                       Int -> Int -> PNM.PpmPixelData -> Either String (Image arr cs e)-pnmDataPGM8ToImage w h (PNM.PgmPixelData8 v) = Right $ make (h, w) (getPx v w)+pnmDataPGM8ToImage w h (PNM.PgmPixelData8 v) = Right $ makeImage (h, w) (getPx v w) pnmDataPGM8ToImage _ _ d                     = pnmCSError "Y8 (Pixel Y Word8)" d  pnmDataPGM16ToImage :: (Array arr cs e, Convertible PNM.PgmPixel16 (Pixel cs e)) =>                        Int -> Int -> PNM.PpmPixelData -> Either String (Image arr cs e)-pnmDataPGM16ToImage w h (PNM.PgmPixelData16 v) = Right $ make (h, w) (getPx v w)+pnmDataPGM16ToImage w h (PNM.PgmPixelData16 v) = Right $ makeImage (h, w) (getPx v w) pnmDataPGM16ToImage _ _ d                      = pnmCSError "Y16 (Pixel Y Word16)" d  pnmDataPPM8ToImage :: (Array arr cs e, Convertible PNM.PpmPixelRGB8 (Pixel cs e)) =>                       Int -> Int -> PNM.PpmPixelData -> Either String (Image arr cs e)-pnmDataPPM8ToImage w h (PNM.PpmPixelDataRGB8 v) = Right $ make (h, w) (getPx v w)+pnmDataPPM8ToImage w h (PNM.PpmPixelDataRGB8 v) = Right $ makeImage (h, w) (getPx v w) pnmDataPPM8ToImage _ _ d                        = pnmCSError "RGB8 (Pixel RGB Word8)" d  pnmDataPPM16ToImage :: (Array arr cs e, Convertible PNM.PpmPixelRGB16 (Pixel cs e)) =>                        Int -> Int -> PNM.PpmPixelData -> Either String (Image arr cs e)-pnmDataPPM16ToImage w h (PNM.PpmPixelDataRGB16 v) = Right $ make (h, w) (getPx v w)+pnmDataPPM16ToImage w h (PNM.PpmPixelDataRGB16 v) = Right $ makeImage (h, w) (getPx v w) pnmDataPPM16ToImage _ _ d                         = pnmCSError "RGB16 (Pixel RGB Word16)" d  

@@ -0,0 +1,119 @@+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, ViewPatterns #-}+-- |+-- Module      : Graphics.Image.IO.Histogram+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+--+module Graphics.Image.IO.Histogram (+  Histogram(..), getHistograms, getHistogram,+  displayHistograms, writeHistograms+  ) where++import Prelude hiding (map, mapM_, zipWith)+import qualified Prelude as P (map, mapM_, zipWith)+import Control.Monad.Primitive (PrimMonad (..))+import Graphics.Image.Interface+import Graphics.Image.ColorSpace+import Graphics.Image.IO.Base (displayProgram, spawnProcess)+import Graphics.Rendering.Chart.Easy+import Graphics.Rendering.Chart.Backend.Cairo+import qualified Data.Colour as C+import qualified Data.Vector.Unboxed as V+import qualified Data.Vector.Unboxed.Mutable as MV+import Data.IORef+import Control.Concurrent (forkIO, ThreadId)+import System.Exit (ExitCode(ExitSuccess))+import System.Process (waitForProcess, showCommandForUser)+import System.IO.Temp (withSystemTempDirectory)+import System.FilePath ((</>))++-- | A single channel histogram of an image.+data Histogram = Histogram { hBins :: V.Vector Int+                             -- ^ Vector containing pixel counts. Index of a+                             -- vector serves as an original pixel value.+                           , hName :: String+                             -- ^ Name of the channel that will be displayed in+                             -- the legend.+                           , hColour :: C.AlphaColour Double+                             -- ^ Color of a plotted line.+                           }+++-- | Create a histogram per channel with 256 bins each.+getHistograms :: forall arr cs e . (SequentialArray arr Gray e,+                                    SequentialArray arr cs e, Elevator e) =>+                 Image arr cs e+              -> [Histogram]+getHistograms = P.zipWith setCh (enumFrom (toEnum 0) :: [cs]) . P.map getHistogram . toGrayImages+  where setCh cs h = h { hName = show cs+                       , hColour = csColour cs }++-- | Generate a histogram with 256 bins for a single channel Gray image.+getHistogram :: (SequentialArray arr Gray e, Elevator e) =>+                Image arr Gray e+             -> Histogram+getHistogram img = Histogram { hBins = V.modify countBins $+                                       V.replicate+                                       (1 + fromIntegral (maxBound :: Word8)) (0 :: Int)+                             , hName = show Gray+                             , hColour = csColour Gray } where+  incBin v (toWord8 -> (PixelGray g)) = modify v (+1) $ fromIntegral g+  countBins v = mapM_ (incBin v) img+  ++-- | Write histograms into a PNG image file.+--+-- >>> frog <- readImageRGB "images/frog.jpg"+-- >>> writeHistograms "images/frog_histogram.png" $ getHistograms frog+--+-- <<images/frog_histogram.png>>+--+writeHistograms :: FilePath -> [Histogram] -> IO ()+writeHistograms fileName hists = toFile def fileName $ do+  layout_title .= "Histogram"+  setColors $ P.map hColour hists+  let axis = set la_nTicks 20 . set la_nLabels 14+  layout_x_axis . laxis_generate .= scaledIntAxis (axis defaultIntAxis) (0, 260)+  P.mapM_ plotHist hists where+    plotHist h = plot (line (hName h) [V.toList $ V.imap (,) $ hBins h])+             ++-- | Display image histograms using an external program. Works the same way as+-- `Graphics.Image.IO.displayImage`.+--+-- >>> frog <- readImageRGB "images/frog.jpg"+-- >>> displayHistograms $ getHistograms frog+--+displayHistograms :: [Histogram] -> IO (Maybe ThreadId)+displayHistograms hists = do+  (program, block) <- readIORef displayProgram+  let displayAction = withSystemTempDirectory "hip" (displayUsing hists program)+  if block+    then displayAction >> return Nothing+    else Just <$> forkIO displayAction+++-- | IO action that writes histogram to file into a system temporary directory+-- and spawns an external program that displays it. File is deleted after+-- program is closed.+displayUsing :: [Histogram] -> String -> FilePath -> IO ()+displayUsing hists program path = do+  let path' = path </> "tmp-hist.png"+  writeHistograms path' hists+  ph <- spawnProcess program [path']+  e <- waitForProcess ph+  let printExit ExitSuccess = return ()+      printExit exitCode = do+        putStrLn $ showCommandForUser program [path']+        print exitCode+  printExit e+++-- | Used for backwards compatibility with vector.+modify :: (PrimMonad m, V.Unbox a) => MV.MVector (PrimState m) a -> (a -> a) -> Int -> m ()+modify v f idx = do+  e <- MV.read v idx+  MV.write v idx $ f e

@@ -1,24 +1,34 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ConstraintKinds, FlexibleContexts, FlexibleInstances,-             MultiParamTypeClasses, ScopedTypeVariables,-             TypeFamilies, UndecidableInstances, ViewPatterns #-}-+{-# LANGUAGE CPP, BangPatterns, ConstraintKinds, FlexibleContexts, FlexibleInstances,+             MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies,+             UndecidableInstances, ViewPatterns #-}+-- |+-- Module      : Graphics.Image.Interface+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.Interface (   ColorSpace(..), Alpha(..), Elevator(..),   Array(..), ManifestArray(..), SequentialArray(..), MutableArray(..),    Exchangable(..),-  defaultIndex, maybeIndex, Border(..), borderIndex+  defaultIndex, maybeIndex, Border(..), borderIndex,+  Applicative(..), (<$>), (<$), (<**>), liftA, liftA2, liftA3,   ) where  import Prelude hiding (and, map, zipWith, sum, product)+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid (Monoid)+import Data.Foldable (Foldable(foldMap))+#endif import GHC.Exts (Constraint) import Data.Typeable (Typeable, showsTypeRep, typeOf)-import Data.Monoid (Monoid) import Control.DeepSeq (NFData(rnf)) import Data.Word-import Data.Foldable (Foldable(foldMap)) import Control.Applicative import Control.Monad.Primitive (PrimMonad (..))+import qualified Data.Colour as C   -- | This class has all included color spaces installed into it and is also@@ -60,10 +70,14 @@    -- | A pixel eqiuvalent of 'foldMap'.   pxFoldMap :: Monoid m => (e -> m) -> Pixel cs e -> m++  -- | Get a pure colour representation of a channel.+  csColour :: cs -> C.AlphaColour Double    +-- | A color space that supports transparency. class (ColorSpace (Opaque cs), ColorSpace cs) => Alpha cs where-  -- | An opaque version of this color space.+  -- | An corresponding opaque version of this color space.   type Opaque cs    -- | Get an alpha channel of a transparant pixel. @@ -81,6 +95,8 @@   --   dropAlpha :: Pixel cs e -> Pixel (Opaque cs) e +  -- | Get a corresponding opaque channel type.+  opaque :: cs -> Opaque cs   -- | A class with a set of convenient functions that allow for changing precision of@@ -106,21 +122,27 @@    fromDouble :: ColorSpace cs => Pixel cs Double -> Pixel cs e -  -class (Show arr, ColorSpace cs, Num (Pixel cs e), Num e, Typeable e, Elt arr cs e) =>++-- | Base array like representation for an image.+class (Show arr, ColorSpace cs, Num (Pixel cs e),+       Functor (Pixel cs), Applicative (Pixel cs), Foldable (Pixel cs),+       Num e, Typeable e, Elt arr cs e) =>       Array arr cs e where-  ++  -- | Required array specific constraints for an array element.   type Elt arr cs e :: Constraint   type Elt arr cs e = ()+  +  -- | Underlying image representation.   data Image arr cs e -  -- | Create an Image by supplying it's dimensions and a pixel genrating+  -- | Create an Image by supplying it's dimensions and a pixel generating   -- function.-  make :: (Int, Int) -- ^ (@m@ rows, @n@ columns) - dimensions of a new image.-            -> ((Int, Int) -> Pixel cs e)-               -- ^ A function that takes (@i@-th row, and @j@-th column) as an-               -- argument and returns a pixel for that location.-            -> Image arr cs e+  makeImage :: (Int, Int) -- ^ (@m@ rows, @n@ columns) - dimensions of a new image.+          -> ((Int, Int) -> Pixel cs e)+          -- ^ A function that takes (@i@-th row, and @j@-th column) as an+          -- argument and returns a pixel for that location.+          -> Image arr cs e    -- | Create a singleton image, required for various operations on images with   -- a scalar.@@ -130,7 +152,7 @@   --   -- >>> frog <- readImageRGB "images/frog.jpg"   -- >>> frog-  -- <Image RepaDelayed RGB: 200x320>+  -- <Image VectorUnboxed RGB (Double): 200x320>   -- >>> dims frog   -- (200,320)   --@@ -201,21 +223,17 @@   -- | Construct an image from a nested rectangular shaped list of pixels.   -- Length of an outer list will constitute @m@ rows, while the length of inner lists -   -- @n@ columns. All of the inner lists must be the same length and greater than @0@.-  ---  -- >>> fromLists [[PixelY (fromIntegral (i*j) / 60000) | j <- [1..300]] | i <- [1..200]] :: Image VU Y Double-  -- <Image VectorUnboxed Luma: 200x300>-  ---  -- <<images/grad_fromLists.png>>-  --   fromLists :: [[Pixel cs e]]             -> Image arr cs e  +-- | Array representation that is actually has real data stored in memory, hence+-- allowing for image indexing, forcing pixels into computed state etc. class Array arr cs e => ManifestArray arr cs e where    -- | Get a pixel at @i@-th and @j@-th location.   ---  -- >>> let grad_gray = computeS $ makeImage (200, 200) (\(i, j) -> PixelY $ fromIntegral (i*j)) / (200*200)+  -- >>> let grad_gray = makeImage (200, 200) (\(i, j) -> PixelY $ fromIntegral (i*j)) / (200*200)   -- >>> index grad_gray (20, 30) == PixelY ((20*30) / (200*200))   -- True   --@@ -240,41 +258,57 @@   eq :: Eq (Pixel cs e) => Image arr cs e -> Image arr cs e -> Bool  +-- | Array representation that allows computation, which depends on some specific+-- order, consequently making it possible to be computed only sequentially. class ManifestArray arr cs e => SequentialArray arr cs e where +  -- | Fold an image from the left in a row major order.   foldl :: (a -> Pixel cs e -> a) -> a -> Image arr cs e -> a +  -- | Fold an image from the right in a row major order.   foldr :: (Pixel cs e -> a -> a) -> a -> Image arr cs e -> a -  mapM :: (Array arr cs' e', Monad m) =>+  -- | Monading mapping over an image.+  mapM :: (SequentialArray arr cs' e', Functor m, Monad m) =>           (Pixel cs' e' -> m (Pixel cs e)) -> Image arr cs' e' -> m (Image arr cs e) -  mapM_ :: (Array arr cs' e', Monad m) =>-           (Pixel cs' e' -> m (Pixel cs e)) -> Image arr cs' e' -> m ()+  -- | Monading mapping over an image. Result is discarded.+  mapM_ :: (Functor m, Monad m) => (Pixel cs e -> m b) -> Image arr cs e -> m () -  foldM :: Monad m => (a -> Pixel cs e -> m a) -> a -> Image arr cs e -> m a+  foldM :: (Functor m, Monad m) => (a -> Pixel cs e -> m a) -> a -> Image arr cs e -> m a -  foldM_ :: Monad m => (a -> Pixel cs e -> m a) -> a -> Image arr cs e -> m ()+  foldM_ :: (Functor m, Monad m) => (a -> Pixel cs e -> m a) -> a -> Image arr cs e -> m ()  +-- | Array representation that supports mutation. class ManifestArray arr cs e => MutableArray arr cs e where   data MImage st arr cs e +  -- | Get dimensions of a mutable image.   mdims :: MImage st arr cs e -> (Int, Int) -  thaw :: PrimMonad m => Image arr cs e -> m (MImage (PrimState m) arr cs e)+  -- | Yield a mutable copy of an image.+  thaw :: (Functor m, PrimMonad m) => Image arr cs e -> m (MImage (PrimState m) arr cs e) -  freeze :: PrimMonad m => MImage (PrimState m) arr cs e -> m (Image arr cs e)+  -- | Yield an immutable copy of an image.+  freeze :: (Functor m, PrimMonad m) => MImage (PrimState m) arr cs e -> m (Image arr cs e) -  new :: PrimMonad m => (Int, Int) -> m (MImage (PrimState m) arr cs e)+  -- | Create a mutable image with given dimensions. Pixels are uninitialized.+  new :: (Functor m, PrimMonad m) => (Int, Int) -> m (MImage (PrimState m) arr cs e) -  read :: PrimMonad m => MImage (PrimState m) arr cs e -> (Int, Int) -> m (Pixel cs e)+  -- | Yield the pixel at a given location.+  read :: (Functor m, PrimMonad m) => MImage (PrimState m) arr cs e -> (Int, Int) -> m (Pixel cs e) -  write :: PrimMonad m => MImage (PrimState m) arr cs e -> (Int, Int) -> Pixel cs e -> m ()+  -- | Set a pixel at a given location.+  write :: (Functor m, PrimMonad m) =>+           MImage (PrimState m) arr cs e -> (Int, Int) -> Pixel cs e -> m () -  swap :: PrimMonad m => MImage (PrimState m) arr cs e -> (Int, Int) -> (Int, Int) -> m ()+  -- | Swap pixels at given locations.+  swap :: (Functor m, PrimMonad m) =>+          MImage (PrimState m) arr cs e -> (Int, Int) -> (Int, Int) -> m ()  +-- | Allows for changing an underlying image representation. class Exchangable arr' arr where    -- | Exchange the underlying array representation of an image.@@ -379,16 +413,21 @@ instance ColorSpace cs => Functor (Pixel cs) where    fmap = pxOp+  {-# INLINE fmap #-}    instance ColorSpace cs => Applicative (Pixel cs) where    pure = fromChannel+  {-# INLINE pure #-}    (<*>) = chApp+  {-# INLINE (<*>) #-} + instance ColorSpace cs => Foldable (Pixel cs) where    foldMap = pxFoldMap+  {-# INLINE foldMap #-}   instance (ColorSpace cs, Num e) => Num (Pixel cs e) where

@@ -1,7 +1,15 @@ {-# LANGUAGE FlexibleContexts #-}+-- |+-- Module      : Graphics.Image.Interface.Repa+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.Interface.Repa (   -- * Construction-  makeImage,+  makeImage, fromLists,   -- * IO   readImageY, readImageYA, readImageRGB, readImageRGBA,   -- * Computation@@ -11,7 +19,8 @@   ) where  import Graphics.Image.IO-import Graphics.Image.Interface+import Graphics.Image.Interface hiding (makeImage, fromLists)+import qualified Graphics.Image.Interface as I (makeImage, fromLists) import Graphics.Image.Interface.Repa.Internal import Graphics.Image.ColorSpace @@ -23,8 +32,16 @@              -- ^ A function that takes (@i@-th row, and @j@-th column) as an argument              -- and returns a pixel for that location.           -> Image RD cs Double-makeImage = make+makeImage = I.makeImage {-# INLINE makeImage #-}+++-- | Construct an image from a nested rectangular shaped list of pixels.+fromLists :: Array RD cs e =>+             [[Pixel cs e]]+          -> Image RD cs e+fromLists = I.fromLists+{-# INLINE fromLists #-}   -- | Read image as luma (brightness).

@@ -1,13 +1,24 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE BangPatterns, ConstraintKinds, GADTs, FlexibleContexts, FlexibleInstances,+{-# OPTIONS -fno-warn-orphans #-}+{-# LANGUAGE CPP, BangPatterns, ConstraintKinds, FlexibleContexts, FlexibleInstances,              MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies,              UndecidableInstances, ViewPatterns #-}-+-- |+-- Module      : Graphics.Image.Interface.Repa.Internal+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.Interface.Repa.Internal (   RD(..), RP(..), RS(..), computeP, computeS, delay   ) where +#if MIN_VERSION_base(4,8,0)+import Prelude hiding (map, zipWith, foldl, foldr, mapM, mapM_, read, traverse)+#else import Prelude hiding (map, zipWith, foldl, foldr, mapM, mapM_, read)+#endif import qualified Prelude as P (map, mapM_) import Graphics.Image.Interface import Graphics.Image.ColorSpace.Binary (Bit(..))@@ -43,14 +54,13 @@   show _ = "RepaSequential"  instance Elt RD cs e => Array RD cs e where-  type Elt RD cs e = (ColorSpace cs, Num e, Typeable e,-                      R.Elt e, Unbox e, +  type Elt RD cs e = (ColorSpace cs, Num e, Typeable e, R.Elt e, Unbox e,                       R.Elt (PixelElt cs e), Unbox (PixelElt cs e),                       R.Elt (Pixel cs e), Unbox (Pixel cs e))-  data Image RD cs e where-    RScalar :: !(Pixel cs e)                  -> Image RD cs e-    RUImage :: !(R.Array U DIM2 (Pixel cs e)) -> Image RD cs e-    RDImage :: !(R.Array D DIM2 (Pixel cs e)) -> Image RD cs e+                     +  data Image RD cs e = RScalar !(Pixel cs e)+                     | RUImage !(R.Array U DIM2 (Pixel cs e))+                     | RDImage !(R.Array D DIM2 (Pixel cs e))    dims (RScalar _                        ) = (1, 1)   dims (RUImage (extent -> (Z :. m :. n))) = (m, n)@@ -60,8 +70,8 @@   singleton = RScalar   {-# INLINE singleton #-} -  make !(m, n) !f = RDImage $ fromFunction (Z :. m :. n) (f . shT2)-  {-# INLINE make #-}+  makeImage !(m, n) !f = RDImage $ fromFunction (Z :. m :. n) (f . shT2)+  {-# INLINE makeImage #-}    map f (RScalar px)        = RScalar (f px)   map f (getDelayed -> arr) = RDImage (R.map f arr)@@ -122,14 +132,13 @@                       R.Elt (PixelElt cs e), Unbox (PixelElt cs e),                       R.Elt (Pixel cs e), Unbox (Pixel cs e))   -  data Image RS cs e where-    RSImage :: !(Image RD cs e) -> Image RS cs e+  data Image RS cs e = RSImage !(Image RD cs e)    dims (RSImage img) = dims img   {-# INLINE dims #-} -  make !ix !f = computeS $ (make ix f :: Image RD cs e)-  {-# INLINE make #-}+  makeImage !ix !f = computeS (makeImage ix f :: Image RD cs e)+  {-# INLINE makeImage #-}    singleton = RSImage . singleton   {-# INLINE singleton #-}@@ -169,14 +178,13 @@                       R.Elt (PixelElt cs e), Unbox (PixelElt cs e),                       R.Elt (Pixel cs e), Unbox (Pixel cs e))   -  data Image RP cs e where-    RPImage :: !(Image RD cs e) -> Image RP cs e+  data Image RP cs e = RPImage !(Image RD cs e)    dims (RPImage img) = dims img   {-# INLINE dims #-} -  make !ix = suspendedComputeP . make ix-  {-# INLINE make #-}+  makeImage !ix = suspendedComputeP . makeImage ix+  {-# INLINE makeImage #-}    singleton = RPImage . singleton   {-# INLINE singleton #-}@@ -287,8 +295,7 @@  instance ManifestArray RS cs e => MutableArray RS cs e where -  data MImage st RS cs e where-    MRSImage :: MImage st VU cs e -> MImage st RS cs e+  data MImage st RS cs e = MRSImage !(MImage st VU cs e)    mdims (MRSImage (mdims -> sz)) = sz   {-# INLINE mdims #-}

@@ -1,7 +1,15 @@ {-# LANGUAGE FlexibleContexts #-}+-- |+-- Module      : Graphics.Image.Interface.Vector+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.Interface.Vector (   -- * Construction-  makeImage, fromUnboxedVector, toUnboxedVector,+  makeImage, fromLists, fromUnboxedVector, toUnboxedVector,   -- * IO   readImageY, readImageYA, readImageRGB, readImageRGBA,   -- * Representation@@ -9,7 +17,8 @@   ) where  import Graphics.Image.IO-import Graphics.Image.Interface+import Graphics.Image.Interface hiding (makeImage, fromLists)+import qualified Graphics.Image.Interface as I (makeImage, fromLists) import Graphics.Image.Interface.Vector.Unboxed import Graphics.Image.ColorSpace @@ -39,11 +48,27 @@              -- ^ A function that takes (@i@-th row, and @j@-th column) as an argument              -- and returns a pixel for that location.           -> Image VU cs Double-makeImage = make+makeImage = I.makeImage {-# INLINE makeImage #-}  --- | Read luma (brightness) of an image.+-- | Construct an image from a nested rectangular shaped list of pixels.+-- Length of an outer list will constitute @m@ rows, while the length of inner lists -+-- @n@ columns. All of the inner lists must be the same length and greater than @0@.+--+-- >>> fromLists [[PixelY (fromIntegral (i*j) / 60000) | j <- [1..300]] | i <- [1..200]]+-- <Image VectorUnboxed Y (Double): 200x300>+--+-- <<images/grad_fromLists.png>>+--+fromLists :: Array VU cs e =>+             [[Pixel cs e]]+          -> Image VU cs e+fromLists = I.fromLists+{-# INLINE fromLists #-}+++-- | Read image as luma (brightness). readImageY :: FilePath -> IO (Image VU Y Double) readImageY = fmap (either error id) . readImage {-# INLINE readImageY #-}

@@ -1,7 +1,14 @@-{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE BangPatterns, ConstraintKinds, FlexibleContexts, FlexibleInstances,-             GADTs, MultiParamTypeClasses, TemplateHaskell, TypeFamilies,-             UndecidableInstances, ViewPatterns #-}+             MultiParamTypeClasses, RankNTypes, TypeFamilies, UndecidableInstances,+             ViewPatterns #-}+-- |+-- Module      : Graphics.Image.Interface.Vector.Unboxed+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.Interface.Vector.Unboxed (   VU(..), Image(..), fromUnboxedVector, toUnboxedVector, fromIx, toIx   ) where@@ -9,15 +16,13 @@ import Prelude hiding (map, zipWith) import qualified Prelude as P (map) import Control.DeepSeq (deepseq)-import Control.Monad (liftM)-import Data.Word (Word8)+import Control.Monad (void) import Data.Typeable (Typeable) import Data.Vector.Unboxed (Vector, Unbox)-import Data.Vector.Unboxed.Deriving import qualified Data.Vector.Unboxed as V import qualified Data.Vector.Unboxed.Mutable as MV import Graphics.Image.Interface-import Graphics.Image.ColorSpace.Binary (Bit(..))+import Graphics.Image.Interface.Vector.Unboxing()   -- | Unboxed 'Vector' representation.@@ -31,12 +36,12 @@ instance Elt VU cs e => Array VU cs e where   type Elt VU cs e = (ColorSpace cs, Num e, Unbox e, Typeable e,                        Unbox (PixelElt cs e), Unbox (Pixel cs e))-  data Image VU cs e where-    VScalar :: !(Pixel cs e)                          -> Image VU cs e-    VUImage :: !Int -> !Int -> !(Vector (Pixel cs e)) -> Image VU cs e+                     +  data Image VU cs e = VScalar !(Pixel cs e)+                     | VUImage !Int !Int !(Vector (Pixel cs e))   -  make !(m, n) !f = VUImage m n $ V.generate (m * n) (f . toIx n)-  {-# INLINE make #-}+  makeImage !(m, n) !f = VUImage m n $ V.generate (m * n) (f . toIx n)+  {-# INLINE makeImage #-}    singleton = VScalar   {-# INLINE singleton #-}@@ -75,14 +80,14 @@     else VUImage m1 n1 (V.izipWith (\ !k !px1 !px2 -> f (toIx n1 k) px1 px2) v1 v2)   {-# INLINE izipWith #-} -  traverse !img !getNewDims !getNewPx = make (getNewDims $ dims img) (getNewPx (index img))+  traverse !img !getNewDims !getNewPx = makeImage (getNewDims $ dims img) (getNewPx (index img))   {-# INLINE traverse #-}    traverse2 !img1 !img2 !getNewDims !getNewPx =-    make (getNewDims (dims img1) (dims img2)) (getNewPx (index img1) (index img2))+    makeImage (getNewDims (dims img1) (dims img2)) (getNewPx (index img1) (index img2))   {-# INLINE traverse2 #-} -  transpose !img@(dims -> (m, n)) = make (n, m) getPx where+  transpose !img@(dims -> (m, n)) = makeImage (n, m) getPx where     getPx !(i, j) = index img (j, i)     {-# INLINE getPx #-}   {-# INLINE transpose #-}@@ -90,7 +95,7 @@   backpermute !(m, n) !f (VUImage _ n' v) =     VUImage m n $ V.backpermute v $ V.generate (m*n) (fromIx n' . f . toIx n)   backpermute !sz      _ (VScalar px)     =-    if sz == (1, 1) then VScalar px else make sz (const px)+    if sz == (1, 1) then VScalar px else makeImage sz (const px)   {-# INLINE backpermute #-}      fromLists !ls = if isSquare@@ -116,12 +121,12 @@   fold !f !px0 (VScalar px)    = f px0 px   {-# INLINE fold #-} -  (|*|) img1@(VUImage m1 n1 v1) !img2@(VUImage {}) =+  (|*|) img1@(VUImage m1 n1 v1) !img2@VUImage {} =     if n1 /= m2      then error ("Inner dimensions of multiplying images must be the same, but received: "++                 show img1 ++" X "++ show img2)     else-      make (m1, n2) getPx where+      makeImage (m1, n2) getPx where         VUImage n2 m2 v2 = transpose img2         getPx !(i, j) = V.sum $ V.zipWith (*) (V.slice (i*n1) n1 v1) (V.slice (j*m2) m2 v2)         {-# INLINE getPx #-}@@ -146,12 +151,12 @@   foldr !f !a (VScalar px)    = f px a   {-# INLINE foldr #-} -  mapM !f (VUImage m n v) = liftM (VUImage m n) (V.mapM f v)-  mapM !f (VScalar px)    = liftM VScalar (f px)+  mapM !f (VUImage m n v) = VUImage m n <$> V.mapM f v+  mapM !f (VScalar px)    = VScalar <$> f px   {-# INLINE mapM #-}    mapM_ !f (VUImage _ _ v) = V.mapM_ f v-  mapM_ !f (VScalar px)    = (f px) >> return ()+  mapM_ !f (VScalar px)    = void $ f px   {-# INLINE mapM_ #-}    foldM !f !a (VUImage _ _ v) = V.foldM' f a v@@ -159,29 +164,28 @@   {-# INLINE foldM #-}    foldM_ !f !a (VUImage _ _ v) = V.foldM'_ f a v-  foldM_ !f !a (VScalar px)    = f a px >> return ()+  foldM_ !f !a (VScalar px)    = void $ f a px   {-# INLINE foldM_ #-}   instance ManifestArray VU cs e => MutableArray VU cs e where -  data MImage st VU cs e where-    MVImage :: !Int -> !Int -> MV.MVector st (Pixel cs e) -> MImage st VU cs e-    MVScalar :: MV.MVector st (Pixel cs e) -> MImage st VU cs e+  data MImage st VU cs e = MVImage !Int !Int (MV.MVector st (Pixel cs e))+                         | MVScalar (MV.MVector st (Pixel cs e))    mdims (MVImage m n _) = (m, n)   mdims (MVScalar _)    = (1, 1)   {-# INLINE mdims #-} -  thaw (VUImage m n v) = liftM (MVImage m n) (V.thaw v)-  thaw (VScalar px)    = liftM MVScalar (V.thaw (V.singleton px))+  thaw (VUImage m n v) = MVImage m n <$> V.thaw v+  thaw (VScalar px)    = MVScalar <$> V.thaw (V.singleton px)   {-# INLINE thaw #-} -  freeze (MVImage m n mv) = liftM (VUImage m n) (V.freeze mv)-  freeze (MVScalar mv)    = liftM (VScalar . (V.! 0)) (V.freeze mv)+  freeze (MVImage m n mv) = VUImage m n <$> V.freeze mv+  freeze (MVScalar mv)    = VScalar . (V.! 0) <$> V.freeze mv   {-# INLINE freeze #-} -  new (m, n) = liftM (MVImage m n) (MV.new (m*n))+  new (m, n) = MVImage m n <$> MV.new (m*n)   {-# INLINE new #-}    read (MVImage _ n mv) ix = MV.read mv (fromIx n ix)@@ -221,24 +225,14 @@   | otherwise = error "fromUnboxedVector: m * n doesn't equal the length of a Vector."  +-- | 2D index conversion to a flat vector index. fromIx :: Int -> (Int, Int) -> Int fromIx !n !(i, j) = i * n + j {-# INLINE fromIx #-}  +-- | Vector to 2D index conversion. toIx :: Int -> Int -> (Int, Int) toIx !n !k = (k `div` n, k `mod` n) {-# INLINE toIx #-}---derivingUnbox "Bit"-    [t| Bit -> Word8 |]-    [| \(Bit w) -> w |]-    [| Bit           |]--  -derivingUnbox "Pixel"-    [t| (ColorSpace cs, Unbox (PixelElt cs e)) => (Pixel cs e) -> (PixelElt cs e) |]-    [| toElt                                                                      |]-    [| fromElt                                                                    |] 

@@ -0,0 +1,123 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeFamilies, UndecidableInstances #-}+-- |+-- Module      : Graphics.Image.Interface.Vector.Unboxing+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+--+module Graphics.Image.Interface.Vector.Unboxing where++import Data.Word+import Graphics.Image.Interface+import Graphics.Image.ColorSpace.Binary (Bit(..))+import qualified Data.Vector.Generic            as V+import qualified Data.Vector.Generic.Mutable    as M+import qualified Data.Vector.Unboxed            as U+import Control.Monad++-- | Unboxing of a `Bit`.+instance U.Unbox Bit++newtype instance U.MVector s Bit = MV_Bit (U.MVector s Word8)++instance M.MVector U.MVector Bit where+  {-# INLINE basicLength #-}+  {-# INLINE basicUnsafeSlice #-}+  {-# INLINE basicOverlaps #-}+  {-# INLINE basicUnsafeNew #-}+  {-# INLINE basicUnsafeReplicate #-}+  {-# INLINE basicUnsafeRead #-}+  {-# INLINE basicUnsafeWrite #-}+  {-# INLINE basicClear #-}+  {-# INLINE basicSet #-}+  {-# INLINE basicUnsafeCopy #-}+  {-# INLINE basicUnsafeMove #-}+  {-# INLINE basicUnsafeGrow #-}+  basicLength (MV_Bit mvec) = M.basicLength mvec+  basicUnsafeSlice idx len (MV_Bit mvec) = MV_Bit (M.basicUnsafeSlice idx len mvec)+  basicOverlaps (MV_Bit mvec) (MV_Bit mvec') = M.basicOverlaps mvec mvec'+  basicUnsafeNew len = MV_Bit `liftM` M.basicUnsafeNew len+  basicUnsafeReplicate len (Bit w) = MV_Bit `liftM` M.basicUnsafeReplicate len w+  basicUnsafeRead (MV_Bit mvec) idx = Bit `liftM` M.basicUnsafeRead mvec idx+  basicUnsafeWrite (MV_Bit mvec) idx (Bit w) = M.basicUnsafeWrite mvec idx w+  basicClear (MV_Bit mvec) = M.basicClear mvec+  basicSet (MV_Bit mvec) (Bit w) =  M.basicSet mvec w+  basicUnsafeCopy (MV_Bit mvec) (MV_Bit mvec') = M.basicUnsafeCopy mvec mvec'+  basicUnsafeMove (MV_Bit mvec) (MV_Bit mvec') = M.basicUnsafeMove mvec mvec'+  basicUnsafeGrow (MV_Bit mvec) len = MV_Bit `liftM` M.basicUnsafeGrow mvec len++    +newtype instance U.Vector Bit = V_Bit (U.Vector Word8)++instance V.Vector U.Vector Bit where+  {-# INLINE basicUnsafeFreeze #-}+  {-# INLINE basicUnsafeThaw #-}+  {-# INLINE basicLength #-}+  {-# INLINE basicUnsafeSlice #-}+  {-# INLINE basicUnsafeIndexM #-}+  {-# INLINE basicUnsafeCopy #-}+  {-# INLINE elemseq #-}+  basicUnsafeFreeze (MV_Bit mvec) = V_Bit `liftM` V.basicUnsafeFreeze mvec+  basicUnsafeThaw (V_Bit vec) = MV_Bit `liftM` V.basicUnsafeThaw vec+  basicLength (V_Bit vec) = V.basicLength vec+  basicUnsafeSlice idx len (V_Bit vec) = V_Bit (V.basicUnsafeSlice idx len vec)+  basicUnsafeIndexM (V_Bit vec) idx = Bit `liftM` V.basicUnsafeIndexM vec idx+  basicUnsafeCopy (MV_Bit mvec) (V_Bit vec) = V.basicUnsafeCopy mvec vec+  elemseq (V_Bit vec) (Bit w) = V.elemseq vec w+++++-- | Unboxing of a `Pixel`.+instance (ColorSpace cs, U.Unbox (PixelElt cs e)) => U.Unbox (Pixel cs e)++newtype instance U.MVector s (Pixel cs e) = MV_Pixel (U.MVector s (PixelElt cs e))+  +instance (ColorSpace cs_aOSR, U.Unbox (PixelElt cs_aOSR e))+         => M.MVector U.MVector (Pixel cs_aOSR e) where+  {-# INLINE basicLength #-}+  {-# INLINE basicUnsafeSlice #-}+  {-# INLINE basicOverlaps #-}+  {-# INLINE basicUnsafeNew #-}+  {-# INLINE basicUnsafeReplicate #-}+  {-# INLINE basicUnsafeRead #-}+  {-# INLINE basicUnsafeWrite #-}+  {-# INLINE basicClear #-}+  {-# INLINE basicSet #-}+  {-# INLINE basicUnsafeCopy #-}+  {-# INLINE basicUnsafeMove #-}+  {-# INLINE basicUnsafeGrow #-}+  basicLength (MV_Pixel mvec) = M.basicLength mvec+  basicUnsafeSlice idx len (MV_Pixel mvec) = MV_Pixel (M.basicUnsafeSlice idx len mvec)+  basicOverlaps (MV_Pixel mvec) (MV_Pixel mvec') = M.basicOverlaps mvec mvec'+  basicUnsafeNew len = MV_Pixel `liftM` M.basicUnsafeNew len+  basicUnsafeReplicate len val = MV_Pixel `liftM` M.basicUnsafeReplicate len (toElt val)+  basicUnsafeRead (MV_Pixel mvec) idx = fromElt `liftM` M.basicUnsafeRead mvec idx+  basicUnsafeWrite (MV_Pixel mvec) idx val = M.basicUnsafeWrite mvec idx (toElt val)+  basicClear (MV_Pixel mvec) = M.basicClear mvec+  basicSet (MV_Pixel mvec) val = M.basicSet mvec (toElt val)+  basicUnsafeCopy (MV_Pixel mvec) (MV_Pixel mvec') = M.basicUnsafeCopy mvec mvec'+  basicUnsafeMove (MV_Pixel mvec) (MV_Pixel mvec') = M.basicUnsafeMove mvec mvec'+  basicUnsafeGrow (MV_Pixel mvec) len = MV_Pixel `liftM` M.basicUnsafeGrow mvec len++    +newtype instance U.Vector (Pixel cs_aOSR e) = V_Pixel (U.Vector (PixelElt cs_aOSR e))+  +instance (ColorSpace cs, U.Unbox (PixelElt cs e)) => V.Vector U.Vector (Pixel cs e) where+  {-# INLINE basicUnsafeFreeze #-}+  {-# INLINE basicUnsafeThaw #-}+  {-# INLINE basicLength #-}+  {-# INLINE basicUnsafeSlice #-}+  {-# INLINE basicUnsafeIndexM #-}+  {-# INLINE basicUnsafeCopy #-}+  {-# INLINE elemseq #-}+  basicUnsafeFreeze (MV_Pixel mvec) = V_Pixel `liftM` V.basicUnsafeFreeze mvec+  basicUnsafeThaw (V_Pixel vec) = MV_Pixel `liftM` V.basicUnsafeThaw vec+  basicLength (V_Pixel vec) = V.basicLength vec+  basicUnsafeSlice idx len (V_Pixel vec) = V_Pixel (V.basicUnsafeSlice idx len vec)+  basicUnsafeIndexM (V_Pixel vec) idx = fromElt `liftM` V.basicUnsafeIndexM vec idx+  basicUnsafeCopy (MV_Pixel mvec) (V_Pixel vec) = V.basicUnsafeCopy mvec vec+  elemseq (V_Pixel vec) val = V.elemseq vec (toElt val)

@@ -1,4 +1,12 @@-{-# LANGUAGE BangPatterns, ViewPatterns #-}+{-# LANGUAGE CPP, BangPatterns, ViewPatterns #-}+-- |+-- Module      : Graphics.Image.Processing+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.Processing (   -- * Geometric   module Graphics.Image.Processing.Geometric,@@ -10,6 +18,9 @@   Border(..), pixelGrid   ) where +#if MIN_VERSION_base(4,8,0)+import Prelude hiding (traverse)+#endif import Data.Word (Word8) import Graphics.Image.Interface import Graphics.Image.Processing.Convolution

@@ -1,5 +1,13 @@ {-# LANGUAGE BangPatterns, FlexibleContexts, FlexibleInstances, FunctionalDependencies,              MultiParamTypeClasses #-}+-- |+-- Module      : Graphics.Image.Processing.Binary+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.Processing.Binary (   -- * Construction   toImageBinaryUsing, toImageBinaryUsing2,

@@ -1,4 +1,12 @@-{-# LANGUAGE BangPatterns, FlexibleContexts, ViewPatterns #-}+{-# LANGUAGE BangPatterns, FlexibleContexts #-}+-- |+-- Module      : Graphics.Image.Processing.Complex+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.Processing.Complex (   -- * Rectangular form   (!+!), realPart', imagPart',@@ -13,7 +21,6 @@   ) where  import Prelude hiding (map, zipWith)---import qualified Data.Complex as C import Graphics.Image.Interface import Graphics.Image.ColorSpace.Complex import Graphics.Image.Processing.Complex.Fourier@@ -21,9 +28,13 @@  infix 6 !+! --- | Constrcut a complex image from two images containing real and imaginary parts.+-- | Constrcut a complex image from two images representing real and imaginary parts. ----- @ PixelRGB 4 8 6 '+:' PixelRGB 7 1 1 __==__ PixelRGB (4 ':+' 7) (8 ':+' 1) (6 ':+' 1) @+-- >>> frog <- readImageRGB "images/frog.jpg"+-- >>> frog !+! 0+-- <Image VectorUnboxed RGB (Complex Double): 200x320>+-- >>> frog !+! frog+-- <Image VectorUnboxed RGB (Complex Double): 200x320> -- (!+!) :: (Array arr cs e, Array arr cs (Complex e)) =>          Image arr cs e -> Image arr cs e -> Image arr cs (Complex e)@@ -90,7 +101,7 @@               -- of @2@, i.e. @m == 2^k@, where @k@ is some integer.            -> ((Int, Int) -> Pixel cs e) -> Image arr cs e makeFilter !(m, n) !getPx -  | isPowerOfTwo m && isPowerOfTwo n = make (m, n) getPx'+  | isPowerOfTwo m && isPowerOfTwo n = makeImage (m, n) getPx'   | otherwise = error " "   where getPx' (i, j) = getPx (if i < (m `div` 2) then i else i - m,                                if j < (n `div` 2) then j else j - n)@@ -103,7 +114,7 @@                Image arr cs e -- ^ Source image.             -> Image arr cs e -- ^ Filter.             -> Image arr cs e-applyFilter img filt = realPart' . ifft $ ((fft (img !+! 0)) * (filt !+! filt))+applyFilter img filt = realPart' . ifft $ (fft (img !+! 0) * (filt !+! filt)) {-# INLINE applyFilter #-}  {-

@@ -1,9 +1,21 @@-{-# LANGUAGE BangPatterns, ConstraintKinds, FlexibleContexts #-}+{-# LANGUAGE CPP, BangPatterns, ConstraintKinds, FlexibleContexts #-}+-- |+-- Module      : Graphics.Image.Processing.Complex.Fourier+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.Processing.Complex.Fourier (   fft, ifft, isPowerOfTwo   ) where +#if MIN_VERSION_base(4,8,0)+import Prelude hiding (map, traverse)+#else import Prelude hiding (map)+#endif import Data.Bits ((.&.)) import Graphics.Image.Interface import Graphics.Image.ColorSpace.Complex@@ -68,7 +80,7 @@ fftGeneral !sign !img = transpose $ go n 0 1 where   !(m, n) = dims img   go !len !offset !stride-    | len == 2 = make (m, 2) swivel+    | len == 2 = makeImage (m, 2) swivel     | otherwise = combine len                    (go (len `div` 2) offset            (stride * 2))                   (go (len `div` 2) (offset + stride) (stride * 2))@@ -86,9 +98,10 @@ -- Compute a twiddle factor. twiddle :: (ColorSpace cs, Floating e) =>            Pixel cs e-	-> Int 			-- index-	-> Int 			-- length-	-> Pixel cs (Complex e)+        -> Int                  -- index+        -> Int                  -- length+        -> Pixel cs (Complex e) twiddle sign k n = cos alpha +: sign * sin alpha where   !alpha = 2 * pi * fromIntegral k / fromIntegral n {-# INLINE twiddle #-}+

@@ -1,7 +1,14 @@ {-# LANGUAGE BangPatterns #-}+-- |+-- Module      : Graphics.Image.Processing.Convolution+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.Processing.Convolution (   convolve, convolveRows, convolveCols,-  --convolve', convolveRows', convolveCols',   ) where  import Prelude hiding (map)@@ -44,30 +51,6 @@ convolve !out = convolve'' out . rotate180 {-# INLINE convolve #-} -{---- | Strict version of convolution that operates on manifest array representations.-convolve'  :: ManifestArray arr cs e =>-             Border (Pixel cs e)   -- ^ Approach to be used near the borders.-          -> Image arr cs e -- ^ Kernel image.-          -> Image arr cs e -- ^ Source image.-          -> Image arr cs e-convolve' !out = convolve'' out . rotate180-{-# INLINE convolve' #-}--}-{---- | Convolve image's rows with a vector kernel represented by a list of pixels.-convolveRows :: Array arr cs e =>-                Border (Pixel cs e) -> [Pixel cs e] -> Image arr cs e -> Image arr cs e-convolveRows !out = convolve out . fromLists . (:[]) . reverse-{-# INLINE convolveRows #-}----- | Convolve image's columns with a vector kernel represented by a list of pixels.-convolveCols :: Array arr cs e =>-                Border (Pixel cs e) -> [Pixel cs e] -> Image arr cs e -> Image arr cs e-convolveCols !out = convolve out . fromLists . P.map (:[]) . reverse-{-# INLINE convolveCols #-}--}  -- | Convolve image's rows with a vector kernel represented by a list of pixels. convolveRows :: ManifestArray arr cs e =>

@@ -1,4 +1,12 @@-{-# LANGUAGE BangPatterns, ViewPatterns #-}+{-# LANGUAGE CPP, BangPatterns, ViewPatterns #-}+-- |+-- Module      : Graphics.Image.Processing.Geometric+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.Processing.Geometric (   -- ** Sampling   downsampleRows, downsampleCols, downsample, @@ -14,6 +22,10 @@   -- ** Scaling   resize, scale                                             ) where++#if MIN_VERSION_base(4,8,0)+import Prelude hiding (traverse)+#endif  import Graphics.Image.Interface import Graphics.Image.Processing.Interpolation

@@ -1,38 +1,52 @@ {-# LANGUAGE BangPatterns, ViewPatterns #-}+-- |+-- Module      : Graphics.Image.Processing.Interpolation+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+-- module Graphics.Image.Processing.Interpolation (   Interpolation(..), Nearest(..), Bilinear(..)   ) where  import Graphics.Image.Interface -+-- | Implementation for an interpolation method. class Interpolation method where++  -- | Construct a new pixel by using information from neighboring pixels.   interpolate :: (Elevator e, Num e, ColorSpace cs) =>                  method (Pixel cs e) -- ^ Interpolation method               -> (Int, Int)          -- ^ Image dimensions @m@ rows and @n@ columns.               -> ((Int, Int) -> Pixel cs e)                  -- ^ Lookup function that returns a pixel at @i@th and @j@th                  -- location.-              -> (Double, Double) -- ^ real values of @i@ and @j@ index+              -> (Double, Double) -- ^ Real values of @i@ and @j@ index               -> Pixel cs e   -- | Nearest Neighbor interpolation method.-data Nearest px = Nearest+data Nearest px = Nearest !(Border px)   -- | Bilinear interpolation method.-data Bilinear px = Bilinear (Border px)+data Bilinear px = Bilinear !(Border px)   instance Interpolation Nearest where-  interpolate _ !(m, n) !getPx !(round -> i, round -> j) =-    if i >= 0 && j >= 0 && i < m && j < n then getPx (i, j) else 0 +  interpolate (Nearest border) !sz !getPx !(round -> i, round -> j) =+    borderIndex border sz getPx (i, j)+  {-# INLINE interpolate #-} + instance Interpolation Bilinear where+   interpolate (Bilinear border) !sz !getPx !(i, j) = fi0 + jPx*(fi1-fi0) where     getPx' = borderIndex border sz getPx+    {-# INLINE getPx' #-}     !(i0, j0) = (floor i, floor j)     !(i1, j1) = (i0 + 1, j0 + 1)     !iPx = fromDouble $ fromChannel (i - fromIntegral i0)

@@ -0,0 +1,20 @@+-- |+-- Module      : Graphics.Image.Types+-- Copyright   : (c) Alexey Kuleshevich 2016+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+--+module Graphics.Image.Types (+  module Graphics.Image.ColorSpace,+  Array, Image, ManifestArray, SequentialArray, MutableArray, MImage,+  Exchangable, Border(..),+  VU(..), RD(..), RS(..), RP(..), +  ) where+++import Graphics.Image.ColorSpace+import Graphics.Image.Interface+import Graphics.Image.Interface.Vector (VU(..))+import Graphics.Image.Interface.Repa (RD(..), RS(..), RP(..))