    module Haskore.Example.Flip where

    import Haskore.Melody as Melody
    import Haskore.Music.GeneralMIDI as MidiMusic

    import Data.Array (Array, (!), listArray)
    import qualified Data.List as List

    {-
      flipSeq 2 !! n = parity of number of 1's in binary representation of n.
      http://www.research.att.com/cgi-bin/access.cgi/as/njas/sequences/eisA.cgi?Anum=A010060
    -}

    flipSeq :: Int -> [Int]
    flipSeq n =
       let incList m = map (\x -> mod (x+m) n)
           recourse y = let z = concatMap (flip incList y) [1..(n-1)]
                       in  z ++ recourse (y++z)
       in  [0] ++ recourse [0]

    {- based on Helmut Podhaisky's implementation
       it must be flipSeq2 == flipSeq 2 -}
    flipSeq2 :: [Int]
    flipSeq2 =
       let recourse y = let z = map (1-) y
                       in  z ++ recourse (y++z)
       in  [0] ++ recourse [0]

    noteArray :: [() -> Melody.T ()] -> Array Int (Melody.T ())
    noteArray ns = listArray (0, length ns - 1) (map (\n -> n ()) ns)

    makeSong :: [() -> Melody.T ()] -> Melody.T ()
    makeSong ms = line (map (noteArray ms ! )
                                (flipSeq (length ms)))

    song, song1, core, core1 :: Melody.T ()

    song = changeTempo 8 core
    core = makeSong [e 1 qn, g 1 qn, c 2 qn, e 2 qn]

    song1 = changeTempo 8 core1
    core1 =
       let rep = 16
       in  line $ zipWith (!) (cycle
              (List.replicate rep (noteArray [e 1 qn, a 1 qn, c 2 qn, e 2 qn]) ++
               List.replicate rep (noteArray [g 1 qn, c 2 qn, e 2 qn, g 2 qn]) ++
               List.replicate rep (noteArray [a 1 qn, d 2 qn, f 2 qn, a 2 qn]) ++
               List.replicate rep (noteArray [a 1 qn, c 2 qn, f 2 qn, a 2 qn]) ++
               List.replicate rep (noteArray [a 1 qn, c 2 qn, e 2 qn, a 2 qn])))
              (flipSeq 4)

    {-
      If you divide the stream into blocks of size n
      each block will contain each of the indices of {0,..,n-1} exactly once.
      Thus you can also choose musical atoms of different length
      for generating rythms.
    -}
    song2, core2 :: MidiMusic.T
    song2 = changeTempo 4 core2
    core2 =
       let rep = 16
           flipper = MidiMusic.fromMelodyNullAttr MidiMusic.AcousticGrandPiano $
             line $ zipWith (!) (cycle
              (List.replicate rep (noteArray [e 1 dqn, a 1 en, c 2 qn, e 2 qn]) ++
               List.replicate rep (noteArray [g 1 dqn, c 2 en, e 2 qn, g 2 qn]) ++
               List.replicate rep (noteArray [a 1 dqn, d 2 en, f 2 qn, a 2 qn]) ++
               List.replicate rep (noteArray [a 1 dqn, c 2 en, f 2 qn, a 2 qn]) ++
               List.replicate rep (noteArray [a 1 dqn, c 2 en, e 2 qn, a 2 qn]) ++
               List.replicate rep (noteArray [a 1 dqn, c 2 en, e 2 qn, a 2 qn])))
              (flipSeq 4)
           bassLine =
              MidiMusic.fromMelodyNullAttr MidiMusic.Viola $
              transpose (-12) $ line $ cycle $
              concatMap (List.replicate 8) $
              List.map ($ ())
                 [a 0 hn, c 1 hn, d 1 hn,
                  f 1 hn, a 1 hn, a 0 hn]
       in  flipper =:= bassLine