now images don't get cropped off at the bottom right. Also added arguments.

This commit is contained in:
Nicole Dresselhaus 2015-11-21 21:28:23 +01:00
parent aa26b51693
commit 14d633586d
4 changed files with 42 additions and 18 deletions

View File

@ -22,6 +22,8 @@ executable img2ascii
-- other-extensions: -- other-extensions:
build-depends: base >=4.8 && <4.9, build-depends: base >=4.8 && <4.9,
JuicyPixels, JuicyPixels,
vector vector,
optparse-applicative,
bytestring
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010

View File

@ -7,22 +7,43 @@ import Data.Word (Word8)
import Data.List (transpose) import Data.List (transpose)
import Text.Printf (printf) import Text.Printf (printf)
import Control.Arrow ((&&&)) import Control.Arrow ((&&&))
import Options.Applicative
import qualified Data.ByteString as B
import System.IO (stdin)
targetWidth :: Int
targetWidth = 80 data Options = Options
targetHeight :: Int { srcFile :: String
targetHeight = 40 , 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 :: IO ()
main = do main = execParser opthelp >>= run
img' <- readImage "test.jpg"
case img' of 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 Left err -> putStrLn err
Right img -> do Right img -> do
src <- return $ extractDynImage img src <- return $ extractDynImage img
case src of case src of
(Just s) -> do (Just s) -> do
pix <- return $ pixelize s targetWidth targetHeight pix <- return $ pixelize s w h
case pix of case pix of
Nothing -> return () Nothing -> return ()
Just (f,b) -> do Just (f,b) -> do
@ -31,6 +52,7 @@ main = do
mapM_ (\x -> putStr x >> putStrLn "\x1b[0m") (concat <$> str) mapM_ (\x -> putStr x >> putStrLn "\x1b[0m") (concat <$> str)
Nothing -> return () Nothing -> return ()
chunksof :: Int -> [a] -> [[a]] chunksof :: Int -> [a] -> [[a]]
chunksof _ [] = [] chunksof _ [] = []
chunksof c xs = take c xs : chunksof c (drop c xs) chunksof c xs = take c xs : chunksof c (drop c xs)
@ -55,23 +77,23 @@ pixelize :: Image PixelRGB8 -> Int -> Int -> Maybe (Image PixelRGB8,Image PixelR
pixelize im@(Image iw ih id) tw th = pixelize im@(Image iw ih id) tw th =
if windoww == 0 || windowh == 0 then if windoww == 0 || windowh == 0 then
Nothing Nothing
else Just $ (snd $ generateFoldImage (folder filterfun 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) snd $ generateFoldImage (folder filterfuninv windoww windowh) im tw th)
where where
windoww = iw `div` tw windoww = fromIntegral iw / fromIntegral tw
windowh = ih `div` th windowh = fromIntegral ih / fromIntegral th
folder :: ((PixelRGB8, Int, Int) -> (PixelRGB8, Int, Int) -> (PixelRGB8, Int, Int)) -> Int -> Int -> Image PixelRGB8 -> Int -> Int -> (Image PixelRGB8, PixelRGB8) 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 folder f ww wh im@(Image iw ih id) x y = (im,(\(a,_,_) -> a) $ foldl1 f
[ (pixelAt im (x'+dx) (y'+dy),dx,dy) [ (pixelAt im (x'+dx) (y'+dy),dx,dy)
| dx <- [-(ww `div` 2)..ww - (ww `div`2)] | dx <- [-(floor $ ww / 2)..(floor $ ww*0.5)]
, dy <- [-(ww `div` 2)..ww - (ww `div`2)] , dy <- [-(floor $ ww / 2)..(floor $ ww*0.5)]
, x'+dx > 0 && x'+dx < iw , x'+dx > 0 && x'+dx < iw
, y'+dy > 0 && y'+dy < ih , y'+dy > 0 && y'+dy < ih
]) ])
where where
x' = x*ww x' = floor $ fromIntegral x *ww
y' = y*wh y' = floor $ fromIntegral y *wh
filterfun :: (PixelRGB8,Int,Int) -> (PixelRGB8, Int, Int) -> (PixelRGB8,Int,Int) 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) filterfun (x@(PixelRGB8 r g b),_,_) (y@(PixelRGB8 r' g' b'),_,_) = if computeLuma x > computeLuma y then (x,0,0) else (y,0,0)

BIN
test.jpg

Binary file not shown.

Before

Width:  |  Height:  |  Size: 134 KiB

After

Width:  |  Height:  |  Size: 47 KiB

BIN
test.png

Binary file not shown.

Before

Width:  |  Height:  |  Size: 8.8 KiB

After

Width:  |  Height:  |  Size: 3.7 KiB