Ppm.hs

---------------------------------------------------------------------------
-- |
-- Module      :  Main
-- Copyright   :  (c) alpheccar, 2007
-- License     :  BSD-style 
-- 
-- Maintainer  :  misc@alpheccar.org
-- Stability   :  experimental
-- Portability :  portable 
--
-- Description
--
--	  Portable Pixel Map 
--
-----------------------------------------------------------------------------

module Graphics.IFS.Ppm (
   -- * Color formats
   Color(..)
   -- * Picture Creation
 , createPict
   -- * Some standard colors
 , red
 , green
 , blue
 , white
 , black
   -- * Coloring functions
 , ColorizeFunction
 , binaryColor
 , densityColor
 )
 where

import Data.Word
import Control.Monad
import Data.Array.Unboxed
import System.IO(hPutStr,Handle,openBinaryFile,IOMode(..),hClose)
import Control.Exception(bracket)
import qualified Data.ByteString as B
import Graphics.IFS(drawIFS,IFS)


-- | Image encoded as an unidimensional array and indexed colors.
-- The meaning of the index color is dependent on the choice of a coloring function 
type Image = UArray Int Word8

-- | RGB Color
data Color = RGB Word8 Word8 Word8 deriving(Eq,Ord)

-- | Red color
red :: Color
red = RGB 255 0 0 

-- | Gree color
green :: Color
green = RGB 0 255 0 

-- | Blue color
blue :: Color
blue = RGB 0 0 255

-- | Black color
black :: Color
black = RGB 0 0 0

-- | white color
white :: Color
white = RGB 255 255 255

withFile :: String -> (Handle -> IO a) -> IO a
withFile name = bracket (openBinaryFile name WriteMode) hClose


-- | The type of a coloring functions.
-- The first argument is an index value and the second argument is a list of RGB value.
-- The function is assumed to concatenate a new triple of RGB value to the list
type ColorizeFunction = Word8 -> [Word8] -> [Word8]
	
-- | Binary coloring
binaryColor :: Color -- ^ Background 'Color' for index null
            -> Color -- ^ Foreground 'Color' for index not null
            -> Word8 -- ^ Index
            -> [Word8] -- ^ List of RGB values
            -> [Word8] -- ^ List of RGB values
binaryColor (RGB br bg bb) (RGB r g b) a n | a /= 0 = r:g:b:n
                                           | otherwise = br:bg:bb:n 

-- |  Density coloring with linear interpolation
densityColor :: Int -- ^ Scaling factor
             -> Color -- ^ Background 'Color' for index null
             -> Color -- ^ Foreground 'Color' for index not null
             -> Word8 -- ^ Index
	         -> [Word8] -- ^ List of RGB values
	         -> [Word8] -- ^ List of RGB values
densityColor m (RGB br bg bb) (RGB r g b) a n | a /= 0 = (scale r):(scale g):(scale b):n                                            
                                              | otherwise = br:bg:bb:n  
 where
    scale r = fromInteger $ floor $ (min ((fromIntegral a) / (fromIntegral m))  (1.0::Double)) * (fromIntegral r) 

-- | Create a PPM picture.
createPict :: String -- ^ Name of file
           -> Int -- ^ Picture width
           -> Int -- ^ Picture height
           -> Int -- ^ Nb of pixels to compute
           -> ColorizeFunction -- ^ How to colorize the result
           -> IFS Double -- ^ IFS
           -> IO() -- ^ Output action
createPict name width height nb colorize ifs = do
   withFile name $ \h -> do
        hPutStr h ("P6 " ++ show width ++ " " ++ show height ++ " 255\n")
        B.hPut h $ B.pack $ foldr colorize [] $ elems $ (accumArray (+) 0 (0,width*height) $ drawIFS width height nb ifs :: Image)