module Graphics.IFS.Ppm (
Color(..)
, createPict
, red
, green
, blue
, white
, black
, 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)
type Image = UArray Int Word8
data Color = RGB Word8 Word8 Word8 deriving(Eq,Ord)
red :: Color
red = RGB 255 0 0
green :: Color
green = RGB 0 255 0
blue :: Color
blue = RGB 0 0 255
black :: Color
black = RGB 0 0 0
white :: Color
white = RGB 255 255 255
withFile :: String -> (Handle -> IO a) -> IO a
withFile name = bracket (openBinaryFile name WriteMode) hClose
type ColorizeFunction = Word8 -> [Word8] -> [Word8]
binaryColor :: Color
-> Color
-> Word8
-> [Word8]
-> [Word8]
binaryColor (RGB br bg bb) (RGB r g b) a n | a /= 0 = r:g:b:n
| otherwise = br:bg:bb:n
densityColor :: Int
-> Color
-> Color
-> Word8
-> [Word8]
-> [Word8]
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)
createPict :: String
-> Int
-> Int
-> Int
-> ColorizeFunction
-> IFS Double
-> IO()
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)