diff --git a/hip.cabal b/hip.cabal --- a/hip.cabal +++ b/hip.cabal @@ -1,5 +1,5 @@ Name: hip -Version: 1.0.1 +Version: 1.0.1.1 License: BSD3 License-File: LICENSE Author: Alexey Kuleshevich diff --git a/images/frog_rotate330.png b/images/frog_rotate330.png new file mode 100644 Binary files /dev/null and b/images/frog_rotate330.png differ diff --git a/src/Graphics/Image.hs b/src/Graphics/Image.hs --- a/src/Graphics/Image.hs +++ b/src/Graphics/Image.hs @@ -10,11 +10,11 @@ -- -- 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 +-- the functionality in this library relies upon a few type classes, which -- corresponding representation types are instances of: -- --- * @__`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 +-- * @__`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. -- @@ -116,7 +116,7 @@ import Graphics.Image.Processing import Graphics.Image.Processing.Complex ---import Graphics.Image.Processing.Binary +import Graphics.Image.Processing.Geometric import Graphics.Image.IO.Histogram diff --git a/src/Graphics/Image/IO.hs b/src/Graphics/Image/IO.hs --- a/src/Graphics/Image/IO.hs +++ b/src/Graphics/Image/IO.hs @@ -199,61 +199,61 @@ * 'BMP': - * __in__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8') - * __out__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8') + * __read__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8') + * __write__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8') * 'GIF': - * __in__: ('RGB' 'Word8'), ('RGBA' 'Word8') - * __out__: ('RGB' 'Word8') + * __read__: ('RGB' 'Word8'), ('RGBA' 'Word8') + * __write__: ('RGB' 'Word8') * Also supports reading and writing animated images, when used as @['GIF']@ * 'HDR': - * __in__: ('RGB' 'Float') - * __out__: ('RGB' 'Float') + * __read__: ('RGB' 'Float') + * __write__: ('RGB' 'Float') * 'JPG': - * __in__: ('Y' 'Word8'), ('YA' 'Word8'), ('RGB' 'Word8'), ('CMYK' 'Word8'), + * __read__: ('Y' 'Word8'), ('YA' 'Word8'), ('RGB' 'Word8'), ('CMYK' 'Word8'), ('YCbCr', 'Word8') - * __out__: ('Y' 'Word8'), ('YA', 'Word8'), ('RGB' 'Word8'), ('CMYK' 'Word8'), + * __write__: ('Y' 'Word8'), ('YA', 'Word8'), ('RGB' 'Word8'), ('CMYK' 'Word8'), ('YCbCr', 'Word8') * 'PNG': - * __in__: ('Y' 'Word8'), ('Y' 'Word16'), ('YA' 'Word8'), ('YA' 'Word16'), + * __read__: ('Y' 'Word8'), ('Y' 'Word16'), ('YA' 'Word8'), ('YA' 'Word16'), ('RGB' 'Word8'), ('RGB' 'Word16'), ('RGBA' 'Word8'), ('RGBA' 'Word16') - * __out__: ('Y' 'Word8'), ('Y' 'Word16'), ('YA' 'Word8'), ('YA' 'Word16'), + * __write__: ('Y' 'Word8'), ('Y' 'Word16'), ('YA' 'Word8'), ('YA' 'Word16'), ('RGB' 'Word8'), ('RGB' 'Word16'), ('RGBA' 'Word8'), ('RGBA' 'Word16') * 'TGA': - * __in__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8') - * __out__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8') + * __read__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8') + * __write__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8') * 'TIF': - * __in__: ('Y' 'Word8'), ('Y' 'Word16'), ('YA' 'Word8'), ('YA' 'Word16'), + * __read__: ('Y' 'Word8'), ('Y' 'Word16'), ('YA' 'Word8'), ('YA' 'Word16'), ('RGB' 'Word8'), ('RGB' 'Word16'), ('RGBA' 'Word8'), ('RGBA' 'Word16'), ('CMYK' 'Word8'), ('CMYK' 'Word16') - * __out__: ('Y' 'Word8'), ('Y' 'Word16'), ('YA' 'Word8'), ('YA' 'Word16'), + * __write__: ('Y' 'Word8'), ('Y' 'Word16'), ('YA' 'Word8'), ('YA' 'Word16'), ('RGB' 'Word8'), ('RGB' 'Word16'), ('RGBA' 'Word8'), ('RGBA' 'Word16') ('CMYK' 'Word8'), ('CMYK' 'Word16'), ('YCbCr' 'Word8') * 'PBM': - * __in__: ('Binary' 'Bit') + * __read__: ('Binary' 'Bit') * Also supports sequence of images in one file, when read as @['PBM']@ * 'PGM': - * __in__: ('Y' 'Word8'), ('Y' 'Word16') + * __read__: ('Y' 'Word8'), ('Y' 'Word16') * Also supports sequence of images in one file, when read as @['PGM']@ * 'PPM': - * __in__: ('RGB' 'Word8'), ('RGB' 'Word16') + * __read__: ('RGB' 'Word8'), ('RGB' 'Word16') * Also supports sequence of images in one file, when read as @['PPM']@ -} diff --git a/src/Graphics/Image/IO/External/JuicyPixels.hs b/src/Graphics/Image/IO/External/JuicyPixels.hs --- a/src/Graphics/Image/IO/External/JuicyPixels.hs +++ b/src/Graphics/Image/IO/External/JuicyPixels.hs @@ -506,7 +506,7 @@ -- PNG Format Reading instance (Array arr Y Word8, Array arr Binary Bit) => Readable (Image arr Binary Bit) PNG where - decode _ = either Left (Right . toImageBinary) . jpImageY8ToImage . JP.decodePng + decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodePng instance Array arr Y Word8 => Readable (Image arr Y Word8) PNG where decode _ = jpImageY8ToImage . JP.decodePng @@ -548,7 +548,7 @@ -- TGA Format Reading instance (Array arr Y Word8, Array arr Binary Bit) => Readable (Image arr Binary Bit) TGA where - decode _ = either Left (Right . toImageBinary) . jpImageY8ToImage . JP.decodeTga + decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodeTga instance Array arr Y Word8 => Readable (Image arr Y Word8) TGA where decode _ = jpImageY8ToImage . JP.decodeTga @@ -575,7 +575,7 @@ -- TIF Format Reading instance (Array arr Y Word8, Array arr Binary Bit) => Readable (Image arr Binary Bit) TIF where - decode _ = either Left (Right . toImageBinary) . jpImageY8ToImage . JP.decodeTiff + decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodeTiff instance Array arr Y Word8 => Readable (Image arr Y Word8) TIF where decode _ = jpImageY8ToImage . JP.decodeTiff @@ -926,13 +926,10 @@ encode _ opts = encodeJPG opts ((convert :: Pixel RGB Word8 -> JP.PixelRGB8) . toWord8) -instance ManifestArray arr CMYK Double => Writable (Image arr CMYK Double) JPG where - encode _ opts = encodeJPG opts ((convert :: Pixel CMYK Word8 -> JP.PixelCMYK8) - . toWord8) +instance ManifestArray arr RGBA Double => Writable (Image arr RGBA Double) JPG where + encode _ opts = encodeJPG opts ((convert :: Pixel RGB Word8 -> JP.PixelRGB8) + . toWord8 . dropAlpha) -instance ManifestArray arr YCbCr Double => Writable (Image arr YCbCr Double) JPG where - encode _ opts = encodeJPG opts ((convert :: Pixel YCbCr Word8 -> JP.PixelYCbCr8) - . toWord8) -- Writable PNG diff --git a/src/Graphics/Image/Interface/Repa.hs b/src/Graphics/Image/Interface/Repa.hs --- a/src/Graphics/Image/Interface/Repa.hs +++ b/src/Graphics/Image/Interface/Repa.hs @@ -16,6 +16,8 @@ computeS, computeP, delay, -- * Representation RD(..), RS(..), RP(..), + -- * Conversion + fromRepaArray, toRepaArray ) where import Graphics.Image.IO diff --git a/src/Graphics/Image/Interface/Repa/Internal.hs b/src/Graphics/Image/Interface/Repa/Internal.hs --- a/src/Graphics/Image/Interface/Repa/Internal.hs +++ b/src/Graphics/Image/Interface/Repa/Internal.hs @@ -11,7 +11,8 @@ -- Portability : non-portable -- module Graphics.Image.Interface.Repa.Internal ( - RD(..), RP(..), RS(..), computeP, computeS, delay + RD(..), RP(..), RS(..), computeP, computeS, delay, + fromRepaArray, toRepaArray ) where #if MIN_VERSION_base(4,8,0) @@ -223,12 +224,12 @@ index (RSImage (RUImage arr)) (i, j) = R.index arr (Z :. i :. j) index (RSImage (RScalar px)) (_, _) = px - index _ _ = _error_compute + index _ _ = _errorCompute {-# INLINE index #-} deepSeqImage (RSImage (RUImage arr)) = deepSeqArray arr deepSeqImage (RSImage (RScalar px)) = seq px - deepSeqImage _ = _error_compute + deepSeqImage _ = _errorCompute {-# INLINE deepSeqImage #-} (|*|) i1@(RSImage img1) i2@(RSImage img2) = @@ -237,11 +238,11 @@ fold !f !px0 (RSImage (RUImage arr)) = R.foldAllS f px0 $ arr fold !f !px0 (RSImage (RScalar px)) = f px0 px - fold _ _ _ = _error_compute + fold _ _ _ = _errorCompute {-# INLINE fold #-} eq (RSImage (RUImage arr1)) (RSImage (RUImage arr2)) = R.equalsS arr1 arr2 - eq _ _ = _error_compute + eq _ _ = _errorCompute {-# INLINE eq #-} @@ -250,12 +251,12 @@ index (RPImage (RUImage arr)) (i, j) = R.index arr (Z :. i :. j) index (RPImage (RScalar px)) (0, 0) = px index (RPImage (RScalar _)) (_, _) = error "Scalar Image can only be indexed at (0,0)." - index _ _ = _error_compute + index _ _ = _errorCompute {-# INLINE index #-} deepSeqImage (RPImage (RUImage arr)) = deepSeqArray arr deepSeqImage (RPImage (RScalar px)) = seq px - deepSeqImage _ = _error_compute + deepSeqImage _ = _errorCompute {-# INLINE deepSeqImage #-} (|*|) i1@(RPImage img1) i2@(RPImage img2) = @@ -264,11 +265,11 @@ fold !f !px0 (RPImage (RUImage arr)) = head . R.foldAllP f px0 $ arr fold !f !px0 (RPImage (RScalar px)) = f px0 px - fold _ _ _ = _error_compute + fold _ _ _ = _errorCompute {-# INLINE fold #-} eq (RPImage (RUImage arr1)) (RPImage (RUImage arr2)) = head $ R.equalsP arr1 arr2 - eq _ _ = _error_compute + eq _ _ = _errorCompute {-# INLINE eq #-} @@ -379,7 +380,7 @@ instance Exchangable RS VU where exchange _ img@(RSImage (RUImage arr)) = fromUnboxedVector (dims img) (R.toUnboxed arr) exchange _ (RSImage (RScalar px)) = singleton px - exchange _ _ = _error_compute + exchange _ _ = _errorCompute {-# INLINE exchange #-} @@ -387,7 +388,7 @@ instance Exchangable RP VU where exchange _ img@(RPImage (RUImage arr)) = fromUnboxedVector (dims img) (R.toUnboxed arr) exchange _ (RPImage (RScalar px)) = singleton px - exchange _ _ = _error_compute + exchange _ _ = _errorCompute {-# INLINE exchange #-} -- | Computes an image in parallel and ensures that all elements are evaluated. @@ -424,7 +425,7 @@ getPx (Z :. i :. j) = sumAllS (slice arr1 (Any :. (i :: Int) :. All) *^ slice arr2 (Any :. (j :: Int))) {-# INLINE getPx #-} -mult _ _ = _error_compute +mult _ _ = _errorCompute {-# INLINE mult #-} @@ -450,13 +451,25 @@ getDelayed _ = error "Scalar image is not an array." {-# INLINE getDelayed #-} + +-- | Create an image from a 2D Repa delayed array. +fromRepaArray :: (ColorSpace cs, Unbox (PixelElt cs e)) => + R.Array D DIM2 (Pixel cs e) -> Image RD cs e +fromRepaArray = RDImage + + +-- | Retrieve an underlying Repa array from `RD` image type. +toRepaArray :: (ColorSpace cs, Unbox (PixelElt cs e)) => + Image RD cs e -> R.Array D DIM2 (Pixel cs e) +toRepaArray (RUImage arr) = R.delay arr +toRepaArray (RDImage arr) = arr +toRepaArray (RScalar px) = R.fromFunction (Z :. 1 :. 1) $ const px -_error_compute :: t -_error_compute = error "Image should be computed at ths point. Please report this error" +_errorCompute :: t +_errorCompute = error "Image should be computed at ths point. Please report this error" -_error_scalar_op :: t -_error_scalar_op = - error "This operation is not allowed on scalar images." +_errorScalarOp :: t +_errorScalarOp = error "This operation is not allowed on scalar images." instance R.Elt Bit where diff --git a/src/Graphics/Image/Processing/Binary.hs b/src/Graphics/Image/Processing/Binary.hs --- a/src/Graphics/Image/Processing/Binary.hs +++ b/src/Graphics/Image/Processing/Binary.hs @@ -35,7 +35,12 @@ -- | 'Thresholding' contains a convenient set of functions for binary image -- construction, which is done by comparing either a single pixel with every --- pixel in an image or two same size images pointwise. +-- pixel in an image or two same size images pointwise. For example: +-- +-- >>> frog <- readImageY "images/frog.jpg" +-- >>> frog .==. PixelY 0 -- (or: PixelY 0 .==. frog) +-- >>> frog .<. flipH frog -- (or: flipH frog .>. frog) +-- class Array arr Binary Bit => Thresholding a b arr | a b -> arr where (.==.) :: (Eq (Pixel cs e), Array arr cs e) => a cs e -> b cs e -> Image arr Binary Bit (./=.) :: (Eq (Pixel cs e), Array arr cs e) => a cs e -> b cs e -> Image arr Binary Bit @@ -119,7 +124,7 @@ {-# INLINE (.||.) #-} --- | Complement each pixel in the image +-- | Complement each pixel in a binary image invert :: Array arr Binary Bit => Image arr Binary Bit -> Image arr Binary Bit invert = map complement {-# INLINE invert #-} diff --git a/src/Graphics/Image/Processing/Geometric.hs b/src/Graphics/Image/Processing/Geometric.hs --- a/src/Graphics/Image/Processing/Geometric.hs +++ b/src/Graphics/Image/Processing/Geometric.hs @@ -18,7 +18,7 @@ -- ** Flipping flipV, flipH, -- ** Rotation - rotate90, rotate180, rotate270, + rotate90, rotate180, rotate270, rotate, -- ** Scaling resize, scale ) where @@ -115,6 +115,7 @@ {-# INLINE newPx #-} {-# INLINE topToBottom #-} + -- | Crop an image, i.e. retrieves a sub-image image with @m@ rows and @n@ -- columns. Make sure @(m + i, n + j)@ is not greater than dimensions of a -- source image. @@ -193,6 +194,39 @@ {-# INLINE rotate270 #-} + +-- | Rotate an image clockwise by an angle Θ in radians. +-- +-- >>> frog <- readImageRGBA "images/frog.jpg" +-- >>> writeImage "images/frog_rotate330.png" $ rotate (Bilinear (Fill 0)) (11*pi/6) frog +-- +-- <> <> +-- +rotate :: (Array arr cs e, Elevator e, Interpolation method) => + method (Pixel cs e) -- ^ Interpolation method to be used + -> Double -- ^ Angle in radians + -> Image arr cs e -- ^ Source image + -> Image arr cs e -- ^ Rotated image +rotate !method !theta' !img = traverse img getNewDims getNewPx where + !theta = angle0to2pi (-theta') -- invert angle direction and put it into [0, 2*pi) range + !sz@(m, n) = dims img + !(mD, nD) = (fromIntegral m, fromIntegral n) + !(sinTheta, cosTheta) = (sin' theta, cos' theta) + !(sinThetaAbs, cosThetaAbs) = (abs sinTheta, abs cosTheta) + !(mD', nD') = (mD * cosThetaAbs + nD * sinThetaAbs, nD * cosThetaAbs + mD * sinThetaAbs) + !(iDelta, jDelta) = + case (sinTheta >= 0, cosTheta >= 0) of + (True , True ) -> (nD * sinTheta, 0) -- I quadrant + (True , False ) -> (mD', -nD * cosTheta) -- II quadrant + (False , False ) -> (-mD * cosTheta, nD') -- III quadrant + (False , True ) -> (0, -mD * sinTheta) -- IV quadrant + getNewDims _ = (ceiling mD', ceiling nD') + getNewPx getPx (i, j) = interpolate method sz getPx (i', j') where + (iD, jD) = (fromIntegral i - iDelta + 0.5, fromIntegral j - jDelta + 0.5) + i' = iD * cosTheta + jD * sinTheta - 0.5 + j' = jD * cosTheta - iD * sinTheta - 0.5 + + -- | Resize an image using an interpolation method. -- -- >>> frog <- readImageRGB "images/frog.jpg" @@ -204,7 +238,7 @@ method (Pixel cs e) -- ^ Interpolation method to be used during scaling. -> (Int, Int) -- ^ Dimensions of a result image. -> Image arr cs e -- ^ Source image. - -> Image arr cs e -- ^ Reuslt image. + -> Image arr cs e -- ^ Result image. resize !method !sz'@(m', n') !img = traverse img (const sz') getNewPx where !sz@(m, n) = dims img !(fM, fN) = (fromIntegral m' / fromIntegral m, fromIntegral n' / fromIntegral n) @@ -229,3 +263,28 @@ then error "scale: scaling factor must be greater than 0." else resize method (round (fM * fromIntegral m), round (fN * fromIntegral n)) img {-# INLINE scale #-} + + + +-- | Put an angle into @[0, 2*pi)@ range. +angle0to2pi :: Double -> Double +angle0to2pi !f = f - 2 * pi * floor' (f / (2 * pi)) + where floor' :: Double -> Double + floor' !x = fromIntegral (floor x :: Int) + {-# INLINE floor' #-} +{-# INLINE angle0to2pi #-} + + +-- | Make sure @sin' pi == 0@ instead of @sin pi == 1.2246467991473532e-16@ +sin' :: Double -> Double +sin' a = if abs sinA <= _0 then 0 else sinA + where !_0 = 10 * sin pi + !sinA = sin a +{-# INLINE sin' #-} + + +-- | Make sure @cos' (pi/2) == 0@ instead of @cos (pi/2) == 6.123233995736766e-17@ +-- and @cos' (3*pi/2) == 0@ instead of @cos (3*pi/2) == -1.8369701987210297e-16@ +cos' :: Double -> Double +cos' a = sin' (a + pi/2) +{-# INLINE cos' #-} diff --git a/src/Graphics/Image/Types.hs b/src/Graphics/Image/Types.hs --- a/src/Graphics/Image/Types.hs +++ b/src/Graphics/Image/Types.hs @@ -8,9 +8,10 @@ -- module Graphics.Image.Types ( module Graphics.Image.ColorSpace, + module Graphics.Image.IO.External, Array, Image, ManifestArray, SequentialArray, MutableArray, MImage, Exchangable, Border(..), - VU(..), RD(..), RS(..), RP(..), + VU(..), RD(..), RS(..), RP(..), ) where @@ -18,3 +19,4 @@ import Graphics.Image.Interface import Graphics.Image.Interface.Vector (VU(..)) import Graphics.Image.Interface.Repa (RD(..), RS(..), RP(..)) +import Graphics.Image.IO.External