diff --git a/examples/Volume/Main.hs b/examples/Volume/Main.hs new file mode 100644 --- /dev/null +++ b/examples/Volume/Main.hs @@ -0,0 +1,97 @@ + +{-# LANGUAGE ScopedTypeVariables #-} +import Data.Word +import Data.Bits +import Data.Array.Repa as R +import Data.Array.Repa.IO.Binary as R +import Data.Array.Repa.IO.BMP as R +import Data.Array.Repa.IO.ColorRamp as R +import Prelude as P +import System.Environment +import Control.Monad + +-- | Cuts slices out of a volume cube of Word16 data. +main :: IO () +main + = do args <- getArgs + case args of + [fileIn, fileOut, depth', height', width', sliceNum', low', high'] + -> run fileIn fileOut + (read depth') (read height') (read width') + (read sliceNum') (read low') (read high') + + _ -> do + putStr $ unlines + [ "usage: volume " ] + +run :: FilePath -> FilePath -> Int -> Int -> Int -> Int -> Int -> Int -> IO () +run fileIn fileOut depth width height sliceNum low high + = do + -- Read data from the raw file of Word16s. + let arraySize = (Z :. depth :. width :. height) + (arr :: Array DIM3 Word16) + <- R.readArrayFromStorableFile fileIn arraySize + + -- Ensure it's all read in before proceeding. + arr `deepSeqArray` return () + dumpSlice fileOut arr sliceNum low high + + +-- | Dump a numbered slice of this array to a BMP file. +dumpSlice + :: FilePath -- output base name + -> Array DIM3 Word16 -- source data + -> Int -- array slice number + -> Int -- low value for color ramp + -> Int -- high value for color ramp + -> IO () + +dumpSlice fileBase arr sliceNum low high + = do -- slice out the part that we want from the cube + let arrSlice = slice arr (Any :. sliceNum :. All :. All) + + -- select a part of the large dynamic range + let arrBrack :: Array DIM2 Word16 + arrBrack = R.map (bracket low high . fromIntegral . flip16) arrSlice + + -- invert the y coordinate so the image is the correct way around + let (Z :. height :. _) = R.extent arrSlice + let arrInv = R.traverse arrBrack id + (\get (Z :. y :. x) -> get (Z :. (height - 1) - y :. x)) + + -- dump the slice back as word16 + R.writeArrayToStorableFile (fileBase P.++ ".w16") arrInv + + -- colorise and write to BMP file + let arrColor :: Array DIM2 (Double, Double, Double) + arrColor = R.map (\x -> if x == 0 + then (0, 0, 0) + else rampColorHotToCold 0 255 x) + $ R.map fromIntegral arrInv + + let arrColor' = R.force + $ R.map (\(r, g, b) -> ( truncate (r * 255) + , truncate (g * 255) + , truncate (b * 255))) + $ arrColor + + R.writeComponentsToBMP (fileBase P.++ ".bmp") + (R.map (\(r, g, b) -> r) arrColor') + (R.map (\(r, g, b) -> g) arrColor') + (R.map (\(r, g, b) -> b) arrColor') + + +{-# INLINE bracket #-} +bracket low high x + | x < low = 0 + | x > high = 255 + | otherwise + = let r = fromIntegral (x - low) / fromIntegral (high - low) + in truncate (r * 255) + + +{-# INLINE flip16 #-} +flip16 :: Word16 -> Word16 +flip16 xx + = shift xx 8 .|. (shift xx (-8) .&. 0x00ff) + diff --git a/repa-examples.cabal b/repa-examples.cabal --- a/repa-examples.cabal +++ b/repa-examples.cabal @@ -1,5 +1,5 @@ Name: repa-examples -Version: 2.1.0.2 +Version: 2.2.0.1 License: BSD3 License-file: LICENSE Author: The DPH Team @@ -20,9 +20,9 @@ Executable repa-mmult Build-depends: base == 4.*, - repa == 2.1.*, - repa-io == 2.1.*, - repa-algorithms == 2.1.*, + repa == 2.2.*, + repa-io == 2.2.*, + repa-algorithms == 2.2.*, random == 1.0.* Main-is: examples/MMult/src-repa/Main.hs @@ -38,8 +38,8 @@ Executable repa-laplace Build-depends: base == 4.*, - repa == 2.1.*, - repa-io == 2.1.* + repa == 2.2.*, + repa-io == 2.2.* Main-is: examples/Laplace/src-repa/Main.hs other-modules: SolverGet SolverStencil @@ -55,9 +55,9 @@ Executable repa-fft2d Build-depends: base == 4.*, - repa == 2.1.*, - repa-algorithms == 2.1.*, - repa-io == 2.1.* + repa == 2.2.*, + repa-algorithms == 2.2.*, + repa-io == 2.2.* Main-is: examples/FFT/FFT2d/src-repa/Main.hs hs-source-dirs: examples/FFT/FFT2d/src-repa . @@ -72,9 +72,9 @@ Executable repa-fft2d-highpass Build-depends: base == 4.*, - repa == 2.1.*, - repa-algorithms == 2.1.*, - repa-io == 2.1.* + repa == 2.2.*, + repa-algorithms == 2.2.*, + repa-io == 2.2.* Main-is: examples/FFT/HighPass2d/src-repa/Main.hs hs-source-dirs: examples/FFT/HighPass2d/src-repa . @@ -89,8 +89,8 @@ Executable repa-fft3d-highpass Build-depends: base == 4.*, - repa == 2.1.*, - repa-algorithms == 2.1.* + repa == 2.2.*, + repa-algorithms == 2.2.* Main-is: examples/FFT/HighPass3d/src-repa/Main.hs hs-source-dirs: examples/FFT/HighPass3d/src-repa . @@ -105,9 +105,9 @@ Executable repa-blur Build-depends: base == 4.*, - repa == 2.1.*, - repa-algorithms == 2.1.*, - vector == 0.7.* + repa == 2.2.*, + repa-algorithms == 2.2.*, + vector == 0.9.* Main-is: examples/Blur/src-repa/Main.hs hs-source-dirs: examples/Blur/src-repa . @@ -122,8 +122,8 @@ Executable repa-sobel Build-depends: base == 4.*, - repa == 2.1.*, - repa-algorithms == 2.1.*, + repa == 2.2.*, + repa-algorithms == 2.2.*, template-haskell >= 2.5 && < 2.7 Main-is: examples/Sobel/src-repa/Main.hs @@ -140,8 +140,8 @@ Executable repa-canny Build-depends: base == 4.*, - repa == 2.1.*, - repa-algorithms == 2.1.*, + repa == 2.2.*, + repa-algorithms == 2.2.*, template-haskell >= 2.5 && < 2.7 Main-is: examples/Canny/src-repa/Main.hs @@ -154,3 +154,18 @@ -funfolding-use-threshold100 -funfolding-keeness-factor100 + +Executable repa-volume + Build-depends: + base == 4.*, + repa == 2.2.*, + repa-io == 2.2.* + + Main-is: examples/Volume/Main.hs + ghc-options: + -threaded + -rtsopts + -Odph -fllvm -optlo-O3 + -fno-liberate-case + -funfolding-use-threshold100 + -funfolding-keeness-factor100