-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{- | Convert from the Derive events to MIDI performer specific events.

    Since this module depends on both the Derive and Perform.Midi layers, it
    should be called from Derive or Cmd, not Perform.Midi, even though it's
    physically located in Perform.Midi.
-}
module Perform.Midi.Convert where
import qualified Data.Map as Map
import qualified Data.Text as Text

import qualified Util.Lists as Lists
import qualified Util.Log as Log
import qualified Util.Texts as Texts

import qualified Cmd.Cmd as Cmd
import qualified Derive.Controls as Controls
import qualified Derive.Derive as Derive
import qualified Derive.DeriveT as DeriveT
import qualified Derive.Env as Env
import qualified Derive.EnvKey as EnvKey
import qualified Derive.LEvent as LEvent
import qualified Derive.PSignal as PSignal
import qualified Derive.Score as Score
import qualified Derive.ScoreT as ScoreT

import qualified Instrument.Common as Common
import qualified Midi.Midi as Midi
import qualified Perform.ConvertUtil as ConvertUtil
import qualified Perform.Midi.Control as Control
import qualified Perform.Midi.MSignal as MSignal
import qualified Perform.Midi.Patch as Patch
import qualified Perform.Midi.Perform as Perform
import qualified Perform.Midi.Types as Types
import qualified Perform.Pitch as Pitch
import qualified Perform.Signal as Signal

import           Global
import           Types


-- | This is the sampling rate used to convert linear segments from
-- 'Signal.Signal' to 'MSignal.Signal'.
--
-- Since this is only used to interpolate linear segments, it probably doesn't
-- need to be as high as one needed to express the nuances of more complicated
-- curves.  If the tracklang srate is higher, then the MIDI output will be
-- denser and more accurate.
default_srate :: RealTime
default_srate :: RealTime
default_srate = RealTime
1 forall a. Fractional a => a -> a -> a
/ RealTime
0.015 -- TODO set to PlayUtil.initial_environ[srate]

data MidiLookup = MidiLookup {
    MidiLookup -> LookupScale
lookup_scale :: Derive.LookupScale
    , MidiLookup -> Instrument -> Map Control UnboxedY
lookup_control_defaults
        :: ScoreT.Instrument -> Map ScoreT.Control Signal.Y
    }

-- | Convert Score events to Perform events, emitting warnings that may have
-- happened along the way.
convert :: RealTime -> MidiLookup
    -> (ScoreT.Instrument -> Maybe Cmd.ResolvedInstrument)
    -> [Score.Event] -> [LEvent.LEvent Types.Event]
convert :: RealTime
-> MidiLookup
-> (Instrument -> Maybe ResolvedInstrument)
-> [Event]
-> [LEvent Event]
convert RealTime
srate MidiLookup
lookup = forall a.
(Event -> ResolvedInstrument -> [LEvent a])
-> (Instrument -> Maybe ResolvedInstrument)
-> [Event]
-> [LEvent a]
ConvertUtil.convert forall a b. (a -> b) -> a -> b
$ \Event
event ResolvedInstrument
resolved ->
    case ResolvedInstrument -> Backend
Cmd.inst_backend ResolvedInstrument
resolved of
        Cmd.Midi Patch
patch Config
config ->
            RealTime
-> MidiLookup -> Patch -> Config -> Event -> [LEvent Event]
convert_event RealTime
srate MidiLookup
lookup Patch
patch Config
config Event
event
        Backend
_ -> []

convert_event :: RealTime -> MidiLookup -> Patch.Patch -> Patch.Config
    -> Score.Event -> [LEvent.LEvent Types.Event]
convert_event :: RealTime
-> MidiLookup -> Patch -> Config -> Event -> [LEvent Event]
convert_event RealTime
srate MidiLookup
lookup Patch
patch Config
config Event
event = forall a. LogId a -> [LEvent a]
run forall a b. (a -> b) -> a -> b
$ do
    let inst :: Instrument
inst = Event -> Instrument
Score.event_instrument Event
event
    let event_controls :: ControlMap
