MUI.hs

-- This code was automatically generated by lhs2tex --code, from the file 
-- HSoM/MUI.lhs.  (See HSoM/MakeCode.bat.)

{-# LANGUAGE Arrows #-}

module Euterpea.Examples.MUI where
import Euterpea
import Control.Arrow
import Data.Maybe (mapMaybe)

ui0  ::  UISF () ()
ui0  =   proc _ -> do
    ap <- hiSlider 1 (0,100) 0 -< ()
    display -< pitch ap

--mui0 = runMUI' "Simple MUI" ui0

ui1 ::  UISF () ()
ui1 =   setLayout (makeLayout (Fixed 150) (Fixed 150)) $ 
  proc _ -> do
    ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()
    title "Pitch" display -< pitch ap

--mui1  =  runMUI' "Simple MUI (sized and titled)" ui1
ui2   ::  UISF () ()
ui2   =   leftRight $
  proc _ -> do
    ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()
    title "Pitch" display -< pitch ap

--mui2  =  runMUI' "Simple MUI (left-to-right layout)" ui2
--ui3  ::  UISF () ()
--ui3  =   proc _ -> do
--    ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()
--    title "Pitch" display -< pitch ap
--    uap <- unique -< ap
--    midiOut -< (0, fmap (\k-> [ANote 0 k 100 0.1]) uap)

--mui3  = runMUI' "Pitch Player" ui3

ui4   ::  UISF () ()
ui4   =   proc _ -> do
    devid <- selectOutput -< ()
    ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()
    title "Pitch" display -< pitch ap
    uap <- unique -< ap
    midiOut -< (devid, fmap (\k-> [ANote 0 k 100 0.1]) uap)

--mui4  = runMUI' "Pitch Player with MIDI Device Select" ui4

ui5   :: UISF () ()
ui5   = proc _ -> do
    mi  <- selectInput   -< ()
    mo  <- selectOutput  -< ()
    m   <- midiIn        -< mi
    midiOut -< (mo, m)

--mui5  = runMUI' "MIDI Input / Output UI" ui5

getDeviceIDs = topDown $
  proc () -> do
    mi    <- selectInput   -< ()
    mo    <- selectOutput  -< ()
    outA  -< (mi,mo)
ui6   ::  UISF () ()
ui6   =   proc _ -> do
    devid   <- selectOutput -< ()
    ap      <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()
    title "Pitch" display -< pitch ap
    f       <- title "Tempo" (hSlider (1,10) 1) -< ()
    tick    <- timer -< 1/f
    midiOut -< (devid, fmap (const [ANote 0 ap 100 0.1]) tick)

--mui6  = runMUI' "Pitch Player with Timer" ui6

chordIntervals :: [ (String, [Int]) ]
chordIntervals = [  ("Maj",     [4,3,5]),    ("Maj7",    [4,3,4,1]),
                    ("Maj9",    [4,3,4,3]),  ("Maj6",    [4,3,2,3]),
                    ("min",     [3,4,5]),    ("min7",    [3,4,3,2]),
                    ("min9",    [3,4,3,4]),  ("min7b5",  [3,3,4,2]),
                    ("mMaj7",   [3,4,4,1]),  ("dim",     [3,3,3]),
                    ("dim7",    [3,3,3,3]),  ("Dom7",    [4,3,3,2]),
                    ("Dom9",    [4,3,3,4]),  ("Dom7b9",  [4,3,3,3]) ]

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

buildChord :: UISF () ()
buildChord = leftRight $ 
  proc _ -> do
    (mi, mo)  <- getDeviceIDs -< ()
    m         <- midiIn -< mi
    i         <- topDown $ title "Chord Type" $ 
                   radio (fst (unzip chordIntervals)) 0 -< ()
    midiOut -< (mo, fmap (toChord i) m)

--chordBuilder = runMUI (600,400) "Chord Builder" buildChord
grow      :: Double -> Double -> Double
grow r x  = r * x * (1-x)

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

bifurcateUI :: UISF () ()
bifurcateUI = proc _ -> do
    mo    <- selectOutput -< ()
    f     <- title "Frequency" $ withDisplay (hSlider (1, 10) 1) -< ()
    tick  <- timer -< 1/f
    r     <- title "Growth rate" $ withDisplay (hSlider (2.4, 4.0) 2.4) -< ()
    pop   <- accum 0.1 -< fmap (const (grow r)) tick
    _     <- title "Population" $ display -< pop
    midiOut -< (mo, fmap (const (popToNote pop)) tick)

--bifurcate = runMUI (300,500) "Bifurcate!" $ bifurcateUI

echoUI :: UISF () ()
echoUI = proc _ -> do
    mi <- selectInput  -< ()
    mo <- selectOutput -< ()
    m <- midiIn -< mi
    r <- title "Decay rate" $ withDisplay (hSlider (0, 0.9) 0.5) -< ()
    f <- title "Echoing frequency" $ withDisplay (hSlider (1, 10) 10) -< ()

    rec let m' = removeNull $ mergeE (++) m s
        s <- vdelay -< (1/f, fmap (mapMaybe (decay 0.1 r)) m')

    midiOut -< (mo, m')

--echo = runMUI (500,500) "Echo" echoUI

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

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