{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
module Graphics.Image.Processing.Noise where
import Control.Monad (forM_)
import Control.Monad.ST
import System.Random
import Prelude as P hiding (subtract)
import Graphics.Image.Interface as I
import Graphics.Image
import Graphics.Image.Types as IP
randomCoords :: StdGen -> Int -> Int -> [(Int,Int)]
randomCoords a width height = (rnx1, rny1) : randomCoords g2 width height
where
(rnx1, g1) = randomR (0, width) a
(rny1, g2) = randomR (0, height) g1
saltAndPepper
:: forall arr e cs . (MArray arr Y Double, IP.Array arr Y Double)
=> Image arr Y Double
-> Float
-> StdGen
-> Image arr Y Double
saltAndPepper image noiseLevel = accBin
where
widthMax, heightMax, noiseIntensity :: Int
widthMax = ((rows image) - 1)
heightMax = ((cols image) - 1)
noiseIntensity = round (noiseLevel * (fromIntegral widthMax) * (fromIntegral heightMax))
accBin :: StdGen -> Image arr Y Double
accBin g = runST $
do arr <- I.thaw image
let coords = take (noiseIntensity + 1) (randomCoords g widthMax heightMax)
forM_ coords $ \i -> do
let a :: Int
a = uncurry (+) i
if (a `mod` 2 == 0)
then do let px = 0
I.write arr i px
else do let px = 1.0
I.write arr i px
freeze arr