120 lines
4.5 KiB
Haskell
120 lines
4.5 KiB
Haskell
module Main where
|
|
|
|
import Codec.Picture
|
|
import Codec.Picture.Types
|
|
import Data.Maybe (fromJust)
|
|
import Data.Word (Word8)
|
|
import Data.List (transpose)
|
|
import Text.Printf (printf)
|
|
import Control.Arrow ((&&&))
|
|
import Options.Applicative
|
|
import qualified Data.ByteString as B
|
|
import System.IO (stdin)
|
|
|
|
|
|
data Options = Options
|
|
{ srcFile :: String
|
|
, width :: Int
|
|
, height :: Int
|
|
}
|
|
|
|
options :: Parser Options
|
|
options = Options
|
|
<$> argument str (metavar "SRC" <> help "source file (or - for stdin)")
|
|
<*> argument auto (metavar "WIDTH" <> help "resulting width")
|
|
<*> argument auto (metavar "HEIGH" <> help "resulting height")
|
|
|
|
opthelp :: ParserInfo Options
|
|
opthelp = info (helper <*> options)
|
|
( fullDesc
|
|
<> progDesc "An image to ASCII-Converter"
|
|
<> header "img2ascii - convert images to console-compatible text"
|
|
)
|
|
|
|
main :: IO ()
|
|
main = execParser opthelp >>= run
|
|
|
|
run :: Options -> IO ()
|
|
run (Options src w h) = do
|
|
src' <- if src == "-" then B.getContents else B.readFile src
|
|
case decodeImage src' of
|
|
Left err -> putStrLn err
|
|
Right img -> do
|
|
src <- return $ extractDynImage img
|
|
case src of
|
|
(Just s) -> do
|
|
pix <- return $ pixelize s w h
|
|
case pix of
|
|
Nothing -> return ()
|
|
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 :: (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 :: ((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,Image PixelRGB8)
|
|
pixelize im@(Image iw ih id) tw th =
|
|
if windoww == 0 || windowh == 0 then
|
|
Nothing
|
|
else Just (snd $ generateFoldImage (folder filterfun windoww windowh) im tw th,
|
|
snd $ generateFoldImage (folder filterfuninv windoww windowh) im tw th)
|
|
where
|
|
windoww = fromIntegral iw / fromIntegral tw
|
|
windowh = fromIntegral ih / fromIntegral th
|
|
|
|
folder :: ((PixelRGB8, Int, Int) -> (PixelRGB8, Int, Int) -> (PixelRGB8, Int, Int)) -> Double -> Double -> 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 <- [-(floor $ ww / 2)..(floor $ ww*0.5)]
|
|
, dy <- [-(floor $ ww / 2)..(floor $ ww*0.5)]
|
|
, x'+dx > 0 && x'+dx < iw
|
|
, y'+dy > 0 && y'+dy < ih
|
|
])
|
|
where
|
|
x' = floor $ fromIntegral x *ww
|
|
y' = floor $ fromIntegral y *wh
|
|
|
|
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
|
|
ImageY8 img -> Just $ promoteImage img
|
|
ImageY16 img -> Nothing
|
|
ImageYF img -> Nothing
|
|
ImageYA8 img -> Just $ promoteImage img
|
|
ImageYA16 img -> Nothing
|
|
ImageRGB8 img -> Just img
|
|
ImageRGB16 img -> Nothing
|
|
ImageRGBF img -> Nothing
|
|
ImageRGBA8 img -> Just $ pixelMap dropTransparency img
|
|
ImageRGBA16 img -> Nothing
|
|
ImageYCbCr8 img -> Just $ convertImage img
|
|
ImageCMYK8 img -> Just $ convertImage img
|
|
ImageCMYK16 img -> Nothing
|