diff --git a/friday.cabal b/friday.cabal --- a/friday.cabal +++ b/friday.cabal @@ -2,7 +2,7 @@ -- +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.2.0.2 +version: 0.2.1.0 synopsis: A functional image processing library for Haskell. homepage: https://github.com/RaphaelJ/friday license: LGPL-3 @@ -47,24 +47,21 @@ Vision.Histogram Vision.Image Vision.Image.Class + Vision.Image.Conversion Vision.Image.Grey - Vision.Image.Grey.Conversion Vision.Image.Grey.Specialize Vision.Image.Grey.Type Vision.Image.Filter Vision.Image.Filter.Internal Vision.Image.HSV - Vision.Image.HSV.Conversion Vision.Image.HSV.Specialize Vision.Image.HSV.Type Vision.Image.Interpolate Vision.Image.Mutable Vision.Image.RGBA - Vision.Image.RGBA.Conversion Vision.Image.RGBA.Specialize Vision.Image.RGBA.Type Vision.Image.RGB - Vision.Image.RGB.Conversion Vision.Image.RGB.Specialize Vision.Image.RGB.Type Vision.Image.Threshold diff --git a/src/Vision/Image.hs b/src/Vision/Image.hs --- a/src/Vision/Image.hs +++ b/src/Vision/Image.hs @@ -14,6 +14,7 @@ -- detailed usage and examples. module Vision.Image ( module Vision.Image.Class + , module Vision.Image.Conversion , module Vision.Image.Grey , module Vision.Image.Filter , module Vision.Image.HSV @@ -27,6 +28,7 @@ ) where import Vision.Image.Class +import Vision.Image.Conversion import Vision.Image.Grey import Vision.Image.Filter import Vision.Image.HSV diff --git a/src/Vision/Image/Class.hs b/src/Vision/Image/Class.hs --- a/src/Vision/Image/Class.hs +++ b/src/Vision/Image/Class.hs @@ -7,11 +7,8 @@ , FunctorImage (..) -- * Functions , (!), (!?), nChannels, pixel - -- * Conversion - , Convertible (..), convert ) where -import Data.Convertible (Convertible (..), convert) import Data.Int import Data.Vector.Storable (Vector, generate, unfoldr) import Data.Word diff --git a/src/Vision/Image/Conversion.hs b/src/Vision/Image/Conversion.hs new file mode 100644 --- /dev/null +++ b/src/Vision/Image/Conversion.hs @@ -0,0 +1,170 @@ +{-# LANGUAGE BangPatterns + , MultiParamTypeClasses #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- 'Convertible' instances for conversions between pixel types. +module Vision.Image.Conversion (Convertible (..), convert) where + +import Data.Convertible (Convertible (..), ConvertResult, convert) +import Data.Word + +import qualified Data.Vector.Storable as VS + +import Vision.Image.Grey.Type (GreyPixel (..)) +import Vision.Image.HSV.Type (HSVPixel (..)) +import Vision.Image.RGBA.Type (RGBAPixel (..)) +import Vision.Image.RGB.Type (RGBPixel (..)) + +-- to Grey --------------------------------------------------------------------- + +instance Convertible GreyPixel GreyPixel where + safeConvert = Right + {-# INLINE safeConvert #-} + +instance Convertible HSVPixel GreyPixel where + safeConvert pix = (safeConvert pix :: ConvertResult RGBPixel) + >>= safeConvert + +instance Convertible RGBAPixel GreyPixel where + safeConvert !(RGBAPixel r g b a) = + Right $ GreyPixel $ word8 $ int (rgbToGrey r g b) * int a `quot` 255 + {-# INLINE safeConvert #-} + +instance Convertible RGBPixel GreyPixel where + safeConvert !(RGBPixel r g b) = + Right $ GreyPixel $ rgbToGrey r g b + {-# INLINE safeConvert #-} + +-- | Converts the colors to greyscale using the human eye colors perception. +rgbToGrey :: Word8 -> Word8 -> Word8 -> Word8 +rgbToGrey !r !g !b = (redLookupTable VS.! int r) + + (greenLookupTable VS.! int g) + + (blueLookupTable VS.! int b) +{-# INLINE rgbToGrey #-} + +redLookupTable, greenLookupTable, blueLookupTable :: VS.Vector Word8 +redLookupTable = VS.generate 256 (\val -> round $ double val * 0.299) +greenLookupTable = VS.generate 256 (\val -> round $ double val * 0.587) +blueLookupTable = VS.generate 256 (\val -> round $ double val * 0.114) + +-- to HSV ---------------------------------------------------------------------- + +instance Convertible HSVPixel HSVPixel where + safeConvert = Right + {-# INLINE safeConvert #-} + +instance Convertible GreyPixel HSVPixel where + safeConvert pix = (safeConvert pix :: ConvertResult RGBPixel) + >>= safeConvert + +instance Convertible RGBPixel HSVPixel where +-- Based on : +-- http://en.wikipedia.org/wiki/HSL_and_HSV#General_approach + safeConvert !(RGBPixel r g b) = + Right pix + where + (!r', !g', !b') = (int r, int g, int b) + + !pix | r >= g && r >= b = -- r == max r g b + let !c = r' - min b' g' + !h = fixHue $ hue c b' g' -- Hue can be negative + in HSVPixel (word8 h) (sat c r') r + | g >= r && g >= b = -- g == max r g b + let !c = g' - min r' b' + !h = 60 + hue c r' b' + in HSVPixel (word8 h) (sat c g') g + | otherwise = -- b == max r g b + let !c = b' - min r' g' + !h = 120 + hue c g' r' + in HSVPixel (word8 h) (sat c b') b + + -- Returns a value in [-30; +30]. + hue 0 _ _ = 0 + hue !c !left !right = (30 * (right - left)) `quot` c + + sat _ 0 = 0 + sat !c v = word8 $ (c * 255) `quot` v + + -- Keeps the value of the hue between [0, 179]. + -- As the Hue's unit is 2°, 180 is equal to 360° and to 0°. + fixHue !h | h < 0 = h + 180 + | otherwise = h + +instance Convertible RGBAPixel HSVPixel where + safeConvert pix = (safeConvert pix :: ConvertResult RGBPixel) + >>= safeConvert + +-- to RGB ---------------------------------------------------------------------- + +instance Convertible RGBPixel RGBPixel where + safeConvert = Right + {-# INLINE safeConvert #-} + +instance Convertible GreyPixel RGBPixel where + safeConvert !(GreyPixel pix) = Right $ RGBPixel pix pix pix + {-# INLINE safeConvert #-} + +instance Convertible RGBAPixel RGBPixel where + safeConvert !(RGBAPixel r g b a) = + Right $ RGBPixel (withAlpha r) (withAlpha g) (withAlpha b) + where + !a' = int a + withAlpha !val = word8 $ int val * a' `quot` 255 + {-# INLINE withAlpha #-} + {-# INLINE safeConvert #-} + +instance Convertible HSVPixel RGBPixel where +-- Based on : +-- http://en.wikipedia.org/wiki/HSL_and_HSV#Converting_to_RGB + safeConvert !(HSVPixel h s v) = + Right $! case h `quot` 30 of + 0 -> RGBPixel v (word8 x1') (word8 m) + 1 -> RGBPixel (word8 (x2 60)) v (word8 m) + 2 -> RGBPixel (word8 m) v (word8 (x1 60)) + 3 -> RGBPixel (word8 m) (word8 (x2 120)) v + 4 -> RGBPixel (word8 (x1 120)) (word8 m) v + 5 -> RGBPixel v (word8 m) (word8 (x2 180)) + _ -> error "Invalid hue value." + where + (!h', v') = (int h, int v) + + -- v is the major color component whereas m is the minor one. + !m = (v' * (255 - int s)) `quot` 255 + + -- Computes the remaining component by resolving the hue equation, + -- knowing v and m. x1 is when the component is on the right of the + -- major one, x2 when on the left. + x1 d = (d * m - d * v' + h' * v' - h' * m + 30 * m) `quot` 30 + x1' = ( h' * v' - h' * m + 30 * m) `quot` 30 -- == x1 0 + + x2 d = (d * v' - d * m + h' * m - h' * v' + 30 * m) `quot` 30 + {-# INLINE safeConvert #-} + +-- to RGBA --------------------------------------------------------------------- + +instance Convertible RGBAPixel RGBAPixel where + safeConvert = Right + {-# INLINE safeConvert #-} + +instance Convertible GreyPixel RGBAPixel where + safeConvert !(GreyPixel pix) = Right $ RGBAPixel pix pix pix 255 + {-# INLINE safeConvert #-} + +instance Convertible HSVPixel RGBAPixel where + safeConvert pix = (safeConvert pix :: ConvertResult RGBPixel) + >>= safeConvert + +instance Convertible RGBPixel RGBAPixel where + safeConvert !(RGBPixel r g b) = Right $ RGBAPixel r g b 255 + {-# INLINE safeConvert #-} + +-- ----------------------------------------------------------------------------- + +double :: Integral a => a -> Double +double = fromIntegral + +int :: Integral a => a -> Int +int = fromIntegral + +word8 :: Integral a => a -> Word8 +word8 = fromIntegral diff --git a/src/Vision/Image/Grey.hs b/src/Vision/Image/Grey.hs --- a/src/Vision/Image/Grey.hs +++ b/src/Vision/Image/Grey.hs @@ -2,6 +2,5 @@ module Vision.Image.Grey.Type ) where -import Vision.Image.Grey.Conversion () import Vision.Image.Grey.Specialize () import Vision.Image.Grey.Type diff --git a/src/Vision/Image/Grey/Conversion.hs b/src/Vision/Image/Grey/Conversion.hs deleted file mode 100644 --- a/src/Vision/Image/Grey/Conversion.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# LANGUAGE BangPatterns - , MultiParamTypeClasses #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Vision.Image.Grey.Conversion () where - -import Data.Convertible (Convertible (..)) -import qualified Data.Vector.Storable as V -import Data.Word - -import Vision.Image.Grey.Type (GreyPixel (..)) -import Vision.Image.RGBA.Type (RGBAPixel (..)) -import Vision.Image.RGB.Type (RGBPixel (..)) - -instance Convertible GreyPixel GreyPixel where - safeConvert = Right - {-# INLINE safeConvert #-} - -instance Convertible RGBAPixel GreyPixel where - safeConvert !(RGBAPixel r g b a) = - Right $ GreyPixel $ word8 $ int (rgbToGrey r g b) * int a `quot` 255 - {-# INLINE safeConvert #-} - -instance Convertible RGBPixel GreyPixel where - safeConvert !(RGBPixel r g b) = - Right $ GreyPixel $ rgbToGrey r g b - {-# INLINE safeConvert #-} - --- | Converts the colors to greyscale using the human eye colors perception. -rgbToGrey :: Word8 -> Word8 -> Word8 -> Word8 -rgbToGrey !r !g !b = (redLookupTable V.! int r) - + (greenLookupTable V.! int g) - + (blueLookupTable V.! int b) -{-# INLINE rgbToGrey #-} - -redLookupTable, greenLookupTable, blueLookupTable :: V.Vector Word8 -redLookupTable = V.generate 256 (\val -> round $ double val * 0.299) -greenLookupTable = V.generate 256 (\val -> round $ double val * 0.587) -blueLookupTable = V.generate 256 (\val -> round $ double val * 0.114) - -double :: Integral a => a -> Double -double = fromIntegral - -int :: Integral a => a -> Int -int = fromIntegral - -word8 :: Integral a => a -> Word8 -word8 = fromIntegral diff --git a/src/Vision/Image/HSV.hs b/src/Vision/Image/HSV.hs --- a/src/Vision/Image/HSV.hs +++ b/src/Vision/Image/HSV.hs @@ -2,6 +2,5 @@ module Vision.Image.HSV.Type ) where -import Vision.Image.HSV.Conversion () import Vision.Image.HSV.Specialize () import Vision.Image.HSV.Type diff --git a/src/Vision/Image/HSV/Conversion.hs b/src/Vision/Image/HSV/Conversion.hs deleted file mode 100644 --- a/src/Vision/Image/HSV/Conversion.hs +++ /dev/null @@ -1,93 +0,0 @@ -{-# LANGUAGE BangPatterns - , MultiParamTypeClasses - , PatternGuards #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Vision.Image.HSV.Conversion () where - -import Data.Convertible (Convertible (..), ConvertResult) -import Data.Word - -import Vision.Image.HSV.Type (HSVPixel (..)) -import Vision.Image.RGB.Type (RGBPixel (..)) -import Vision.Image.RGB.Conversion () -import Vision.Image.RGBA.Type (RGBAPixel (..)) -import Vision.Image.RGBA.Conversion () - -instance Convertible HSVPixel HSVPixel where - safeConvert = Right - {-# INLINE safeConvert #-} - -instance Convertible RGBPixel HSVPixel where --- Based on : --- http://en.wikipedia.org/wiki/HSL_and_HSV#General_approach - safeConvert !(RGBPixel r g b) = - Right pix - where - (!r', !g', !b') = (int r, int g, int b) - - !pix | r >= g && r >= b = -- r == max r g b - let !c = r' - min b' g' - !h = fixHue $ hue c b' g' -- Hue can be negative - in HSVPixel (word8 h) (sat c r') r - | g >= r && g >= b = -- g == max r g b - let !c = g' - min r' b' - !h = 60 + hue c r' b' - in HSVPixel (word8 h) (sat c g') g - | otherwise = -- b == max r g b - let !c = b' - min r' g' - !h = 120 + hue c g' r' - in HSVPixel (word8 h) (sat c b') b - - -- Returns a value in [-30; +30]. - hue 0 _ _ = 0 - hue !c !left !right = (30 * (right - left)) `quot` c - - sat _ 0 = 0 - sat !c v = word8 $ (c * 255) `quot` v - - -- Keeps the value of the hue between [0, 179]. - -- As the Hue's unit is 2°, 180 is equal to 360° and to 0. - fixHue !h | h < 0 = h + 180 - | otherwise = h - -instance Convertible HSVPixel RGBPixel where --- Based on : --- http://en.wikipedia.org/wiki/HSL_and_HSV#Converting_to_RGB - safeConvert !(HSVPixel h s v) = - Right $! case h `quot` 30 of - 0 -> RGBPixel v (word8 x1') (word8 m) - 1 -> RGBPixel (word8 (x2 60)) v (word8 m) - 2 -> RGBPixel (word8 m) v (word8 (x1 60)) - 3 -> RGBPixel (word8 m) (word8 (x2 120)) v - 4 -> RGBPixel (word8 (x1 120)) (word8 m) v - 5 -> RGBPixel v (word8 m) (word8 (x2 180)) - _ -> error "Invalid hue value." - where - (!h', v') = (int h, int v) - - -- v is the major color component whereas m is the minor one. - !m = (v' * (255 - int s)) `quot` 255 - - -- Computes the remaining component by resolving the hue equation, - -- knowing v and m. x1 is when the component is on the right of the - -- major one, x2 when on the left. - x1 d = (d * m - d * v' + h' * v' - h' * m + 30 * m) `quot` 30 - x1' = ( h' * v' - h' * m + 30 * m) `quot` 30 -- == x1 0 - - x2 d = (d * v' - d * m + h' * m - h' * v' + 30 * m) `quot` 30 - {-# INLINE safeConvert #-} - -instance Convertible RGBAPixel HSVPixel where - safeConvert pix = (safeConvert pix :: ConvertResult RGBPixel) - >>= safeConvert - -instance Convertible HSVPixel RGBAPixel where - safeConvert pix = (safeConvert pix :: ConvertResult RGBPixel) - >>= safeConvert - -int :: Integral a => a -> Int -int = fromIntegral - -word8 :: Integral a => a -> Word8 -word8 = fromIntegral diff --git a/src/Vision/Image/RGB.hs b/src/Vision/Image/RGB.hs --- a/src/Vision/Image/RGB.hs +++ b/src/Vision/Image/RGB.hs @@ -2,6 +2,5 @@ module Vision.Image.RGB.Type ) where -import Vision.Image.RGB.Conversion () import Vision.Image.RGB.Specialize () import Vision.Image.RGB.Type diff --git a/src/Vision/Image/RGB/Conversion.hs b/src/Vision/Image/RGB/Conversion.hs deleted file mode 100644 --- a/src/Vision/Image/RGB/Conversion.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE BangPatterns - , MultiParamTypeClasses #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Vision.Image.RGB.Conversion () where - -import Data.Convertible (Convertible (..)) -import Data.Word - -import Vision.Image.Grey.Type (GreyPixel (..)) -import Vision.Image.RGBA.Type (RGBAPixel (..)) -import Vision.Image.RGB.Type (RGBPixel (..)) - -instance Convertible RGBPixel RGBPixel where - safeConvert = Right - {-# INLINE safeConvert #-} - -instance Convertible GreyPixel RGBPixel where - safeConvert !(GreyPixel pix) = Right $ RGBPixel pix pix pix - {-# INLINE safeConvert #-} - -instance Convertible RGBAPixel RGBPixel where - safeConvert !(RGBAPixel r g b a) = - Right $ RGBPixel (withAlpha r) (withAlpha g) (withAlpha b) - where - !a' = int a - withAlpha !val = word8 $ int val * a' `quot` 255 - {-# INLINE withAlpha #-} - {-# INLINE safeConvert #-} - -int :: Integral a => a -> Int -int = fromIntegral - -word8 :: Integral a => a -> Word8 -word8 = fromIntegral diff --git a/src/Vision/Image/RGBA.hs b/src/Vision/Image/RGBA.hs --- a/src/Vision/Image/RGBA.hs +++ b/src/Vision/Image/RGBA.hs @@ -2,6 +2,5 @@ module Vision.Image.RGBA.Type ) where -import Vision.Image.RGBA.Conversion () import Vision.Image.RGBA.Specialize () import Vision.Image.RGBA.Type diff --git a/src/Vision/Image/RGBA/Conversion.hs b/src/Vision/Image/RGBA/Conversion.hs deleted file mode 100644 --- a/src/Vision/Image/RGBA/Conversion.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE BangPatterns - , MultiParamTypeClasses #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Vision.Image.RGBA.Conversion () where - -import Data.Convertible (Convertible (..)) - -import Vision.Image.Grey.Type (GreyPixel (..)) -import Vision.Image.RGBA.Type (RGBAPixel (..)) -import Vision.Image.RGB.Type (RGBPixel (..)) - -instance Convertible RGBAPixel RGBAPixel where - safeConvert = Right - {-# INLINE safeConvert #-} - -instance Convertible GreyPixel RGBAPixel where - safeConvert !(GreyPixel pix) = Right $ RGBAPixel pix pix pix 255 - {-# INLINE safeConvert #-} - -instance Convertible RGBPixel RGBAPixel where - safeConvert !(RGBPixel r g b) = Right $ RGBAPixel r g b 255 - {-# INLINE safeConvert #-} diff --git a/src/Vision/Image/Type.hs b/src/Vision/Image/Type.hs --- a/src/Vision/Image/Type.hs +++ b/src/Vision/Image/Type.hs @@ -20,6 +20,7 @@ import Control.Applicative ((<$>)) import Control.DeepSeq (NFData (..)) +import Data.Convertible (Convertible (..), convert) import Data.Vector.Storable (Vector, create, enumFromN, forM_, generate) import Data.Vector.Storable.Mutable (new, write) import Foreign.Storable (Storable) @@ -28,8 +29,7 @@ import qualified Data.Vector.Storable as V import Vision.Image.Class ( - MaskedImage (..), Image (..), FromFunction (..), FunctorImage (..) - , Convertible (..), (!), convert + MaskedImage (..), Image (..), FromFunction (..), FunctorImage (..), (!) ) import Vision.Primitive (Z (..), (:.) (..), Point, Size, ix2)