module Graphics.Chalkboard.Array
(
boardToArray, arrayToBoard,
threshold, floydSteinberg,
widthHeight
)
where
import Data.Array
import Graphics.Chalkboard.Board as Board
import Graphics.Chalkboard.Utils
import Graphics.Chalkboard.Types
import Control.Applicative
boardToArray :: (Average a)
=> (Int,Int)
-> Int
-> Board a
-> Array (Int,Int) a
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
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 bnd@((0,0),(w,h)) = pure img <*> coord
where
outside x0 y0 = x0 < 0
|| x0 > fromIntegral w
|| y0 < 0
|| y0 > fromIntegral h
img (x,y) | outside x y = Nothing
| otherwise = lerp p00_p10 p01_p11 y_gap
where
(x',x_gap) = close (x 0.5)
(y',y_gap) = close (y 0.5)
find x0 y0 | not (inRange bnd (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
arrayToBoard' arr bnds@((low_w,low_h),_) = arrayToBoard (ixmap bnds (\ (w,h) -> (w low_w,h low_h)) arr)
close :: R -> (Int,R)
close v0 = (v_floor,fracPart v0)
where
v_floor = floor v0
widthHeight :: Array ((Int,Int)) a -> (Int,Int)
widthHeight arr = (w+1,h+1)
where
((0,0),(w,h)) = bounds arr
threshold :: (Floating a) => (a -> a) -> Array (Int,Int) a -> Array (Int,Int) a
threshold quantize = fmap quantize
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 (x1,y)) * 7 +
(errors (x+1,y1)) * 3 +
(errors (x,y1)) * 5 +
(errors (x1,y1)) * 1
q_value = quantize value
in ((x,y),(q_value,(value q_value) / 16))
| x <- [x_min..x_max]
, y <- [y_min..y_max]
]