Show a basic storage type to handle a simple RGB raster graphics image,
and some primitive associated functions.

If possible provide a function to allocate an uninitialised image,
given its width and height, and provide 3 additional functions:

   one to fill an image with a plain RGB color,
   one to set a given pixel with a color,
   one to get the color of a pixel.


(If there are specificities about the storage or the allocation, explain those.)

These functions are used as a base for the articles in the category raster graphics operations, 
and a basic output function to check the results
is available in the article write ppm file.




module Bitmap(module Bitmap) where
 
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
 
newtype Pixel = Pixel (Int, Int) deriving Eq
 
instance Ord Pixel where
    compare (Pixel (x1, y1)) (Pixel (x2, y2)) =
        case compare y1 y2 of
            EQ -> compare x1 x2
            v  -> v
 
instance Ix Pixel where
{- This instance differs from the one for (Int, Int) in that
the ordering of indices is
  (0,0), (1,0), (2,0), (0,1), (1,1), (2,1)
instead of
  (0,0), (0,1), (1,0), (1,1), (2,0), (2,1). -}
    range (Pixel (xa, ya), Pixel (xz, yz)) =
        [Pixel (x, y) | y <- [ya .. yz], x <- [xa .. xz]]
    index (Pixel (xa, ya), Pixel (xz, _)) (Pixel (xi, yi)) =
        (yi - ya)*(xz - xa + 1) + (xi - xa)
    inRange (Pixel (xa, ya), Pixel (xz, yz)) (Pixel (xi, yi)) =
        not $ xi < xa || xi > xz || yi < ya || yi > yz
    rangeSize (Pixel (xa, ya), Pixel (xz, yz)) =
        (xz - xa + 1) * (yz - ya + 1)
 
instance Show Pixel where
    show (Pixel p) = show p
 
class Ord c => Color c where
    luminance :: c -> Int
     -- The Int should be in the range [0 .. 255].
    black, white :: c
    toNetpbm :: [c] -> String
    fromNetpbm :: [Int] -> [c]
    netpbmMagicNumber, netpbmMaxval :: c -> String
      {- The argument to these two functions is ignored; the
      parameter is only for typechecking. -}
 
newtype Color c => Image s c = Image (STArray s Pixel c)
 
image :: Color c => Int -> Int -> c -> ST s (Image s c)
{- Creates a new image with the given width and height, filled
with the given color. -}
image w h = liftM Image .
    newArray (Pixel (0, 0), Pixel (w - 1, h - 1))
 
listImage :: Color c => Int -> Int -> [c] -> ST s (Image s c)
{- Creates a new image with the given width and height, with
each pixel set to the corresponding element of the given list. -}
listImage w h = liftM Image .
    newListArray (Pixel (0, 0), Pixel (w - 1, h - 1))
 
dimensions :: Color c => Image s c -> ST s (Int, Int)
dimensions (Image i) = do
    (_, Pixel (x, y)) <- getBounds i
    return (x + 1, y + 1)
 
getPix :: Color c => Image s c -> Pixel -> ST s c
getPix (Image i) = readArray i
 
getPixels :: Color c => Image s c -> ST s [c]
getPixels (Image i) = getElems i
 
setPix :: Color c => Image s c -> Pixel -> c -> ST s ()
setPix (Image i) = writeArray i
 
fill :: Color c => Image s c -> c -> ST s ()
fill (Image i) c = getBounds i >>= mapM_ f . range
  where f p = writeArray i p c
 
mapImage :: (Color c, Color c') =>
    (c -> c') -> Image s c -> ST s (Image s c')
mapImage f (Image i) = liftM Image $ mapArray f i