drawille 0.1.0.2 → 0.1.0.3
raw patch · 3 files changed
+235/−32 lines, 3 filesdep +fridaydep +terminal-sizedep +vectornew-component:exe:image2termPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependencies added: friday, terminal-size, vector
API changes (from Hackage documentation)
+ System.Drawille: type Canvas = Map (Int, Int) Int
Files
- drawille.cabal +15/−2
- examples/Image2Term.hs +145/−0
- src/System/Drawille.hs +75/−30
drawille.cabal view
@@ -1,8 +1,9 @@ Name: drawille-Version: 0.1.0.2+Version: 0.1.0.3 Category: System Author: Pedro Yamada <tacla.yamada@gmail.com> Maintainer: Pedro Yamada <tacla.yamada@gmail.com>+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
+ examples/Image2Term.hs view
@@ -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
src/System/Drawille.hs view
@@ -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 <tacla.yamada@gmail.com>+-- 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)