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
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
ui2 :: UISF () ()
ui2 = leftRight $
proc _ -> do
ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()
title "Pitch" display -< pitch ap
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)
ui5 :: UISF () ()
ui5 = proc _ -> do
mi <- selectInput -< ()
mo <- selectOutput -< ()
m <- midiIn -< mi
midiOut -< (mo, m)
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)
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)
grow :: Double -> Double -> Double
grow r x = r * x * (1x)
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)
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')
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