diff --git a/Sound/Tidal/MIDI/Ambika.hs b/Sound/Tidal/MIDI/Ambika.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/Ambika.hs @@ -0,0 +1,188 @@ +module Sound.Tidal.MIDI.Ambika where + +import Sound.Tidal.MIDI.Control +import Sound.Tidal.Params + +ambikaController :: ControllerShape +ambikaController = + ControllerShape + { controls = + [ mCC gain_p 7 + , mCC growl_p 9 + , mCC fuzz_p 12 + , mCC crush_p 13 + , mCC osc1range_p 14 + , mCC osc1detune_p 15 + , mCC osc1shape_p 16 + , mCC osc1param_p 17 + , mCC osc2shape_p 18 + , mCC osc2param_p 19 + , mCC osc2range_p 20 + , mCC osc2detune_p 21 + , mCC pan_p 22 + , mCC xmodtype_p 23 + , mCC xmodamount_p 24 + , mCC subshape_p 25 + , mCC sublevel_p 26 + , mCC noiselevel_p 27 + , mCC filtermode_p 28 + , mCC f2cutoff_p 29 + , mCC f2res_p 30 + , mCC f2mode_p 31 + , mCC lfo1sync_p 44 + , mCC lfo1rate_p 45 + , mCC lfo1shape_p 46 + , mCC lfo4rate_p 47 + , mCC lfo4shape_p 48 + , mCC lfo2sync_p 52 + , mCC lfo2rate_p 53 + , mCC lfo2shape_p 54 + , mCC lfo3sync_p 60 + , mCC lfo3rate_p 61 + , mCC lfo3shape_p 62 + , mCC hold_p 64 + , mCC legato_p 68 + , mCC env1s_p 70 + , mCC f1res_p 71 + , mCC env1r_p 72 + , mCC env1a_p 73 + , mCC f1cutoff_p 74 + , mCC env1d_p 75 + , mCC env2s_p 78 + , mCC env2r_p 80 + , mCC env2a_p 81 + , mCC env2d_p 83 + , mCC env3s_p 86 + , mCC env3r_p 88 + , mCC env3a_p 89 + , mCC env3d_p 91 + , mCC parttuning_p 94 + , mCC tuningspread_p 95 + , mCC arpmode_p 102 + , mCC arpdir_p 103 + , mCC arpoct_p 104 + , mCC arppat_p 105 + , mCC arpres_p 106 + , mCC polymode_p 107 + , mCC allsoundsoff_p 120 + , mCC resetallcontrollers_p 121 + , mCC allnotesoff_p 123 + ] + , latency = 0.1 + } + +ambikaSynth = toShape ambikaController + +(growl, growl_p) = pF "growl" (Just 0) + +(fuzz, fuzz_p) = pF "fuzz" (Just 0) + +(acrush, acrush_p) = pF "crush" (Just 0) + +(osc1range, osc1range_p) = pF "osc1range" (Just 0) + +(osc1detune, osc1detune_p) = pF "osc1detune" (Just 0) + +(osc1shape, osc1shape_p) = pF "osc1shape" (Just 0) + +(osc1param, osc1param_p) = pF "osc1param" (Just 0) + +(osc2range, osc2range_p) = pF "osc2range" (Just 0) + +(osc2detune, osc2detune_p) = pF "osc2detune" (Just 0) + +(osc2shape, osc2shape_p) = pF "osc2shape" (Just 0) + +(osc2param, osc2param_p) = pF "osc2param" (Just 0) + +(xmodtype, xmodtype_p) = pF "xmodtype" (Just 0) + +(xmodamount, xmodamount_p) = pF "xmodamount" (Just 0) + +(subshape, subshape_p) = pF "subshape" (Just 0) + +(sublevel, sublevel_p) = pF "sublevel" (Just 0) + +(noiselevel, noiselevel_p) = pF "noiselevel" (Just 0) + +(filtermode, filtermode_p) = pF "filtermode" (Just 0) + +(f1cutoff, f1cutoff_p) = pF "f1cutoff" (Just 0) + +(f1res, f1res_p) = pF "f1res" (Just 0) + +(f2cutoff, f2cutoff_p) = pF "f2cutoff" (Just 0) + +(f2res, f2res_p) = pF "f2res" (Just 0) + +(f2mode, f2mode_p) = pF "f2mode" (Just 0) + +(lfo1sync, lfo1sync_p) = pF "lfo1sync" (Just 0) + +(lfo1rate, lfo1rate_p) = pF "lfo1rate" (Just 0) + +(lfo1shape, lfo1shape_p) = pF "lfo1shape" (Just 0) + +(lfo2sync, lfo2sync_p) = pF "lfo2sync" (Just 0) + +(lfo2rate, lfo2rate_p) = pF "lfo2rate" (Just 0) + +(lfo2shape, lfo2shape_p) = pF "lfo2shape" (Just 0) + +(lfo3sync, lfo3sync_p) = pF "lfo3sync" (Just 0) + +(lfo3rate, lfo3rate_p) = pF "lfo3rate" (Just 0) + +(lfo3shape, lfo3shape_p) = pF "lfo3shape" (Just 0) + +(lfo4sync, lfo4sync_p) = pF "lfo4sync" (Just 0) + +(lfo4rate, lfo4rate_p) = pF "lfo4rate" (Just 0) + +(lfo4shape, lfo4shape_p) = pF "lfo4shape" (Just 0) + +(env1a, env1a_p) = pF "env1a" (Just 0) + +(env1d, env1d_p) = pF "env1d" (Just 0) + +(env1s, env1s_p) = pF "env1s" (Just 0) + +(env1r, env1r_p) = pF "env1r" (Just 0) + +(env2a, env2a_p) = pF "env2a" (Just 0) + +(env2d, env2d_p) = pF "env2d" (Just 0) + +(env2s, env2s_p) = pF "env2s" (Just 0) + +(env2r, env2r_p) = pF "env2r" (Just 0) + +(env3a, env3a_p) = pF "env3a" (Just 0) + +(env3d, env3d_p) = pF "env3d" (Just 0) + +(env3s, env3s_p) = pF "env3s" (Just 0) + +(env3r, env3r_p) = pF "env3r" (Just 0) + +(arpmode, arpmode_p) = pF "arpmode" (Just 0) + +(arpdir, arpdir_p) = pF "arpdir" (Just 0) + +(arpoct, arpoct_p) = pF "arpoct" (Just 0) + +(arppat, arppat_p) = pF "arppat" (Just 0) + +(arpres, arpres_p) = pF "arpres" (Just 0) + +(parttuning, parttuning_p) = pF "parttuning" (Just 0) + +(tuningspread, tuningspread_p) = pF "tuningspread" (Just 0) + +(polymode, polymode_p) = pF "polymode" (Just 0) + +(allsoundsoff, allsoundsoff_p) = pF "allsoundsoff" (Just 0) + +(allnotesoff, allnotesoff_p) = pF "allnotesoff" (Just 0) + +(resetallcontrollers, resetallcontrollers_p) = pF "resetallcontrollers" (Just 0) diff --git a/Sound/Tidal/MIDI/Blofeld.hs b/Sound/Tidal/MIDI/Blofeld.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/Blofeld.hs @@ -0,0 +1,67 @@ +module Sound.Tidal.MIDI.Blofeld where + +import Sound.Tidal.MIDI.Control +import Sound.Tidal.Params hiding (octave_p, semitone_p) + +bloController :: ControllerShape +bloController = + ControllerShape + { controls = + [ mCC portamento_p 5 + , mCC expression_p 11 + , CC lfoshape_p 15 (0, 5) passThru -- 0..5 - sine,triangle,square,saw,random,sample&hold + , mCC lforate_p 16 + , CC lfosync_p 17 (0, 1) passThru -- 0 off, 1 on + , mCC lfodelay_p 18 + , CC octave_p 27 (16, 112) passThru -- 16, 28, 40 .. 112 - 128' .. 1/2' + , CC semitone_p 28 (52, 76) passThru -- 52 .. 76 - -12 - +12 semitones + , mCC detune_p 29 + , mCC osc1fm_p 30 + , CC osc1shape_p 31 (0, 5) passThru -- 0..5 - pulse, saw, tri, sine, alt 1, alt 2 + , mCC osc1pw_p 33 + , mCC osc1pwm_p 34 + , mCC osc1vol_p 52 + , mCC osc1pan_p 53 + , mCC ringmod_p 54 + , mCC ringpan_p 55 + , mCC noise_p 60 + , mCC noisepan_p 61 + , mCC noisecol_p 62 + , mCC cutoff_p 69 + , mCC attack_p 101 + , mCC decay_p 102 + , mCC sustain_p 103 + , mCC release_p 106 + ] + , latency = 0.1 + } + +blofeld = toShape bloController + +(_, octave_p) = pF "octave" (Just 0) + +(_, semitone_p) = pF "semitone" (Just 0.5) + +(lforate, lforate_p) = pF "lforate" (Just 0) + +(osc1fm, osc1fm_p) = pF "osc1fm" (Just 0) + +(osc1shape, osc1shape_p) = pF "osc1shape" (Just 0) + +(osc1pw, osc1pw_p) = pF "osc1pw" (Just 0) + +(osc1pwm, osc1pwm_p) = pF "osc1pwm" (Just 0) + +(osc1vol, osc1vol_p) = pF "osc1vol" (Just 0) + +(osc1pan, osc1pan_p) = pF "osc1pan" (Just 0) + +(ringmod, ringmod_p) = pF "ringmod" (Just 0) + +(ringpan, ringpan_p) = pF "ringpan" (Just 0) + +(noise, noise_p) = pF "noise" (Just 0) + +(noisepan, noisepan_p) = pF "noisepan" (Just 0) + +(noisecol, noisecol_p) = pF "noisecol" (Just 0) diff --git a/Sound/Tidal/MIDI/CC.hs b/Sound/Tidal/MIDI/CC.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/CC.hs @@ -0,0 +1,397 @@ +module Sound.Tidal.MIDI.CC where + +import Sound.Tidal.MIDI.Control +import Sound.Tidal.Params + +ccallController :: ControllerShape +ccallController = + ControllerShape + { controls = + [ mCC cc0_p 0 + , mCC cc1_p 1 + , mCC cc2_p 2 + , mCC cc3_p 3 + , mCC cc4_p 4 + , mCC cc5_p 5 + , mCC cc6_p 6 + , mCC cc7_p 7 + , mCC cc8_p 8 + , mCC cc9_p 9 + , mCC cc10_p 10 + , mCC cc11_p 11 + , mCC cc12_p 12 + , mCC cc13_p 13 + , mCC cc14_p 14 + , mCC cc15_p 15 + , mCC cc16_p 16 + , mCC cc17_p 17 + , mCC cc18_p 18 + , mCC cc19_p 19 + , mCC cc20_p 20 + , mCC cc21_p 21 + , mCC cc22_p 22 + , mCC cc23_p 23 + , mCC cc24_p 24 + , mCC cc25_p 25 + , mCC cc26_p 26 + , mCC cc27_p 27 + , mCC cc28_p 28 + , mCC cc29_p 29 + , mCC cc30_p 30 + , mCC cc31_p 31 + , mCC cc32_p 32 + , mCC cc33_p 33 + , mCC cc34_p 34 + , mCC cc35_p 35 + , mCC cc36_p 36 + , mCC cc37_p 37 + , mCC cc38_p 38 + , mCC cc39_p 39 + , mCC cc40_p 40 + , mCC cc41_p 41 + , mCC cc42_p 42 + , mCC cc43_p 43 + , mCC cc44_p 44 + , mCC cc45_p 45 + , mCC cc46_p 46 + , mCC cc47_p 47 + , mCC cc48_p 48 + , mCC cc49_p 49 + , mCC cc50_p 50 + , mCC cc51_p 51 + , mCC cc52_p 52 + , mCC cc53_p 53 + , mCC cc54_p 54 + , mCC cc55_p 55 + , mCC cc56_p 56 + , mCC cc57_p 57 + , mCC cc58_p 58 + , mCC cc59_p 59 + , mCC cc60_p 60 + , mCC cc61_p 61 + , mCC cc62_p 62 + , mCC cc63_p 63 + , mCC cc64_p 64 + , mCC cc65_p 65 + , mCC cc66_p 66 + , mCC cc67_p 67 + , mCC cc68_p 68 + , mCC cc69_p 69 + , mCC cc70_p 70 + , mCC cc71_p 71 + , mCC cc72_p 72 + , mCC cc73_p 73 + , mCC cc74_p 74 + , mCC cc75_p 75 + , mCC cc76_p 76 + , mCC cc77_p 77 + , mCC cc78_p 78 + , mCC cc79_p 79 + , mCC cc80_p 80 + , mCC cc81_p 81 + , mCC cc82_p 82 + , mCC cc83_p 83 + , mCC cc84_p 84 + , mCC cc85_p 85 + , mCC cc86_p 86 + , mCC cc87_p 87 + , mCC cc89_p 89 + , mCC cc90_p 90 + , mCC cc91_p 91 + , mCC cc92_p 92 + , mCC cc93_p 93 + , mCC cc94_p 94 + , mCC cc95_p 95 + , mCC cc96_p 96 + , mCC cc97_p 97 + , mCC cc98_p 98 + , mCC cc99_p 99 + , mCC cc100_p 100 + , mCC cc101_p 101 + , mCC cc102_p 102 + , mCC cc103_p 103 + , mCC cc104_p 104 + , mCC cc105_p 105 + , mCC cc106_p 106 + , mCC cc107_p 107 + , mCC cc108_p 108 + , mCC cc109_p 109 + , mCC cc110_p 110 + , mCC cc111_p 111 + , mCC cc112_p 112 + , mCC cc113_p 113 + , mCC cc114_p 114 + , mCC cc115_p 115 + , mCC cc116_p 116 + , mCC cc117_p 117 + , mCC cc118_p 118 + , mCC cc119_p 119 + , mCC cc120_p 120 + , mCC cc121_p 121 + , mCC cc122_p 122 + , mCC cc123_p 123 + , mCC cc124_p 124 + , mCC cc125_p 125 + , mCC cc126_p 126 + , mCC cc127_p 127 + ] + , latency = 0.1 + } + +ccall = toShape ccallController + +(cc0, cc0_p) = pF "cc0" (Just 0) + +(cc1, cc1_p) = pF "cc1" (Just 0) + +(cc2, cc2_p) = pF "cc2" (Just 0) + +(cc3, cc3_p) = pF "cc3" (Just 0) + +(cc4, cc4_p) = pF "cc4" (Just 0) + +(cc5, cc5_p) = pF "cc5" (Just 0) + +(cc6, cc6_p) = pF "cc6" (Just 0) + +(cc7, cc7_p) = pF "cc7" (Just 0) + +(cc8, cc8_p) = pF "cc8" (Just 0) + +(cc9, cc9_p) = pF "cc9" (Just 0) + +(cc10, cc10_p) = pF "cc10" (Just 0) + +(cc11, cc11_p) = pF "cc11" (Just 0) + +(cc12, cc12_p) = pF "cc12" (Just 0) + +(cc13, cc13_p) = pF "cc13" (Just 0) + +(cc14, cc14_p) = pF "cc14" (Just 0) + +(cc15, cc15_p) = pF "cc15" (Just 0) + +(cc16, cc16_p) = pF "cc16" (Just 0) + +(cc17, cc17_p) = pF "cc17" (Just 0) + +(cc18, cc18_p) = pF "cc18" (Just 0) + +(cc19, cc19_p) = pF "cc19" (Just 0) + +(cc20, cc20_p) = pF "cc20" (Just 0) + +(cc21, cc21_p) = pF "cc21" (Just 0) + +(cc22, cc22_p) = pF "cc22" (Just 0) + +(cc23, cc23_p) = pF "cc23" (Just 0) + +(cc24, cc24_p) = pF "cc24" (Just 0) + +(cc25, cc25_p) = pF "cc25" (Just 0) + +(cc26, cc26_p) = pF "cc26" (Just 0) + +(cc27, cc27_p) = pF "cc27" (Just 0) + +(cc28, cc28_p) = pF "cc28" (Just 0) + +(cc29, cc29_p) = pF "cc29" (Just 0) + +(cc30, cc30_p) = pF "cc30" (Just 0) + +(cc31, cc31_p) = pF "cc31" (Just 0) + +(cc32, cc32_p) = pF "cc32" (Just 0) + +(cc33, cc33_p) = pF "cc33" (Just 0) + +(cc34, cc34_p) = pF "cc34" (Just 0) + +(cc35, cc35_p) = pF "cc35" (Just 0) + +(cc36, cc36_p) = pF "cc36" (Just 0) + +(cc37, cc37_p) = pF "cc37" (Just 0) + +(cc38, cc38_p) = pF "cc38" (Just 0) + +(cc39, cc39_p) = pF "cc39" (Just 0) + +(cc40, cc40_p) = pF "cc40" (Just 0) + +(cc41, cc41_p) = pF "cc41" (Just 0) + +(cc42, cc42_p) = pF "cc42" (Just 0) + +(cc43, cc43_p) = pF "cc43" (Just 0) + +(cc44, cc44_p) = pF "cc44" (Just 0) + +(cc45, cc45_p) = pF "cc45" (Just 0) + +(cc46, cc46_p) = pF "cc46" (Just 0) + +(cc47, cc47_p) = pF "cc47" (Just 0) + +(cc48, cc48_p) = pF "cc48" (Just 0) + +(cc49, cc49_p) = pF "cc49" (Just 0) + +(cc50, cc50_p) = pF "cc50" (Just 0) + +(cc51, cc51_p) = pF "cc51" (Just 0) + +(cc52, cc52_p) = pF "cc52" (Just 0) + +(cc53, cc53_p) = pF "cc53" (Just 0) + +(cc54, cc54_p) = pF "cc54" (Just 0) + +(cc55, cc55_p) = pF "cc55" (Just 0) + +(cc56, cc56_p) = pF "cc56" (Just 0) + +(cc57, cc57_p) = pF "cc57" (Just 0) + +(cc58, cc58_p) = pF "cc58" (Just 0) + +(cc59, cc59_p) = pF "cc59" (Just 0) + +(cc60, cc60_p) = pF "cc60" (Just 0) + +(cc61, cc61_p) = pF "cc61" (Just 0) + +(cc62, cc62_p) = pF "cc62" (Just 0) + +(cc63, cc63_p) = pF "cc63" (Just 0) + +(cc64, cc64_p) = pF "cc64" (Just 0) + +(cc65, cc65_p) = pF "cc65" (Just 0) + +(cc66, cc66_p) = pF "cc66" (Just 0) + +(cc67, cc67_p) = pF "cc67" (Just 0) + +(cc68, cc68_p) = pF "cc68" (Just 0) + +(cc69, cc69_p) = pF "cc69" (Just 0) + +(cc70, cc70_p) = pF "cc70" (Just 0) + +(cc71, cc71_p) = pF "cc71" (Just 0) + +(cc72, cc72_p) = pF "cc72" (Just 0) + +(cc73, cc73_p) = pF "cc73" (Just 0) + +(cc74, cc74_p) = pF "cc74" (Just 0) + +(cc75, cc75_p) = pF "cc75" (Just 0) + +(cc76, cc76_p) = pF "cc76" (Just 0) + +(cc77, cc77_p) = pF "cc77" (Just 0) + +(cc78, cc78_p) = pF "cc78" (Just 0) + +(cc79, cc79_p) = pF "cc79" (Just 0) + +(cc80, cc80_p) = pF "cc80" (Just 0) + +(cc81, cc81_p) = pF "cc81" (Just 0) + +(cc82, cc82_p) = pF "cc82" (Just 0) + +(cc83, cc83_p) = pF "cc83" (Just 0) + +(cc84, cc84_p) = pF "cc84" (Just 0) + +(cc85, cc85_p) = pF "cc85" (Just 0) + +(cc86, cc86_p) = pF "cc86" (Just 0) + +(cc87, cc87_p) = pF "cc87" (Just 0) + +(cc88, cc88_p) = pF "cc88" (Just 0) + +(cc89, cc89_p) = pF "cc89" (Just 0) + +(cc90, cc90_p) = pF "cc90" (Just 0) + +(cc91, cc91_p) = pF "cc91" (Just 0) + +(cc92, cc92_p) = pF "cc92" (Just 0) + +(cc93, cc93_p) = pF "cc93" (Just 0) + +(cc94, cc94_p) = pF "cc94" (Just 0) + +(cc95, cc95_p) = pF "cc95" (Just 0) + +(cc96, cc96_p) = pF "cc96" (Just 0) + +(cc97, cc97_p) = pF "cc97" (Just 0) + +(cc98, cc98_p) = pF "cc98" (Just 0) + +(cc99, cc99_p) = pF "cc99" (Just 0) + +(cc100, cc100_p) = pF "cc100" (Just 0) + +(cc101, cc101_p) = pF "cc101" (Just 0) + +(cc102, cc102_p) = pF "cc102" (Just 0) + +(cc103, cc103_p) = pF "cc103" (Just 0) + +(cc104, cc104_p) = pF "cc104" (Just 0) + +(cc105, cc105_p) = pF "cc105" (Just 0) + +(cc106, cc106_p) = pF "cc106" (Just 0) + +(cc107, cc107_p) = pF "cc107" (Just 0) + +(cc108, cc108_p) = pF "cc108" (Just 0) + +(cc109, cc109_p) = pF "cc109" (Just 0) + +(cc110, cc110_p) = pF "cc110" (Just 0) + +(cc111, cc111_p) = pF "cc111" (Just 0) + +(cc112, cc112_p) = pF "cc112" (Just 0) + +(cc113, cc113_p) = pF "cc113" (Just 0) + +(cc114, cc114_p) = pF "cc114" (Just 0) + +(cc115, cc115_p) = pF "cc115" (Just 0) + +(cc116, cc116_p) = pF "cc116" (Just 0) + +(cc117, cc117_p) = pF "cc117" (Just 0) + +(cc118, cc118_p) = pF "cc118" (Just 0) + +(cc119, cc119_p) = pF "cc119" (Just 0) + +(cc120, cc120_p) = pF "cc120" (Just 0) + +(cc121, cc121_p) = pF "cc121" (Just 0) + +(cc122, cc122_p) = pF "cc122" (Just 0) + +(cc123, cc123_p) = pF "cc123" (Just 0) + +(cc124, cc124_p) = pF "cc124" (Just 0) + +(cc125, cc125_p) = pF "cc125" (Just 0) + +(cc126, cc126_p) = pF "cc126" (Just 0) + +(cc127, cc127_p) = pF "cc127" (Just 0) diff --git a/Sound/Tidal/MIDI/Control.hs b/Sound/Tidal/MIDI/Control.hs --- a/Sound/Tidal/MIDI/Control.hs +++ b/Sound/Tidal/MIDI/Control.hs @@ -1,74 +1,159 @@ +{- | +Mappings between Tidal's 'Sound.Tidal.Stream.Param's and MIDI control changes +-} module Sound.Tidal.MIDI.Control where +import Control.Applicative ((<$>)) import qualified Sound.Tidal.Stream as S +import Sound.Tidal.Tempo (Tempo(cps)) +import qualified Data.Map.Strict as Map +import Data.Ratio +import Sound.Tidal.Params hiding (n_p) -import Sound.Tidal.Params +n_p :: S.Param +n_p = snd $ pI "n" (Just 128) +{-| +Map a 'Double' to 'Int' using given min/max values +-} type RangeMapFunc = (Int, Int) -> Double -> Int +{- | Make sure you apply @cutShape midiShape@ to an 'Sound.Tidal.Stream.ParamMap' +before passing it into a function wanting this type -} +type MIDINoteShape = S.ParamMap + +{-| +Describe mapping a Tidal 'Sound.Tidal.Stream.Param' in terms of MIDI +-} data ControlChange = - CC { param :: S.Param, - midi :: Int, - range :: (Int, Int), - vdefault :: Double, - scalef :: RangeMapFunc + CC { param :: S.Param, -- ^ the 'Sound.Tidal.Stream.Param' this control will apply to + midi :: Int, -- ^ the MIDI parameter number to map to + range :: (Int, Int), -- ^ the range this MIDI parameter accepts, by default this is (0,127) + scalef :: RangeMapFunc -- ^ the function to apply mapping floating point values from pattern to MIDI integer values } | NRPN { param :: S.Param, midi :: Int, range :: (Int, Int), - vdefault :: Double, scalef :: RangeMapFunc } | SysEx { param :: S.Param, midi :: Int, range :: (Int, Int), - vdefault :: Double, scalef :: RangeMapFunc } +{- | +A definition for using a Tidal with specific MIDI device type. + +By default, every 'ControllerShape' accepts the following 'Sound.Tidal.Stream.Param's: + +* 'Sound.Tidal.Params.dur' +* 'Sound.Tidal.Params.n' +* 'Sound.Tidal.Params.velocity' +* 'Sound.Tidal.Params.nudge' +* 'Sound.Tidal.Params.unit' + +which will define the MIDI note to be played. +-} data ControllerShape = ControllerShape { - controls :: [ControlChange], - latency :: Double + controls :: [ControlChange], -- ^ a list of controls that can be understood by a certain device type + latency :: Double -- ^ the latency to be used when sending out MIDI messages, this is passed to 'Sound.Tidal.Stream.Shape' } +{- | +A simple shape defining the 'Sound.Tidal.Stream.Param's that are used for generating MIDI notes. +This simplifies splitting a 'Sound.Tidal.Stream.ParamMap' into params for notes and control values. +-} +midiShape :: S.Shape +midiShape = S.Shape { + S.params = [ + dur_p, + n_p, + nudge_p, + velocity_p, + unit_p + ], + S.latency = 0, + S.cpsStamp = False + } + +{- | +Turns a 'MIDINoteShape' into concrete values for scheduling. + +-} +computeTiming :: Tempo -- ^ the current playback speed + -> Ratio Integer {- ^ if 'Sound.Tidal.Params.unit' is specified as @cycle@, +this will be utilized to calculate the note's absolute duration with regard to current cycle length __Note__: this will ignore the specified duration of the Tidal param 'Sound.Tidal.Params.dur' -} + -> MIDINoteShape -- ^ A map of 'Sound.Tidal.Stream.Param's that describes the note to be played + -> ((Int,Int,Ratio Integer), Double) -- ^ A tuple of a 'Sound.Tidal.MIDI.Output.TimedNote' triplet and the value for 'nudge' to offset this note by +computeTiming tempo duration note' = ((n', v', d'), nudge') + where + unit' = S.svalue $ note' Map.! unit_p + v' = mapRange (0, 127) $ S.fvalue $ note' Map.! velocity_p + n' = S.ivalue $ note' Map.! n_p + d' = case unit' of + "rate" -> byRate + "cycle" -> (+) (-0.001) $ (/) duration $ realToFrac $ cps tempo + _ -> byRate + byRate = realToFrac $ S.fvalue $ note' Map.! dur_p + + nudge' = S.fvalue $ note' Map.! nudge_p + +{- | Converts a 'ControllerShape's controls into 'Sound.Tidal.Stream.Param's and makes a 'Sound.Tidal.Stream.Shape' +This acts as an interface between Tidal's scheduling loop and MIDI scheduling. -} toShape :: ControllerShape -> S.Shape -toShape cs = - let params = [dur_p, n_p, velocity_p] ++ params' - params' = [param p | p <- (controls cs)] - in S.Shape { S.params = params, - S.cpsStamp = False, - S.latency = latency cs - } +toShape cs = S.Shape { + S.params = toParams cs, + S.cpsStamp = False, + S.latency = latency cs + } +{- | A 'RangeMapFunc' that simply passes 'floor's 'Double's. + +This can be used if a MIDI parameter of a device has different meanings for each value, +e.g. the type of oscillator has to be specified by either "0", "1", "2" or "3" each representing a different waveform (sine, tri, square, rand) +-} passThru :: (Int, Int) -> Double -> Int passThru (_, _) = floor -- no sanitizing of range… +{- | Default mapping function from Double to Int. + +>>> mapRange (0, 127) 0.5 +63 +-} mapRange :: (Int, Int) -> Double -> Int -mapRange (low, high) = floor . (+ (fromIntegral low)) . (* ratio) +mapRange (low, high) = floor . (+ fromIntegral low) . (* ratio) where ratio = fromIntegral $ high - low +-- | Helper function for creating a standard ControlChange for MIDI parameter mCC :: S.Param -> Int -> ControlChange -mCC p m = CC {param=p, midi=m, range=(0, 127), vdefault=0, scalef=mapRange } +mCC p m = CC {param=p, midi=m, range=(0, 127), scalef=mapRange } +-- | Helper function for creating a standard ControlChange for a non-registered MIDI parameter mNRPN :: S.Param -> Int -> ControlChange -mNRPN p m = NRPN {param=p, midi=m, range=(0, 127), vdefault=0, scalef=mapRange } +mNRPN p m = NRPN {param=p, midi=m, range=(0, 127), scalef=mapRange } -mrNRPN :: S.Param -> Int -> (Int, Int) -> Double -> ControlChange -mrNRPN p m r d = NRPN {param=p, midi=m, range=r, vdefault=d, scalef=mapRange } +-- | Helper function for creating a ControlChange for a non-registered MIDI parameter with a custom range +mrNRPN :: S.Param -> Int -> (Int, Int) -> ControlChange +mrNRPN p m r = NRPN {param=p, midi=m, range=r, scalef=mapRange } +-- | Translate a 'ControllerShape's controls into a list of 'Sound.Tidal.Stream.Param' toParams :: ControllerShape -> [S.Param] -toParams shape = map param (controls shape) +toParams shape' = map param (controls shape') +{- | Translate a Tidal 'Sound.Tidal.Stream.Param' into the corresponding MIDI parameter number +according to a specific 'ControllerShape' -} ctrlN :: Num b => ControllerShape -> S.Param -> Maybe b -ctrlN shape x = fmap fromIntegral $ fmap midi (paramN shape x) +ctrlN shape' x = (fromIntegral . midi) <$> (paramN shape' x) +-- | Find the first 'ControlChange' that uses 'Sound.Tidal.Stream.Param' paramN :: ControllerShape -> S.Param -> Maybe ControlChange -paramN shape x +paramN shape' x | x `elem` names = paramX $ matching p - | otherwise = Nothing -- error $ "No such Controller param: " ++ show x - where names = toParams shape + | otherwise = Nothing + where names = toParams shape' paramX [] = Nothing paramX (h:_) = Just h matching = filter ((== x) . param) - p = controls shape + p = controls shape' diff --git a/Sound/Tidal/MIDI/Device.hs b/Sound/Tidal/MIDI/Device.hs --- a/Sound/Tidal/MIDI/Device.hs +++ b/Sound/Tidal/MIDI/Device.hs @@ -1,17 +1,30 @@ +{-# OPTIONS_HADDOCK not-home #-} +{-| +Convenience functions to access "Sound.PortMidi" devices. +-} module Sound.Tidal.MIDI.Device where import qualified Sound.PortMidi as PM +{-| Example usage: + +>>> putStrLn =<< displayOutputDevices +ID: Name +0: Midi Through Port-0 +2: DSI Tetra MIDI 1 + +-} displayOutputDevices :: IO String displayOutputDevices = do devices <- getIndexedDevices return $ displayDevices $ getOutputDevices devices +-- | Readable version of a list of indexed MIDI devices displayDevices :: Show a => [(a, PM.DeviceInfo)] -> String displayDevices devices = let indices = map (show . fst) devices names = map ((":\t"++) . PM.name . snd) devices pairs = zipWith (++) indices names - in unlines (["ID:\tName"]++pairs) + in unlines ("ID:\tName" : pairs) getOutputDevices :: [(a, PM.DeviceInfo)] -> [(a, PM.DeviceInfo)] getOutputDevices = filter (PM.output . snd) @@ -21,9 +34,9 @@ rawDevices <- getDevices return $ zip [0..] rawDevices -getDevices :: IO ([PM.DeviceInfo]) +getDevices :: IO [PM.DeviceInfo] getDevices = do - PM.initialize + _ <- PM.initialize count <- PM.countDevices mapM PM.getDeviceInfo [0..(count - 1)] @@ -34,3 +47,5 @@ case res of [] -> return Nothing [dev] -> return $ Just $ fromIntegral $ fst dev + + diff --git a/Sound/Tidal/MIDI/GMPerc.hs b/Sound/Tidal/MIDI/GMPerc.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/GMPerc.hs @@ -0,0 +1,87 @@ +module Sound.Tidal.MIDI.GMPerc where + +import Control.Applicative +import Sound.Tidal.MIDI.Control +import Sound.Tidal.Params + +gmpercController :: ControllerShape +gmpercController = + ControllerShape + { controls = [mCC balance_p 10, mCC reverb_p 91, mCC chorus_p 93] + , latency = 0.1 + } + +perc = midinote . (percN <$>) + +percN :: String -> Int +percN "hq" = 27 +percN "sl" = 28 +percN "sps" = 29 +percN "spl" = 30 +percN "st" = 31 +percN "sqc" = 32 +percN "mcl" = 33 +percN "mb" = 34 +percN "abd" = 35 +percN "bd" = 36 +percN "sti" = 37 +percN "sn" = 38 +percN "cp" = 39 +percN "esn" = 40 +percN "lft" = 41 +percN "ch" = 42 +percN "hft" = 43 +percN "hh" = 44 +percN "lt" = 45 +percN "oh" = 46 +percN "lmt" = 47 +percN "hmt" = 48 +percN "cr" = 49 +percN "ht" = 50 +percN "ri" = 51 +percN "cy" = 52 +percN "be" = 53 +percN "ta" = 54 +percN "scy" = 55 +percN "cow" = 56 +percN "cr2" = 57 +percN "vib" = 58 +percN "ri2" = 59 +percN "hb" = 60 +percN "lb" = 61 +percN "mhc" = 62 +percN "ohc" = 63 +percN "lc" = 64 +percN "hti" = 65 +percN "lti" = 66 +percN "hag" = 67 +percN "lag" = 68 +percN "ca" = 69 +percN "ma" = 70 +percN "shi" = 71 +percN "lhi" = 72 +percN "sgui" = 73 +percN "lgui" = 74 +percN "cl" = 75 +percN "hwb" = 76 +percN "lwb" = 77 +percN "mc" = 78 +percN "oc" = 79 +percN "mt" = 80 +percN "ot" = 81 +percN "sha" = 82 +percN "jb" = 83 +percN "bt" = 84 +percN "cas" = 85 +percN "ms" = 86 +percN "os" = 87 +percN _ = 0 + +-- general shape for stream +gmperc = toShape gmpercController + +(balance, balance_p) = pF "balance" (Just 0) + +(reverb, reverb_p) = pF "reverb" (Just 0) + +(chorus, chorus_p) = pF "chorus" (Just 0) diff --git a/Sound/Tidal/MIDI/KorgKP3.hs b/Sound/Tidal/MIDI/KorgKP3.hs --- a/Sound/Tidal/MIDI/KorgKP3.hs +++ b/Sound/Tidal/MIDI/KorgKP3.hs @@ -5,24 +5,29 @@ import Sound.Tidal.MIDI.Control kp3 :: ControllerShape -kp3 = ControllerShape { controls = [ - mCC xaxis_p 12, - mCC yaxis_p 13, - mCC padon_p 92, - mCC level_p 93, - mCC fxdepth_p 94, - mCC holdbut_p 95 - ], - -- duration = ("dur", 0.05), - -- velocity = ("vel", 0.5), - latency = 0.1 - } +kp3 = + ControllerShape + { controls = + [ mCC xaxis_p 12 + , mCC yaxis_p 13 + , mCC padon_p 92 + , mCC level_p 93 + , mCC fxdepth_p 94 + , mCC holdbut_p 95 + ] + , latency = 0.1 + } oscKp3 = toShape kp3 (xaxis, xaxis_p) = pF "xaxis" (Just 0) + (yaxis, yaxis_p) = pF "yaxis" (Just 0) + (padon, padon_p) = pF "padon" (Just 0) + (level, level_p) = pF "level" (Just 0) + (fxdepth, fxdepth_p) = pF "fxdepth" (Just 0) + (holdbut, holdbut_p) = pF "holdbut" (Just 0) diff --git a/Sound/Tidal/MIDI/MBase01.hs b/Sound/Tidal/MIDI/MBase01.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/MBase01.hs @@ -0,0 +1,34 @@ +module Sound.Tidal.MIDI.MBase01 where + +import Sound.Tidal.MIDI.Control +import Sound.Tidal.Params + +mbase01Controller :: ControllerShape +mbase01Controller = + ControllerShape + { controls = + [ mCC tune_p 100 + , mCC pitch_p 101 + , mCC decay_p 102 + , mCC harmonics_p 103 + , mCC pulse_p 104 + , mCC noise_p 105 + , mCC attack_p 106 + , mCC eqlzr_p 107 + ] + , latency = 0.1 + } + +mbase01 = toShape mbase01Controller + +(tune, tune_p) = pF "tune" (Just 0) + +(pitch, pitch_p) = pF "pitch" (Just 0) + +(harmonics, harmonics_p) = pF "harmonics" (Just 0) + +(pulse, pulse_p) = pF "pulse" (Just 0) + +(noise, noise_p) = pF "noise" (Just 0) + +(eqlzr, eqlzr_p) = pF "eqlzr" (Just 0) diff --git a/Sound/Tidal/MIDI/MiniAtmegatron.hs b/Sound/Tidal/MIDI/MiniAtmegatron.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/MiniAtmegatron.hs @@ -0,0 +1,69 @@ +{-| +miniAtmegatron - Soulsby Synthesizers + +http://soulsbysynths.com/wp-content/uploads/2016/08/Mini-Manual.pdf, page 15 + +-} +module Sound.Tidal.MIDI.MiniAtmegatron where + +import Sound.Tidal.MIDI.Control +import Sound.Tidal.Params + +matmController :: ControllerShape +matmController = + ControllerShape + { controls = + [ mCC modwheel_p 1 + , mCC pan_p 10 + , mCC expression_p 11 + , mCC sustainpedal_p 64 + , mCC cutoff_p 74 + , mCC filtenv_p 16 + , mCC flfo_p 93 + , mCC alfo_p 92 + , mCC shape_p 17 + , mCC resonance_p 71 + , mCC penv_p 94 + , mCC plfo_p 1 + , mCC pwm_p 91 + , mCC flange_p 95 + , mCC fwave_p 30 + , mCC ffilt_p 31 + , mCC ffenv_p 32 + , mCC faenv_p 33 + , mCC mlfoshape_p 34 + , mCC lfospeed_p 79 + , mCC porta_p 5 + ] + , latency = 0.1 + } + +matm = toShape matmController + +(fen, filtenv_p) = pF "fen" (Just 0) + +(flo, flfo_p) = pF "flo" (Just 0) + +(alo, alfo_p) = pF "alo" (Just 0) + +(pen, penv_p) = pF "pen" (Just 0) + +(plo, plfo_p) = pF "plo" (Just 0) + +(pwm, pwm_p) = pF "pwm" (Just 0) + +(fln, flange_p) = pF "fln" (Just 0) + +(fwv, fwave_p) = pF "fwv" (Just 0) + +(ffl, ffilt_p) = pF "ffl" (Just 0) + +(ffe, ffenv_p) = pF "ffe" (Just 0) + +(fae, faenv_p) = pF "fae" (Just 0) + +(lfs, mlfoshape_p) = pF "lfs" (Just 0) + +(lss, lfospeed_p) = pF "lss" (Just 0) + +(por, porta_p) = pF "por" (Just 0) diff --git a/Sound/Tidal/MIDI/Output.hs b/Sound/Tidal/MIDI/Output.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/Output.hs @@ -0,0 +1,550 @@ +{-# OPTIONS_HADDOCK not-home #-} +{-| +A bridge between evaluated Tidal patterns and MIDI events. + +This module contains functions necessary to mediate between +'Sound.Tidal.Time.Event's generated from a Tidal 'Sound.Tidal.Pattern.Pattern' +and plain MIDI events sent through 'Sound.PortMidi.PMStream'. +-} +module Sound.Tidal.MIDI.Output ( + -- * Types + Output(..), + OutputState, + MidiDeviceMap, + TimedNote, + -- * Initialization + makeConnection, + flushBackend, + -- * Scheduling + sendevents, + store, + mkStore, + storeParams, + scheduleTime, + -- * Converters + toMidiValue, + cutShape, + stripDefaults, + -- * State handling + changeState, + readState, + -- * Low-level functions + useOutput, + displayOutputDevices, + outputDevice, + makeRawEvent, + noteOn, + noteOff, + makeCtrl + ) where + +-- generics +import Control.Applicative ((<$>), (<*>), pure) +import Control.Monad +import Control.Concurrent +import Control.Concurrent.MVar () +import Data.Bits +import Data.List (sortBy, find, partition) +import qualified Data.Map as Map +import Data.Maybe +import Data.Ord (comparing) +import Data.Ratio (Ratio) +import Data.Time (getCurrentTime, UTCTime) +import Data.Time.Clock.POSIX +import Foreign.C +import Numeric + +-- Tidal specific +import Sound.Tidal.Tempo (Tempo(Tempo)) +import Sound.Tidal.Stream as S + +-- MIDI specific +import Sound.Tidal.MIDI.Device +import Sound.Tidal.MIDI.Control +import qualified Sound.PortMidi as PM + +type ConnectionCount = Int +type TickedConnectionCount = Int +type OutputOnline = Bool +{- | +Keep track of virtual streams + +* Reflects the number of virtual streams that have already stored their events for this tick. Every time 'TickedConnectionCount' cycles, MIDI events will be sent out. +* 'ConnectionCount' is increased on every new stream created via `midiSetters` +* For each channel, currently used params and their values are kept. +* Output will only be scheduling, once __online__, i.e. when the first stream is initialized +-} +type OutputState = ( + TickedConnectionCount, + ConnectionCount, + [ParamMap], + OutputOnline + ) + +type Tick = Int +type Onset = Double +type Offset = Double +type RelativeOffset = Double +type MIDITime = (Tempo, Tick, Onset, RelativeOffset) +type MIDIEvent = (MIDITime, MIDIMessage) +type MIDIChannel = CLong +type MIDIStatus = CLong +type MIDINote = MIDIDatum +type MIDIVelocity = MIDIDatum +type MIDIDatum = CLong +type MIDIDuration = Ratio Integer +type MIDIMessage = (MIDIChannel, MIDIStatus, MIDINote, MIDIVelocity) +-- | A Triplet of the deviation from the note @a5@, velocity and duration +type TimedNote = (CLong, MIDIVelocity, MIDIDuration) +type SentEvent = (CULong, Double, PM.PMEvent, CULong, UTCTime) +{-| +An abstract definition of a physical MIDI Output. + +Manages virtual streams to multiple channels of a single connection to a MIDI device. +-} +data Output = Output { + cshape :: ControllerShape, -- ^ The ControllerShape defining which 'Param's will be available for use + conn :: PM.PMStream, -- ^ The physical connection to the device, uses 'PortMidi' + buffer :: MVar ([ParamMap], [MIDIEvent]), -- ^ A buffer of currently used 'Param's and their 'Value's as well as a list of 'MIDIEvent's to be sent on the next tick. + bufferstate :: MVar OutputState, -- ^ Keeps track of connected virtual streams during one tick + midistart :: CULong, -- ^ the MIDI time when this output was created + rstart :: UTCTime -- ^ the real time when this output was created + } + +type MidiMap = Map.Map S.Param (Maybe Int) +type MidiDeviceMap = Map.Map String Output + + +-- | Initialize a connection to the given MIDI device by Name +makeConnection :: MVar MidiDeviceMap -- ^ The current list of already connected devices + -> String -- ^ The MIDI device name + -> Int -- ^ The MIDI channel + -> ControllerShape -- ^ The definition of useable 'Control's + -> IO (S.ToMessageFunc, Output) -- ^ A function to schedule MIDI events and the output that keeps track of connections +makeConnection devicesM displayname channel controllershape = do + moutput <- useOutput devicesM displayname controllershape + case moutput of + Just o -> do + s <- connected channel displayname o + return (s, o) + Nothing -> + error "Failed initializing MIDI connection" + + +{- | +Sends out MIDI events once all virtual streams have buffered their events. + +This will be called after every tick +-} +flushBackend :: Output -> S.Shape -> Tempo -> Int -> IO () +flushBackend o shape change ticks = do + changeState tickConnections o + cycling <- readState isCycling o + + Control.Monad.when cycling (do + -- gather last sent params, update state with new + let buf = buffer o + (states, events) <- takeMVar buf + + ((_,_,newstates,_), (_,_,oldstates,_)) <- changeState' (resetParamStates states) o + + -- find params that were removed + let mapDefaults = Map.mapWithKey (\k _ -> defaultValue k) + diffs = map mapDefaults $ zipWith Map.difference oldstates newstates + -- store additional "reset" events in buffer + -- schedule time must be exactly before/ontime with the next regular event to be sent. otherwise we risk + -- mixing order of ctrl messages, and resets get overridden + -- FIXME: when scheduling, note late CC messages and DROP THEM, otherwise everything is screwed + let offset = S.latency shape + mididiffs = map ((toMidiMap (cshape o)).(stripShape (toShape $ cshape o))) $ diffs + resetevents = concat $ zipWith (\x y -> makectrls o x (change,ticks,1,offset) y) [1..] mididiffs + + -- send out MIDI events + (late, later) <- sendevents o shape change ticks events resetevents + -- finally clear buffered ParamMap for next tick + putMVar buf (replicate 16 Map.empty, later) + let len = length late + case len of + 0 -> + return () + _ -> do + putStrLn $ showLate $ head late + putStrLn $ "and " ++ show (len - 1) ++ " more") + + +-- Scheduling + +{- | +Sends out MIDI events due for this tick. +-} +sendevents :: Output -- ^ The connection to be used + -> S.Shape -- ^ The shape to be queried for latency + -> Tempo -- ^ The current speed + -> Tick -- ^ The number of ticks elapsed since start, may be reset when using @cps (-1)@ + -> [MIDIEvent] -- ^ A list of events potentially needed to be sent + -> [MIDIEvent] -- ^ A list of reset events potentially needed to be sent + -> IO ([SentEvent], [MIDIEvent]) -- ^ A list of events sent late and a list of events to send later +sendevents _ _ _ _ [] [] = return ([],[]) +sendevents s shape change ticks evts resets = do + -- assumptions: + -- all reset events have the same timestamp + -- questions: + -- could there be any events in `evts` at all that need reset? or are these just in late from the last tick? + let output = conn s + toDescriptor midiTime now (o,_,t,e) = (o,t,e, midiTime, now) + calcOnsets (a@(tempo, tick, onset, offset), e) = (a, logicalOnset' tempo tick onset offset, e) + + midiTime <- PM.time + now <- getCurrentTime + let offset = S.latency shape + nextTick = logicalOnset' change (ticks+1) 0 offset + mkEvent (t, o, e) = (midionset, t, o, makeRawEvent e midionset) + where midionset = scheduleTime (midistart s, rstart s) o + onsets = map calcOnsets evts + -- calculate temporary scheduling for resetevts + resetevts = map calcOnsets resets + -- split into events sent now and later (e.g. a noteOff that would otherwise cut off noteOn's in the next tick) + (evts', later) = span ((< nextTick).(\(_,o,_) -> o)) $ sortBy (comparing (\(_,o,_) -> o)) onsets + -- calculate MIDI time to schedule events, putting time into fn to create PM.PMEvents + evts'' = map mkEvent evts' + -- a list CC `names` that need to be reset + resetccs = map (\(_, _, (_, _, d1, _)) -> d1) resetevts + later' = map (\(t,_,e) -> (t,e)) later + findCC match list = find (\(_, _, (_, st, d1, _)) -> st == 0xB0 && (d1 `elem` match)) $ reverse list + + + -- 1. find the ccs that needs reset (search in `later` then in `evts`) + (evtstosend, laterevts) = case findCC resetccs later of + Nothing -> case findCC resetccs evts' of + -- 1c. no events at all need to be reset + -- 1cI. use the default passed in midionset for resets + -- 1cII. append `resets` to `evts` FIXME: make sure we really do by timing + -- 1cIII. send `evts` + Nothing -> (evts'' ++ map mkEvent resetevts, later') + -- 1b. only `evts` contain a CC to be reset + -- 1bI. set scheduletime for reset __after__ the latest CC that needs to be reset in `evts` + -- 1bII. add `resets` to `evts` + -- 1bIII. send `evts` + Just (_, latestO, _) -> (before ++ + map ( + \(t, o, e) -> + let midionset = scheduleTime (midistart s, rstart s) latestO + in (midionset, t,o,makeRawEvent e midionset) + ) resetevts ++ after, later') + where + (before, after) = partition (\(m,_,o,_) -> m > scheduleTime (midistart s, rstart s) o) evts'' + + -- 1a. `later` contains a cc to be reset, (omit searching in evts) + -- 1aI. set scheduletime for reset __after__ the latest CC that needs to be reset in `later` + -- 1aII. add `resetevts` to `later` + -- 1aIII. send `evts` + Just (latestT, _, _) -> (evts'', later' ++ map (\(_, _, e) -> (latestT, e)) resetevts) + evtstosend' = map (\(_,_,_,e) -> e) evtstosend + -- filter events that are too late + late = map (toDescriptor midiTime now) $ filter (\(_,_,t,_) -> t < realToFrac (utcTimeToPOSIXSeconds now)) evtstosend + -- drop late CC events to avoid glitches +-- evtstosend'' = map (\(_,_,e,_,_) -> e) $ filter (not.isCC) late + -- write events for this tick to stream + err <- PM.writeEvents output evtstosend' + + case err of + PM.NoError -> return (late, laterevts) -- return events for logging in outer scope + e -> do + putStrLn ("sending failed: " ++ show e) + return (late, laterevts) + +isCC :: SentEvent -> Bool +isCC (_,_,e,_,_) = (0x0f .&. cc) == 0xB0 + where + cc = PM.status $ PM.decodeMsg $ PM.message $ e + + + +-- | Buffer a single tick's MIDI events for a single channel of a single connection +store :: Output -> Int -> Tempo -> Tick -> Onset -> Offset -> MidiMap -> ParamMap -> IO () +store s ch change tick on off ctrls note = storemidi s ch' note' (change, tick, on, offset) ctrls + where + (note', nudge) = computeTiming' change on off note + ch' = fromIntegral ch + cshape' = cshape s + offset = Sound.Tidal.MIDI.Control.latency cshape' + nudge + +{- | +Returns a function to be called on every tick, +splits the given @ParamMap@ into MIDI note information +and CCs. +-} +mkStore :: Int -> Output -> IO ToMessageFunc +mkStore channel s = return $ \ shape change tick (on,off,m) -> do + let ctrls = cutShape shape m + props = cutShape midiShape m + ctrls' = stripDefaults ctrls + ctrls'' = toMidiMap (cshape s) <$> ctrls' + store' = store s channel change tick on off <$> ctrls'' + -- store even non-midi params, otherwise removing last ctrl results in a missing reset since diff in `flushBackend` would be empty + -- then buffer ctrl messages to be sent + -- with the appropriate note properties + ($) <$> (storeParams s channel <$> stripDefaults (applyShape' shape m)) <*> (($) <$> store' <*> props) + + +-- | Union the currently stored paramstate for certain channel with the given one +storeParams :: Output -> Int -> ParamMap -> IO () -> IO () +storeParams o ch m action = do + modifyMVar_ (buffer o) $ \(states, events) -> do + let (before,current:after) = splitAt (ch - 1) states + state' = Map.union m current + states' = before ++ [state'] ++ after + return (states', events) + action + +-- | Thin wrapper around @computeTiming@ to convert onset/offset into onset/duration relative +computeTiming' :: Tempo -> Double -> Double -> ParamMap -> (TimedNote, Double) +computeTiming' tempo on off note = ((fromIntegral n, fromIntegral v, d), nudge) + where + ((n,v,d), nudge) = computeTiming tempo (realToFrac (off - on) / S.ticksPerCycle) note + +{- | Schedule sending all CC's default values. +Produces an `onTick` handler. +-} +connected :: Int -> String -> Output -> IO ToMessageFunc +connected channel displayname s = do + let cshape' = cshape s + shape = toShape $ cshape s + defaultParams = S.defaultMap shape + allctrls = toMidiMap cshape' defaultParams + putStrLn ("Successfully initialized Device '" ++ displayname ++ "'") + changeState goOnline s + now <- getCurrentTime + _ <- storeevents s $ makectrls s (fromIntegral channel) (Tempo now 0 1 False 0,0,0,0) allctrls + mkStore channel s + +-- State handling + +readState :: (OutputState -> b) -> Output -> IO b +readState f o = do + s <- readMVar $ bufferstate o + + return $ f s + +isCycling :: OutputState -> Bool +isCycling (0, _, _, True) = True +isCycling _ = False + +-- displayState :: OutputState -> String +-- displayState (ticked, conns, paramstate, online) = show ticked ++ "/" ++ show conns ++ "[" ++ show online ++ "]" ++ " active params: " ++ show paramstate + +changeState :: (OutputState -> OutputState) -> Output -> IO () +changeState f o = do + _ <- changeState' f o + return () + +changeState' :: (OutputState -> OutputState) -> Output -> IO (OutputState, OutputState) +changeState' f o = do + bs <- takeMVar stateM + let fs = f bs + putMVar stateM fs + return (fs, bs) + where + stateM = bufferstate o + +-- | Params in use get overwritten by new ones, except if new ones means _no params_, in this case keep old +resetParamStates :: [ParamMap] -> OutputState -> OutputState +resetParamStates newstates (ticked, conns, paramstates, online) = (ticked, conns, zipWith resetParamState newstates paramstates, online) + +resetParamState :: ParamMap -> ParamMap -> ParamMap +resetParamState newstate currentstate + | Map.empty == newstate = currentstate -- updating with an empty state is a noop + | otherwise = newstate + +goOnline :: OutputState -> OutputState +goOnline (ticked, conns, paramstate, _) = (ticked, conns, paramstate, True) + +addConnection :: OutputState -> OutputState +addConnection (ticked, conns, paramstate, online) = (ticked, conns + 1, paramstate, online) + +tickConnections :: OutputState -> OutputState +tickConnections (ticked, conns, paramstate, online) = ((ticked + 1) `mod` conns, conns, paramstate, online) + +-- | open named MIDI output or use cached (PortMIDI doesn't like opening two connections to the same device!) +useOutput :: MVar MidiDeviceMap -> String -> ControllerShape -> IO (Maybe Output) +useOutput outsM displayname controllershape = do + outs <- readMVar outsM -- blocks + let outM = Map.lookup displayname outs -- maybe + -- if we have a valid output by now, return + case outM of + Just o -> do + putStrLn "Cached Device Output" + changeState addConnection o -- blocks + return $ Just o + Nothing -> do + -- otherwise open a new output and store the result in the mvar + devidM <- (>>= maybe (failed displayname "Failed opening MIDI Output Device ID") return) (getIDForDeviceName displayname) + econn <- outputDevice devidM 1 controllershape -- either + case econn of + Left o -> do + changeState addConnection o + _ <- swapMVar outsM $ Map.insert displayname o outs + return $ Just o + Right _ -> return Nothing + + +-- | Turn logicalOnset into MIDITime +scheduleTime :: (CULong, UTCTime)-> Double -> CULong +scheduleTime (mstart', rstart') logicalOnset = (+) mstart $ floor $ 1000 * (logicalOnset - rstart'') + where + rstart'' = realToFrac $ utcTimeToPOSIXSeconds rstart' + mstart = fromIntegral mstart' + +-- Converters + +{-| +Convert a @Param@'s @Value@ into a MIDI consumable datum. + +Applies range mapping and scaling functions according to @ControllerShape@ +-} +toMidiValue :: ControllerShape -> S.Param -> Value -> Maybe Int +toMidiValue s p (VF x) = ($) <$> mscale <*> mrange <*> pure x + where + mrange = fmap range mcc + mscale = fmap scalef mcc + mcc = paramN s p +toMidiValue _ _ (VI x) = Just x +toMidiValue _ _ (VS _) = Nothing -- ignore strings for now, we might 'read' them later + +-- | Translates generic params into midi params +toMidiMap :: ControllerShape -> S.ParamMap -> MidiMap +toMidiMap s m = Map.mapWithKey (toMidiValue s) m + +-- | Keep only params that are in a given shape, replace missing with defaults +cutShape :: S.Shape -> ParamMap -> Maybe ParamMap +cutShape s m = flip Map.intersection (S.defaultMap s) <$> S.applyShape' s m + +-- | Keep only params that are in a given shape +stripShape :: S.Shape -> ParamMap -> ParamMap +stripShape s = Map.intersection p' + where + p' = S.defaultMap s + +-- | Keep only params that are explicitly set (i.e. not default) +stripDefaults :: Maybe ParamMap -> Maybe ParamMap +stripDefaults m = Map.filterWithKey (\k v -> v /= defaultValue k) <$> m + + +-- Event creation + +-- FIXME: throws if param cannot be found +makectrls :: Output -> MIDIChannel -> MIDITime -> MidiMap -> [MIDIEvent] +makectrls o ch t ctrls = concatMap (\(param', ctrl) -> makeCtrl ch (fromJust $ paramN shape param') (fromIntegral ctrl) t) ctrls' + where + shape = cshape o + ctrls' = filter ((>=0) . snd) $ Map.toList $ Map.mapMaybe id ctrls + +makenote :: MIDIChannel -> TimedNote -> MIDITime -> [MIDIEvent] +makenote ch (note,vel,dur) (tempo,tick,onset,offset) = noteon' ++ noteoff' + where + noteon' = noteOn ch midinote vel (tempo,tick,onset,offset) + noteoff' = noteOff ch midinote (tempo,tick,onset,offset + fromRational dur) + midinote = note + 60 + +makemidi :: Output -> MIDIChannel -> TimedNote -> MIDITime -> MidiMap -> [MIDIEvent] +makemidi o ch (128,_,_) t ctrls = makectrls o ch t ctrls -- HACK: to send only CC use (n + 60) == 128 +makemidi o ch note t ctrls = makectrls o ch t ctrls ++ makenote ch note t + +-- Event buffering +storemidi :: Output -> MIDIChannel -> TimedNote -> MIDITime -> MidiMap -> IO () +storemidi o ch n t ctrls = do + _ <- storeevents o $ makemidi o ch n t ctrls + return () + + +makeEvent :: MIDIStatus -> MIDINote -> MIDIChannel -> MIDIVelocity -> MIDITime -> MIDIEvent +makeEvent st n ch v t = (t, msg) + where + msg = (ch, st, n, v) + +storeevents :: Output -> [MIDIEvent] -> IO (Maybe a) +storeevents o evts = do + let buf = buffer o + (paramstate, cbuf) <- takeMVar buf + putMVar buf (paramstate, cbuf ++ evts) + return Nothing + +-- Misc helpers + +showLate :: SentEvent -> String +showLate (o, t, e, m, n) = + unwords ["late", + show $ (\x -> [PM.status x, PM.data1 x, PM.data2 x]) $ PM.decodeMsg $ PM.message e, + "midi now ", show m, " midi onset: ", show o, + "onset (relative): ", show $ showFFloat (Just 3) (t - realToFrac (utcTimeToPOSIXSeconds n)) "", + ", sched: ", show $ PM.timestamp e] + +showEvent :: PM.PMEvent -> String +showEvent e = show t ++ " " ++ show msg + where msg = PM.decodeMsg $ PM.message e + t = PM.timestamp e + +showRawEvent :: (CULong, MIDITime, Double, PM.PMEvent) -> String +showRawEvent (_, (_,_,onset,offset), logicalOnset, e) = "(" ++ show onset ++ "," ++ show offset ++ ") / " ++ show logicalOnset ++ " " ++ showEvent e + +failed :: (Show a, Show b) => a -> b -> c +failed di err = error (show err ++ ": " ++ show di) + + +--------------- +-- LOW LEVEL -- +--------------- + +-- MIDI Event wrapping +makeRawEvent :: MIDIMessage -> CULong -> PM.PMEvent +makeRawEvent (ch, st, n, v) = PM.PMEvent msg + where msg = PM.encodeMsg $ PM.PMMsg (encodeChannel ch st) n v + + +-- MIDI Utils +encodeChannel :: MIDIChannel -> MIDIStatus -> CLong +encodeChannel ch cc = (-) ch 1 .|. cc + + +-- MIDI Messages +noteOn :: MIDIChannel -> MIDINote -> MIDIVelocity -> MIDITime -> [MIDIEvent] +noteOn ch val vel t = [makeEvent 0x90 val ch vel t] + +noteOff :: MIDIChannel -> MIDINote -> MIDITime -> [MIDIEvent] +noteOff ch val t = [makeEvent 0x80 val ch 60 t] + +makeCtrl :: MIDIChannel -> ControlChange -> MIDIDatum -> MIDITime -> [MIDIEvent] +makeCtrl ch CC {midi=midi'} n t = makeCC ch (fromIntegral midi') n t -- FIXME: no SysEx support right now +makeCtrl ch NRPN {midi=midi'} n t = makeNRPN ch (fromIntegral midi') n t + +makeCC :: MIDIChannel -> MIDIDatum -> MIDIDatum -> MIDITime -> [MIDIEvent] +makeCC ch c n t = [makeEvent 0xB0 c ch n t] + +makeNRPN :: MIDIChannel -> MIDIDatum -> MIDIDatum -> MIDITime -> [MIDIEvent] +makeNRPN ch c n t = [ + nrpn 0x63 ch (shift (c .&. 0x3F80) (-7)) t, + nrpn 0x62 ch (c .&. 0x7F) t, + nrpn 0x06 ch (shift (n .&. 0x3F80) (-7)) t, + nrpn 0x26 ch (n .&. 0x7F) t + ] + where + nrpn = makeEvent 0xB0 + + +-- | Creates an 'Output' wrapping a PortMidi device +outputDevice :: PM.DeviceID -> Int -> ControllerShape -> IO (Either Output PM.PMError) +outputDevice deviceID latency' shape = do + _ <- PM.initialize + result <- PM.openOutput deviceID latency' + bs <- newMVar (0, 0, replicate 16 Map.empty, False) + case result of + Left dev -> + do + info <- PM.getDeviceInfo deviceID + time <- getCurrentTime + mstart <- PM.time + putStrLn ("Opened: " ++ show (PM.interface info) ++ ": " ++ show (PM.name info)) + b <- newMVar (replicate 16 Map.empty, []) + + return (Left Output { cshape=shape, conn=dev, buffer=b, bufferstate=bs, midistart=mstart, rstart=time }) + Right err -> return (Right err) diff --git a/Sound/Tidal/MIDI/Stream.hs b/Sound/Tidal/MIDI/Stream.hs --- a/Sound/Tidal/MIDI/Stream.hs +++ b/Sound/Tidal/MIDI/Stream.hs @@ -1,368 +1,91 @@ -module Sound.Tidal.MIDI.Stream (midiStream, midiBackend, midiState, midiSetters, midiDevices,send) where +{-| +Entry functions for interacting with MIDI devices through Tidal. +-} +module Sound.Tidal.MIDI.Stream (midiStream, midiBackend, midiState, midiSetters, midiDevices, displayOutputDevices) where -import Control.Monad.Trans.Maybe -- generics +import Control.Concurrent +import Control.Concurrent.MVar () import qualified Data.Map as Map -import Data.List (sortBy) -import Data.Maybe -import Data.Ord (comparing) -import Data.Time (getCurrentTime, UTCTime, diffUTCTime) -import Data.Time.Clock.POSIX -import Control.Concurrent -import Control.Concurrent.MVar -import Data.Bits -import Foreign.C -import Control.Applicative -import Numeric - -- Tidal specific -import Sound.Tidal.Tempo (Tempo, cps, clockedTick) -import Sound.Tidal.Stream as S -import Sound.Tidal.Utils -import Sound.Tidal.Time -import Sound.Tidal.Transition (transition) +import Sound.Tidal.Stream as S +import Sound.Tidal.Time +import Sound.Tidal.Transition (transition) -- MIDI specific -import Sound.Tidal.MIDI.Device -import Sound.Tidal.MIDI.Control -import qualified Sound.PortMidi as PM +import Sound.Tidal.MIDI.Control +import Sound.Tidal.MIDI.Output -type ConnectionCount = Int -type TickedConnectionCount = Int -type OutputOnline = Bool -type OutputState = (TickedConnectionCount, ConnectionCount, OutputOnline) -type MIDITime = (Tempo, Int, Double, Double) -type MIDIEncoder = CULong -> PM.PMEvent -type MIDIEvent = (MIDITime, MIDIEncoder) +{-| +Create a handle for all currently used 'Output's indexed by their device name. -data Output = Output { - conn :: PM.PMStream, - buffer :: MVar [MIDIEvent], - bufferstate :: MVar OutputState - } +We use this to cache once opened devices. -type MidiMap = Map.Map S.Param (Maybe Int) -type MidiDeviceMap = Map.Map String Output +This will be passed to _every_ initialization of a virtual stream to a MIDI device +and is necessary since, 'PortMidi' only allows a single connection to a device. +-} +midiDevices :: IO (MVar MidiDeviceMap) +midiDevices = newMVar $ Map.fromList [] -toMidiEvent :: ControllerShape -> S.Param -> Value -> Maybe Int -toMidiEvent s p (VF x) = ($) <$> mscale <*> mrange <*> pure x - where - mrange = fmap range mcc - mscale = fmap scalef mcc - mcc = paramN s p -toMidiEvent s p (VI x) = Just x -toMidiEvent s p (VS x) = Nothing -- ignore strings for now, we might 'read' them later - -toMidiMap :: ControllerShape -> S.ParamMap -> MidiMap -toMidiMap s m = Map.mapWithKey (toMidiEvent s) (Map.mapMaybe (id) m) - -send s ch cshape shape change tick o ctrls (tdur:tnote:trest) = midi - where - midi = sendmidi s cshape ch' (note, vel, dur) (change, tick, o, offset) ctrls - note = fromIntegral $ ivalue $ snd tnote - dur = realToFrac $ fvalue $ snd tdur - (vel, nudge) = case length trest of - 2 -> (mkMidi $ trest !! 1, fvalue $ snd $ trest !! 0) - 1 -> (mkMidi $ trest !! 0, 0) - ch' = fromIntegral ch - mkMidi = fromIntegral . floor . (*127) . fvalue . snd - offset = ((Sound.Tidal.MIDI.Control.latency cshape) + nudge) - -mkSend cshape channel s = return $ (\ shape change tick (o,m) -> do - let defaulted = (S.applyShape' shape m) - -- split ParamMap into Properties and Controls - mpartition = fmap (Map.partitionWithKey (\k _ -> (name k) `elem` ["dur", "n", "velocity", "nudge"])) defaulted - props = fmap fst mpartition - ctrls = fmap snd mpartition - props' = fmap (Map.toAscList) $ fmap (Map.mapMaybe (id)) props - -- only send explicitly set Control values - ctrls' = fmap (Map.filterWithKey (\k v -> v /= (defaultValue k))) ctrls - ctrls'' = fmap (toMidiMap cshape) ctrls' - send' = fmap (send s channel cshape shape change tick o) ctrls'' - ($) <$> send' <*> props' - ) - -connected cshape channel name s = do - putStrLn ("Successfully initialized Device '" ++ name ++ "'") - changeState goOnline s - mkSend cshape channel s - -failed di err = do - error (show err ++ ": " ++ show di) - -notfound name = do - putStrLn "List of Available Device Names" - putStrLn =<< displayOutputDevices - error ("Device '" ++ show name ++ "' not found") - -readState f o = do - s <- readMVar $ bufferstate o - let fs = f s - (ticked, conns, online) = s - return fs - -isCycling (0, conns, True) = True -isCycling _ = False - -displayState (ticked, conns, online) = show ticked ++ "/" ++ show conns ++ "[" ++ show online ++ "]" - -changeState f o = do - bs <- takeMVar stateM - let fs = f bs - (ticked, conns, online) = fs - putMVar stateM $ fs - where - stateM = bufferstate o +{-| +Connect to a MIDI device with a given name and channel, +using a 'ControllerShape' to allow customized interaction +with specific MIDI synths. -goOnline (ticked, conns, online) = (ticked, conns, True) -addConnection (ticked, conns, online) = (ticked, conns + 1, online) -tickConnections (ticked, conns, online) = ((ticked + 1) `mod` conns, conns, online) +Needs a 'MidiDeviceMap' to operate, create on using 'midiDevices'! -useOutput outsM name lat = do - outs <- readMVar outsM -- blocks - let outM = Map.lookup name outs -- maybe - -- if we have a valid output by now, return - case outM of - Just o -> do - putStrLn "Cached Device Output" - changeState addConnection o -- blocks - return $ Just o - Nothing -> do - -- otherwise open a new output and store the result in the mvar - devidM <- (>>= maybe (failed name "Failed opening MIDI Output Device ID") return) (getIDForDeviceName name) - econn <- outputDevice devidM lat -- either - case econn of - Left o -> do - changeState addConnection o - swapMVar outsM $ Map.insert name o outs - return $ Just o - Right _ -> return Nothing +Usage: -makeConnection :: MVar (MidiDeviceMap) -> String -> Int -> ControllerShape -> IO ((S.ToMessageFunc), Output) -makeConnection devicesM deviceName channel cshape = do - moutput <- useOutput devicesM deviceName 1 - case moutput of - Just o -> do - s <- connected cshape channel deviceName o - return (s, o) - Nothing -> - --failed o - error "Failed" +@ +(m1, mt1) <- midiSetters devices "My Synth Controller Device name" 1 synthController getNow +@ -showLate :: (CULong, Double, PM.PMEvent, CULong, UTCTime) -> String -showLate (o, t, e, m, n) = - unwords ["late", - (show $ (\x -> [PM.status x, PM.data1 x, PM.data2 x]) $ PM.decodeMsg $ PM.message e), - "midi now ", show m, " midi onset: ", show o, - "onset (relative): ", show $ showFFloat (Just 3) (t - (realToFrac $ utcTimeToPOSIXSeconds n)) "", - ", sched: ", show $ PM.timestamp e] +To find the correct name for your device see 'displayOutputDevices' +-} +midiSetters :: MVar MidiDeviceMap -- ^ A list of MIDI output devices + -> String -- ^ The name of the output device to connect + -> Int -- ^ The MIDI Channel to use + -> ControllerShape -- ^ The definition of params to be usable + -> IO Time -- ^ a method to get the current time + -> IO (ParamPattern -> IO (), (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ()) +midiSetters d n c s getNow = do + ds <- midiState d n c s + return (setter ds, transition getNow ds) --- should only send out events if all connections have ticked -flushBackend :: Output -> S.Shape -> Tempo -> Int -> IO () -flushBackend o shape change ticks = do - changeState tickConnections o - cycling <- readState isCycling o - - case cycling of - True -> do - late <- sendevents o shape change ticks - let len = length late - - case len of - 0 -> - return () - _ -> do - putStrLn $ showLate $ head late - putStrLn $ "and " ++ show (len - 1) ++ " more" - False -> do - s <- readState displayState o - - return () - - -midiDevices :: IO (MVar (MidiDeviceMap)) -midiDevices = do - newMVar $ Map.fromList [] - -midiBackend d n c cs = do - (s, o) <- makeConnection d n c cs - return $ Backend s (flushBackend o) +{-| +Creates a single virtual stream to a MIDI device using a specific 'ControllerShape' +Needs a 'MidiDeviceMap' to operate, create one using 'midiDevices'! +-} +midiStream :: MVar MidiDeviceMap -> String -> Int -> ControllerShape -> IO (ParamPattern -> IO ()) midiStream d n c s = do backend <- midiBackend d n c s stream backend (toShape s) +{-| +Creates a single virtual state for a MIDI device using a specific 'ControllerShape' + +This state can be used to either create a 'Sound.Tidal.Stream.setter' or a 'Sound.Tidal.Transition.transition' from it. + +Needs a 'MidiDeviceMap' to operate, create one using 'midiDevices'! +-} +midiState :: MVar MidiDeviceMap -> String -> Int -> ControllerShape -> IO (MVar (ParamPattern, [ParamPattern])) midiState d n c s = do backend <- midiBackend d n c s S.state backend (toShape s) -midiSetters :: MVar (MidiDeviceMap) -> String -> Int -> ControllerShape -> IO Time -> IO (ParamPattern -> IO (), (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ()) -midiSetters d n c s getNow = do - ds <- midiState d n c s - return (setter ds, transition getNow ds) - -toDescriptor midiTime now (o,m,t,e) = (o,t,e, midiTime, now) - -calcOnsets (a@(tempo, tick, onset, offset), e) = (a, logicalOnset' tempo tick onset offset, e) - -showEvent :: PM.PMEvent -> String -showEvent e = show t ++ " " ++ show msg - where msg = PM.decodeMsg $ PM.message e - t = PM.timestamp e - -showRawEvent :: (CULong, MIDITime, Double, PM.PMEvent) -> String -showRawEvent (midionset, (tempo,tick,onset,offset), logicalOnset, e) = show onset ++ " " ++ " / " ++ show logicalOnset ++ " " ++ showEvent e - -sendevents :: Output -> S.Shape -> Tempo -> Int -> IO ([(CULong, Double, PM.PMEvent, CULong, UTCTime)]) -sendevents stream shape change ticks = do - let buf = buffer stream - output = conn stream - buf' <- tryTakeMVar buf - case buf' of - Nothing -> do - return [] - Just [] -> do - -- make sure we put back an empty buffer - putMVar buf [] - return [] - (Just evts@(x:xs)) -> do - midiTime <- PM.time - now <- getCurrentTime - - let offset = S.latency shape - nextTick = logicalOnset' change (ticks+1) 0 offset - onsets = map calcOnsets evts - -- split into events sent now and later (e.g. a noteOff that would otherwise cut off noteOn's in the next tick) - (evts', later) = span ((< nextTick).(\(_,o,_) -> o)) $ sortBy (comparing (\(_,o,_) -> o)) onsets - -- calculate MIDI time to schedule events, putting time into fn to create PM.PMEvents - evts'' = map (\(t, o, e) -> let midionset = scheduleTime midiTime now o - in (midionset, t, o, e midionset)) evts' - later' = map (\(t,o,e) -> (t,e)) later - evts''' = map (\(_,_,_,e) -> e) evts'' - -- filter events that are too late - late = map (toDescriptor midiTime now) $ filter (\(_,_,t,_) -> t < (realToFrac $ utcTimeToPOSIXSeconds now)) $ evts'' - - -- write events for this tick to stream - err <- PM.writeEvents output evts''' - -- store later events for nextTick - putMVar buf later' - case err of - PM.NoError -> do - -- return events for logging in outer scope - return late - e -> do - putStrLn "sending failed" - return [] - - -sendctrls :: Output -> ControllerShape -> CLong -> MIDITime -> MidiMap -> IO () -sendctrls stream shape ch t ctrls = do - let ctrls' = filter ((>=0) . snd) $ Map.toList $ Map.mapMaybe (id) ctrls - sequence_ $ map (\(param, ctrl) -> makeCtrl stream ch (fromJust $ paramN shape param) (fromIntegral ctrl) t) ctrls' -- FIXME: we should be sure param has ControlChange - return () - -sendnote :: Output -> t -> CLong -> (CLong, CLong, Double) -> MIDITime -> IO () -sendnote stream shape ch (note,vel, dur) (tempo,tick,onset,offset) = - do - noteOn stream ch midinote vel (tempo,tick,onset,offset) - noteOff stream ch midinote (tempo, tick, onset, offset + dur) - return () - where midinote = note + 60 - -scheduleTime :: CULong -> UTCTime -> Double -> CULong -scheduleTime mnow' now' logicalOnset = t - where - now = realToFrac $ utcTimeToPOSIXSeconds $ now' - mnow = fromIntegral mnow' - t = floor $ mnow + (1000 * (logicalOnset - now)) -- 1 second are 1000 microseconds as is the unit of timestamps in PortMidi - - -sendmidi :: Output -> ControllerShape -> CLong -> (CLong, CLong, Double) -> MIDITime -> MidiMap -> IO () -sendmidi stream shape ch n t ctrls = do - sendmidi' stream shape ch n t ctrls - return () - - -sendmidi' stream shape ch (128,vel,dur) t ctrls = do - sendctrls stream shape ch t ctrls - return () -sendmidi' stream shape ch (note,vel,dur) t ctrls = do - sendnote stream shape ch (note,vel,dur) t - sendctrls stream shape ch t ctrls - return () - - --- MIDI Utils -encodeChannel :: (Bits a, Num a) => a -> a -> a -encodeChannel ch cc = (((-) ch 1) .|. cc) - - --- MIDI Messages -noteOn :: Output -> CLong -> CLong -> CLong -> MIDITime -> IO (Maybe a) -noteOn o ch val vel t = do - let evt = (t, \t' -> makeEvent 0x90 val ch vel t') - sendEvent o evt - -noteOff :: Output -> CLong -> CLong -> MIDITime -> IO (Maybe a) -noteOff o ch val t = do - let evt = (t, \t' -> makeEvent 0x80 val ch 60 t') - sendEvent o evt - -makeCtrl :: Output -> CLong -> ControlChange -> CLong -> MIDITime -> IO (Maybe a) -makeCtrl o ch (CC {midi=midi, range=range}) n t = makeCC o ch (fromIntegral midi) n t -makeCtrl o ch (NRPN {midi=midi, range=range}) n t = makeNRPN o ch (fromIntegral midi) n t - --- This is sending CC -makeCC :: Output -> CLong -> CLong -> CLong -> MIDITime -> IO (Maybe a) -makeCC o ch c n t = do - let evt = (t, \t' -> makeEvent 0xB0 c ch n t') - sendEvent o evt - --- This is sending NRPN -makeNRPN :: Output -> CLong -> CLong -> CLong -> MIDITime -> IO (Maybe a) -makeNRPN o ch c n t = do - let nrpn = makeEvent 0xB0 - evts = [(t, (\t' -> nrpn 0x63 ch (shift (c .&. 0x3F80) (-7)) t')), - (t, (\t' -> nrpn 0x62 ch (c .&. 0x7F) t')), - (t, (\t' -> nrpn 0x06 ch (shift (n .&. 0x3F80) (-7)) t')), - (t, (\t' -> nrpn 0x26 ch (n .&. 0x7F) t')) - ] - mapM (sendEvent o) evts - return Nothing - - --- Port Midi Wrapper - -outputDevice :: PM.DeviceID -> Int -> IO (Either Output PM.PMError) -outputDevice deviceID latency = do - PM.initialize - now <- getCurrentTime - result <- PM.openOutput deviceID latency - bs <- newMVar (0, 0, False) - case result of - Left dev -> - do - info <- PM.getDeviceInfo deviceID - putStrLn ("Opened: " ++ show (PM.interface info) ++ ": " ++ show (PM.name info)) - buffer <- newMVar [] - - return (Left Output { conn=dev, buffer=buffer, bufferstate=bs }) - Right err -> return (Right err) - - -makeEvent :: CLong -> CLong -> CLong -> CLong -> CULong -> PM.PMEvent -makeEvent st n ch v t = PM.PMEvent msg (t) - where msg = PM.encodeMsg $ PM.PMMsg (encodeChannel ch st) (n) (v) +{-| +Opens a connection to a MIDI device and wraps it in a 'Sound.Tidal.Stream.Backend' implementation. -sendEvent :: Output -> (MIDITime, (CULong -> PM.PMEvent)) -> IO (Maybe a) -sendEvent o evt = do - let buf = buffer o +Needs a 'MidiDeviceMap' to operate, create one using 'midiDevices'! +-} +midiBackend :: MVar MidiDeviceMap -> String -> Int -> ControllerShape -> IO (Backend a) +midiBackend d n c cs = do + (s, o) <- makeConnection d n c cs + return $ Backend s (flushBackend o) - cbuf <- takeMVar buf - putMVar buf (cbuf ++ [evt]) - return Nothing diff --git a/Sound/Tidal/MIDI/Synth.hs b/Sound/Tidal/MIDI/Synth.hs --- a/Sound/Tidal/MIDI/Synth.hs +++ b/Sound/Tidal/MIDI/Synth.hs @@ -1,17 +1,18 @@ module Sound.Tidal.MIDI.Synth where -import Sound.Tidal.Params import Sound.Tidal.MIDI.Control +import Sound.Tidal.Params synthController :: ControllerShape -synthController = ControllerShape { - controls = [ - mCC modwheel_p 1, - mCC pan_p 10, - mCC expression_p 11, - mCC sustainpedal_p 64 - ], - latency = 0.04 +synthController = + ControllerShape + { controls = + [ mCC modwheel_p 1 + , mCC pan_p 10 + , mCC expression_p 11 + , mCC sustainpedal_p 64 + ] + , latency = 0.1 } synth = toShape synthController diff --git a/Sound/Tidal/MIDI/SynthParams.hs b/Sound/Tidal/MIDI/SynthParams.hs deleted file mode 100644 --- a/Sound/Tidal/MIDI/SynthParams.hs +++ /dev/null @@ -1,46 +0,0 @@ -{- | -Module: SynthParams -Description: Parameters to control synth - -In general, synth parameters specify patterns of sounds, and patterns of effects on those sounds. These are the synthesis parameters you can use with the default Dirt synth: --} -module Sound.Tidal.MIDI.SynthParams ( - sound, - grp, - accelerate, - bandf, - bandq, - begin, - channel, - coarse, - crush, - cut, - cutoff, - cutoffegint, - delay, - delayfeedback, - delaytime, - detune, - dry, - end, - gain, - hcutoff, - hresonance, - loop, - n, - nudge, - offset, - orbit, - pan, - resonance, - room, - shape, - size, - speed, - s, - unit, - velocity, - vowel - ) where - -import Sound.Tidal.Params diff --git a/Sound/Tidal/MIDI/Synthino.hs b/Sound/Tidal/MIDI/Synthino.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/Synthino.hs @@ -0,0 +1,55 @@ +module Sound.Tidal.MIDI.Synthino where + +import Sound.Tidal.MIDI.Control +import Sound.Tidal.Params + +synthinoController :: ControllerShape +synthinoController = + ControllerShape + { controls = + [ mCC attack_p 73 + , mCC decay_p 75 + , mCC sustain_p 79 + , mCC release_p 72 + , mCC waveform_p 70 + , mCC pitchlforate_p 76 + , mCC pitchlfodepth_p 1 + , mCC lfowaveform_p 12 + , mCC filterlforate_p 13 + , mCC filterlfodepth_p 91 + , mCC peak_p 71 + , mCC cutoff_p 74 + , mCC bpm_p 16 + , mCC arplength_p 17 + , mCC arptranspose_p 18 + , mCC vol_p 7 + , mCC off_p 123 + ] + , latency = 0.1 + } + +synthino = toShape synthinoController + +(waveform, waveform_p) = pF "waveform" (Just 0) + +(pitchlforate, pitchlforate_p) = pF "pitchlforate" (Just 0) + +(pitchlfodepth, pitchlfodepth_p) = pF "pitchlfodepth" (Just 0) + +(lfowaveform, lfowaveform_p) = pF "lfowaveform" (Just 0) + +(filterlforate, filterlforate_p) = pF "filterlforate" (Just 0) + +(filterlfodepth, filterlfodepth_p) = pF "filterlfodepth" (Just 0) + +(peak, peak_p) = pF "peak" (Just 0) + +(bpm, bpm_p) = pF "bpm" (Just 0) + +(arplength, arplength_p) = pF "arplength" (Just 0) + +(arptranspose, arptranspose_p) = pF "arptranspose" (Just 0) + +(vol, vol_p) = pF "vol" (Just 0) + +(off, off_p) = pF "off" (Just 0) diff --git a/Sound/Tidal/MIDI/System1M.hs b/Sound/Tidal/MIDI/System1M.hs --- a/Sound/Tidal/MIDI/System1M.hs +++ b/Sound/Tidal/MIDI/System1M.hs @@ -1,118 +1,170 @@ module Sound.Tidal.MIDI.System1M where -import Sound.Tidal.Params import Sound.Tidal.MIDI.Control +import Sound.Tidal.Params system1mController :: ControllerShape -system1mController = ControllerShape {controls = [ - mCC rmod_p 1, - mCC rlpcutoff_p 3, - mCC rport_p 5, - mCC rres_p 9, - mCC rcrush_p 12, - mCC rdelaytime_p 13, - mCC rosc1_p 16, - mCC rosc2_p 17, - mCC rsub_p 18, - mCC rnoise_p 19, - mCC rpitchenv_p 22, - mCC rpitchatk_p 23, - mCC rpitchdecay_p 24, - mCC rlfopitch_p 26, - mCC rlfofade_p 27, - mCC rlfofilter_p 28, - mCC rlforate_p 29, - mCC rlfoamp_p 30, - mCC rlfotype_p 35, - mCC rosc1type_p 46, - mCC rosc1range_p 47, - mCC rosc1color_p 50, - mCC rosc1xmod_p 52, - mCC rosc2color_p 55, - mCC rosc2tune_p 56, - mCC rosc1mod_p 60, - mCC rosc2type_p 61, - mCC rosc2range_p 62, - mCC rosc2mod_p 63, - mCC ramptone_p 69, - mCC rhpcutoff_p 79, - mCC rfilterenv_p 81, - mCC rfilterkey_p 82, - mCC rfilteratk_p 83, - mCC rfilterdecay_p 84, - mCC rfiltersustain_p 85, - mCC rfilterrelease_p 86, - mCC rampatk_p 89, - mCC rampdecay_p 90, - mCC rreverb_p 91, - mCC rdelay_p 94, - mCC rampsustain_p 96, - mCC ramprelease_p 97, - mCC rosc2ring_p 111, - mCC rosc2sync_p 112, - mCC rsubtype_p 113, - mCC rnoisetype_p 114, - mCC rlpftype_p 115, - mCC rlegato_p 116, - mCC rlfokeytrig_p 117, - mCC rtemposync_p 118, - mCC rmono_p 119 - ], - -- duration = ("dur", 0.05), - -- velocity = ("vel", 0.5), - latency = 0.1} +system1mController = + ControllerShape + { controls = + [ mCC rmod_p 1 + , mCC rlpcutoff_p 3 + , mCC rport_p 5 + , mCC rres_p 9 + , mCC rcrush_p 12 + , mCC rdelaytime_p 13 + , mCC rosc1_p 16 + , mCC rosc2_p 17 + , mCC rsub_p 18 + , mCC rnoise_p 19 + , mCC rpitchenv_p 22 + , mCC rpitchatk_p 23 + , mCC rpitchdecay_p 24 + , mCC rlfopitch_p 26 + , mCC rlfofade_p 27 + , mCC rlfofilter_p 28 + , mCC rlforate_p 29 + , mCC rlfoamp_p 30 + , mCC rlfotype_p 35 + , mCC rosc1type_p 46 + , mCC rosc1range_p 47 + , mCC rosc1color_p 50 + , mCC rosc1xmod_p 52 + , mCC rosc2color_p 55 + , mCC rosc2tune_p 56 + , mCC rosc1mod_p 60 + , mCC rosc2type_p 61 + , mCC rosc2range_p 62 + , mCC rosc2mod_p 63 + , mCC ramptone_p 69 + , mCC rhpcutoff_p 79 + , mCC rfilterenv_p 81 + , mCC rfilterkey_p 82 + , mCC rfilteratk_p 83 + , mCC rfilterdecay_p 84 + , mCC rfiltersustain_p 85 + , mCC rfilterrelease_p 86 + , mCC rampatk_p 89 + , mCC rampdecay_p 90 + , mCC rreverb_p 91 + , mCC rdelay_p 94 + , mCC rampsustain_p 96 + , mCC ramprelease_p 97 + , mCC rosc2ring_p 111 + , mCC rosc2sync_p 112 + , mCC rsubtype_p 113 + , mCC rnoisetype_p 114 + , mCC rlpftype_p 115 + , mCC rlegato_p 116 + , mCC rlfokeytrig_p 117 + , mCC rtemposync_p 118 + , mCC rmono_p 119 + ] + , latency = 0.1 + } -oscKeys = toShape system1mController +system1m = toShape system1mController (rmod, rmod_p) = pF "rmod" (Just 0) + (rlpcutoff, rlpcutoff_p) = pF "rlpcutoff" (Just 0) + (rport, rport_p) = pF "rport" (Just 0) + (rres, rres_p) = pF "rres" (Just 0) + (rcrush, rcrush_p) = pF "rcrush" (Just 0) + (rdelaytime, rdelaytime_p) = pF "rdelaytime" (Just 0) + (rosc1, rosc1_p) = pF "rosc1" (Just 0) + (rosc2, rosc2_p) = pF "rosc2" (Just 0) + (rsub, rsub_p) = pF "rsub" (Just 0) + (rnoise, rnoise_p) = pF "rnoise" (Just 0) + (rpitchenv, rpitchenv_p) = pF "rpitchenv" (Just 0) + (rpitchatk, rpitchatk_p) = pF "rpitchatk" (Just 0) + (rpitchdecay, rpitchdecay_p) = pF "rpitchdecay" (Just 0) + (rlfopitch, rlfopitch_p) = pF "rlfopitch" (Just 0) + (rlfofade, rlfofade_p) = pF "rlfofade" (Just 0) + (rlfofilter, rlfofilter_p) = pF "rlfofilter" (Just 0) + (rlforate, rlforate_p) = pF "rlforate" (Just 0) + (rlfoamp, rlfoamp_p) = pF "rlfoamp" (Just 0) + (rlfotype, rlfotype_p) = pF "rlfotype" (Just 0) + (rosc1type, rosc1type_p) = pF "rosc1type" (Just 0) + (rosc1range, rosc1range_p) = pF "rosc1range" (Just 0) + (rosc1color, rosc1color_p) = pF "rosc1color" (Just 0) + (rosc1xmod, rosc1xmod_p) = pF "rosc1xmod" (Just 0) + (rosc2color, rosc2color_p) = pF "rosc2color" (Just 0) + (rosc2tune, rosc2tune_p) = pF "rosc2tune" (Just 0) + (rosc1mod, rosc1mod_p) = pF "rosc1mod" (Just 0) + (rosc2type, rosc2type_p) = pF "rosc2type" (Just 0) + (rosc2range, rosc2range_p) = pF "rosc2range" (Just 0) + (rosc2mod, rosc2mod_p) = pF "rosc2mod" (Just 0) + (ramptone, ramptone_p) = pF "ramptone" (Just 0) + (rhpcutoff, rhpcutoff_p) = pF "rhpcutoff" (Just 0) + (rfilterenv, rfilterenv_p) = pF "rfilterenv" (Just 0) + (rfilterkey, rfilterkey_p) = pF "rfilterkey" (Just 0) + (rfilteratk, rfilteratk_p) = pF "rfilteratk" (Just 0) + (rfilterdecay, rfilterdecay_p) = pF "rfilterdecay" (Just 0) + (rfiltersustain, rfiltersustain_p) = pF "rfiltersustain" (Just 0) + (rfilterrelease, rfilterrelease_p) = pF "rfilterrelease" (Just 0) + (rampatk, rampatk_p) = pF "rampatk" (Just 0) + (rampdecay, rampdecay_p) = pF "rampdecay" (Just 0) + (rreverb, rreverb_p) = pF "rreverb" (Just 0) + (rdelay, rdelay_p) = pF "rdelay" (Just 0) + (rampsustain, rampsustain_p) = pF "rampsustain" (Just 0) + (ramprelease, ramprelease_p) = pF "ramprelease" (Just 0) + (rosc2ring, rosc2ring_p) = pF "rosc2ring" (Just 0) + (rosc2sync, rosc2sync_p) = pF "rosc2sync" (Just 0) + (rsubtype, rsubtype_p) = pF "rsubtype" (Just 0) + (rnoisetype, rnoisetype_p) = pF "rnoisetype" (Just 0) + (rlpftype, rlpftype_p) = pF "rlpftype" (Just 0) + (rlegato, rlegato_p) = pF "rlegato" (Just 0) + (rlfokeytrig, rlfokeytrig_p) = pF "rlfokeytrig" (Just 0) + (rtemposync, rtemposync_p) = pF "rtemposync" (Just 0) + (rmono, rmono_p) = pF "rmono" (Just 0) diff --git a/Sound/Tidal/MIDI/Tetra.hs b/Sound/Tidal/MIDI/Tetra.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/Tetra.hs @@ -0,0 +1,694 @@ +{-# LANGUAGE OverloadedStrings #-} +{-| +Mapping and Abstractions for the analog four-voice synthesizer, TETR4 by Dave Smith Instruments. + +Rather than being a tutorial on how to write your own mappings for your MIDI devices, this is more like the kitchen sink: it shows what is possible. + +The DSI TETR4 has four separate voices that can (when set to multi-mode) be controlled via four different MIDI channels. Almost everything you can control directly on the device can be automated via MIDI messages. +-} +module Sound.Tidal.MIDI.Tetra where + +import Sound.Tidal.MIDI.Control + +import Sound.Tidal.Params + hiding (cutoff_p, attack_p, decay_p, sustain_p, release_p) +import Sound.Tidal.Pattern (Pattern(..), atom) +import Sound.Tidal.Stream + ((|+|), (|=|), ( # ), merge, ParamPattern) + +import Control.Applicative + +{-| +The controller mapping for TETR4 + +To get the most out of this device with tidal, I chose to use the non-registered parameter (NRPN) variant to control it. This allows to use the full spectrum for controls like @cutoff@ that allow more granular stepping than standard MIDI (164 instead of 128 steps). + +Many parameters diverge from the default ranges of 0 to 127 and therefore this mapping uses the @mapRange@ functionality for controls to allow you to always use double params, e.g.: + +>>> t1 $ n (run 4) # famt "0.5" # cutoff "0.3" # resonance "0.8" + +while @famt@, @cutoff@ and @resonance@ all have different ranges of operation (0..254, 0..14 and 0..127 respectively) + +Some parameters are essentially mode switches and I chose to pass the values you enter into patterns directly through to the resulting control change. The method @passThru@ on control specification simply skips the scaling of values (you can write your own scaler if you want). + +For very generic control I reused Tidal's own params, like @cutoff@, @attack@, @gain@, @pan@ and @release@. Sometimes the defaults for Tidal do not make sense for MIDI. See @(_, cutoff_p)@ below the actual controller shape for examples on how to deal with this. +-} +tetraController :: ControllerShape +tetraController = + ControllerShape + { controls = + [ mrNRPN osc1freq_p 0 (0, 120) + , mrNRPN osc1detune_p 1 (0, 100) + , NRPN osc1shape_p 2 (0, 103) passThru + , mNRPN osc1glide_p 3 + , NRPN osc1kbd_p 4 (0, 1) passThru + , mrNRPN osc2freq_p 5 (0, 120) + , mrNRPN osc2detune_p 6 (0, 100) + , NRPN osc2shape_p 7 (0, 103) passThru + , mNRPN osc2glide_p 8 + , NRPN osc2kbd_p 9 (0, 1) passThru + , NRPN oscsync_p 10 (0, 1) passThru + , NRPN glidemode_p 11 (0, 3) passThru + , NRPN oscslop_p 12 (0, 5) passThru + , mrNRPN oscmix_p 13 (0, 127) + , mNRPN noise_p 14 + , mrNRPN cutoff_p 15 (0, 164) + , mNRPN resonance_p 16 + , mNRPN kamt_p 17 + , mNRPN audiomod_p 18 + , NRPN fpoles_p 19 (0, 1) passThru + -- filter envelope + , mrNRPN famt_p 20 (0, 254) + , mNRPN fvel_p 21 + , mNRPN fdel_p 22 + , mNRPN fatk_p 23 + , mNRPN fdcy_p 24 + , mNRPN fsus_p 25 + , mNRPN frel_p 26 + , mNRPN vcavol_p 27 + , mNRPN pan_p 28 + , mNRPN gain_p 29 -- max volume by default + , mrNRPN vamt_p 30 (0, 127) -- max vca envelope amount + , mNRPN vvel_p 31 + , mNRPN vdel_p 32 + , mNRPN attack_p 33 + , mrNRPN decay_p 34 (0, 127) + , mrNRPN sustain_p 35 (0, 127) + , mNRPN release_p 36 + , NRPN lfo1rate_p 37 (0, 166) passThru + , NRPN lfo1shape_p 38 (0, 4) passThru + , mNRPN lfo1amt_p 39 + , NRPN lfo1dest_p 40 (0, 43) passThru + , NRPN lfo1sync_p 41 (0, 1) passThru + , NRPN lfo2rate_p 42 (0, 166) passThru -- unsynced + , NRPN lfo2shape_p 43 (0, 4) passThru + , mNRPN lfo2amt_p 44 + , NRPN lfo2dest_p 45 (0, 43) passThru + , NRPN lfo2sync_p 46 (0, 1) passThru + , NRPN lfo3rate_p 47 (0, 166) passThru -- unsynced + , NRPN lfo3shape_p 48 (0, 4) passThru + , mNRPN lfo3amt_p 49 + , NRPN lfo3dest_p 50 (0, 43) passThru + , NRPN lfo3sync_p 51 (0, 1) passThru + , NRPN lfo4rate_p 52 (0, 166) passThru -- unsynced + , NRPN lfo4shape_p 53 (0, 4) passThru + , mNRPN lfo4amt_p 54 + , NRPN lfo4dest_p 55 (0, 43) passThru + , NRPN lfo4sync_p 56 (0, 1) passThru + , NRPN emod_p 57 (0, 43) passThru + , mrNRPN eamt_p 58 (0, 254) + , mNRPN evel_p 59 + , mNRPN edel_p 60 + , mNRPN eatk_p 61 + , mNRPN edcy_p 62 + , mNRPN esus_p 63 + , mNRPN erel_p 64 + , NRPN mod1src_p 65 (0, 20) passThru + , mrNRPN mod1amt_p 66 (0, 254) + , NRPN mod1dst_p 67 (0, 47) passThru + , NRPN mod2src_p 68 (0, 20) passThru + , mrNRPN mod2amt_p 69 (0, 254) + , NRPN mod2dst_p 70 (0, 47) passThru + , NRPN mod3src_p 71 (0, 20) passThru + , mrNRPN mod3amt_p 72 (0, 254) + , NRPN mod3dst_p 73 (0, 47) passThru + , NRPN mod4src_p 74 (0, 20) passThru + , mrNRPN mod4amt_p 75 (0, 254) + , NRPN mod4dst_p 76 (0, 47) passThru + , NRPN seq1dst_p 77 (0, 47) passThru + , NRPN seq2dst_p 78 (0, 47) passThru + , NRPN seq3dst_p 79 (0, 47) passThru + , NRPN seq4dst_p 80 (0, 47) passThru + , mrNRPN mwhl_p 81 (0, 254) + , NRPN mwhldst_p 82 (0, 47) passThru + , mrNRPN aftt_p 83 (0, 254) + , NRPN afttdst_p 84 (0, 47) passThru + , mrNRPN breath_p 85 (0, 254) + , NRPN breathdst_p 86 (0, 47) passThru + , mrNRPN mvel_p 87 (0, 254) + , NRPN mveldst_p 88 (0, 47) passThru + , mrNRPN foot_p 89 (0, 254) + , NRPN footdst_p 90 (0, 47) passThru + , NRPN kbpm_p 91 (30, 250) passThru + , NRPN clockdiv_p 92 (0, 12) passThru -- TODO: document values + , NRPN bendrng_p 93 (0, 12) passThru + , NRPN sqntrig_p 94 (0, 4) passThru -- TODO: document values + , NRPN unisonkey_p 95 (0, 5) passThru -- TODO: document values + , NRPN unisonmode_p 96 (0, 4) passThru -- TODO: document values + , NRPN arpmode_p 97 (0, 14) passThru + , NRPN erepeat_p 98 (0, 1) passThru + , NRPN unison_p 99 (0, 1) passThru + , NRPN arp_p 100 (0, 1) passThru + , NRPN sqn_p 101 (0, 1) passThru + , NRPN mcr1_p 105 (0, 183) passThru + , NRPN mcr2_p 106 (0, 183) passThru + , NRPN mcr3_p 107 (0, 183) passThru + , NRPN mcr4_p 108 (0, 183) passThru + , mNRPN shape_p 110 + , mrNRPN btnfreq_p 111 (0, 127) + , mrNRPN btnvel_p 112 (0, 127) + , NRPN btnmode_p 113 (0, 1) passThru + , mNRPN pitch1_p 114 + , mNRPN pitch2_p 115 + , mNRPN fbvol_p 116 + -- left out: editor byte, + , mrNRPN ksplitpoint_p 118 (0, 127) + -- each patch has layer a/b + , NRPN kmode_p 119 (0, 2) passThru -- 0: normal, 1: stack, both layers respond to full key range, 2: split at ksplitpoint + , mCC notesoff_p 123 + , mCC ccreset_p 121 + , mCC damp_p 64 + ] + , latency = 0.1 + } + +tetra = toShape tetraController + +(notesoff, notesoff_p) = pF "notesoff" (Just 0) + +(ccreset, ccreset_p) = pF "ccreset" (Just 0) + +(damp, damp_p) = pF "damp" (Just (-1)) + +(osc1freq, osc1freq_p) = pF "osc1freq" (Just 0.2) + +(osc1detune, osc1detune_p) = pF "osc1detune" (Just 0.5) + +(osc1shape, osc1shape_p) = pI "osc1shape" (Just 1) + +(osc1glide, osc1glide_p) = pF "osc1glide" (Just 0) + +(osc1kbd, osc1kbd_p) = pI "osc1kbd" (Just 1) + +(osc2freq, osc2freq_p) = pF "osc2freq" (Just 0.2) + +(osc2detune, osc2detune_p) = pF "osc2detune" (Just 0.5) + +(osc2shape, osc2shape_p) = pI "osc2shape" (Just 1) + +(osc2glide, osc2glide_p) = pF "osc2glide" (Just 0) + +(osc2kbd, osc2kbd_p) = pI "osc2kbd" (Just 1) + +(oscsync, oscsync_p) = pF "oscsync" (Just 0) + +(glidemode, glidemode_p) = pI "glidemode" (Just 0) + +(oscslop, oscslop_p) = pF "oscslop" (Just 0) + +(oscmix, oscmix_p) = pF "oscmix" (Just 0.5) + +(noise, noise_p) = pF "noise" (Just 0) + +(kamt, kamt_p) = pF "kamt" (Just 0.5) + +-- overridden defaults for MIDI +(_, cutoff_p) = pF "cutoff" (Just 1) + +(_, attack_p) = pF "attack" (Just 0.12) + +(_, release_p) = pF "release" (Just 0.01) + +(_, decay_p) = pF "decay" (Just 0.5) + +(_, sustain_p) = pF "sustain" (Just 0.5) + +(audiomod, audiomod_p) = pF "audiomod" (Just 0) + +(fpoles, fpoles_p) = pI "fpoles" (Just 0) + +twopole = fpoles "0" + +fourpole = fpoles "1" + +-- filter envelope +(famt, famt_p) = pF "famt" (Just 0.5) + +(fvel, fvel_p) = pF "fvel" (Just 0) + +(fdel, fdel_p) = pF "fdel" (Just 0) + +(fatk, fatk_p) = pF "fatk" (Just 0.01) + +(fdcy, fdcy_p) = pF "fdcy" (Just 0) + +(fsus, fsus_p) = pF "fsus" (Just 0) + +(frel, frel_p) = pF "frel" (Just 0.01) + +(vcavol, vcavol_p) = pF "vcavol" (Just 0) + +(vamt, vamt_p) = pF "vamt" (Just 1) + +(vvel, vvel_p) = pF "vvel" (Just 0) + +(vdel, vdel_p) = pF "vdel" (Just 0) + +(lfo1rate, lfo1rate_p) = pF "lfo1rate" (Just 0) + +(lfo1shape, lfo1shape_p) = pI "lfo1shape" (Just 0) + +(lfo1amt, lfo1amt_p) = pF "lfo1amt" (Just 0) + +(lfo1dest, lfo1dest_p) = pF "lfo1dest" (Just 0) + +(lfo1sync, lfo1sync_p) = pI "lfo1sync" (Just 0) + +(lfo2rate, lfo2rate_p) = pF "lfo2rate" (Just 0) + +(lfo2shape, lfo2shape_p) = pI "lfo2shape" (Just 0) + +(lfo2amt, lfo2amt_p) = pF "lfo2amt" (Just 0) + +(lfo2dest, lfo2dest_p) = pF "lfo2dest" (Just 0) + +(lfo2sync, lfo2sync_p) = pI "lfo2sync" (Just 0) + +(lfo3rate, lfo3rate_p) = pF "lfo3rate" (Just 0) + +(lfo3shape, lfo3shape_p) = pI "lfo3shape" (Just 0) + +(lfo3amt, lfo3amt_p) = pF "lfo3amt" (Just 0) + +(lfo3dest, lfo3dest_p) = pF "lfo3dest" (Just 0) + +(lfo3sync, lfo3sync_p) = pI "lfo3sync" (Just 0) + +(lfo4rate, lfo4rate_p) = pF "lfo4rate" (Just 0) + +(lfo4shape, lfo4shape_p) = pI "lfo4shape" (Just 0) + +(lfo4amt, lfo4amt_p) = pF "lfo4amt" (Just 0) + +(lfo4dest, lfo4dest_p) = pF "lfo4dest" (Just 0) + +(lfo4sync, lfo4sync_p) = pI "lfo4sync" (Just 0) + +(emod, emod_p) = pF "emod" (Just 0) + +(eamt, eamt_p) = pF "eamt" (Just 0.5) + +(evel, evel_p) = pF "evel" (Just 0) + +(edel, edel_p) = pF "edel" (Just 0) + +(eatk, eatk_p) = pF "eatk" (Just 0.01) + +(edcy, edcy_p) = pF "edcy" (Just 0) + +(esus, esus_p) = pF "esus" (Just 0) + +(erel, erel_p) = pF "erel" (Just 0.01) + +(mod1src, mod1src_p) = pF "mod1src" (Just 0) + +(mod1amt, mod1amt_p) = pF "mod1amt" (Just 0.5) + +(mod1dst, mod1dst_p) = pF "mod1dst" (Just 0) + +(mod2src, mod2src_p) = pF "mod2src" (Just 0) + +(mod2amt, mod2amt_p) = pF "mod2amt" (Just 0.5) + +(mod2dst, mod2dst_p) = pF "mod2dst" (Just 0) + +(mod3src, mod3src_p) = pF "mod3src" (Just 0) + +(mod3amt, mod3amt_p) = pF "mod3amt" (Just 0.5) + +(mod3dst, mod3dst_p) = pF "mod3dst" (Just 0) + +(mod4src, mod4src_p) = pF "mod4src" (Just 0) + +(mod4amt, mod4amt_p) = pF "mod4amt" (Just 0.5) + +(mod4dst, mod4dst_p) = pF "mod4dst" (Just 0) + +(seq1dst, seq1dst_p) = pF "seq1dst" (Just 0) + +(seq2dst, seq2dst_p) = pF "seq2dst" (Just 0) + +(seq3dst, seq3dst_p) = pF "seq3dst" (Just 0) + +(seq4dst, seq4dst_p) = pF "seq4dst" (Just 0) + +(mwhl, mwhl_p) = pF "mwhl" (Just 0.5) + +(mwhldst, mwhldst_p) = pI "mwhldst" (Just 0) + +(aftt, aftt_p) = pF "aftt" (Just 0.5) + +(afttdst, afttdst_p) = pI "afttdst" (Just 0) + +(breath, breath_p) = pF "breath" (Just 0.5) + +(breathdst, breathdst_p) = pI "breathdst" (Just 0) + +(mvel, mvel_p) = pF "mvel" (Just 0.5) + +(mveldst, mveldst_p) = pI "mveldst" (Just 0) + +(foot, foot_p) = pF "foot" (Just 0.5) + +(footdst, footdst_p) = pI "footdst" (Just 0) + +(bendrng, bendrng_p) = pI "bendrng" (Just 0) + +-- left out: modwheel, breath, footctrl, pressure, velocity +(kbpm, kbpm_p) = pI "kbpm" (Just 0) + +(clockdiv, clockdiv_p) = pI "clockdiv" (Just 0) + +-- left out: pitchbend range +(sqntrig, sqntrig_p) = pF "sqntrig" (Just 0) + +(unisonkey, unisonkey_p) = pF "unisonkey" (Just 0) + +(unisonmode, unisonmode_p) = pF "unisonmode" (Just 0) + +(arpmode, arpmode_p) = pF "arpmode" (Just 0) + +(erepeat, erepeat_p) = pF "erepeat" (Just 0) + +(unison, unison_p) = pF "unison" (Just 0) + +(arp, arp_p) = pF "arp" (Just 0) + +(sqn, sqn_p) = pF "sqn" (Just 0) + +(mcr1, mcr1_p) = pI "mcr1" (Just 0) + +(mcr2, mcr2_p) = pI "mcr2" (Just 0) + +(mcr3, mcr3_p) = pI "mcr3" (Just 0) + +(mcr4, mcr4_p) = pI "mcr4" (Just 0) + +(btnfreq, btnfreq_p) = pF "btnfreq" (Just 0.25) + +(btnvel, btnvel_p) = pF "btnvel" (Just 1) + +(btnmode, btnmode_p) = pF "btnmode" (Just 0) + +(sub1vol, sub1vol_p) = pF "sub1vol" (Just 0) + +(sub2vol, sub2vol_p) = pF "sub2vol" (Just 0) + +(fbvol, fbvol_p) = pF "fbvol" (Just 0) + +(ksplitpoint, ksplitpoint_p) = pF "ksplitpoint" (Just 0.5) + +(kmode, kmode_p) = pF "kmode" (Just 0) + +knormal = kmode "0" + +kstack = kmode "0.5" + +ksplit = kmode "1" + +{-| Abstractions + +Though not yet finished, these are some examples on how to combine multiple parameters into one single function you can use within your patterns. + +Since Tidal 0.7 you can use the @grp@ method to allow things like: + +>>> t1 $ n (run 4) # adsr "0.1:0.6:0.3:0.9 0.8:0.3:0.9:0.1" + +which alternates between two filter envelope shapes, the first one with a sharp attack and a long decay/release and the latter with a long attack, high sustain and a short release. + +-} +-- adsr +adsr = grp [attack_p, decay_p, sustain_p, release_p] + +atk3 = grp [attack_p, fatk_p, eatk_p] + +dcy3 = grp [decay_p, fdcy_p, edcy_p] + +sus3 = grp [sustain_p, fsus_p, esus_p] + +rel3' = grp [release_p, frel_p, erel_p] + +-- lfo +lfotri = doublePattern 0 + +lforsaw = doublePattern 1 + +lfosaw = doublePattern 2 + +lfopulse = doublePattern 3 + +lforand = doublePattern 4 + +{-| +A hack to handle a param with completely different behavior for certain parts of the range: + +@lrate@ is limited from 0 to 150 and specifies values that will produce an lfo frequency + +@lstep@ however is essentially limited from 0 to 16 and specifies values that will produce rhythmic lfo based on the _sequence speed_. as taken from the manual: + +0: 32 steps +1: 16 steps +2: 8 steps +3: 6 steps +4: 4 steps +5: 3 steps +6: 2 steps +7: 1.5 steps +8: 1 step +9: 2/3 steps +10: 1/2 step +11: 1/3 step +12: 1/4 step +13: 1/6 step +14: 1/8 step +15: 1/16 step + +-} +lrate r = min 150 . max 0 <$> r + +lstep s = min 166 . max 151 . (+ 150) <$> s + +lfo1 s d r a = lfo1shape s |+| lfo1dest d |+| lfo1rate r |+| lfo1amt a + +lfo2 s d r a = lfo2shape s |+| lfo2dest d |+| lfo2rate r |+| lfo2amt a + +lfo3 s d r a = lfo3shape s |+| lfo3dest d |+| lfo3rate r |+| lfo3amt a + +lfo4 s d r a = lfo4shape s |+| lfo4dest d |+| lfo4rate r |+| lfo4amt a + +-- mod +mod1 s d a = mod1src s |+| mod1dst d |+| mod1amt a + +mod2 s d a = mod2src s |+| mod2dst d |+| mod2amt a + +mod3 s d a = mod3src s |+| mod3dst d |+| mod3amt a + +mod4 s d a = mod4src s |+| mod4dst d |+| mod4amt a + +{-| Modulation + +named sources and destinations to able to refer them for lfos, mods and also sequences. +-} +doublePattern d = atom d :: Pattern Double + +dosc1 = doublePattern 1 + +dosc2 = doublePattern 2 + +dosc = doublePattern 3 + +dmix = doublePattern 4 + +dnoise = doublePattern 5 + +dpw1 = doublePattern 6 + +dpw2 = doublePattern 7 + +dpw = doublePattern 8 + +dcut = doublePattern 9 + +dres = doublePattern 10 + +damod = doublePattern 11 + +dvca = doublePattern 12 + +dspread = doublePattern 13 + +dlfo1f = doublePattern 14 + +dlfo2f = doublePattern 15 + +dlfo3f = doublePattern 16 + +dlfo4f = doublePattern 17 + +dlfof = doublePattern 18 + +dlfo1a = doublePattern 19 + +dlfo2a = doublePattern 20 + +dlfo3a = doublePattern 21 + +dlfo4a = doublePattern 22 + +dlfoa = doublePattern 23 + +dfamt = doublePattern 24 + +dvamt = doublePattern 25 + +deamt = doublePattern 26 + +damt = doublePattern 27 + +dfatk = doublePattern 28 + +dvatk = doublePattern 29 + +deatk = doublePattern 30 + +datk = doublePattern 31 + +dfdcy = doublePattern 32 + +dvdcy = doublePattern 33 + +dedcy = doublePattern 34 + +ddcy = doublePattern 35 + +dfrel = doublePattern 36 + +dvrel = doublePattern 37 + +derel = doublePattern 38 + +drel = doublePattern 39 + +dmod1 = doublePattern 40 + +dmod2 = doublePattern 41 + +dmod3 = doublePattern 42 + +dmod4 = doublePattern 43 + +dfb = doublePattern 44 + +dsub1 = doublePattern 45 + +dsub2 = doublePattern 46 + +dshape = doublePattern 47 + +dslew = doublePattern 48 + +-- mod sources +sseq1 = doublePattern 1 + +sseq2 = doublePattern 2 + +sseq3 = doublePattern 3 + +sseq4 = doublePattern 4 + +slfo1 = doublePattern 5 + +slfo2 = doublePattern 6 + +slfo3 = doublePattern 7 + +slfo4 = doublePattern 8 + +sfenv = doublePattern 9 + +svenv = doublePattern 10 + +seenv = doublePattern 11 + +spitchb = doublePattern 12 + +smodwh = doublePattern 13 + +saftert = doublePattern 14 + +sbreath = doublePattern 15 + +sfoot = doublePattern 16 + +sexpr = doublePattern 17 + +svel = doublePattern 18 + +snote = doublePattern 19 + +snoise = doublePattern 20 + +{-| +Presets suck, but I constantly forget how to make drums +with the TETR4, so here are some defaults (that can mostly be changed when using them) +to make a snare and a kick. + +Use the snare like this: + +>>> t1 $ n "0(3,8)" # snare + +To make it shorter: + +>>> t1 $ n "0(3,8)" # snare |-| release "0.1" |-| decay "0.1" +-} +snare = + fourpole |=| osc1shape "0" |+| osc1kbd "0" |+| osc2shape "0" |+| osc2kbd "0" |+| + noise "1" |+| + shape "0.7" |+| + fbvol "0.3" |=| + resonance "0.2" |+| + release "0.3" |+| + sustain "0" |+| + decay "0.3" |+| + cutoff "1" |+| + dur "0.02" + +{-| +usage would be: + +>>> t1 $ n "0 [[0 1] 1]" # kick + +you can change the defaults by applying merge operations for certain params: + +>>> t1 $ n "0(3,8)" # kick |+| edcy "0.05" + +will give the kick more resonance + +>>> t1 $ n "0(3,8)" # kick |-| edcy "0.15" + +will make it really dry +-} +kick = + fourpole |+| osc1shape "0" |+| osc1kbd "0" |+| osc2shape "0" |+| osc2kbd "0" |+| + sustain "0" |+| + decay "0.95" |+| + release "0.5" |+| + resonance "0.99" |+| + cutoff "0.001" |+| + eamt "0.8" |+| + emod "9" |+| + edcy "0.2" + +{-| +Since the TETR4 lacks a high-pass filter, things like snares and especially cymbals are somewhat limited to filtered noise which sounds okish. + +Therefore some presets for the different types of sounds you can get from the TETR4 can come in handy and can also be combined and modified with and through others: +-} +{-| +A chip tune like sound, reminds me of gameboys +-} +chip = + osc1shape "2" # osc2shape "2" |+| osc2freq "0.23" # osc1glide "0.05" # + osc2glide "0.05" # + glidemode "3" # + release "0.78" diff --git a/Sound/Tidal/MIDI/VolcaBass.hs b/Sound/Tidal/MIDI/VolcaBass.hs --- a/Sound/Tidal/MIDI/VolcaBass.hs +++ b/Sound/Tidal/MIDI/VolcaBass.hs @@ -1,27 +1,26 @@ module Sound.Tidal.MIDI.VolcaBass where -import Sound.Tidal.Params import Sound.Tidal.MIDI.Control +import Sound.Tidal.Params -bassController :: ControllerShape -bassController = ControllerShape { controls = [ - mCC slide_p 5, - mCC expression_p 11, - mCC octave_p 40, - mCC lfo_p 41, - mCC lfoint_p 42, - mCC pitch1_p 43, - mCC pitch2_p 44, - mCC pitch3_p 45, - mCC attack_p 46, - mCC decay_p 47, - mCC cutoff_p 48, - mCC gate_p 49 - ], - --duration = ("dur", 0.05), - --velocity = ("vel", 0.5), - latency = 0.01 - } - -bass = toShape bassController +volcabassController :: ControllerShape +volcabassController = + ControllerShape + { controls = + [ mCC slide_p 5 + , mCC expression_p 11 + , mCC octave_p 40 + , mCC lfo_p 41 + , mCC lfoint_p 42 + , mCC pitch1_p 43 + , mCC pitch2_p 44 + , mCC pitch3_p 45 + , mCC attack_p 46 + , mCC decay_p 47 + , mCC cutoff_p 48 + , mCC gate_p 49 + ] + , latency = 0.1 + } +volcabass = toShape volcabassController diff --git a/Sound/Tidal/MIDI/VolcaBeats.hs b/Sound/Tidal/MIDI/VolcaBeats.hs --- a/Sound/Tidal/MIDI/VolcaBeats.hs +++ b/Sound/Tidal/MIDI/VolcaBeats.hs @@ -1,35 +1,34 @@ module Sound.Tidal.MIDI.VolcaBeats where -import Sound.Tidal.Params import Sound.Tidal.MIDI.Control +import Sound.Tidal.Params -beatsController :: ControllerShape -beatsController = ControllerShape { controls = [ - mCC lkick_p 40, - mCC lsnare_p 41, - mCC llotom_p 42, - mCC lhitom_p 43, - mCC lclhat_p 44, - mCC lophat_p 45, - mCC lclap_p 46, - mCC lclaves_p 47, - mCC lagogo_p 48, - mCC lcrash_p 49, - mCC sclap_p 50, - mCC sclaves_p 51, - mCC sagogo_p 52, - mCC scrash_p 53, - mCC stuttertime_p 54, - mCC stutterdepth_p 55, - mCC tomdecay_p 56, - mCC clhatdecay_p 57, - mCC ophatdecay_p 58, - mCC hatgrain_p 59 - ], - -- duration = ("dur", 0.05), - -- velocity = ("vel", 0.5), - latency = 0.01 - } +volcabeatsController :: ControllerShape +volcabeatsController = + ControllerShape + { controls = + [ mCC lkick_p 40 + , mCC lsnare_p 41 + , mCC llotom_p 42 + , mCC lhitom_p 43 + , mCC lclhat_p 44 + , mCC lophat_p 45 + , mCC lclap_p 46 + , mCC lclaves_p 47 + , mCC lagogo_p 48 + , mCC lcrash_p 49 + , mCC sclap_p 50 + , mCC sclaves_p 51 + , mCC sagogo_p 52 + , mCC scrash_p 53 + , mCC stuttertime_p 54 + , mCC stutterdepth_p 55 + , mCC tomdecay_p 56 + , mCC clhatdecay_p 57 + , mCC ophatdecay_p 58 + , mCC hatgrain_p 59 + ] + , latency = 0.1 + } --- What is this used for? -beats = toShape beatsController +volcabeats = toShape volcabeatsController diff --git a/Sound/Tidal/MIDI/VolcaFM.hs b/Sound/Tidal/MIDI/VolcaFM.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/VolcaFM.hs @@ -0,0 +1,39 @@ +module Sound.Tidal.MIDI.VolcaFM where + +import Sound.Tidal.MIDI.Control +import Sound.Tidal.Params + +volcafmController :: ControllerShape +volcafmController = + ControllerShape + { controls = + [ mCC octave_p 40 + , mCC velocity_p 41 + , mCC modattack_p 42 + , mCC moddecay_p 43 + , mCC carattack_p 44 + , mCC cardecay_p 45 + , mCC lfo_p 46 + , mCC lfopitchint_p 47 + , mCC algtm_p 48 + , mCC arp_p 49 + , mCC arpdiv_p 50 + ] + , latency = 0.1 + } + +(modattack, modattack_p) = pF "modattack" (Just 0) + +(moddecay, moddecay_p) = pF "moddecay" (Just 0) + +(carattack, carattack_p) = pF "carattack" (Just 0) + +(cardecay, cardecay_p) = pF "cardecay" (Just 0) + +(algtm, algtm_p) = pF "algtm" (Just 0) + +(arp, arp_p) = pF "arp" (Just 0) + +(arpdiv, arpdiv_p) = pF "arpdiv" (Just 0) + +volcafm = toShape volcafmController diff --git a/Sound/Tidal/MIDI/VolcaKeys.hs b/Sound/Tidal/MIDI/VolcaKeys.hs --- a/Sound/Tidal/MIDI/VolcaKeys.hs +++ b/Sound/Tidal/MIDI/VolcaKeys.hs @@ -1,30 +1,30 @@ module Sound.Tidal.MIDI.VolcaKeys where -import Sound.Tidal.Params import Sound.Tidal.MIDI.Control +import Sound.Tidal.Params -keysController :: ControllerShape -keysController = ControllerShape { controls = [ - mCC portamento_p 5, - mCC expression_p 11, - mCC voice_p 40, -- voi - mCC octave_p 41, -- oct - mCC detune_p 42, -- det - mCC vcoegint_p 43, -- vco - mCC cutoff_p 44, -- ctf - mCC vcfegint_p 45, -- vcf - mCC lfo_p 46, - mCC lfopitchint_p 47, -- lfop - mCC lfocutoffint_p 48, -- lfoc - mCC attack_p 49, -- att - mCC decay_p 50, -- dec - mCC sustain_p 51, -- sus - mCC delaytime_p 52, -- delayt - mCC delayfeedback_p 53 -- delayfb - ], - -- duration = ("dur", 0.05), - -- velocity = ("vel", 0.5), - latency = 0.01 - } +volcakeysController :: ControllerShape +volcakeysController = + ControllerShape + { controls = + [ mCC portamento_p 5 + , mCC expression_p 11 + , mCC voice_p 40 -- voi + , mCC octave_p 41 -- oct + , mCC detune_p 42 -- det + , mCC vcoegint_p 43 -- vco + , mCC cutoff_p 44 -- ctf + , mCC vcfegint_p 45 -- vcf + , mCC lfo_p 46 + , mCC lfopitchint_p 47 -- lfop + , mCC lfocutoffint_p 48 -- lfoc + , mCC attack_p 49 -- att + , mCC decay_p 50 -- dec + , mCC sustain_p 51 -- sus + , mCC delaytime_p 52 -- delayt + , mCC delayfeedback_p 53 -- delayfb + ] + , latency = 0.1 + } -keys = toShape keysController +volcakeys = toShape volcakeysController diff --git a/tidal-midi.cabal b/tidal-midi.cabal --- a/tidal-midi.cabal +++ b/tidal-midi.cabal @@ -1,5 +1,5 @@ name: tidal-midi -version: 0.8.2 +version: 0.9 synopsis: MIDI support for tidal -- description: homepage: http://tidal.lurk.org/ @@ -19,18 +19,27 @@ library Exposed-modules: Sound.Tidal.MIDI.Context - Sound.Tidal.MIDI.Device Sound.Tidal.MIDI.Control + Sound.Tidal.MIDI.Device + Sound.Tidal.MIDI.Stream + Sound.Tidal.MIDI.Output + Sound.Tidal.MIDI.CC + Sound.Tidal.MIDI.GMPerc + Sound.Tidal.MIDI.Synth + Sound.Tidal.MIDI.Synthino + Sound.Tidal.MIDI.Blofeld + Sound.Tidal.MIDI.MBase01 + Sound.Tidal.MIDI.Tetra + Sound.Tidal.MIDI.Ambika + Sound.Tidal.MIDI.MiniAtmegatron Sound.Tidal.MIDI.VolcaBeats Sound.Tidal.MIDI.VolcaBass Sound.Tidal.MIDI.VolcaKeys - Sound.Tidal.MIDI.Stream - Sound.Tidal.MIDI.Synth - Sound.Tidal.MIDI.SynthParams + Sound.Tidal.MIDI.VolcaFM Sound.Tidal.MIDI.System1M Sound.Tidal.MIDI.KorgKP3 - Build-depends: base < 5, tidal == 0.8.2, PortMidi == 0.1.6.0, time, containers, transformers + Build-depends: base < 5, tidal == 0.9, PortMidi == 0.1.6.0, time, containers, transformers source-repository head type: git