    module Haskore.Example.Fractal where

    import Prelude hiding (init)
    import System.Random (randomRs, mkStdGen)
    import Data.Array (Array, (!), listArray, bounds)

    import qualified Haskore.Basic.Pitch  as Pitch
    import qualified Haskore.Music        as Music
    import qualified Haskore.Melody       as Melody
    import Haskore.Music((+:+))

    import qualified Haskore.Basic.Duration as Dur

    type Vector a = [a]
    type Matrix a = [Vector a]
    type AT     a = Vector a -> Vector a
    type IFS    a = Array Int (AT a)

    -- First define some general matrix operations.
    -- These will facilitate moving to higher dimensions later.

    vadd :: Num a => Vector a -> Vector a -> Vector a
    vadd = zipWith (+)

    vvmult :: Num a => Vector a -> Vector a -> a
    vvmult v1 v2 = sum (zipWith (*) v1 v2)

    mvmult :: Num a => Matrix a -> Vector a -> Vector a
    mvmult m v = map (vvmult v) m

    cvmult :: Num a => a -> Vector a -> Vector a
    cvmult z = map (z*)

    ---------------------------------------------------------------------

    {- The following simulates the Iterated Function System for the
       Sierpinski Triangle as described in Barnsley's "Desktop Fractal
       Design Handbook". -}

    -- First the affine transformations:

    w0, w1, w2 :: Fractional a => AT a
    w0 v = (cvmult 0.01 ([[50,0],[0,50],[50,0]] `mvmult` v))
           `vadd` [8,8,8]
    w1 v = (cvmult 0.01 ([[50,0],[0,50],[50,0]] `mvmult` v))
           `vadd` [30,16,2]
    w2 v = (cvmult 0.01 ([[50,0],[0,50],[50,0]] `mvmult` v))
           `vadd` [20,40,30]

    init0 :: Num a => Vector a
    init0 = [0,0,0]

    -- Now we have an Iterated Function System:

    ws :: Fractional a => IFS a
    ws = let wl = [w0,w1,w2]
         in  listArray (0, length wl - 1) wl

    -- And here is the result:

    result :: [Vector Rational]
    result =
       let ws' = ws -- make it monomorph
           f init r = (ws'!r) init
       in  scanl f init0 (randomRs (bounds ws') (mkStdGen 215))
       -- (read "42" :: StdGen)

    -- where "randomRs" computes a list of random indices in the range 0-2,
    -- which simulates flipping the coin in Barnsley.

    --------

    mkNote :: [Rational] -> Melody.T ()
    mkNote [a,b,c] =
       Music.rest (Dur.fromRatio (b/20)) +:+
       Melody.note (Pitch.fromInt (round a)) (Dur.fromRatio (c/20)) ()
    mkNote _ = error "mkNote: Need three components."

    {- Of course, a triple would be the better type
       but that would complicate the vector computation. -}

    sourceToMusic :: [[Rational]] -> Melody.T ()
    sourceToMusic s = Music.chord (map mkNote s)

    song :: Melody.T ()
    song = Music.transpose (-12) (sourceToMusic (take 128 result))