content: 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
  