+{-# LANGUAGE DeriveDataTypeable #-}
+
+module CommandLine (
+ Args(..),
+ apply_args,
+ program_name,
+ show_help)
+where
+
+-- Get the version from Cabal.
+import Paths_spline3 (version)
+import Data.Version (showVersion)
+
+import Data.String.Utils (startswith)
+import System.Console.CmdArgs (
+ CmdArgs,
+ Data,
+ Mode,
+ Typeable,
+ (&=),
+ argPos,
+ cmdArgsApply,
+ cmdArgsMode,
+ def,
+ details,
+ groupname,
+ help,
+ helpArg,
+ program,
+ typ,
+ summary,
+ versionArg
+ )
+
+import System.Console.CmdArgs.Explicit (process)
+import System.Environment (getArgs, withArgs)
+import System.Exit (ExitCode(..), exitWith)
+import System.IO (hPutStrLn, stderr)
+
+import ExitCodes
+
+
+
+data Args =
+ Args { depth :: Int,
+ height :: Int,
+ input :: FilePath,
+ scale :: Int,
+ slice :: Maybe Int,
+ output :: FilePath,
+ width :: Int }
+ deriving (Show, Data, Typeable)
+
+description :: String
+description =
+ "Interpolate volumetric data according to \"Local quasi-interpolation " ++
+ "by cubic C^1 splines on type-6 tetrahedral partitions.\" The defaults " ++
+ "are tailored to the MRI data contained in data/mri.bin from the " ++
+ "Stanford volume data archive at http://graphics.stanford.edu/data/voldata/."
+
+program_name :: String
+program_name = "spline3"
+
+spline3_summary :: String
+spline3_summary =
+ program_name ++ "-" ++ (showVersion version)
+
+depth_help :: String
+depth_help = "The size of the z dimension (default: 109)"
+
+height_help :: String
+height_help = "The size of the y dimension (default: 256)"
+
+scale_help :: String
+scale_help =
+ "The magnification scale. A scale of 2 would result " ++
+ "in an image twice as large as the original. (default: 2)"
+
+slice_help :: String
+slice_help =
+ "The index of the two-dimensional slice to use if no depth is specified"
+
+width_help :: String
+width_help = "The size of the x dimension (default: 256)"
+
+arg_spec :: Mode (CmdArgs Args)
+arg_spec =
+ cmdArgsMode $
+ Args {
+ depth = 109 &= groupname "Dimensions" &= help depth_help,
+ height = 256 &= groupname "Dimensions" &= help height_help,
+ input = def &= typ "INPUT" &= argPos 0,
+ output = def &= typ "OUTPUT" &= argPos 1,
+ scale = 2 &= help scale_help,
+ slice = Nothing &= groupname "2D options" &= help slice_help,
+ width = 256 &= groupname "Dimensions" &= help width_help
+ }
+ &= program program_name
+ &= summary spline3_summary
+ &= details [description]
+ &= helpArg [groupname "Common flags"]
+ &= versionArg [groupname "Common flags"]
+
+-- Infix notation won't work, the arguments are backwards!
+is_missing_arg_error :: String -> Bool
+is_missing_arg_error s =
+ startswith "Requires at least" s
+
+
+show_help :: IO Args
+show_help = withArgs ["--help"] apply_args
+
+parse_args :: IO (CmdArgs Args)
+parse_args = do
+ x <- getArgs
+ let y = process arg_spec x
+ case y of
+ Right result -> return result
+ Left err ->
+ if (is_missing_arg_error err) then
+ -- Start this function over, pretending that --help was
+ -- passed.
+ withArgs ["--help"] parse_args
+ else do
+ hPutStrLn stderr err
+ exitWith (ExitFailure exit_arg_parse_failed)
+
+
+-- | Really get the command-line arguments. This calls 'parse_args'
+-- first to replace the default "wrong number of arguments" error,
+-- and then runs 'cmdArgsApply' on the result to do what the
+-- 'cmdArgs' function usually does.
+apply_args :: IO Args
+apply_args =
+ parse_args >>= cmdArgsApply