X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FMain.hs;h=6848ff86264c3fc461e554cc2067cd6f312db2d4;hb=0c411010bfcb83bc010d506d30dbac35a0082ae4;hp=9742a1f096d5bc6e1ec6946e7b968eeb846a641e;hpb=374082b271180b6ffc64d49c334ace155a196d59;p=spline3.git diff --git a/src/Main.hs b/src/Main.hs index 9742a1f..6848ff8 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,78 +1,126 @@ +{-# LANGUAGE RecordWildCards, DoAndIfThenElse #-} + module Main where +import Data.Maybe (fromJust) +import Control.Monad (when) import qualified Data.Array.Repa as R -import qualified Data.Array.Repa.IO.BMP as R (writeComponentsToBMP) -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 Volumetric ( + bracket_array, + flip_x, + flip_y, + read_word16s, + round_array, + swap_bytes, + write_values_to_bmp, + write_word16s, + z_slice + ) + + +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 () -import Grid (make_grid, zoom) -import MRI -import Values (drop_z, zoom_shape) main :: IO () main = do - (s:_) <- getArgs - let scale = read s :: Int - let zoom_factor = (1, scale, scale) - let out_file = "output.bmp" - arr <- read_word16s in_file - let arr' = swap_bytes arr - let arrInv = flip_x $ flip_y arr' - let arrSlice = z_slice3 50 arrInv - let dbl_data = R.map fromIntegral arrSlice - let g = make_grid 1 dbl_data - let output = zoom g zoom_factor - let arrBrack = bracket_array output - print $ "arrBrack extent:" ++ (show $ R.extent arrBrack) - let arrBrack' = z_slice 1 arrBrack - print $ "arrBrack' extent:" ++ (show $ R.extent arrBrack') - let mri_slice2d = drop_z $ zoom_shape zoom_factor mri_slice3d - let colors = values_to_colors $ R.reshape mri_slice2d - $ R.map fromIntegral arrBrack' - let routput = R.map (\(red, _, _) -> red) colors - let goutput = R.map (\(_, green, _) -> green) colors - let boutput = R.map (\(_, _, blue) -> blue) colors - R.writeComponentsToBMP out_file routput goutput boutput - - -in_file :: FilePath -in_file = "./data/mri.bin" - -main3d :: IO () -main3d = do - (s:_) <- getArgs - let scale = read s :: Int + 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 + + -- Determine whether we're doing 2d or 3d. If we're given a slice, + -- assume 2d. + let shape = (R.Z R.:. depth R.:. height R.:. width) :: R.DIM3 + + if (isJust slice) then + main2d args shape + else + main3d args shape + + exitSuccess + + where + + + +main3d :: Args -> R.DIM3 -> IO () +main3d Args{..} shape = do let zoom_factor = (scale, scale, scale) - let out_file = "output.bin" - arr <- read_word16s in_file - let arr' = swap_bytes arr --- let arrInv = flip_x $ flip_y arr' - let arrMRI = R.reshape mri_shape arr' - let dbl_data = R.force $ R.map fromIntegral arrMRI - let g = make_grid 1 dbl_data - let output = zoom g zoom_factor - let word16_output = bracket_array output - write_word16s out_file word16_output - -main2d :: IO () -main2d = do - (s:_) <- getArgs - let scale = read s :: Int + arr <- read_word16s input shape + let arr_swapped = swap_bytes arr + let arr_shaped = R.reshape shape arr_swapped + dbl_data <- R.computeUnboxedP $ R.map fromIntegral arr_shaped + raw_output <- zoom dbl_data zoom_factor + let word16_output = round_array raw_output + -- Switch the bytes order back to what it was. This lets us use the + -- same program to view the input/output data. + swapped_output <- R.computeUnboxedP $ swap_bytes word16_output + write_word16s output swapped_output + + +main2d :: Args -> R.DIM3 -> IO () +main2d Args{..} shape = do let zoom_factor = (1, scale, scale) - let out_file = "output.bmp" - arr <- read_word16s in_file - let arr' = swap_bytes arr - let arrInv = flip_x $ flip_y arr' - let arrSlice = z_slice 50 arrInv - let arrSlice' = R.reshape mri_slice3d arrSlice - let dbl_data = R.map fromIntegral arrSlice' - let g = make_grid 1 dbl_data - let output = zoom g zoom_factor - let arrBrack = bracket_array output - let mri_slice2d = drop_z $ zoom_shape zoom_factor mri_slice3d - let colors = values_to_colors $ R.reshape mri_slice2d - $ R.map fromIntegral arrBrack - let routput = R.map (\(red, _, _) -> red) colors - let goutput = R.map (\(_, green, _) -> green) colors - let boutput = R.map (\(_, _, blue) -> blue) colors - R.writeComponentsToBMP out_file routput goutput boutput + arr <- read_word16s input shape + arrSlice <- R.computeUnboxedP + $ z_slice (fromJust slice) + $ flip_x width + $ flip_y height + $ swap_bytes arr + let arrSlice' = R.reshape 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' + raw_output <- zoom dbl_data zoom_factor + arrSlice0 <- R.computeUnboxedP $ z_slice 0 raw_output + + -- Make doubles from the thresholds which are given as Ints. + let lt = fromIntegral lower_threshold + let ut = fromIntegral upper_threshold + + let arr_bracketed = bracket_array lt ut arrSlice0 + values <- R.computeUnboxedP $ R.map fromIntegral arr_bracketed + write_values_to_bmp output values + + where + slice3d :: R.DIM3 + slice3d = (R.Z R.:. 1 R.:. height R.:. width)