{-| Module : Main Copyright : (c) 2016 Brian W Bush License : MIT Maintainer : Brian W Bush Stability : Stable Portability : Portable Main entry. -} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RecordWildCards #-} module Main ( -- * Main entry. main ) where import Control.Monad (unless) import Data.Data (Data) import Data.Typeable (Typeable) import Data.Version (showVersion) import Data.Yaml (decodeFile, encodeFile) import Paths_color_counter (version) import System.Console.CmdArgs ((&=), argPos, auto, cmdArgs, def, details, help, modes, name, opt, program, summary, typ, typFile) import Vision.Image (RGBPixel(..)) import Vision.Image.IO (readRGB, writeRGB) #ifdef CAPTURE import Vision.Image.IO.Capture (captureRGB) #endif import qualified Data.Default as D (def) import qualified Vision.Image.Color.Detection as C (ColorConfiguration, analyze, quantize, effectiveTally) stringVersion :: String stringVersion = showVersion version ++ " (2016)" main :: IO () main = do command <- cmdArgs imager dispatch command imager :: Imager imager = modes [ process , defaults #ifdef CAPTURE , capture #endif ] &= program "color-counter" &= summary ("Color Counter, Version " ++ stringVersion) &= help "This tool detects and counts colors in an image or in a camera feed." data Imager = Process { configuration :: FilePath , input :: FilePath #ifdef CAPTURE , device :: Bool #endif , analyze :: FilePath , tally :: FilePath , quantize :: FilePath , width :: Maybe Int , height :: Maybe Int } | Defaults { configuration :: FilePath } #ifdef CAPTURE | Capture { input :: FilePath , output :: FilePath , width :: Maybe Int , height :: Maybe Int } #endif deriving (Data, Show, Typeable) process :: Imager process = Process { configuration = def &= typFile &= help "YAML or JSON configuration file" , input = def &= opt "/dev/stdin" &= typ "INPUT_IMAGE" &= argPos 0 #ifdef CAPTURE , device = def &= typ "BOOLEAN" &= help "the input is a Video for Linux device instead of a file" #endif , analyze = def &= opt "/dev/stdout" &= typFile &= help "tab-separated-value file for pixel-by-pixel analysis" , tally = def &= opt "/dev/stdout" &= typFile &= help "tab-separated-value file for counts of pixels, by color" , quantize = def &= typFile &= help "image file with quantized colors" , width = def &= help "width of output image" , height = def &= help "height of output image" } &= name "process" &= help "Process an image." &= details ["The input image must in a standard format like JPEG or PNG. The analyze flag outputs the RGB and CIE-LAB values for each pixel, along with the color detected there. The tally flag outputs a histogram of the colors detected. The quantize flag outputs an image where the pixels have been replaced by the colors detected there. The file extension must be that of a common format like PNG."] &= auto defaults :: Imager defaults = Defaults { configuration = def &= opt "/dev/stdout" &= typFile &= help "YAML or JSON configuration file" } &= name "defaults" &= help "Write a default configuration file." &= details ["The default configuration file is written in YAML format. SVG names are used to specify colors. The 'svgDefault' field specifies the color to be used when no color is detected. Each of the entries in 'colorSpecifications' specifies how to detect the color given by 'svgColor'. The 'labVertex' and 'labDirection' fields specify a half plane in CIE LAB color space. The given color is considered to be detected with probability 'efficiency' if its distance into the half plane is at least 'labThreshold'."] #ifdef CAPTURE capture :: Imager capture = Capture { input = def &= typ "DEVICE" &= argPos 0 , output = def &= typ "OUTPUT_IMAGE" &= argPos 1 , width = def &= help "width of output image" -- FIXME: This does not appear in the help message. , height = def &= help "height of output image" -- FIXME: This does not appear in the help message. } &= name "capture" &= help "Capture an image from a device." &= details ["The input must be a Video for Linux devices such as /dev/video0. The file extension for the output must be that of a common format like PNG."] #endif dispatch :: Imager -> IO () dispatch Process{..} = do Just configuration' <- if null configuration then return (Just D.def) else decodeFile configuration :: IO (Maybe (C.ColorConfiguration Double)) image <- #ifdef CAPTURE if device then captureRGB input (width, height) else readRGB input #else readRGB input #endif unless (null analyze) $ writeFile analyze $ unlines $ (("Red" +++ "Green" +++ "Blue" +++ "L" +++ "A" +++ "B" +++ "Color") :) $ map (\(RGBPixel{..}, (l, a, b), color) -> show rgbRed +++ show rgbGreen +++ show rgbBlue +++ show l +++ show a +++ show b +++ color) $ C.analyze configuration' image unless (null tally) $ writeFile tally $ unlines $ (("Color" +++ "Pixels") :) $ map (\(color, count) -> color +++ show count) $ C.effectiveTally configuration' image unless (null quantize) $ writeRGB True (width, height) quantize $ C.quantize configuration' image dispatch Defaults{..} = encodeFile configuration (D.def :: C.ColorConfiguration Double) #ifdef CAPTURE dispatch Capture{..} = do image <- captureRGB input (width, height) writeRGB True (width, height) output image #endif infixr 5 +++ (+++) :: String -> String -> String x +++ y = x ++ "\t" ++ y