IFS.hs

---------------------------------------------------------------------------
-- |
-- Module      :  Main
-- Copyright   :  (c) alpheccar, 2007
-- License     :  BSD-style 
-- 
-- Maintainer  :  misc@alpheccar.org
-- Stability   :  experimental
-- Portability :  portable 
--
-- Description
--
--	  Iterated Function Systems in Haskell
--
-----------------------------------------------------------------------------

module Graphics.IFS (
   -- * Types
   IFS
 , Pixel
   -- * Drawing an IFS
 , drawIFS
   -- * IFS creation functions
 , (<+>)
 , (<?>)
 , linearIFS
 )
 where

import Graphics.IFS.Geometry
import Control.Monad(liftM2,liftM)
import System.Random
import Data.Word

-- | A position in an array of pixels and the color index
type Pixel = (Int,Word8)

-- | An IFS is expressed in a [0,1]x[0,1] squares. So, the linear transforms used to build it must take that into account.
newtype IFS a =  IFS([(NonLinearTransform a,Double)])

infixl 5 <+>
infixl 6 <?>

-- | Union of two IFS (probabilities are normalized if required when the IFS is drawn)
(<+>) :: IFS a -> IFS a -> IFS a
(IFS la) <+> (IFS lb) = IFS (la ++ lb)

-- | Multiply IFS probabilities
(<?>) :: Double -> IFS a -> IFS a
p <?> (IFS la) = IFS $ map changeProba la where
	changeProba (nl,op) = (nl,p*op)
	
-- | Create a linear IFS from an affine transformation
linearIFS :: M a -> IFS a
linearIFS m = IFS [(NL(id,m),1.0)]

-- | The sum of all probabilities must be 1
normalizeProba :: IFS a -> IFS a
normalizeProba (IFS l) = IFS $ map (divideBy total) l 
 where
	total = sum . map snd $ l
	divideBy x (a,p) = (a,p/x)

-- | For applying a non linear transformation to the IFS
instance Num a => Module (NonLinear a) (IFS a) where
	f <*> (IFS l) = IFS (map applyTransform l) where
		 applyTransform (n,p) = (f <*> n,p)
		
-- | For applying a linear transformation to an IFS
instance Fractional a => Module (M a) (IFS a) where
	f <*> (IFS l) = IFS $ map applyTransform l where
		applyTransform (NL(n,m),p) = (NL(n,f * m * (inv f)),p)
		
-- | For applying a scalar transformation to an IFS
instance Num a => Module a (IFS a) where
	f <*> (IFS l) = IFS $ map applyTransform l where
		applyTransform (NL(n,m),p) = (NL(n,f <*> m),p)
		
-- | Pick a non linear transformation from the IFS according to the given proba
pick :: IFS a -> Double -> NonLinearTransform a
pick (IFS l) = getTransform l
 where 
   getTransform ((a,_):[]) _ = a
   getTransform ((x,p):ps) n | n <= p    = x
                             | otherwise = getTransform ps (n-p)

-- | Draw an IFS
drawIFS :: Int -- ^ Width of the IFS square in pixel (the IFS is contained in a [0,1]x[0,1] square)
        -> Int -- ^ Height of the IFS square
        -> Int -- ^ Number of pixels to generate
        -> IFS Double -- ^ The IFS
        -> [Pixel] -- ^ List of pixels
drawIFS width height n x = genPixel . take n . drop 100 . scanl (flip (<*>)) startVector . map (pick (normalizeProba x)) . randomRs ((0.0,1.0)::(Double,Double)) $ mkStdGen 0
 where
	genPixel [] = []
	genPixel (V(x,y):l) =
		let ny = 1 - y
		    minb = 0
		    maxb = width*height
		    p = floor ((fromIntegral width)*x) + width*floor ((fromIntegral height)*ny) in
	    if (x>=0) && (ny>=0) && (x<1.0) && (ny<1.0) && (p >= minb) && (p < maxb) then (p,1):genPixel l else genPixel l