now in technicolor!

src/Main.hs

@@ -5,11 +5,13 @@ import Codec.Picture.Types
 import Data.Maybe (fromJust)
 import Data.Word (Word8)
 import Data.List (transpose)
+import Text.Printf (printf)
+import Control.Arrow ((&&&))
 
 targetWidth :: Int
 targetWidth = 80
 targetHeight :: Int
-targetHeight = 50
+targetHeight = 40
 
 main :: IO ()
 main = do
@@ -23,41 +25,44 @@ main = do
                  pix <- return $ pixelize s targetWidth targetHeight
                  case pix of
                    Nothing -> return ()
-                   Just c -> do
-                     savePngImage "test.png" (ImageRGB8 c)
-                     str <- return $ img2ascii conv c
-                     mapM_ putStrLn (transpose $ chunksof targetHeight str)
+                   Just (f,b) -> do
+                     savePngImage "test.png" (ImageRGB8 b)
+                     str <- return $ img2ascii conv (f,b)
+                     mapM_ (\x -> putStr x >> putStrLn "\x1b[0m") (concat <$> str)
               Nothing -> return ()
 
 chunksof :: Int -> [a] -> [[a]]
 chunksof _ [] = []
 chunksof c xs = take c xs : chunksof c (drop c xs)
 
-conv :: Word8 -> Char
-conv x 
-  | x > 225 = '@'
-  | x > 180 = 'O'
-  | x > 150 = 'o'
-  | x > 50 = '.'
-  | otherwise = ' '
+conv :: (PixelRGB8,PixelRGB8) -> String
+conv (fp@(PixelRGB8 fr fg fb),PixelRGB8 br bg bb) = printf "\x1b[48;2;%d;%d;%dm\x1b[38;2;%d;%d;%dm%c" br bg bb fr fg fb (lumi.computeLuma $ fp)
+   where
+     lumi :: Word8 -> Char
+     lumi x 
+          | x > 225 = '@'
+          | x > 180 = 'O'
+          | x > 150 = 'X'
+          | x > 50 = 'o'
+          | x > 25 = 'x'
+          | x > 10 = '.'
+          | otherwise = ' '
 
-img2ascii :: (Word8 -> Char) -> Image PixelRGB8 -> String
-img2ascii c im@(Image w h _) = do
-   x <- [0..w-1]
-   y <- [0..h-1]
-   return $ c (255-computeLuma (pixelAt im x y))
+img2ascii :: ((PixelRGB8,PixelRGB8) -> String) -> (Image PixelRGB8,Image PixelRGB8) -> [[String]]
+img2ascii c (fg@(Image w h _),bg@(Image w' h' _)) = (fmap.fmap) (c.(uncurry (pixelAt fg) &&& uncurry (pixelAt bg))) [[(x,y) | x <- [0..w-1]] | y <- [0..h-1]]
 
-pixelize :: Image PixelRGB8 -> Int -> Int -> Maybe (Image PixelRGB8)
+pixelize :: Image PixelRGB8 -> Int -> Int -> Maybe (Image PixelRGB8,Image PixelRGB8)
 pixelize im@(Image iw ih id) tw th =
       if windoww == 0 || windowh == 0 then
           Nothing
-      else Just $ snd $ generateFoldImage (folder windoww windowh) im tw th
+      else Just $ (snd $ generateFoldImage (folder filterfun windoww windowh) im tw th,
+                   snd $ generateFoldImage (folder filterfuninv windoww windowh) im tw th)
      where
        windoww = iw `div` tw
        windowh = ih `div` th
 
-folder :: Int -> Int -> Image PixelRGB8 -> Int -> Int -> (Image PixelRGB8, PixelRGB8)
-folder ww wh im@(Image iw ih id) x y = (im,(\(a,_,_) -> a) $ foldl1 filterfun
+folder :: ((PixelRGB8, Int, Int) -> (PixelRGB8, Int, Int) -> (PixelRGB8, Int, Int)) -> Int -> Int -> Image PixelRGB8 -> Int -> Int -> (Image PixelRGB8, PixelRGB8)
+folder f ww wh im@(Image iw ih id) x y = (im,(\(a,_,_) -> a) $ foldl1 f
     [ (pixelAt im (x'+dx) (y'+dy),dx,dy)
     | dx <- [-(ww `div` 2)..ww - (ww `div`2)]
     , dy <- [-(ww `div` 2)..ww - (ww `div`2)]
@@ -71,6 +76,9 @@ folder ww wh im@(Image iw ih id) x y = (im,(\(a,_,_) -> a) $ foldl1 filterfun
 filterfun :: (PixelRGB8,Int,Int) -> (PixelRGB8, Int, Int) -> (PixelRGB8,Int,Int)
 filterfun (x@(PixelRGB8 r g b),_,_) (y@(PixelRGB8 r' g' b'),_,_) = if computeLuma x > computeLuma y then (x,0,0) else (y,0,0)
 
+filterfuninv :: (PixelRGB8,Int,Int) -> (PixelRGB8, Int, Int) -> (PixelRGB8,Int,Int)
+filterfuninv (x@(PixelRGB8 r g b),_,_) (y@(PixelRGB8 r' g' b'),_,_) = if computeLuma x < computeLuma y then (x,0,0) else (y,0,0)
+
 extractDynImage :: DynamicImage -> Maybe (Image PixelRGB8)
 extractDynImage image =
          case image of