event_controls = Event -> ControlMap
Score.event_controls Event
event
    ((Patch
perf_patch, [(Control, Control)]
ks_controls), PitchSignal
pitch) <-
        forall (m :: * -> *).
LogMonad m =>
RealTime
-> Instrument
-> Patch
-> Config
-> ControlMap
-> Event
-> m ((Patch, [(Control, Control)]), PitchSignal)
convert_midi_pitch RealTime
srate Instrument
inst Patch
patch Config
config ControlMap
event_controls Event
event
    let mode_controls :: Map Control UnboxedY
mode_controls = Environ -> ModeMap -> Map Control UnboxedY
mode_keyswitches (Event -> Environ
Score.event_environ Event
event)
            (Patch -> ModeMap
Patch.patch_mode_map Patch
patch)
    let controls :: Map Control PitchSignal
controls = forall a. Monoid a => [a] -> a
mconcat
            [ [(Control, Control)] -> Map Control PitchSignal
make_controls [(Control, Control)]
ks_controls
            , forall (v :: * -> *) y. Vector v (Sample y) => y -> v (Sample y)
MSignal.constant forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Control UnboxedY
mode_controls
            , RealTime -> ControlMap -> ControlMap -> Map Control PitchSignal
convert_controls RealTime
srate (Patch -> ControlMap
Types.patch_control_map Patch
perf_patch)
                (Bool -> ControlMap -> ControlMap
convert_dynamic Bool
pressure ControlMap
event_controls)
            , forall (v :: * -> *) y. Vector v (Sample y) => y -> v (Sample y)
MSignal.constant forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MidiLookup -> Instrument -> Map Control UnboxedY
lookup_control_defaults MidiLookup
lookup Instrument
inst
            ]
        pressure :: Bool
pressure = Config -> Flag -> Bool
Patch.has_flag Config
config Flag
Patch.Pressure
        velocity :: UnboxedY
velocity = forall a. a -> Maybe a -> a
fromMaybe UnboxedY
Perform.default_velocity forall a b. (a -> b) -> a -> b
$
            forall a. Typecheck a => Key -> Environ -> Maybe a
Env.maybe_val Key
EnvKey.attack_val Environ
env
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Typecheck a => Key -> Environ -> Maybe a
Env.maybe_val Key
EnvKey.dynamic_val Environ
env
        release_velocity :: UnboxedY
release_velocity = forall a. a -> Maybe a -> a
fromMaybe UnboxedY
velocity forall a b. (a -> b) -> a -> b
$
            forall a. Typecheck a => Key -> Environ -> Maybe a
Env.maybe_val Key
EnvKey.release_val Environ
env
        env :: Environ
env = Event -> Environ
Score.event_environ Event
event
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Types.Event
        { event_start :: RealTime
event_start = Event -> RealTime
Score.event_start Event
event
        , event_duration :: RealTime
event_duration = Event -> RealTime
Score.event_duration Event
event
        , event_patch :: Patch
event_patch = Patch
perf_patch
        , event_controls :: Map Control PitchSignal
event_controls = Map Control PitchSignal
controls
        , event_pitch :: PitchSignal
event_pitch = PitchSignal
pitch
        -- If it's a pressure instrument, then I'm using breath instead
        -- of velocity.  I still set velocity because some synths (e.g.
        -- vsl) use the velocity too in certain cases, but it should be
        -- at least 1 to avoid not even starting the note.  Of course
        -- even without pressure, a note on with velocity 0 is kind of
        -- pointless, but maybe someone wants to fade out.
        , event_start_velocity :: UnboxedY
event_start_velocity = if Bool
pressure then forall a. Ord a => a -> a -> a
max UnboxedY
0.008 UnboxedY
velocity
            else UnboxedY
velocity
        , event_end_velocity :: UnboxedY
event_end_velocity = UnboxedY
release_velocity
        , event_stack :: Stack
event_stack = Event -> Stack
Score.event_stack Event
event
        }

