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

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

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

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><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
     pixelBound = bound (0, 255)