> import Data.Maybe
> import Euterpea.MidiIO
> import Euterpea.UI
> import qualified Codec.Midi as Midi
> import System.Environment (getArgs, getProgName)

> --withDisplay w = w >>= \w -> display' w >> return w

> display' :: Show a => Signal a -> UI ()
> display' = display . lift1 show


=============
Chord builder

Here is a simple program that plays the selected chord when a root
note is entered using a Midi input device.

We define a mapping between chord extensions and their intervals with
respect to the root note.

> chordIntervals = [("Maj", [4,3,5]),
>                   ("Maj7", [4,3,4,1]),
>                   ("Maj9", [2,2,3,4,1]),
>                   ("6", [4,3,2,3]),
>                   ("m", [3,4,5]),
>                   ("m7", [3,4,3,2]),
>                   ("m9", [2,1,4,3,2]),
>                   ("m7b5", [3,3,4,2]),
>                   ("mMaj7", [3,4,4,1]),
>                   ("dim", [3,3,3]),
>                   ("7", [4,3,3,2]),
>                   ("9", [2,2,3,3,2]),
>                   ("7b9", [1,3,3,3,2])]

We display the list of extensions on the screen as radio buttons for
the user to click on.

The toChord function takes in an input message as the root note and
the index of the selected chord extension, and outputs the notes of
the selected chord based on the root note.  For simplicity, we only
process the head of the message list and ignore everything else.

> toChord :: ([MidiMessage], Int) -> [MidiMessage]
> toChord (ms@(m:_),i) = 
>   case m of 
>     Std (Midi.NoteOn c k v) -> f Midi.NoteOn c k v
>     Std (Midi.NoteOff c k v) -> f Midi.NoteOff c k v
>     _ -> ms
>   where f g c k v = map (\k -> Std (g c k v)) 
>                         (scanl (+) k (snd (chordIntervals !! i)))

The UI is arranged in the following way.  On the left side, the list
of input and output devices are displayed top-down. On the right is
the list of chord extensions.  We take the name of each extension from
the chordIntervals list to create the radio buttons.  

When a Midi input event occurs, the input message and the currently
selected index to the list of chords is sent to the toChord function,
and the resulting chord is sent to the output device.

> buildChord = runUIEx (500,500) "Chord Builder" $ leftRight $ do
>   (mi,mo) <- topDown $ do
>                mi <- selectInput
>                mo <- selectOutput
>                return (mi,mo)
>   m <- midiIn mi
>   i <- topDown $ title "Extension" $ radio (fst (unzip chordIntervals)) 0
>   midiOut mo (snapshot m i =>> toChord)


=================
Bifurcate example

Here is an example with some ideas borrowed from Gary Lee Nelson's
composition "Bifurcate me, Baby!"

The basic idea is to evaluate the logistic growth function at
different points and convert the value to a musical note.  The growth
function is given by

  x_(n+1) = r x_n (1 - x_n)

We start with an initial population x_0 and iteratively apply the
growth function to it, where r is the growth rate.  For certain values
of r, the population stablizes to a certain value, but as r increases,
the period doubles, quadruples, and eventually leads to chaos.  It is
one of the classic examples in chaos theory.

First we define the growth function which, given a rate r and
current population x, generates the next population.

> grow :: Double -> Double -> Double
> grow r x = r * x * (1-x)

Then we define a signal 'ticks' that pulsates at a given frequency
specified by slider f.  This is the signal that will drive the
simulation.  The timer function takes in a time signal and a interval
signal, and generates a unit event at the given interval.

The next thing we need is a time-varying population.  This is where
accum comes in handy.  accum takes in an initial value, an event
signal carrying a modifying function, and updates the current value by
applying the function to it.  Since we want the growth rate to be
time-varying, we lift the grow function to the signal level and pass
in the growth rate signal r.  This gives us a Signal (Double ->
Double), that is, a function signal that will update a population at
the current growth rate.  Then, at every tick, we take a snapshot of
this function signal, producing EventS (Double->Double).
This is given to accum with an initial value of 0.1, and we get back
our population signal 'pop' driven by the clock ticks.