-- TODO it's awkward how I have to go from (Midi.Control, Midi.ControlValue)
-- up to (ScoreT.Control, Signal) only to go back down to
-- (Midi.Control, Midi.ControlValue)
make_controls :: [(Midi.Control, Midi.ControlValue)]
    -> Map ScoreT.Control MSignal.Signal
make_controls :: [(Control, Control)] -> Map Control PitchSignal
make_controls [(Control, Control)]
controls = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (Control -> Control
Control.cc_to_control Control
cc, forall (v :: * -> *) y. Vector v (Sample y) => y -> v (Sample y)
MSignal.constant forall a b. (a -> b) -> a -> b
$ Control -> UnboxedY
Control.cval_to_val Control
cval)
    | (Control
cc, Control
cval) <- [(Control, Control)]
controls
    ]

run :: Log.LogId a -> [LEvent.LEvent a]
run :: forall a. LogId a -> [LEvent a]
run LogId a
action = forall a. a -> LEvent a
LEvent.Event a
note forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Msg -> LEvent a
LEvent.Log [Msg]
logs
    where (a
note, [Msg]
logs) = forall a. LogId a -> (a, [Msg])
Log.run_id LogId a
action

type PitchSignal = MSignal.Signal

-- | If the Event has an attribute matching its keymap, use the pitch from the
-- keymap.  Otherwise convert the pitch signal.
--
-- TODO this used to warn about unmatched attributes, but it got annoying
-- because I use attributes freely.  It still seems like it could be useful,
-- so maybe I want to put it back in again someday.
convert_midi_pitch :: Log.LogMonad m => RealTime -> ScoreT.Instrument
    -> Patch.Patch -> Patch.Config -> ScoreT.ControlMap -> Score.Event
    -> m ((Types.Patch, [(Midi.Control, Midi.ControlValue)]), PitchSignal)
convert_midi_pitch :: forall (m :: * -> *).
LogMonad m =>
RealTime
-> Instrument
-> Patch
-> Config
-> ControlMap
-> Event
-> m ((Patch, [(Control, Control)]), PitchSignal)
convert_midi_pitch RealTime
srate Instrument
inst Patch
patch Config
config ControlMap
controls Event
event =
    case forall a. Attributes -> AttributeMap a -> Maybe (Attributes, a)
Common.lookup_attributes (Event -> Attributes
Score.event_attributes Event
event) AttributeMap
attr_map of
        Maybe (Attributes, ([Keyswitch], Maybe Keymap))
Nothing -> ((Patch
perf_patch, []),) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PitchSignal -> PitchSignal
round_sig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m PitchSignal
get_signal
        Just (Attributes
_, ([Keyswitch]
keyswitches, Maybe Keymap
maybe_keymap)) -> do
            PitchSignal
sig <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe m PitchSignal
get_signal Keymap -> m PitchSignal
set_keymap Maybe Keymap
maybe_keymap
            forall (m :: * -> *) a. Monad m => a -> m a
return ([Keyswitch] -> (Patch, [(Control, Control)])
set_keyswitches [Keyswitch]
keyswitches, PitchSignal -> PitchSignal
round_sig PitchSignal
sig)
    where
    set_keyswitches :: [Keyswitch] -> (Patch, [(Control, Control)])
set_keyswitches [] = (Patch
perf_patch, [])
    set_keyswitches [Keyswitch]
keyswitches =
        (Patch
perf_patch { patch_keyswitches :: [Keyswitch]
Types.patch_keyswitches = [Keyswitch]
ks }, [(Control, Control)]
ccs)
        where ([(Control, Control)]
ccs, [Keyswitch]
ks) = forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
Lists.partitionOn Keyswitch -> Maybe (Control, Control)
is_control_switch [Keyswitch]
keyswitches
    is_control_switch :: Keyswitch -> Maybe (Control, Control)
is_control_switch (Patch.ControlSwitch Control
cc Control
ccval) = forall a. a -> Maybe a
Just (Control
cc, Control
ccval)
    is_control_switch Keyswitch
