X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FVolumetric.hs;h=0d1dfaac641773cbc35e0f39147e6359f23613b1;hb=83ef0aaeae074756e4ee90d72d3e27e74e136061;hp=24bc13bb464ca524c0cfc280332c1b7e3ce87a5d;hpb=02df1d5763a5d2bfe750bbc30b5c001ee9b23b17;p=spline3.git diff --git a/src/Volumetric.hs b/src/Volumetric.hs index 24bc13b..0d1dfaa 100644 --- a/src/Volumetric.hs +++ b/src/Volumetric.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} + -- | The Volumetric module contains functions for manipulating the -- volumetric data files found at, -- @@ -13,21 +14,36 @@ module Volumetric ( swap_bytes, write_values_to_bmp, write_word16s, - z_slice - ) + z_slice ) where -import Data.Word -import Data.Bits -import Data.Array.Repa as R -import Data.Array.Repa.Eval as R (now) -import Data.Array.Repa.Repr.Unboxed as R -import Data.Array.Repa.IO.Binary as R -import Data.Array.Repa.Algorithms.ColorRamp as R -import Data.Array.Repa.Operators.Traversal as R (unsafeTraverse) -import Data.Array.Repa.IO.BMP as R (writeImageToBMP) +import Data.Word ( Word8, Word16 ) +import Data.Bits ( (.&.), (.|.), shift ) +import qualified Data.Array.Repa as Repa ( map ) +import Data.Array.Repa ( + (:.)( (:.) ), + Array, + D, + DIM2, + DIM3, + Shape, + Source, + U, + Z( Z ), + computeUnboxedP, + copyP, + slice ) +import Data.Array.Repa.Algorithms.ColorRamp ( rampColorHotToCold ) +import Data.Array.Repa.Eval ( now ) +import Data.Array.Repa.IO.Binary ( + readArrayFromStorableFile, + writeArrayToStorableFile ) +import Data.Array.Repa.IO.BMP ( writeImageToBMP ) +import Data.Array.Repa.Operators.Traversal ( unsafeTraverse ) +import Data.Array.Repa.Slice ( All( All ), Any( Any ) ) + +import Values ( Values, Values2D ) -import Values -- | RawData is an array of words (16 bits), as contained in the -- volumetric data files. @@ -43,9 +59,9 @@ type ColorData sh = Array U sh RGB {-# INLINE read_word16s #-} read_word16s :: FilePath -> DIM3 -> IO RawData3D read_word16s path shape = do - arr <- R.readArrayFromStorableFile path shape - c <- R.copyP arr - now $ c + arr <- readArrayFromStorableFile path shape + c <- copyP arr + now c @@ -53,7 +69,7 @@ bracket :: Double -> Double -> Double -> Word16 bracket lower_threshold upper_threshold x | x < lower_threshold = 0 | x > upper_threshold = 255 - | otherwise = truncate (r * 255) + | otherwise = truncate (r * 255) where numerator = x - lower_threshold denominator = upper_threshold - lower_threshold @@ -69,36 +85,36 @@ flip16 xx = swap_bytes :: (Shape sh, Source r Word16) => Array r sh Word16 -> Array D sh Word16 swap_bytes = - R.map flip16 + Repa.map flip16 bracket_array :: Shape sh => Double -> Double -> Values sh -> Array D sh Word16 bracket_array lt ut = - R.map (bracket lt ut) + Repa.map (bracket lt ut) {-# INLINE round_array #-} round_array :: Shape sh => Values sh -> Array D sh Word16 round_array = - R.map round + Repa.map round flip_y :: Source r Word16 => Int -> Array r DIM3 Word16 -> Array D DIM3 Word16 flip_y height arr = - R.unsafeTraverse arr id + unsafeTraverse arr id (\get (Z :. z :. y :. x) -> get (Z :. z :. (height - 1) - y :. x)) flip_x :: Source r Word16 => Int -> Array r DIM3 Word16 -> Array D DIM3 Word16 flip_x width arr = - R.unsafeTraverse arr id + unsafeTraverse arr id (\get (Z :. z :. y :. x) -> get (Z :. z :. y :. (width - 1) - x)) {-# INLINE write_word16s #-} write_word16s :: (Shape sh) => FilePath -> (RawData sh) -> IO () -write_word16s = R.writeArrayToStorableFile +write_word16s = writeArrayToStorableFile @@ -108,7 +124,7 @@ write_word16s = R.writeArrayToStorableFile -- values_to_colors :: (Shape sh) => (Values sh) -> IO (ColorData sh) values_to_colors arr = - R.computeUnboxedP $ R.map (truncate_rgb . ramp_it) arr + computeUnboxedP $ Repa.map (truncate_rgb . ramp_it) arr where ramp_it :: Double -> (Double, Double, Double) ramp_it x = @@ -121,17 +137,17 @@ values_to_colors arr = truncate_rgb (r, g, b) = (r', g', b') where - r' = truncate (r * 255) - g' = truncate (g * 255) - b' = truncate (b * 255) + r' = truncate (r * 255) :: Word8 + g' = truncate (g * 255) :: Word8 + b' = truncate (b * 255) :: Word8 write_values_to_bmp :: FilePath -> Values2D -> IO () write_values_to_bmp path values = do colors <- values_to_colors values - R.writeImageToBMP path colors + writeImageToBMP path colors -z_slice :: (R.Unbox a, Source r a) => Int -> Array r DIM3 a -> Array D DIM2 a +z_slice :: (Source r a) => Int -> Array r DIM3 a -> Array D DIM2 a z_slice n arr = slice arr (Any :. n :. All :. All)