feat(embed): allow embedding of images into each other

This commit is contained in:
Mahdi Dibaiee 2017-02-02 23:46:42 +03:30
parent c26883db10
commit d468550af5
5 changed files with 49 additions and 25 deletions

BIN
45.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.4 KiB

View File

@ -1,6 +1,7 @@
module Main where module Main where
import Data.Picture import Data.Picture
import System.Environment import System.Environment
import Data.Either
data Options = Options { file :: FilePath data Options = Options { file :: FilePath
, output :: FilePath , output :: FilePath
@ -47,6 +48,7 @@ module Main where
let options = parseArgs args opts let options = parseArgs args opts
pic <- readPicture (file options) pic <- readPicture (file options)
Right other <- readPicture ("output.png")
case pic of case pic of
Left err -> print err Left err -> print err

View File

@ -1,5 +1,5 @@
name: picedit name: picedit
version: 0.1.1.2 version: 0.2.0.0
synopsis: simple image manipulation functions synopsis: simple image manipulation functions
description: Simple set of functions for image manipulation: contrast, brightnesss, rotation, etc. description: Simple set of functions for image manipulation: contrast, brightnesss, rotation, etc.
homepage: https://github.com/mdibaiee/picedit#readme homepage: https://github.com/mdibaiee/picedit#readme

View File

@ -21,6 +21,7 @@ module Data.Picture ( Picture
, gamma , gamma
, invert , invert
, compress , compress
, embed
-- * Converting between Image and Picture -- * Converting between Image and Picture
, fromImage , fromImage
, toImage , toImage
@ -36,27 +37,29 @@ module Data.Picture ( Picture
import System.IO import System.IO
import Data.Maybe import Data.Maybe
import Debug.Trace import Debug.Trace
import Data.List (zipWith4)
-- | (R, G, B) color channels -- | (R, G, B, A) color channels
type Picture = (Matrix Double, Matrix Double, Matrix Double) type Picture = (Matrix Double, Matrix Double, Matrix Double, Matrix Double)
-- | Converts a JuicyPixel 'Image PixelRGB8' to 'Picture' -- | Converts a JuicyPixel 'Image PixelRGBA8' to 'Picture'
fromImage :: Image PixelRGB8 -> Picture fromImage :: Image PixelRGBA8 -> Picture
fromImage Image { imageWidth = w, imageHeight = h, imageData = vec } = 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)) let [r, g, b, a] = map (reshape w . V.fromList . reverse) (snd $ V.foldl' gp (0, [[],[],[],[]]) (V.map fromIntegral vec))
in (r, g, b) in (r, g, b, a)
where where
gp acc x = gp acc x =
case acc of case acc of
(0, [r, g, b]) -> (1, [x:r, g, b]) (0, [r, g, b, a]) -> (1, [x:r, g, b, a])
(1, [r, g, b]) -> (2, [r, x:g, b]) (1, [r, g, b, a]) -> (2, [r, x:g, b, a])
(2, [r, g, b]) -> (0, [r, g, x:b]) (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' -- | Converts a 'Picture' to JuicyPixel 'Image PixelRGBA8'
toImage :: Picture -> Image PixelRGB8 toImage :: Picture -> Image PixelRGBA8
toImage (r, g, b) = toImage (r, g, b, a) =
let (fr, fg, fb) = (toList $ flatten r, toList $ flatten g, toList $ flatten b) let (fr, fg, fb, fa) = (toList $ flatten r, toList $ flatten g, toList $ flatten b, toList $ flatten a)
img = V.map (fromIntegral . floor) . V.concat $ zipWith3 (\a b c -> vector [a, b, c]) fr fg fb 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 } in Image { imageWidth = cols r, imageHeight = rows r, imageData = img }
@ -66,7 +69,7 @@ module Data.Picture ( Picture
img <- readImage path img <- readImage path
return $ case img of return $ case img of
Left err -> Left err Left err -> Left err
Right im -> Right $ fromImage (convertRGB8 im) Right im -> Right $ fromImage (convertRGBA8 im)
-- | Write the specified 'Picture' to a PNG file -- | Write the specified 'Picture' to a PNG file
writePicturePng :: FilePath -> Picture -> IO () writePicturePng :: FilePath -> Picture -> IO ()
@ -74,46 +77,46 @@ module Data.Picture ( Picture
-- | Turn the 'Picture' grayscale -- | Turn the 'Picture' grayscale
grayscale :: Picture -> Picture grayscale :: Picture -> Picture
grayscale (r, g, b) = grayscale (r, g, b, a) =
let (fr, fg, fb) = (flatten r, flatten g, flatten b) let (fr, fg, fb) = (flatten r, flatten g, flatten b)
mean = reshape (cols r) $ V.map (/ 3) (fr + fg + fb) 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 the 'Picture' by a number between 0 and 1
fade :: Double -> Picture -> Picture 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 where
f = cmap (*opacity) f = cmap (*opacity)
-- | Set contrast level of 'Picture', a number between -255 and 255 -- | Set contrast level of 'Picture', a number between -255 and 255
contrast :: Double -> Picture -> Picture 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 where
cfactor = (259 * (level + 255)) / (255 * (259 - level)) cfactor = (259 * (level + 255)) / (255 * (259 - level))
f = cmap (\x -> pixelBound $ cfactor * (x - 128) + 128) f = cmap (\x -> pixelBound $ cfactor * (x - 128) + 128)
-- | Set brightness level of 'Picture', a number between -255 and 255 -- | Set brightness level of 'Picture', a number between -255 and 255
brightness :: Double -> Picture -> Picture 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 where
f = cmap (pixelBound . (+level)) f = cmap (pixelBound . (+level))
-- | Set gamma level of 'Picture' -- | Set gamma level of 'Picture'
gamma :: Int -> Picture -> 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 where
f = cmap (\x -> pixelBound $ 255 * (x / 255) ^ level) f = cmap (\x -> pixelBound $ 255 * (x / 255) ^ level)
-- | Inverts the 'Picture' -- | Inverts the 'Picture'
invert :: Picture -> 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 where
f = cmap (`subtract` 255) f = cmap (`subtract` 255)
-- | Rotate 'Picture' for the specified degrees, around the specified origin. -- | Rotate 'Picture' for the specified degrees, around the specified origin.
-- If the origin is `Nothing`, rotates around the center -- If the origin is `Nothing`, rotates around the center
rotate :: Double -> Maybe (Int, Int) -> Picture -> Picture 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 where
-- rotation in radians -- rotation in radians
rad = deg * pi / 180 rad = deg * pi / 180
@ -139,7 +142,7 @@ module Data.Picture ( Picture
-- | Compress the image using SVD -- | Compress the image using SVD
-- note: this is not size compression, it's just a k-rank approximation of the image -- note: this is not size compression, it's just a k-rank approximation of the image
compress :: Int -> Picture -> Picture 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 where
k = cols r - rate k = cols r - rate
f m = 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)) (mu, ms, mv) = (u ?? (All, Take k), si ?? (Take k, Take k), (tr v) ?? (Take k, All))
in mu <> ms <> mv 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><x) (repeat 0)
xPast = (rows m><(cols br - x - cols m)) (repeat 0)
positioned = xPush ||| m ||| xPast
flat = toList $ flatten positioned
in (rows br><cols br) $ replicate distance 0 ++ flat ++ repeat 0
f b lm = (b * (cmap (1-) scaledAlpha)) + (lm * scaledAlpha)
maxAlpha = (rows ba><cols ba) $ zipWith max (toList . flatten $ ba) (toList . flatten . fit $ la)
bound (l, u) x = max l $ min u x bound (l, u) x = max l $ min u x
pixelBound = bound (0, 255) pixelBound = bound (0, 255)

BIN
test.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 140 KiB