diff --git a/45.png b/45.png new file mode 100644 index 0000000..9e014e4 Binary files /dev/null and b/45.png differ diff --git a/app/Main.hs b/app/Main.hs index 8930e93..7ca940f 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,7 @@ module Main where import Data.Picture import System.Environment + import Data.Either data Options = Options { file :: FilePath , output :: FilePath @@ -47,6 +48,7 @@ module Main where let options = parseArgs args opts pic <- readPicture (file options) + Right other <- readPicture ("output.png") case pic of Left err -> print err diff --git a/picedit.cabal b/picedit.cabal index a034ba3..615b27e 100644 --- a/picedit.cabal +++ b/picedit.cabal @@ -1,5 +1,5 @@ name: picedit -version: 0.1.1.2 +version: 0.2.0.0 synopsis: simple image manipulation functions description: Simple set of functions for image manipulation: contrast, brightnesss, rotation, etc. homepage: https://github.com/mdibaiee/picedit#readme diff --git a/src/Data/Picture.hs b/src/Data/Picture.hs index 9566fa4..2fc4d9c 100644 --- a/src/Data/Picture.hs +++ b/src/Data/Picture.hs @@ -21,6 +21,7 @@ module Data.Picture ( Picture , gamma , invert , compress + , embed -- * Converting between Image and Picture , fromImage , toImage @@ -36,27 +37,29 @@ module Data.Picture ( Picture import System.IO import Data.Maybe import Debug.Trace + import Data.List (zipWith4) - -- | (R, G, B) color channels - type Picture = (Matrix Double, Matrix Double, Matrix Double) + -- | (R, G, B, A) color channels + type Picture = (Matrix Double, Matrix Double, Matrix Double, Matrix Double) - -- | Converts a JuicyPixel 'Image PixelRGB8' to 'Picture' - fromImage :: Image PixelRGB8 -> Picture + -- | Converts a JuicyPixel 'Image PixelRGBA8' to 'Picture' + fromImage :: Image PixelRGBA8 -> Picture fromImage Image { imageWidth = w, imageHeight = h, imageData = vec } = - let [r, g, b] = map (reshape w . V.fromList . reverse) (snd $ V.foldl' gp (0, [[],[],[]]) (V.map fromIntegral vec)) - in (r, g, b) + let [r, g, b, a] = map (reshape w . V.fromList . reverse) (snd $ V.foldl' gp (0, [[],[],[],[]]) (V.map fromIntegral vec)) + in (r, g, b, a) where gp acc x = case acc of - (0, [r, g, b]) -> (1, [x:r, g, b]) - (1, [r, g, b]) -> (2, [r, x:g, b]) - (2, [r, g, b]) -> (0, [r, g, x:b]) + (0, [r, g, b, a]) -> (1, [x:r, g, b, a]) + (1, [r, g, b, a]) -> (2, [r, x:g, b, a]) + (2, [r, g, b, a]) -> (3, [r, g, x:b, a]) + (3, [r, g, b, a]) -> (0, [r, g, b, x:a]) - -- | Converts a 'Picture' to JuicyPixel 'Image PixelRGB8' - toImage :: Picture -> Image PixelRGB8 - toImage (r, g, b) = - let (fr, fg, fb) = (toList $ flatten r, toList $ flatten g, toList $ flatten b) - img = V.map (fromIntegral . floor) . V.concat $ zipWith3 (\a b c -> vector [a, b, c]) fr fg fb + -- | Converts a 'Picture' to JuicyPixel 'Image PixelRGBA8' + toImage :: Picture -> Image PixelRGBA8 + toImage (r, g, b, a) = + let (fr, fg, fb, fa) = (toList $ flatten r, toList $ flatten g, toList $ flatten b, toList $ flatten a) + img = V.map (fromIntegral . floor) . V.concat $ zipWith4 (\a b c d -> vector [a, b, c, d]) fr fg fb fa in Image { imageWidth = cols r, imageHeight = rows r, imageData = img } @@ -66,7 +69,7 @@ module Data.Picture ( Picture img <- readImage path return $ case img of Left err -> Left err - Right im -> Right $ fromImage (convertRGB8 im) + Right im -> Right $ fromImage (convertRGBA8 im) -- | Write the specified 'Picture' to a PNG file writePicturePng :: FilePath -> Picture -> IO () @@ -74,46 +77,46 @@ module Data.Picture ( Picture -- | Turn the 'Picture' grayscale grayscale :: Picture -> Picture - grayscale (r, g, b) = + grayscale (r, g, b, a) = let (fr, fg, fb) = (flatten r, flatten g, flatten b) mean = reshape (cols r) $ V.map (/ 3) (fr + fg + fb) - in (mean, mean, mean) + in (mean, mean, mean, a) -- | Fade the 'Picture' by a number between 0 and 1 fade :: Double -> Picture -> Picture - fade opacity (r, g, b) = (f r, f g, f b) + fade opacity (r, g, b, a) = (r, g, b, f a) where f = cmap (*opacity) -- | Set contrast level of 'Picture', a number between -255 and 255 contrast :: Double -> Picture -> Picture - contrast level (r, g, b) = (f r, f g, f b) + contrast level (r, g, b, a) = (f r, f g, f b, a) where cfactor = (259 * (level + 255)) / (255 * (259 - level)) f = cmap (\x -> pixelBound $ cfactor * (x - 128) + 128) -- | Set brightness level of 'Picture', a number between -255 and 255 brightness :: Double -> Picture -> Picture - brightness level (r, g, b) = (f r, f g, f b) + brightness level (r, g, b, a) = (f r, f g, f b, a) where f = cmap (pixelBound . (+level)) -- | Set gamma level of 'Picture' gamma :: Int -> Picture -> Picture - gamma level (r, g, b) = (f r, f g, f b) + gamma level (r, g, b, a) = (f r, f g, f b, a) where f = cmap (\x -> pixelBound $ 255 * (x / 255) ^ level) -- | Inverts the 'Picture' invert :: Picture -> Picture - invert (r, g, b) = (f r, f g, f b) + invert (r, g, b, a) = (f r, f g, f b, a) where f = cmap (`subtract` 255) -- | Rotate 'Picture' for the specified degrees, around the specified origin. -- If the origin is `Nothing`, rotates around the center rotate :: Double -> Maybe (Int, Int) -> Picture -> Picture - rotate deg orig (r, g, b) = (f r, f g, f b) + rotate deg orig (r, g, b, a) = (f r, f g, f b, f a) where -- rotation in radians rad = deg * pi / 180 @@ -139,7 +142,7 @@ module Data.Picture ( Picture -- | Compress the image using SVD -- note: this is not size compression, it's just a k-rank approximation of the image compress :: Int -> Picture -> Picture - compress rate (r, g, b) = (f r, f g, f b) + compress rate (r, g, b, a) = (f r, f g, f b, a) where k = cols r - rate f m = @@ -148,5 +151,24 @@ module Data.Picture ( Picture (mu, ms, mv) = (u ?? (All, Take k), si ?? (Take k, Take k), (tr v) ?? (Take k, All)) in mu <> ms <> mv + -- | Embed a 'Picture' into another one, in the specified position-} + embed :: Picture -> (Int, Int) -> Picture -> Picture + embed (br, bg, bb, ba) (x, y) (lr, lg, lb, la) = (f br lmr, f bg lmg, f bb lmb, maxAlpha) + where + (lmr, lmg, lmb, lma) = (fit lr, fit lg, fit lb, fit la) + scaledAlpha = cmap (/255) lma + + fit m = + let distance = y * cols br + total = rows br * cols br + xPush = (rows m><(cols br - x - cols m)) (repeat 0) + positioned = xPush ||| m ||| xPast + flat = toList $ flatten positioned + in (rows br>