camh (empty) → 0.0.1
raw patch · 7 files changed
+304/−0 lines, 7 filesdep +Imlibdep +basedep +bytestringsetup-changed
Dependencies added: Imlib, base, bytestring, terminfo
Files
- .hg_archival.txt +5/−0
- .hgignore +16/−0
- COPYING +25/−0
- Setup.hs +3/−0
- camh.1 +48/−0
- camh.cabal +25/−0
- camh.hs +182/−0
+ .hg_archival.txt view
@@ -0,0 +1,5 @@+repo: ab857342ad48bfaaaf218f888cfdae5caf759dbf+node: 18b2eb9a61e96bab8d1afcafd465f04b77bb87ed+branch: default+latesttag: null+latesttagdistance: 12
+ .hgignore view
@@ -0,0 +1,16 @@+syntax: glob+\#*\#+.\#*+*~+*.bak+*.log+*.orig+*.rej+core+core.*+camh+camh.hi+camh.o+camh.prof+dist/*+
+ COPYING view
@@ -0,0 +1,25 @@+Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. The name of the author may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, +INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING +IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ camh.1 view
@@ -0,0 +1,48 @@+.TH CAMH "1" "August 2013" "CAMH 0.0.1" "User Commands"+.SH NAME+camh \- image-to-text converter for 256-colored terminals+.SH SYNOPSIS+.B camh+[options] [image files]+.SH DESCRIPTION+.PP+\fBCamh\fR is a program to display image files on text terminals.+Terminals are supposed to present 256-colored text.+.PP+Camh is named after its predecessor cam <http://github.com/itchyny/cam>,+plus H as it's reimplemented in Haskell.+.SH OPTIONS+Camh accepts options below:+.TP+.B \-?, \-\-help+Show help message.+.TP+.B \-v, \-\-version+Show version information.+.TP+.B \-h, \-\-height-percent=HEIGHT+Specify output height percent to that of the terminal.+.TP+.B \-H, \-\-height-char=HEIGHT+Specify absolute output height.+.TP+.B \-w, \-\-width-percent=WIDTH+Specify output width percent to that of the terminal.+.TP+.B \-W, \-\-width-char=WIDTH+Specify absolute output width.+.TP+.B \-g, \-\-gamma=GAMMA+Apply gamma correction.+.TP+.B \-b, \-\-brightness=BRIGHTNESS+Apply brightness correction.+.TP+.B \-c, \-\-contrast=CONTRAST+Apply contrast correction.+.SH EXAMPLE+.TP+.B camh \-H 20 \-w 40.5 foo.jpg+Display image file ``foo.jpg'' with its size 20 chars height and width 40.5% to the terminal.+.SH AUTHOR+This manual page is written by Hironao Komatsu <hirkmt@gmail.com>
+ camh.cabal view
@@ -0,0 +1,25 @@+Name: camh+Version: 0.0.1+Synopsis: Image converter to 256-colored text.+Description: Camh is a program to display image files onto text terminals.++License: BSD3+License-file: COPYING+Author: Hironao Komatsu+Maintainer: Hironao Komatsu <hirkmt@gmail.com>+Build-Type: Simple+Cabal-Version: >= 1.8+Stability: alpha+Homepage: not yet available+Bug-Reports: not yet available+Category: Graphics+Tested-With: GHC == 7.6.3++Data-Files: camh.1++Extra-Source-Files: COPYING++Executable camh+ build-depends: base >= 4 && < 5, bytestring, terminfo, Imlib+ Main-is: camh.hs+ Hs-Source-Dirs: .
+ camh.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE OverloadedStrings #-}++import Control.Applicative ((<|>))+import Control.Monad+import Control.Exception (handle)+import Data.Bits+import qualified Data.ByteString.Lazy.Char8 as B+import Data.List (group)+import Data.Word (Word32)+import Foreign.Ptr+import Foreign.Storable+import Graphics.Imlib+import System.Console.GetOpt+import System.Console.Terminfo+import System.Environment (getArgs)+import System.Exit (exitSuccess)+import System.IO (stderr, hPutStrLn)++from24bitColor :: Word32 -> Int+from24bitColor w =+ let p = fromIntegral w+ r = p `shift` (-16) .&. 255+ g = p `shift` (-8) .&. 255+ b = p .&. 255+ in 16 + 36 * (r `quot` 43) + 6 * (g `quot` 43) + (b `quot` 43)++changeBgColor256 :: Int -> B.ByteString+changeBgColor256 col =+ "\x1b[48;5;" `B.append` B.pack (show col) `B.append` "m"++restoreBgColor :: B.ByteString+restoreBgColor = "\x1b[m"++colorLine :: [Word32] -> B.ByteString+colorLine row =+ let g = group row+ e = changeBgColor256 . from24bitColor+ s n = B.replicate n ' '+ f (w:ws) = e w `B.append` s (fromIntegral $ 1 + length ws)+ in B.concat (map f g) `B.append` restoreBgColor++writeImage :: Int -> Int -> Ptr Word32 -> IO ()+writeImage w h p =+ forM_ [0 .. h-1] $ \j -> do+ row <- forM [0 .. w-1] $ \i -> peekElemOff p (w * j + i)+ B.putStrLn $ colorLine row++dealFile :: Config -> FilePath -> IO ()+dealFile conf filename =+ loadImageWithErrorReturn filename >>= \(image, err) ->+ if err == ImlibLoadErrorNone then+ do+ let tw = getWidth conf+ th = getHeight conf++ contextSetImage image+ iw <- imageGetWidth+ ih <- imageGetHeight++ let ratio x y = fromIntegral x / fromIntegral y+ z = ratio tw iw `min` ratio (2 * th) ih+ rw = floor $ fromIntegral iw * z+ rh = floor $ fromIntegral ih * z / 2++ createCroppedScaledImage 0 0 iw ih rw rh >>= contextSetImage++ createColorModifier >>= contextSetColorModifier++ let whenJust (Just a) f = f a+ whenJust Nothing f = return ()+ whenJust (getGamma conf) modifyColorModifierGamma+ whenJust (getBrightness conf) modifyColorModifierBrightness+ whenJust (getContrast conf) modifyColorModifierContrast++ applyColorModifier+ freeColorModifier++ imageWithData $ writeImage rw rh+ freeImage++ contextSetImage image+ freeImage+ else+ hPutStrLn stderr $ "error " ++ show err ++ ": " ++ filename++getTermSize :: IO (Maybe (Int, Int))+getTermSize = handle (const $ return Nothing+ :: SetupTermError -> IO (Maybe a)) $ do+ term <- setupTermFromEnv+ let size = do+ lines <- tiGetNum "lines"+ cols <- tiGetNum "cols"+ return (lines, cols)++ return $ getCapability term size++data Opts = Help+ | Version+ | WidthChr Int+ | HeightChr Int+ | Gamma Double+ | Brightness Double+ | Contrast Double++options :: Config -> [OptDescr Opts]+options conf =+ let tw = getWidth conf+ th = getHeight conf+ in [ Option "?" ["help"] (NoArg Help) "Show this message"+ , Option "v" ["version"] (NoArg Version) "Show version info"+ , Option "W" ["width-char"]+ (ReqArg (WidthChr . read) "WIDTH")+ "Set output width (in chars)"+ , Option "w" ["width-percent"]+ (ReqArg (WidthChr . percent tw . read) "WIDTH")+ "Set output width (in percent)"+ , Option "H" ["height-char"]+ (ReqArg (HeightChr . read) "HEIGHT")+ "Set output height (in chars)"+ , Option "h" ["height-percent"]+ (ReqArg (HeightChr . percent th . read) "HEIGHT")+ "Set output height (in percent)"+ , Option "g" ["gamma"]+ (ReqArg (Gamma . read) "GAMMA")+ "Apply gamma correction"+ , Option "b" ["blightness"]+ (ReqArg (Brightness . read) "BLIGHTNESS")+ "Apply blightness correction"+ , Option "c" ["contrast"]+ (ReqArg (Contrast . read) "CONTRAST")+ "Apply contrast correction" ]++percent :: Int -> Double -> Int+percent v p = floor $ fromIntegral v * p / 100++usage = usageInfo (version ++ "\n\nOptions:") $ options defaultConfig++version = "camh version 0.0.1"++data Config = Config { getWidth :: Int+ , getHeight :: Int+ , getGamma :: Maybe Double+ , getBrightness :: Maybe Double+ , getContrast :: Maybe Double }++defaultConfig = Config { getWidth = 80+ , getHeight = 25+ , getGamma = Nothing+ , getBrightness = Nothing+ , getContrast = Nothing }++getOpts :: Config -> [String] -> IO ([Opts], [String])+getOpts conf args =+ let th = getHeight conf+ tw = getWidth conf+ in case getOpt Permute (options conf) args of+ (o, n, [] ) -> return (o, n)+ (_, _, errs) -> error $ concat errs ++ usage++reduceOpt :: Config -> Opts -> IO Config+reduceOpt conf opts =+ case opts of+ Help -> putStr usage >> exitSuccess+ Version -> putStrLn version >> exitSuccess+ WidthChr w -> return conf { getWidth = w }+ HeightChr h -> return conf { getHeight = h }+ Gamma g -> return conf { getGamma = Just g }+ Brightness b -> return conf { getBrightness = Just b }+ Contrast c -> return conf { getContrast = Just c }++main = do+ s <- getTermSize+ let Just (th, tw) = s <|> Just ( getHeight defaultConfig+ , getWidth defaultConfig )+ conf = defaultConfig { getWidth = tw, getHeight = th-1 }++ (opts, args) <- getArgs >>= getOpts conf++ conf' <- foldM reduceOpt conf opts++ mapM_ (dealFile conf') args+