-- maquinitas-tidal

module Korg.MR16 where

  import Korg.KorgBase
  import qualified Sound.Tidal.Params
  import Sound.Tidal.Pattern

  -- MIDI notes
  -- Korg MR-16 drum machine

  mr16 :: Pattern String -> ControlPattern
  mr16 :: Pattern String -> ControlPattern
mr16 = Pattern Note -> ControlPattern
Sound.Tidal.Params.n forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
subtract Note
60 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => String -> a
mr16MidiNote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
  
  mr16MidiNote :: Num a => String -> a
  mr16MidiNote :: forall a. Num a => String -> a
mr16MidiNote String
m =
    case String
m of
      String
"bd" -> a
35 -- bass drum
      String
"rs" -> a
37 -- rimshot
      String
"sd" -> a
38 -- snare drum
      String
"cp" -> a
39 -- clap
      String
"lt" -> a
41 -- low tom
      String
"ch" -> a
42 -- closed hihat
      String
"oh" -> a
46 -- open hihat
      String
"ht" -> a
47 -- high tom
      String
"cr" -> a
49 -- crash
      String
"rd" -> a
51 -- ride
      String
"lc" -> a
52 -- low conga
      String
"hc" -> a
53 -- high conga
      String
"ta" -> a
54 -- tambourine
      String
"cb" -> a
56 -- cow bell
      String
"ti" -> a
57 -- timbale
      String
"ca" -> a
58 -- cabasa
      String
"wb" -> a
60 -- wood block
      String
"la" -> a
61 -- low agogo
      String
"ha" -> a
63 -- high agogo
      String
"mp" -> a
64 -- metronome piano
      String
"mf" -> a
65 -- metronome forte
      String
_    -> a
0  -- no match