We can now write a simple function that maps a population value to a
musical note:

> popToNote :: Double -> [MidiMessage]
> popToNote x = [ANote 0 n 64 0.05] where n = truncate (x * 127)

Finally, to play the note at every tick, we again take a snapshot of
the current population at every tick and send the result to popToNote.
The resulting event signal is played through the selected Midi output
device.

> bifurcate = runUIEx (300,500) "Bifurcate!" $ do
>   t <- time
>   mo <- selectOutput
>   f <- title "Frequency" $ withDisplay (hSlider (1, 10) 1)
>   r <- title "Growth rate" $ withDisplay (hSlider (2.4, 4.0) 2.4)
>
>   let ticks :: EventS ()
>       ticks = timer t (1.0 / f)
>       pop :: Signal Double
>       pop = accum 0.1 (snapshot_ ticks (lift1 grow r))
>       
>   title "Population" $ display' pop
>   midiOut mo (snapshot_ ticks pop =>> popToNote)



============
Echo example

Here we present a program that takes in a Midi event stream and, in
addition to playing each note received from the input device, it also
echoes the note at a given rate, while playing each successive note
more softly until the velocity reduces to 0.

The key component we need for this problem is a delay function that
can delay a given event signal for a certain amount of time.  delayt
takes in a time signal, the amount of time to delay, an input signal,
and outputs the delayed signal.

There are two signals we want to attenuate.  One is the signal coming
from the input device, and the other is the delayed and decayed signal
containing the echoes.  In the code shown below, they are denoted as m
and s, respectively.  First we merge the two event streams into one,
and then remove events with empty Midi messages by replacing them with
Nothing.  The resulting signal m' is then processed further as follows.

Whenever there is an event in m', we take a snapshot of the current
decay rate indicated by a slider r.  The Midi messages and the current
decay rate are passed to function k, which softens each note in the
list of messages.  We define a function called 'decay' that reduces
the velocity of each note by the given rate.  If the velocity drops to
0, the note is removed.  The resulting signal is then delayed by the
amount of time determined by another slider f, producing signal s.  s
is then fed back to the merge function, closing the loop of the
recursive signal.  At the same time, m' is sent to the output device.

> echo = runUIEx (500,500) "Echo" $ do
>   mi <- selectInput
>   mo <- selectOutput
>   m <- midiIn mi
>   t <- time
>   r <- title "Decay rate" $ withDisplay (hSlider (0, 0.9) 0.5)
>   f <- title "Echoing frequency" $ withDisplay (hSlider (1, 10) 10)
>
>   let m' = lift1 removeNull $ lift2 merge m s
>       s  = delayt t (1.0 / f) (snapshot m' r =>> k)
>       k (ns,r) = mapMaybe (decay 0.1 r) ns
>                  
>   midiOut mo m'

> merge :: Maybe [MidiMessage] -> Maybe [MidiMessage] -> Maybe [MidiMessage]
> merge (Just ns1) (Just ns2) = Just (ns1 ++ ns2)
> merge n1         Nothing    = n1
> merge Nothing    n2         = n2

> removeNull :: Maybe [MidiMessage] -> Maybe [MidiMessage]
> removeNull (Just []) = Nothing
> removeNull (Just xs) = Just xs
> removeNull Nothing   = Nothing

> decay :: Time -> Double -> MidiMessage -> Maybe MidiMessage
> decay dur r m = 
>   let f c k v d = if v > 0 
>                   then Just (ANote c k (truncate (fromIntegral v * r)) d)
>                   else Nothing
>   in case m of
>     ANote c k v d -> f c k v d
>     Std (Midi.NoteOn c k v) -> f c k v dur
>     _ -> Nothing

> main = do
>   args <- getArgs 
>   prog <- getProgName
>   case args of
>     "echo":_ -> echo
>     "buildChord":_ -> buildChord
>     "bifurcate":_ -> bifurcate
>     _ -> putStrLn (usage prog)
>   where
>     usage prog = "USAGE: " ++ prog ++ " [echo|buildChord|bifurcate]"