diff --git a/drawille.cabal b/drawille.cabal --- a/drawille.cabal +++ b/drawille.cabal @@ -1,8 +1,9 @@ Name: drawille -Version: 0.1.0.2 +Version: 0.1.0.3 Category: System Author: Pedro Yamada Maintainer: Pedro Yamada +Copyright: (c) Pedro Yamada License: GPL-3 License-File: LICENSE Synopsis: A port of asciimoo's drawille to haskell @@ -20,7 +21,7 @@ , containers >=0.5 && <0.6 Executable senoid - Default-Language: Haskell2010 + Default-Language: Haskell2010 HS-Source-Dirs: examples , src Ghc-Options: -Wall @@ -28,6 +29,18 @@ Build-Depends: base >=4 && <5 , containers >=0.5 && <0.6 , AC-Angle >=1.0 && <1.1 + +Executable image2term + Default-Language: Haskell2010 + HS-Source-Dirs: examples + , src + Ghc-Options: -Wall + Main-Is: Image2Term.hs + Build-Depends: base >=4 && <5 + , containers >=0.5 && <0.6 + , friday >=0.1 && <0.2 + , terminal-size >=0.2 && <1 + , vector Test-Suite spec Type: exitcode-stdio-1.0 diff --git a/examples/Image2Term.hs b/examples/Image2Term.hs new file mode 100644 --- /dev/null +++ b/examples/Image2Term.hs @@ -0,0 +1,145 @@ +import Control.Monad (forM_, liftM, unless, when) +import Data.Maybe (isJust) +import qualified Data.Vector.Storable as VS +import Vision.Image (Grey, GreyPixel, InterpolMethod(..), convert, load, + manifestVector, resize, shape) +import Vision.Primitive ((:.)(..), ix2, Z(..)) +import System.Console.Terminal.Size (size, height, width, Window(..)) +import System.Console.GetOpt (ArgDescr(..), ArgOrder(..), getOpt, + OptDescr(..), usageInfo) +import System.Environment (getArgs, getProgName) +import System.Exit (ExitCode(..), exitWith, exitSuccess) +import System.IO (hPutStr, hPutStrLn, stderr) + +import qualified System.Drawille as D + +data Options = Options { optRatio :: Maybe Double + , optThreshold :: Int + , optInvert :: Bool + , optHelp :: Bool + } + deriving(Eq) + +defaultOpts :: Options +defaultOpts = Options { optRatio = Nothing + , optThreshold = 128 + , optInvert = False + , optHelp = False + } + + +options :: [ OptDescr (Options -> Options) ] +options = [ Option "r" ["ratio"] + (ReqArg (\arg opt -> opt { optRatio = Just $ read arg }) + "ratio") + "Image resize ratio" + , Option "t" ["threshold"] + (ReqArg (\arg opt -> opt { optThreshold = read arg }) + "threshold") + "Pixel printing threshold" + , Option "i" ["invert"] + (NoArg (\opt -> opt { optInvert = True})) + "Invert colors" + , Option "h" ["help"] + (NoArg (\opt -> opt { optHelp = True })) + "Display this message" + ] + +main :: IO () +main = do + (genOpts, files, errs) <- liftM (getOpt Permute options) getArgs + let opts = foldr ($) defaultOpts genOpts + + when (not (null errs) || null files) $ + hPutStr stderr "\n" >> + mapM_ (hPutStrLn stderr) errs >> + printUsage >> + exitWith (ExitFailure 1) + + when (optHelp opts) $ + hPutStr stderr "\n" >> + printUsage >> + exitSuccess + + maybeWindow <- size + unless (isJust maybeWindow || isJust (optRatio opts)) $ + hPutStrLn stderr "Couldn't get window size and no ratio was provided" >> + exitWith (ExitFailure 2) + + forM_ files $ \fp -> do + errOrImage <- load Nothing fp + case errOrImage of + Left err -> + hPutStr stderr (show err) >> + exitWith (ExitFailure 3) + Right image -> + let grey = convert image :: Grey + nwindow = getNWindow grey (optRatio opts) maybeWindow in + putStr $ D.frame $ fromImage nwindow + grey + (optThreshold opts) + (optInvert opts) + +printUsage :: IO () +printUsage = do + name <- getProgName + hPutStrLn stderr $ usageInfo ("Usage: " ++ name ++ " [options] files...") + options + +-- | +-- Gets a normalized Window given an image, a Maybe ratio and a Maybe +-- window. +getNWindow :: Grey -> Maybe Double -> Maybe (Window Int) -> Window Int +-- This is the base case. We'll want to resize the window to fit the +-- terminal's width and have its height scaled relative to that. +getNWindow image Nothing (Just window) = window { width = wwid + , height = round whei + } + where Z :. h :. w = shape image + wwid = 2 * width window + whei = fromIntegral h * (fromIntegral wwid / fromIntegral w) :: Double +-- This is the ratio case, in which a factor to scale the image by is +-- given. +getNWindow image (Just ratio) _ = + Window { height = round $ ratio * fromIntegral h + , width = round $ ratio * fromIntegral w + } + where Z :. h :. w = shape image +-- Because we check this is main, this pattern shouldn't ever run. It's +-- expected that one value or the other is provided - I think it'd be more +-- idiomatic to do this in two separate functions. +getNWindow _ Nothing Nothing = error "This shouldn't have happened" + +-- | +-- Creates a canvas from a greyscale image. +fromImage :: Window Int -> Grey -> Int -> Bool -> D.Canvas +fromImage window greyImage threshold invert = VS.ifoldr accCanvas' D.empty imageVector + where resizedImage = resizeToFitWindow window greyImage + imageVector = manifestVector resizedImage + {-# INLINEABLE accCanvas' #-} + accCanvas' = accCanvas threshold (width window) invert + +-- | +-- Gets a canvas coordinate given a canvas' width and a index to the flat +-- vector representation of an image's pixel matrix. +{-# INLINEABLE coord #-} +coord :: Int -> Int -> (Int, Int) +coord w i = (i `rem` w, w - i `div` w) + +-- | +-- Accumulates pixels into a canvas. +{-# INLINEABLE accCanvas #-} +accCanvas :: Int -> Int -> Bool -> Int -> GreyPixel -> D.Canvas -> D.Canvas +accCanvas threshold winW invert idx pix m = + let withinThreshold = pix < fromIntegral threshold + shouldSet = if invert then not withinThreshold else withinThreshold + in if shouldSet + then D.set m (coord winW idx) + else m + +-- | +-- Resizes an image to fit a window. +resizeToFitWindow :: Window Int -> Grey -> Grey +resizeToFitWindow win = resize TruncateInteger (ix2 h w) + where h = height win + w = width win diff --git a/src/System/Drawille.hs b/src/System/Drawille.hs --- a/src/System/Drawille.hs +++ b/src/System/Drawille.hs @@ -1,4 +1,17 @@ -module System.Drawille ( empty -- drawing API +-- | +-- Module : System.Drawille +-- Description : A port of asciimoo's drawille to haskell. +-- Copyright : (c) Pedro Yamada +-- License : GPL-3 +-- +-- Maintainer : Pedro Yamada +-- Stability : stable +-- Portability : non-portable (not tested on multiple environments) +-- +-- This module enables using UTF-8 braille characters to render drawings onto +-- the console. +module System.Drawille ( Canvas + , empty -- drawing API , frame , get , set @@ -16,59 +29,91 @@ import Data.Bits ((.|.), (.&.), complement, xor) import Data.Char (chr) +-- | +-- The Canvas type. Represents a canvas, mapping points to their braille +-- "px" codes. type Canvas = M.Map (Int, Int) Int -pxMap :: Num a => [[a]] -pxMap = [ [0x01, 0x08] - , [0x02, 0x10] - , [0x04, 0x20] - , [0x40, 0x80] - ] - -pxOff :: Num a => a -pxOff = 0x2800 - -toPx :: (Int, Int) -> Int -toPx (px, py) = pxMap !! mod py 4 !! mod px 2 - -toPs :: (Int, Int) -> (Int, Int) -toPs (x, y) = (x `div` 2, y `div` 4) - +-- | +-- The empty canvas, to be drawn upon. empty :: Canvas empty = M.empty +-- | +-- Pretty prints a canvas as a `String`, ready to be printed. frame :: Canvas -> String frame c = unlines $ map (row c mX) [minY..maxY] where keys = M.keys c mX = maximumMinimum $ map fst keys (maxY, minY) = maximumMinimum $ map snd keys -row :: Canvas -> (Int, Int) -> Int -> String -row c (maxX, minX) y = map helper vs - where vs = map (\x -> M.lookup (x, y) c) [minX..maxX] - helper (Just v) = chr $ v + pxOff - helper Nothing = ' ' - -set :: Canvas -> (Int, Int) -> Canvas -set c p = M.insertWith (.|.) (toPs p) (toPx p) c - +-- | +-- Gets the current state for a coordinate in a canvas. get :: Canvas -> (Int, Int) -> Bool get c p = case M.lookup (toPs p) c of Just x -> let px = toPx p in x .&. px == px Nothing -> False +-- | +-- Sets a coordinate in a canvas. +set :: Canvas -> (Int, Int) -> Canvas +set c p = M.insertWith (.|.) (toPs p) (toPx p) c + +-- | +-- Unsets a coordinate in a canvas. unset :: Canvas -> (Int, Int) -> Canvas unset c p = M.insertWith (.&.) (toPs p) ((complement . toPx) p) c +-- | +-- Toggles the state of a coordinate in a canvas toggle :: Canvas -> (Int, Int) -> Canvas toggle c p = M.insertWith xor (toPs p) (toPx p) c +-- | +-- Creates a canvas from a List of coordinates fromList :: [(Int, Int)] -> Canvas fromList = foldr (flip set) empty +-- | +-- Pretty prints a single canvas' row into a `String`. +row :: Canvas -> (Int, Int) -> Int -> String +row c (maxX, minX) y = map helper vs + where vs = map (\x -> M.lookup (x, y) c) [minX..maxX] + helper (Just v) = chr $ v + pxOff + helper Nothing = ' ' + +-- | +-- A mapping between local coordinates, inside of a single cell, and each +-- of the braille characters they correspond to (with an offset). +pxMap :: Num a => [[a]] +pxMap = [ [0x01, 0x08] + , [0x02, 0x10] + , [0x04, 0x20] + , [0x40, 0x80] + ] + +-- | +-- The offset between the values in the `pxMap`, which have nice binary +-- properties between each other, and the actual braille character codes. +pxOff :: Num a => a +pxOff = 0x2800 + +-- | +-- Converts a coordinate into its local braille "px" code, using the +-- `pxMap`. +toPx :: (Int, Int) -> Int +toPx (px, py) = pxMap !! mod py 4 !! mod px 2 + +-- | +-- Helper to convert a coordinate to its corespondent in the bigger braille +-- grid's size +toPs :: (Int, Int) -> (Int, Int) +toPs (x, y) = (x `div` 2, y `div` 4) + +-- | +-- Gets the maximum and minimum values of a list and return them in +-- a tuple of `(maximumValue, minimumValue)`. maximumMinimum :: Ord a => [a] -> (a, a) -maximumMinimum (x:xs) = foldr maxMin (x, x) xs maximumMinimum [] = error "Empty list" - -maxMin :: Ord a => a -> (a, a) -> (a, a) -maxMin x (b, s) = (max x b, min x s) +maximumMinimum (x:xs) = foldr maxMin (x, x) xs + where maxMin y (b, s) = (max y b, min y s)