_ = forall a. Maybe a
Nothing

    -- A PitchedKeymap is mapped through the Patch.Scale.
    set_keymap :: Keymap -> m PitchSignal
set_keymap (Patch.PitchedKeymap Key
low Key
high Key
low_pitch) =
        UnboxedY -> UnboxedY -> Key -> PitchSignal -> PitchSignal
convert_pitched_keymap (forall a. Num a => Key -> a
Midi.from_key Key
low) (forall a. Num a => Key -> a
Midi.from_key Key
high)
            Key
low_pitch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m PitchSignal
get_signal
    -- But UnpitchedKeymap is a constant.
    set_keymap (Patch.UnpitchedKeymap Key
key) =
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) y. Vector v (Sample y) => y -> v (Sample y)
MSignal.constant (forall a. Num a => Key -> a
Midi.from_key Key
key)
    get_signal :: m PitchSignal
get_signal = forall (m :: * -> *).
LogMonad m =>
Maybe Scale -> PitchSignal -> m PitchSignal
apply_patch_scale Maybe Scale
scale
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
LogMonad m =>
RealTime -> Patch -> ControlMap -> Event -> m PitchSignal
convert_event_pitch RealTime
srate Patch
perf_patch ControlMap
controls Event
event
    scale :: Maybe Scale
scale = Settings -> Maybe Scale
Patch.config_scale (Config -> Settings
Patch.config_settings Config
config)
    round_sig :: PitchSignal -> PitchSignal
round_sig = forall (v :: * -> *) y.
Vector v (Sample y) =>
(y -> y) -> v (Sample y) -> v (Sample y)
MSignal.map_y UnboxedY -> UnboxedY
round_pitch

    perf_patch :: Patch
perf_patch = Instrument -> Config -> Patch -> Patch
Types.patch Instrument
inst Config
config Patch
patch
    attr_map :: AttributeMap
attr_map = Patch -> AttributeMap
Patch.patch_attribute_map Patch
patch

mode_keyswitches :: Env.Environ -> Patch.ModeMap -> Map ScoreT.Control Signal.Y
mode_keyswitches :: Environ -> ModeMap -> Map Control UnboxedY
mode_keyswitches (DeriveT.Environ Map Key Val
env) (Patch.ModeMap Map Key ((Control, UnboxedY), Map MiniVal (Control, UnboxedY))
modes) =
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Key, (a, Map MiniVal a)) -> a
get (forall k a. Map k a -> [(k, a)]
Map.toList Map Key ((Control, UnboxedY), Map MiniVal (Control, UnboxedY))
modes)
    where
    -- for each mode, if set, use that, if unset, use first
    get :: (Key, (a, Map MiniVal a)) -> a
get (Key
key, (a
deflt, Map MiniVal a
mini_to_control)) = forall a. a -> Maybe a -> a
fromMaybe a
deflt forall a b. (a -> b) -> a -> b
$ do
        MiniVal
mini <- Val -> Maybe MiniVal
DeriveT.val_to_mini forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Key
key Map Key Val
env
        -- If the lookup fails, then they set a mode, but I don't recognize it.
        -- TODO warn about this?
        forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup MiniVal
mini Map MiniVal a
mini_to_control

convert_pitched_keymap :: Signal.Y -> Signal.Y -> Midi.Key
    -> PitchSignal -> PitchSignal
convert_pitched_keymap :: UnboxedY -> UnboxedY -> Key -> PitchSignal -> PitchSignal
convert_pitched_keymap UnboxedY
low UnboxedY
high Key
low_pitch PitchSignal
sig = PitchSignal
clipped
    where
    -- TODO warn about out_of_range
    (PitchSignal
clipped, [(RealTime, RealTime)]
out_of_range) = UnboxedY
-> UnboxedY -> PitchSignal -> (PitchSignal, [(RealTime, RealTime)])
MSignal.clip_bounds UnboxedY
low UnboxedY
high forall a b. (a -> b) -> a -> b
$
        UnboxedY -> PitchSignal -> PitchSignal
