{-# LANGUAGE FlexibleContexts #-}
--
-- Example demonstrating artefacts caused by combining colour values in the
-- non-linear RGB colour space.
--
-- Test image (and more information) available at:
--
-- <http://ninedegreesbelow.com/photography/linear-gamma-blur-normal-blend.html>
--
-- Note in the given test image (blocks.bmp, generated by  TestImage.hs) the
-- boundaries between the different colours:
--
--  * In the linear-gamma sRGB colour space colours blend smoothly.
--
--  * In the non-linear gamma RGB image, there are dark regions separating red
--    from green and cyan, and blue from red and green; purple lines separate
--    cyan from red and magenta; green separates yellow from cyan. These dark
--    lines are artefacts produces from mixing colours in the non-linear RGB
--    colour space.
--

module Main where

import Data.Array.Accelerate                              as A
import Data.Array.Accelerate.Interpreter                  as A
import Data.Array.Accelerate.IO                           as A        -- package: accelerate-io
import Data.Array.Accelerate.Data.Colour.RGB              as RGB
import Data.Array.Accelerate.Data.Colour.SRGB             as SRGB

import Control.Monad
import System.FilePath
import System.Directory
import System.Environment
import Prelude                                            as P


type Image a      = Array DIM2 a

type Stencil5x1 a = (Stencil3 a, Stencil5 a, Stencil3 a)
type Stencil1x5 a = (Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a)

type Stencil9x1 a = (Stencil3 a, Stencil9 a, Stencil3 a)
type Stencil1x9 a = (Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a)


convolve5x1 :: A.Num a => [Exp a] -> Stencil5x1 a -> Exp a
convolve5x1 kernel (_, (a,b,c,d,e), _)
  = P.sum $ P.zipWith (*) kernel [a,b,c,d,e]

convolve1x5 :: A.Num a => [Exp a] -> Stencil1x5 a -> Exp a
convolve1x5 kernel ((_,a,_), (_,b,_), (_,c,_), (_,d,_), (_,e,_))
  = P.sum $ P.zipWith (*) kernel [a,b,c,d,e]

convolve9x1 :: A.Num a => [Exp a] -> Stencil9x1 a -> Exp a
convolve9x1 kernel (_, (a,b,c,d,e,f,g,h,i), _)
  = P.sum $ P.zipWith (*) kernel [a,b,c,d,e,f,g,h,i]

convolve1x9 :: A.Num a => [Exp a] -> Stencil1x9 a -> Exp a
convolve1x9 kernel ((_,a,_), (_,b,_), (_,c,_), (_,d,_), (_,e,_), (_,f,_), (_,g,_), (_,h,_), (_,i,_))
  = P.sum $ P.zipWith (*) kernel [a,b,c,d,e,f,g,h,i]


-- Separable Gaussian blur in the x- and y-directions
--
gaussianX :: Acc (Image (RGB Float)) -> Acc (Image (RGB Float))
gaussianX = stencil (convolve9x1 gaussian9) Clamp

gaussianY :: Acc (Image (RGB Float)) -> Acc (Image (RGB Float))
gaussianY = stencil (convolve1x9 gaussian9) Clamp

-- <http://dev.theomader.com/gaussian-kernel-calculator/>
--
gaussian5, gaussian9 :: [Exp (RGB Float)]
gaussian5 = [0.06136,0.24477,0.38774,0.24477,0.06136]
gaussian9 = [0.028532,0.067234,0.124009,0.179044,0.20236,0.179044,0.124009,0.067234,0.028532]



main :: IO ()
main = do
  argv        <- getArgs
  let inputFile = case argv of
                    []  -> "blocks.bmp"
                    f:_ -> f

  exists      <- doesFileExist inputFile
  unless exists $
    error $ unlines [ "usage: blur <file.bmp>"
                    , ""
                    , "If no input image is specified, the default 'blocks.bmp'"
                    , "in the current directory will be used (if available)."
                    ]

  input       <- either (error . show) id `fmap` readImageFromBMP inputFile

  let name f    = "blur_" P.++ f <.> "bmp"

      img       = A.map unpackRGB (use input)
      blur      = gaussianY . gaussianX

      rgb_blur  = blur img
      srgb_blur = A.map toRGB . blur . A.map fromRGB $ img

  writeImageToBMP (name "rgb")  $ run $ A.map packRGB rgb_blur
  writeImageToBMP (name "srgb") $ run $ A.map packRGB srgb_blur