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)
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*)
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]
ws :: Fractional a => IFS a
ws = let wl = [w0,w1,w2]
in listArray (0, length wl 1) wl
result :: [Vector Rational]
result =
let ws' = ws
f init r = (ws'!r) init
in scanl f init0 (randomRs (bounds ws') (mkStdGen 215))
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."
sourceToMusic :: [[Rational]] -> Melody.T ()
sourceToMusic s = Music.chord (map mkNote s)
song :: Melody.T ()
song = Music.transpose (12) (sourceToMusic (take 128 result))