MSignal.scalar_add (UnboxedY
low forall a. Num a => a -> a -> a
- forall a. Num a => Key -> a
Midi.from_key Key
low_pitch) PitchSignal
sig

-- | Get the flattened Signal.NoteNumber from an event.
convert_event_pitch :: Log.LogMonad m => RealTime -> Types.Patch
    -> ScoreT.ControlMap -> Score.Event -> m PitchSignal
convert_event_pitch :: forall (m :: * -> *).
LogMonad m =>
RealTime -> Patch -> ControlMap -> Event -> m PitchSignal
convert_event_pitch RealTime
srate Patch
patch ControlMap
controls Event
event =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} (kind :: k). RealTime -> Signal kind -> PitchSignal
Signal.to_piecewise_constant RealTime
srate) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
LogMonad m =>
Environ -> ControlMap -> RealTime -> PSignal -> m NoteNumber
convert_pitch (Event -> Environ
Score.event_environ Event
event) ControlMap
controls RealTime
note_end forall a b. (a -> b) -> a -> b
$
        Event -> PSignal
Score.event_pitch Event
event
    where
    note_end :: RealTime
note_end = Event -> RealTime
Score.event_end Event
event
        forall a. Num a => a -> a -> a
+ forall a. a -> Maybe a -> a
fromMaybe RealTime
Types.default_decay (Patch -> Maybe RealTime
Types.patch_decay Patch
patch)

convert_pitch :: Log.LogMonad m => Env.Environ
    -> ScoreT.ControlMap -> RealTime -> PSignal.PSignal -> m Signal.NoteNumber
convert_pitch :: forall (m :: * -> *).
LogMonad m =>
Environ -> ControlMap -> RealTime -> PSignal -> m NoteNumber
convert_pitch Environ
env ControlMap
controls RealTime
note_end PSignal
psig = do
    -- Trim controls to avoid applying out of range transpositions.
    -- TODO was drop_at_after
    let trimmed :: ControlMap
trimmed = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} (kind :: k). RealTime -> Signal kind -> Signal kind
Signal.drop_after RealTime
note_end)) ControlMap
controls
    let (NoteNumber
sig, [(RealTime, Key)]
nn_errs) = PSignal -> (NoteNumber, [(RealTime, Key)])
PSignal.to_nn forall a b. (a -> b) -> a -> b
$ ControlMap -> PSignal -> PSignal
PSignal.apply_controls ControlMap
trimmed forall a b. (a -> b) -> a -> b
$
            Environ -> PSignal -> PSignal
PSignal.apply_environ Environ
env PSignal
psig
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RealTime, Key)]
nn_errs) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). (Stack, LogMonad m) => Key -> m ()
Log.warn forall a b. (a -> b) -> a -> b
$ Key
"convert pitch: "
        forall a. Semigroup a => a -> a -> a
<> Key -> [Key] -> Key
Text.intercalate Key
", " (Int -> [Key] -> [Key]
Texts.ellipsisList Int
4
            [forall a. Pretty a => a -> Key
pretty RealTime
x forall a. Semigroup a => a -> a -> a
<> Key
": " forall a. Semigroup a => a -> a -> a
<> Key
err | (RealTime
x, Key
err) <- [(RealTime, Key)]
nn_errs])
    forall (m :: * -> *) a. Monad m => a -> m a
return NoteNumber
sig
    where
    -- TODO should I also trim the pitch signal to avoid doing extra work?
    -- trimmed_vals = fmap (fmap (Signal.drop_at_after note_end)) controls

apply_patch_scale :: Log.LogMonad m => Maybe Patch.Scale -> PitchSignal
    -> m PitchSignal
