diff --git a/.hg_archival.txt b/.hg_archival.txt new file mode 100644 --- /dev/null +++ b/.hg_archival.txt @@ -0,0 +1,5 @@ +repo: ab857342ad48bfaaaf218f888cfdae5caf759dbf +node: 18b2eb9a61e96bab8d1afcafd465f04b77bb87ed +branch: default +latesttag: null +latesttagdistance: 12 diff --git a/.hgignore b/.hgignore new file mode 100644 --- /dev/null +++ b/.hgignore @@ -0,0 +1,16 @@ +syntax: glob +\#*\# +.\#* +*~ +*.bak +*.log +*.orig +*.rej +core +core.* +camh +camh.hi +camh.o +camh.prof +dist/* + diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +import Distribution.Simple +main = defaultMain diff --git a/camh.1 b/camh.1 new file mode 100644 --- /dev/null +++ b/camh.1 @@ -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 , +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 diff --git a/camh.cabal b/camh.cabal new file mode 100644 --- /dev/null +++ b/camh.cabal @@ -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 +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: . diff --git a/camh.hs b/camh.hs new file mode 100644 --- /dev/null +++ b/camh.hs @@ -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 +