module Graphics.IFS (
IFS
, Pixel
, drawIFS
, (<+>)
, (<?>)
, linearIFS
)
where
import Graphics.IFS.Geometry
import Control.Monad(liftM2,liftM)
import System.Random
import Data.Word
type Pixel = (Int,Word8)
newtype IFS a = IFS([(NonLinearTransform a,Double)])
infixl 5 <+>
infixl 6 <?>
(<+>) :: IFS a -> IFS a -> IFS a
(IFS la) <+> (IFS lb) = IFS (la ++ lb)
(<?>) :: Double -> IFS a -> IFS a
p <?> (IFS la) = IFS $ map changeProba la where
changeProba (nl,op) = (nl,p*op)
linearIFS :: M a -> IFS a
linearIFS m = IFS [(NL(id,m),1.0)]
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)
instance Num a => Module (NonLinear a) (IFS a) where
f <*> (IFS l) = IFS (map applyTransform l) where
applyTransform (n,p) = (f <*> n,p)
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)
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 :: 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 (np)
drawIFS :: Int
-> Int
-> Int
-> IFS Double
-> [Pixel]
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