more things

    (==) (Envelope n0 e0) (Envelope n1 e1) = n0 == n1

genEnvelope a s d = attack ++ sustain ++ decay

genEnvelope m a s d = attack ++ sustain ++ decay

    where

        attack = map (\x -> x/a) [0 .. a]

        sustain = take s $ repeat 1.0

        sustain = take s $ repeat m

        decay = map (\x -> x/d) $ reverse [0 .. d]

applyEnvelope env wave = zipWith (*) wave $ env ++ (repeat 0)

constEnv4 = Envelope { name = "constEnv4", envl = repeat 0.3 }

-- Some envelopes

bwap1Env = Envelope { name = "bwap1Env", envl = genEnvelope 4000 1000 4000 }

bwap2Env = Envelope { name = "bwap2Env", envl = genEnvelope 2200 500 2000 }

bwap3Env = Envelope { name = "bwap3Env", envl = genEnvelope 100 3000 2000 }

short1Env = Envelope { name = "short1Env", envl = genEnvelope 1000 10 1000 }

bwap1Env = Envelope { name = "bwap1Env", envl = genEnvelope 1.0 4000 1000 4000 }

bwap2Env = Envelope { name = "bwap2Env", envl = genEnvelope 1.0 2200 500 2000 }

bwap3Env = Envelope { name = "bwap3Env", envl = genEnvelope 1.0 100 3000 2000 }

short1Env = Envelope { name = "short1Env", envl = genEnvelope 1.0 1000 10 1000 }

bwap1Env2 = Envelope { name = "bwap1Env2", envl = genEnvelope 0.5 4000 1000 4000 }

bwap2Env2 = Envelope { name = "bwap2Env2", envl = genEnvelope 0.5 2200 500 2000 }

bwap3Env2 = Envelope { name = "bwap3Env2", envl = genEnvelope 0.5 100 3000 2000 }

short1Env2 = Envelope { name = "short1Env2", envl = genEnvelope 0.5 1000 10 1000 }

bwap1Env3 = Envelope { name = "bwap1Env3", envl = genEnvelope 0.3 4000 1000 4000 }

bwap2Env3 = Envelope { name = "bwap2Env3", envl = genEnvelope 0.3 2200 500 2000 }

bwap3Env3 = Envelope { name = "bwap3Env3", envl = genEnvelope 0.3 100 3000 2000 }

short1Env3 = Envelope { name = "short1Env3", envl = genEnvelope 0.3 1000 10 1000 }

v2 = map (setVoice distSn) d2

e2 = map setEnvelope [constEnv2, constEnv3, constEnv2]

-- p2 = concat $ replicate  16 $  map (setEnvelope constEnv1) v2

p2 = concat $ replicate  16 $  zipWith ($) (concat $ repeat e2) v2

note3Map = map noteTranspose [0,0,0,5,5,5]

p2 = concat $ replicate  8 $  zipWith ($) (concat $ repeat e2) v2

p4 = p2 ++ p2 

note3Map = map noteTranspose [0,0,0,5,5,5,-2,-3,-4,0,0,0]

notes3 = note3Map <*> [a4]

durMap3 = map setDuration $ [D.n16, D.n16, D.n8]

voiceMap3 = map setVoice $ (replicate 4 silence ) ++ (replicate 3 minorSquareStab) ++ (replicate 4 silence)

e3 = map setEnvelope [short1Env, bwap2Env, constEnv0, short1Env]

voiceMap3 = map setVoice $ (replicate 2 silence ) ++ (replicate 4 minorSquareStab) ++ (replicate 2 silence)

-- e3 = map setEnvelope [bwap2Env3, constEnv3, constEnv0, short1Env3, constEnv0]

e3 = map setEnvelope [bwap2Env3, short1Env3, constEnv0]

d3 = zipWith ($) (concat $ repeat durMap3) notes3

v3 = (voiceMap3) <*> d3

        header = WAVEHeader 1 sampleRate bitrate (Just $ length $ concat xs)

        samples = xs >>= return . map doubleToSample

hardFlange :: Int -> Maybe [Double] -> Maybe [Double]

hardFlange n  xs =

    do {  ds <- xs;

        return $ normalize $ mix ds $ (replicate n 0) ++ (take ((length ds) - n) ds) }

-- Take a list of patterns, mux them together, return a Maybe [Double] that we can render

-- If they are different lengths repeat the shorter

-- to the length of the longer

main =

    do

        -- let outWav = fromJust $ render outPattern

        let outWav = genWaveFile [fromJust $ stack [p1, p2], fromJust $ stack [p1, p2,p1, p3], fromJust $ stack [p1, p2]]

        let outWav = genWaveFile [fromJust $ stack [p1, p4], fromJust $ stack [p1, p4,p1, p3], fromJust $ hardFlange 1000 $ stack [p1, p4], fromJust $ hardFlange 750 $ stack [p3, p2], fromJust $ hardFlange 500 $ chain [p2]]

        putWAVEFile "out.wav" outWav 

        -- pid <- runCommand "aplay -q out.wav"

        return ()

-- Some generalised square waves, with variable pulse width

squareFunc pw x 

    | x < 2 * pw * pi  = -0.5

    | x >= 2 * pw * pi = 0.5

    | x < 2 * pw * pi  = -0.3

    | x >= 2 * pw * pi = 0.3

sqfs = map ( squareFunc ) [0.10, 0.11 .. 0.90]