{-# LANGUAGE PackageImports, BangPatterns, QuasiQuotes, PatternGuards #-} {-# OPTIONS -Wall -fno-warn-missing-signatures -fno-warn-incomplete-patterns #-} -- | Apply Sobel operators to an image. import Data.Word import Control.Monad import System.Environment import Data.Array.Repa as Repa import Data.Array.Repa.IO.BMP import Data.Array.Repa.IO.Timing import Prelude hiding (compare) import Solver -- Main routine --------------------------------------------------------------- main = do args <- getArgs case args of [iterations, fileIn, fileOut] -> run (read iterations) fileIn fileOut _ -> putStrLn "Usage: sobel " run iterations fileIn fileOut = do inputImage <- liftM (force . either (error . show) id) $ readImageFromBMP fileIn let greyImage = toGreyScale inputImage greyImage `deepSeqArray` return () (result, tElapsed) <- time $ let (gX, gY) = loop iterations greyImage in gX `deepSeqArray` gY `deepSeqArray` return (gX, gY) putStr $ prettyTime tElapsed let (gX, gY) = result let outImage = force2 $ Repa.zipWith magnitude gX gY outImage `seq` return () -- TODO: The image normalization in this write fn eats up most of the runtime. writeMatrixToGreyscaleBMP fileOut outImage loop :: Int -> Image -> (Image, Image) loop n = withManifest $ \img -> if n == 0 then (img, img) else do let gX = gradientX img let gY = gradientY img if (n == 1) then gX `deepSeqArray` gY `deepSeqArray` (gX, gY) else gX `deepSeqArray` gY `deepSeqArray` loop (n - 1) img -- | Determine the squared magnitude of a vector. magnitude :: Float -> Float -> Double {-# INLINE magnitude #-} magnitude x y = fromRational $ toRational $ sqrt (x * x + y * y) -- | RGB to greyscale conversion. toGreyScale :: Array DIM3 Word8 -> Image {-# NOINLINE toGreyScale #-} toGreyScale = withManifest $ \arr -> arr `seq` force2 $ traverse arr (\(sh :. _) -> sh) (\get ix -> rgbToLuminance (get (ix :. 0)) (get (ix :. 1)) (get (ix :. 2))) -- | Convert a RGB value to a luminance. rgbToLuminance :: Word8 -> Word8 -> Word8 -> Float {-# INLINE rgbToLuminance #-} rgbToLuminance r g b = fromIntegral r * 0.3 + fromIntegral g * 0.59 + fromIntegral b * 0.11