```-- |
-- Module: Graphics.Chalkboard.Array
-- Copyright: (c) 2009 Andy Gill
--
-- Maintainer: Andy Gill <andygill@ku.edu>
-- Stability: unstable
-- Portability: ghc
--
-- This module coverts 2D arrays into 'Board's, and back, and supplies basic dithering algorithms.

module Graphics.Chalkboard.Array
( -- * Converters
boardToArray, arrayToBoard,
-- * Dithering
threshold, floydSteinberg
)
where

import Data.Array

import Graphics.Chalkboard.Board as Board
import Graphics.Chalkboard.Utils
import Graphics.Chalkboard.Types

import Control.Applicative

-- | 'boardToArray' turns a Board into a 2D Array (pixelization).

boardToArray :: (Average a)
=> (Int,Int) 	-- ^ the x,y size of the image to be captured. We assume the bottom left hand size is 0,0.
-> Int       	-- ^ the square root of the amount of super-sampling to be done. I recommend 3, which is 9 points.
-> Board a	-- ^ the board to sample.
-> Array (Int,Int) a -- ^ the result array.
boardToArray (x_dim,y_dim) n board = array ((0,0),(x_dim,y_dim))
[ ((x,y), average
[ fn (fromIntegral x + x',fromIntegral y + y')
| x' <- innerSteps n
, y' <- innerSteps n
]
)
| x <- [0..x_dim]
, y <- [0..y_dim]
]
where
fn = Board.lookup board

-- There are different ways of taking a 2d array into a Board.
--   * Do you pixelize the input, or make it continuous (using Bilinear interpolation)?
--   * Be careful at the edges! You want the samples to be inside the actual edge, not on it.
--  How do we handle the alpha at the edges!
{-

0       1       2
+---X---+---Y---+

So, with pixels, what value does 1 have (X or Y), how about 0 and 2, do you biest to the left or right?
with continuous, what value does 0 or 2 have?

-}

-- | 'arrayToBoard' turns a 2D Array into a Board, using bi-linear inteprelation.

arrayToBoard :: (Lerp a, Scale a) => Array (Int,Int) a -> Board (Maybe a)
arrayToBoard arr = arrayToBoard' arr (bounds arr)

arrayToBoard' :: (Lerp a, Scale a) => Array (Int,Int) a -> ((Int,Int),(Int,Int)) -> Board (Maybe a)
arrayToBoard' arr ((0,0),(w,h)) = pure img <*> coord
where
(width,height) = (w-1,h-1)
outside x0 y0 = x0 < 0
|| x0 > fromIntegral width
|| y0 < 0
|| y0 > fromIntegral height
img (x,y) | outside x y = Nothing
| otherwise   = lerp p00_p10 p01_p11 y_gap
where
(x',x_gap) = close x
(y',y_gap) = close y
find x0 y0 | outside x0 y0
= Nothing
| otherwise
= Just (arr ! (x0,y0))
p00 = find x' y'
p10 = find (succ x') y'
p01 = find x' (succ y')
p11 = find (succ x') (succ y')
p00_p10 = lerp p00 p10 x_gap
p01_p11 = lerp p01 p11 x_gap
-- normalize the board to start at (0,0)
arrayToBoard' arr bnds@((low_w,low_h),_) = arrayToBoard (ixmap bnds (\ (w,h) -> (w - low_w,h - low_h)) arr)

-- how close are you to one of our samples?
close :: R -> (Int,R)
close v0 = (v_floor,fracPart v0)
where
v_floor = floor v0

------------------------------------------------------
-- | 'threshold' quantized based on a simple, pointwise function.

threshold :: (Floating a) => (a -> a) -> Array (Int,Int) a -> Array (Int,Int) a
threshold quantize = fmap quantize

-- | 'floydSteinberg' quantized using the Floyd Steinberg algorithm.

floydSteinberg :: (Floating a) => (a -> a) -> Array (Int,Int) a -> Array (Int,Int) a
floydSteinberg quantize orig = fmap fst values
where
bnds@((x_min,y_min),(x_max,y_max)) = bounds orig
errors (x,y) | inRange bnds (x,y) = snd (values ! (x,y))
| otherwise    = 0
values = array bnds
[ let value = orig ! (x,y) +
(errors (x-1,y))   * 7 +
(errors (x+1,y-1)) * 3 +
(errors (x,y-1))   * 5 +
(errors (x-1,y-1)) * 1
q_value = quantize value
in ((x,y),(q_value,(value - q_value) / 16))
| x <- [x_min..x_max]
, y <- [y_min..y_max]
]
```