apply_patch_scale :: forall (m :: * -> *).
LogMonad m =>
Maybe Scale -> PitchSignal -> m PitchSignal
apply_patch_scale Maybe Scale
scale PitchSignal
sig = do
    let (PitchSignal
nn_sig, [(RealTime, UnboxedY)]
scale_errs) = Maybe Scale -> PitchSignal -> (PitchSignal, [(RealTime, UnboxedY)])
convert_scale Maybe Scale
scale PitchSignal
sig
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RealTime, UnboxedY)]
scale_errs) forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *). (Stack, LogMonad m) => Key -> m ()
Log.warn forall a b. (a -> b) -> a -> b
$ Key
"out of range for patch scale: "
            forall a. Semigroup a => a -> a -> a
<> Key -> [Key] -> Key
Text.intercalate Key
", "
                (Int -> [Key] -> [Key]
Texts.ellipsisList Int
10 (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Key
pretty [(RealTime, UnboxedY)]
scale_errs))
    forall (m :: * -> *) a. Monad m => a -> m a
return PitchSignal
nn_sig

-- | Round pitches to the nearest tenth of a cent.  Differences below this are
-- probably imperceptible.  Due to floating point inaccuracy, pitches can wind
-- up being slightly off of integral, leading to pitch bending where there
-- should be none.
round_pitch :: Signal.Y -> Signal.Y
round_pitch :: UnboxedY -> UnboxedY
round_pitch UnboxedY
nn = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (RealFrac a, Integral b) => a -> b
round (UnboxedY
nn forall a. Num a => a -> a -> a
* UnboxedY
1000)) forall a. Fractional a => a -> a -> a
/ UnboxedY
1000

convert_scale :: Maybe Patch.Scale -> PitchSignal
    -> (PitchSignal, [(Signal.X, Signal.Y)])
convert_scale :: Maybe Scale -> PitchSignal -> (PitchSignal, [(RealTime, UnboxedY)])
convert_scale Maybe Scale
Nothing = (, [])
convert_scale (Just Scale
scale) = forall (v :: * -> *) a err.
Vector v a =>
(a -> Either err a) -> v a -> (v a, [err])
MSignal.map_err forall a b. (a -> b) -> a -> b
$ \(MSignal.Sample RealTime
x UnboxedY
y) ->
    case Scale -> NoteNumber -> Maybe NoteNumber
Patch.convert_scale Scale
scale (UnboxedY -> NoteNumber
Pitch.NoteNumber UnboxedY
y) of
        Just (Pitch.NoteNumber UnboxedY
nn) -> forall a b. b -> Either a b
Right (forall y. RealTime -> y -> Sample y
MSignal.Sample RealTime
x UnboxedY
nn)
        Maybe NoteNumber
Nothing -> forall a b. a -> Either a b
Left (RealTime
x, UnboxedY
y)

-- | Convert deriver controls to performance controls.  Drop all non-MIDI
-- controls, since those will inhibit channel sharing later.
convert_controls :: RealTime
    -> Control.ControlMap -- ^ Instrument's control map.
    -> ScoreT.ControlMap -- ^ Controls to convert.
    -> Map ScoreT.Control MSignal.Signal
convert_controls :: RealTime -> ControlMap -> ControlMap -> Map Control PitchSignal
convert_controls RealTime
srate ControlMap
inst_cmap =
    forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall {k} (kind :: k). RealTime -> Signal kind -> PitchSignal
Signal.to_piecewise_constant RealTime
srate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typed a -> a
ScoreT.val_of))
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (ControlMap -> Control -> Bool
Control.is_midi_control ControlMap
inst_cmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toAscList

-- | If it's a 'Patch.Pressure' instrument, move the 'Controls.dynamic'
-- control to 'Controls.breath'.
convert_dynamic :: Bool -> ScoreT.ControlMap -> ScoreT.ControlMap
convert_dynamic :: Bool -> ControlMap -> ControlMap
convert_dynamic Bool
pressure ControlMap
controls
    | Bool
pressure = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ControlMap
controls
        (\Typed (Signal ControlSig)
sig -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Control
Controls.breath Typed (Signal ControlSig)
sig ControlMap
controls)
        (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Control
Controls.dynamic ControlMap
controls)
    | Bool
otherwise = ControlMap
controls