]> gitweb.michael.orlitzky.com - spline3.git/commitdiff
Use cmdargs to parse command-line arguments.
authorMichael Orlitzky <michael@orlitzky.com>
Tue, 21 Aug 2012 19:55:01 +0000 (15:55 -0400)
committerMichael Orlitzky <michael@orlitzky.com>
Tue, 21 Aug 2012 19:55:01 +0000 (15:55 -0400)
Allow selection of 2d/3d processing from the command-line.

src/CommandLine.hs [new file with mode: 0644]
src/ExitCodes.hs [new file with mode: 0644]
src/MRI.hs
src/Main.hs

diff --git a/src/CommandLine.hs b/src/CommandLine.hs
new file mode 100644 (file)
index 0000000..6479145
--- /dev/null
@@ -0,0 +1,135 @@
+{-# 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
diff --git a/src/ExitCodes.hs b/src/ExitCodes.hs
new file mode 100644 (file)
index 0000000..47cd15c
--- /dev/null
@@ -0,0 +1,15 @@
+-- | All failure exit codes that the program can return.
+module ExitCodes
+where
+
+-- | Indicates that the command-line arguments could not be parsed.
+exit_arg_parse_failed :: Int
+exit_arg_parse_failed = 1
+
+-- | One of the arguments that should be positive wasn't.
+exit_arg_not_positive :: Int
+exit_arg_not_positive = 2
+
+-- | One of the arguments wasn't within the allowable bounds.
+exit_arg_out_of_bounds :: Int
+exit_arg_out_of_bounds = 3
index 5cca1aed9ffcd2ab9250cd5883326fd45a59f087..1c244c1c81c8b738b95bcf5385d52290e536082a 100644 (file)
@@ -7,8 +7,6 @@
 module MRI (
   flip_x,
   flip_y,
-  mri_shape,
-  mri_slice3d,
   read_word16s,
   round_array,
   swap_bytes,
@@ -30,27 +28,12 @@ import Data.Array.Repa.IO.BMP                   as R (writeImageToBMP)
 
 import Values
 
-mri_depth :: Int
-mri_depth = 109
-
-mri_width :: Int
-mri_width = 256
-
-mri_height :: Int
-mri_height = 256
-
-mri_shape :: DIM3
-mri_shape = (Z :. mri_depth :. mri_height :. mri_width)
-
 mri_lower_threshold :: Double
 mri_lower_threshold = 1400
 
 mri_upper_threshold :: Double
 mri_upper_threshold = 2500
 
-mri_slice3d :: DIM3
-mri_slice3d = (Z :. 1 :. mri_height  :. mri_width)
-
 -- | RawData is an array of words (16 bits), as contained in the MRI
 --   data files.
 type RawData sh = Array U sh Word16
@@ -63,8 +46,8 @@ type ColorData sh = Array U sh RGB
 
 
 {-# INLINE read_word16s #-}
-read_word16s :: FilePath -> IO RawData3D
-read_word16s path = do
+read_word16s :: FilePath -> DIM3 -> IO RawData3D
+read_word16s path mri_shape = do
   arr <- R.readArrayFromStorableFile path mri_shape
   c   <- R.copyP arr
   now $ c
@@ -105,17 +88,17 @@ round_array =
   R.map round
 
 
-flip_y :: Source r Word16 => Array r DIM3 Word16 -> Array D DIM3 Word16
-flip_y arr =
+flip_y :: Source r Word16 => Int -> Array r DIM3 Word16 -> Array D DIM3 Word16
+flip_y height arr =
   R.unsafeTraverse arr id
               (\get (Z :. z :. y :. x) ->
-                   get (Z :. z :. (mri_height - 1) - y :. x))
+                   get (Z :. z :. (height - 1) - y :. x))
 
-flip_x :: Source r Word16 => Array r DIM3 Word16 -> Array D DIM3 Word16
-flip_x arr =
+flip_x :: Source r Word16 => Int -> Array r DIM3 Word16 -> Array D DIM3 Word16
+flip_x width arr =
   R.unsafeTraverse arr id
               (\get (Z :. z :. y :. x) ->
-                   get (Z :. z :. y :. (mri_width - 1) - x))
+                   get (Z :. z :. y :. (width - 1) - x))
 
 
 {-# INLINE write_word16s #-}
index 1a716836c5db52096e7c15e6caaf45e307ba83cc..951c9c36bf7a819b51f758de42a158484e00d90b 100644 (file)
@@ -1,15 +1,22 @@
+{-# LANGUAGE RecordWildCards, DoAndIfThenElse #-}
+
 module Main
 where
 
+import Data.Maybe (fromJust)
+import Control.Monad (when)
 import qualified Data.Array.Repa as R
-import System.Environment (getArgs)
+import Data.Maybe (isJust)
+import GHC.Conc (getNumProcessors, setNumCapabilities)
+import System.IO (hPutStrLn, stderr)
+import System.Exit (exitSuccess, exitWith, ExitCode(..))
 
+import CommandLine (Args(..), apply_args)
+import ExitCodes
 import Grid (zoom)
 import MRI (
   flip_x,
   flip_y,
-  mri_shape,
-  mri_slice3d,
   read_word16s,
   round_array,
   swap_bytes,
@@ -18,43 +25,91 @@ import MRI (
   z_slice
   )
 
-in_file :: FilePath
-in_file = "./data/mri.bin"
+
+validate_args :: Args -> IO ()
+validate_args Args{..} = do
+  when (scale <= 0) $ do
+    hPutStrLn stderr "ERROR: scale must be greater than zero."
+    exitWith (ExitFailure exit_arg_not_positive)
+
+  when (width <= 0) $ do
+    hPutStrLn stderr "ERROR: width must be greater than zero."
+    exitWith (ExitFailure exit_arg_not_positive)
+
+  when (height <= 0) $ do
+    hPutStrLn stderr "ERROR: height must be greater than zero."
+    exitWith (ExitFailure exit_arg_not_positive)
+
+  when (depth <= 0) $ do
+    hPutStrLn stderr "ERROR: depth must be greater than zero."
+    exitWith (ExitFailure exit_arg_not_positive)
+
+  case slice of
+    Just s ->
+      when (s < 0 || s > depth) $ do
+        hPutStrLn stderr "ERROR: slice must be between zero and depth."
+        exitWith (ExitFailure exit_arg_out_of_bounds)
+    Nothing -> return ()
 
 
 main :: IO ()
-main = main3d
+main = do
+  args@Args{..} <- apply_args
+  -- validate_args will simply exit if there's a problem.
+  validate_args args
+
+  -- The first thing we do is set the number of processors. We get the
+  -- number of processors (cores) in the machine with
+  -- getNumProcessors, and set it with setNumCapabilities. This is so
+  -- we don't have to pass +RTS -Nfoo on the command line every time.
+  num_procs <- getNumProcessors
+  setNumCapabilities num_procs
 
-main3d :: IO ()
-main3d = do
-  (s:_) <- getArgs
-  let scale = read s :: Int
+  -- Determine whether we're doing 2d or 3d. If we're given a slice,
+  -- assume 2d.
+  let mri_shape = (R.Z R.:. depth R.:. height R.:. width) :: R.DIM3
+
+  if (isJust slice) then
+    main2d args mri_shape
+  else
+    main3d args mri_shape
+
+  exitSuccess
+
+  where
+
+
+
+main3d :: Args -> R.DIM3 -> IO ()
+main3d Args{..} mri_shape = do
   let zoom_factor = (scale, scale, scale)
-  let out_file = "output.bin"
-  arr <- read_word16s in_file
+  arr <- read_word16s input mri_shape
   let arr'          = swap_bytes arr
   let arrMRI        = R.reshape mri_shape arr'
   dbl_data <- R.computeUnboxedP $ R.map fromIntegral arrMRI
-  output <- zoom dbl_data zoom_factor
-  word16_output <- R.computeUnboxedP $ round_array output
-  write_word16s out_file word16_output
-  return ()
+  raw_output <- zoom dbl_data zoom_factor
+  word16_output <- R.computeUnboxedP $ round_array raw_output
+  write_word16s output word16_output
 
 
-main2d :: IO ()
-main2d = do
-  (s:_) <- getArgs
-  let scale = read s :: Int
+main2d :: Args -> R.DIM3 -> IO ()
+main2d Args{..} mri_shape = do
   let zoom_factor = (1, scale, scale)
-  let out_file = "output.bmp"
-  arr <- read_word16s in_file
-  arrSlice <- R.computeUnboxedP $ z_slice 50 $ flip_x $ flip_y $ swap_bytes arr
+  arr <- read_word16s input mri_shape
+  arrSlice <- R.computeUnboxedP
+               $ z_slice (fromJust slice)
+               $ flip_x width
+               $ flip_y height
+               $ swap_bytes arr
   let arrSlice' = R.reshape mri_slice3d arrSlice
 
   -- If zoom isn't being inlined we need to extract the slice before hand,
   -- and convert it to the require formed.
   dbl_data      <- R.computeUnboxedP $ R.map fromIntegral arrSlice'
-  output        <- zoom dbl_data zoom_factor
-  arrSlice0     <- R.computeUnboxedP $ z_slice 0 output
-  
-  write_values_slice_to_bitmap arrSlice0 out_file
+  raw_output    <- zoom dbl_data zoom_factor
+  arrSlice0     <- R.computeUnboxedP $ z_slice 0 raw_output
+
+  write_values_slice_to_bitmap arrSlice0 output
+  where
+    mri_slice3d :: R.DIM3
+    mri_slice3d = (R.Z R.:. 1 R.:. height  R.:. width)