isiz (empty) → 0.0.1
raw patch · 6 files changed
+272/−0 lines, 6 filesdep +basedep +gtk3
Dependencies added: base, gtk3
Files
- .hg_archival.txt +5/−0
- .hgignore +12/−0
- COPYING +25/−0
- isiz.cabal +19/−0
- src/PixbufExtras.hs +30/−0
- src/isiz.hs +181/−0
+ .hg_archival.txt view
@@ -0,0 +1,5 @@+repo: 6a8148a175dcc23043059d4229a0e1ae3745688f+node: e993863c51c531869ca224a56d6657c494088af5+branch: default+latesttag: null+latesttagdistance: 2
+ .hgignore view
@@ -0,0 +1,12 @@+syntax: glob+\#*\#+.\#*+*~+*.bak+*.log+*.orig+*.rej+core+core.*+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.
+ isiz.cabal view
@@ -0,0 +1,19 @@+Name: isiz+Version: 0.0.1+Synopsis: A program to show the size of image and whether suitable for wallpaper.+License: BSD3+License-file: COPYING+Author: Hironao Komatsu+Maintainer: Hironao Komatsu <hirkmt@gmail.com>+Build-Type: Simple+Cabal-Version: >= 1.8+Stability: alpha+Category: Graphics+Tested-With: GHC == 7.6.3++Extra-Source-Files: COPYING++Executable isiz+ build-depends: base >= 4 && < 5, gtk3+ Main-is: isiz.hs+ Hs-Source-Dirs: src
+ src/PixbufExtras.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# OPTIONS -Wall -O #-}++module PixbufExtras (pixbufGetSizeInfoFile) where++import Control.Applicative (Applicative, liftA, pure)+import Data.Word+import Foreign.C+import Foreign.Marshal.Alloc+import Foreign.Ptr+import Foreign.Storable+import Graphics.UI.Gtk.Gdk.Pixbuf ()++-- | Read file metadata and return image size+pixbufGetSizeInfoFile :: FilePath -> IO (Maybe (Int, Int))+pixbufGetSizeInfoFile fp =+ withCString fp $ \cfp ->+ alloca $ \wp -> alloca $ \hp -> pixbufGetFileInfo cfp wp hp+ >>= ptrMaybeA (\_ -> peek wp >>= \w+ -> peek hp >>= \h+ -> return (w, h))++-- FIXME: the return value shall not be a Ptr to a Word.+foreign import ccall "static gdk/gdkpixbuf.h gdk_pixbuf_get_file_info"+ pixbufGetFileInfo :: CString -> Ptr Int -> Ptr Int -> IO (Ptr Word)++-- | Apply function if the pointer is not NULL+ptrMaybeA :: Applicative m => (Ptr a -> m b) -> Ptr a -> m (Maybe b)+ptrMaybeA f p | p == nullPtr = pure Nothing+ | otherwise = liftA Just $ f p
+ src/isiz.hs view
@@ -0,0 +1,181 @@+{-# OPTIONS -O -Wall #-}++import Control.Applicative ((<$>), (<*>), (<|>))+import Control.Monad (foldM, join)+import Data.List (find)+import Data.Maybe (catMaybes)+import System.Console.GetOpt+import System.Environment (getArgs)+import System.Exit (ExitCode (..), exitSuccess, exitWith)+import Text.Printf+import PixbufExtras++data RunMode = RunModeDefault+ | RunModeList Bool+ | RunModeSilent Bool+ deriving (Eq, Show)++data ImageSize = ZeroSized+ | Ratio4_3+ | Ratio5_4+ | Ratio16_9+ | Ratio16_10+ | Ratio21_9+ | NonStdHVGA+ | NonStdWVGA+ | NonStdWVGAPlus+ | NonStdFWVGA+ | NonStdWSVGA+ | NonStdWXGA+ | NonStdUnnamed+ | NonStdWSXGA+ | OtherSize+ deriving (Eq, Show)++sizeName :: ImageSize -> String+sizeName ZeroSized = "(zero-sized)"+sizeName Ratio4_3 = "4:3"+sizeName Ratio5_4 = "5:4"+sizeName Ratio16_9 = "16:9"+sizeName Ratio16_10 = "16:10"+sizeName Ratio21_9 = "21:9"+sizeName NonStdHVGA = "HVGA"+sizeName NonStdWVGA = "WVGA"+sizeName NonStdWVGAPlus = "WVGA+"+sizeName NonStdFWVGA = "FWVGA"+sizeName NonStdWSVGA = "WSVGA"+sizeName NonStdWXGA = "WXGA"+sizeName NonStdUnnamed = "(unnamed)"+sizeName NonStdWSXGA = "WSXGA"+sizeName OtherSize = "(other)"++nonStdSizes :: [(Int, Int, ImageSize)]+nonStdSizes = [ ( 480, 320, NonStdHVGA )+ , ( 800, 480, NonStdWVGA )+ , ( 854, 480, NonStdWVGAPlus)+ , ( 864, 480, NonStdFWVGA )+ , (1024, 600, NonStdWSVGA )+ , (1280, 768, NonStdWXGA )+ , (1366, 768, NonStdUnnamed )+ , (1280, 854, NonStdWSXGA ) ]++isWallpaper :: ImageSize -> Bool+isWallpaper ZeroSized = False+isWallpaper OtherSize = False+isWallpaper _ = True++checkSize :: Int -> Int -> Maybe ImageSize+checkSize w h+ | w < h = checkSize h w+ | h < 0 = Nothing+ | h == 0 = Just ZeroSized+ | otherwise =+ let ratio = fromIntegral h / fromIntegral w+ minDelta = 1e-2 :: Double+ testD s = abs (ratio - s) < minDelta+ trd (_,_,c) = c+ in case () of+ _ | testD (3/ 4) -> Just Ratio4_3+ _ | testD (4/ 5) -> Just Ratio5_4+ _ | testD (9/16) -> Just Ratio16_9+ _ | testD (5/ 8) -> Just Ratio16_10+ _ | testD (3/ 7) -> Just Ratio21_9+ _ ->+ (trd <$>+ find (\(u, v, _) -> u == w && v == h)+ nonStdSizes) <|> Just OtherSize++-- | read from file and return its size and whether suitable for wallpaper+checkFile :: FilePath -> IO (Maybe (ImageSize, Bool, Int, Int))+checkFile path = do+ mg <- pixbufGetSizeInfoFile path+ let ms = join $ uncurry checkSize <$> mg+ mp = isWallpaper <$> ms+ return $ (\(w, h) s p -> (s, p, w, h)) <$> mg <*> ms <*> mp++-- | flipped <$>+(<$$>) :: Functor m => m a -> (a -> b) -> m b+(<$$>) = flip fmap+infixl 5 <$$>++-- | perform action corresponding to RunMode on each file+checkFiles :: RunMode -> [FilePath] -> IO ()+checkFiles RunModeDefault paths =+ mapM_ (\path ->+ checkFile path >>=+ maybe (printf "%s: read error or not a image file\n" path)+ (\(s, p, w, h) ->+ printf "%s: %s, %s, %dx%d\n" path+ (if p then "wallpaper" else "not wallpaper")+ (sizeName s) w h)) paths+checkFiles (RunModeList v) paths =+ mapM (\path -> do+ res <- checkFile path+ return $ (\(_, p, _, _) ->+ (path, if v then not p else p)) <$> res) paths+ <$$> catMaybes+ <$$> filter snd+ >>= mapM_ (putStrLn . fst)+checkFiles (RunModeSilent v) paths =+ mapM (\path -> do+ res <- checkFile path+ return $ (\(_, p, _, _) ->+ if v then not p else p) <$> res) paths+ <$$> catMaybes+ <$$> and+ >>= \q -> if q then exitSuccess+ else exitWith (ExitFailure 1)++data Opts = Help+ | Version+ | ListMode+ | SilentMode+ | InvPred++options :: [OptDescr Opts]+options = [ Option "h" ["help"] (NoArg Help)+ "Show help message and exit"+ , Option "V" ["version"] (NoArg Version)+ "Show version info and exit"+ , Option "v" ["invert"] (NoArg InvPred)+ "Invert filtering condition for `-l' and `-q'"+ , Option "l" ["list"] (NoArg ListMode)+ "Just list files suitable for wallpapers"+ , Option "q" ["quiet"] (NoArg SilentMode)+ "Return successful status if all images suitable" ]++-- | parse commandline arguments+getOpts :: [String] -> IO (RunMode, [String])+getOpts argv =+ case getOpt Permute options argv of+ (o, n, [] ) -> foldOpts o <$$> toRunMode <$$> (\o' -> (o', n))+ (_, _, errs) -> ioError (userError $ concat errs)+ where foldOpts :: [Opts] -> IO (RunMode, Bool)+ foldOpts =+ foldM (\(m, v) e ->+ case e of+ Help -> putStrLn usage+ >> exitSuccess+ >> return (m, v)+ Version -> putStrLn version+ >> exitSuccess+ >> return (m, v)+ ListMode -> return (RunModeList False, v)+ SilentMode -> return (RunModeSilent False, v)+ InvPred -> return (m, not v))+ (RunModeDefault, False)+ toRunMode :: (RunMode, Bool) -> RunMode+ toRunMode (m, v) = case m of+ RunModeDefault -> RunModeDefault+ RunModeList _ -> RunModeList v+ RunModeSilent _ -> RunModeSilent v++usage :: String+usage = usageInfo "isiz [options] [files]\n\nOptions:" options++version :: String+version = "isiz version 0.0.1"++main :: IO ()+main = getArgs >>= getOpts >>= uncurry checkFiles+