1 {-# LANGUAGE FlexibleContexts #-}
2 -- | The Volumetric module contains functions for manipulating the
3 -- volumetric data files found at,
5 -- <http://graphics.stanford.edu/data/voldata/>
22 import Data.Array.Repa as R
23 import Data.Array.Repa.Eval as R (now)
24 import Data.Array.Repa.Repr.Unboxed as R
25 import Data.Array.Repa.IO.Binary as R
26 import Data.Array.Repa.Algorithms.ColorRamp as R
27 import Data.Array.Repa.Operators.Traversal as R (unsafeTraverse)
28 import Data.Array.Repa.IO.BMP as R (writeImageToBMP)
32 -- | RawData is an array of words (16 bits), as contained in the
33 -- volumetric data files.
34 type RawData sh = Array U sh Word16
36 -- | A specialization of the 'RawData' type, to three dimensions.
37 type RawData3D = RawData DIM3
39 type RGB = (Word8, Word8, Word8)
40 type ColorData sh = Array U sh RGB
43 {-# INLINE read_word16s #-}
44 read_word16s :: FilePath -> DIM3 -> IO RawData3D
45 read_word16s path shape = do
46 arr <- R.readArrayFromStorableFile path shape
52 bracket :: Double -> Double -> Double -> Word16
53 bracket lower_threshold upper_threshold x
54 | x < lower_threshold = 0
55 | x > upper_threshold = 255
56 | otherwise = truncate (r * 255)
58 numerator = x - lower_threshold
59 denominator = upper_threshold - lower_threshold
60 r = numerator/denominator
63 flip16 :: Word16 -> Word16
65 shift xx 8 .|. (shift xx (-8) .&. 0x00ff)
68 {-# INLINE swap_bytes #-}
69 swap_bytes :: (Shape sh, Source r Word16) => Array r sh Word16
75 bracket_array :: Shape sh => Double -> Double -> Values sh -> Array D sh Word16
80 {-# INLINE round_array #-}
81 round_array :: Shape sh => Values sh -> Array D sh Word16
86 flip_y :: Source r Word16 => Int -> Array r DIM3 Word16 -> Array D DIM3 Word16
88 R.unsafeTraverse arr id
89 (\get (Z :. z :. y :. x) ->
90 get (Z :. z :. (height - 1) - y :. x))
92 flip_x :: Source r Word16 => Int -> Array r DIM3 Word16 -> Array D DIM3 Word16
94 R.unsafeTraverse arr id
95 (\get (Z :. z :. y :. x) ->
96 get (Z :. z :. y :. (width - 1) - x))
99 {-# INLINE write_word16s #-}
100 write_word16s :: (Shape sh) => FilePath -> (RawData sh) -> IO ()
101 write_word16s = R.writeArrayToStorableFile
106 -- Instead of IO, we could get away with a generic monad 'm'
107 -- here. However, /we/ only call this function from within IO.
109 values_to_colors :: (Shape sh) => (Values sh) -> IO (ColorData sh)
110 values_to_colors arr =
111 R.computeUnboxedP $ R.map (truncate_rgb . ramp_it) arr
113 ramp_it :: Double -> (Double, Double, Double)
118 rampColorHotToCold 0 255 x
120 truncate_rgb :: (Double, Double, Double) -> (Word8, Word8, Word8)
121 truncate_rgb (r, g, b) =
124 r' = truncate (r * 255)
125 g' = truncate (g * 255)
126 b' = truncate (b * 255)
129 write_values_to_bmp :: FilePath -> Values2D -> IO ()
130 write_values_to_bmp path values = do
131 colors <- values_to_colors values
132 R.writeImageToBMP path colors
135 z_slice :: (R.Unbox a, Source r a) => Int -> Array r DIM3 a -> Array D DIM2 a
137 slice arr (Any :. n :. All :. All)