-- 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

-- | Support for MIDI controls.
module Perform.Midi.Control where
import qualified Data.Map as Map
import qualified Data.Tuple as Tuple

import qualified Util.Num as Num
import qualified Derive.Controls as Controls
import qualified Derive.ScoreT as ScoreT
import qualified Midi.Midi as Midi
import qualified Perform.Pitch as Pitch
import qualified Perform.Signal as Signal

import           Global


type ControlMap = Map ScoreT.Control Midi.Control

control_map :: [(Midi.Control, ScoreT.Control)] -> ControlMap
control_map :: [(ControlValue, Control)] -> ControlMap
control_map = [(Control, ControlValue)] -> ControlMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Control, ControlValue)] -> ControlMap)
-> ([(ControlValue, Control)] -> [(Control, ControlValue)])
-> [(ControlValue, Control)]
-> ControlMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ControlValue, Control) -> (Control, ControlValue))
-> [(ControlValue, Control)] -> [(Control, ControlValue)]
forall a b. (a -> b) -> [a] -> [b]
map (ControlValue, Control) -> (Control, ControlValue)
forall a b. (a, b) -> (b, a)
Tuple.swap

empty_map :: ControlMap
empty_map :: ControlMap
empty_map = [(ControlValue, Control)] -> ControlMap
control_map []

-- | Pitchbend range in tempered semitones below and above unity.  The first
-- integer should probably be negative.
type PbRange = (Int, Int)

-- | Convert from a control to a function that creates its MIDI message.
control_constructor :: ControlMap -> ScoreT.Control -> Midi.Key
    -> Maybe (Signal.Y -> Midi.ChannelMessage)
control_constructor :: ControlMap -> Control -> Key -> Maybe (Y -> ChannelMessage)
control_constructor ControlMap
cmap Control
cont Key
key
    | Just ControlValue
cc <- Control -> ControlMap -> Maybe ControlValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Control
cont ControlMap
cmap =
        (Y -> ChannelMessage) -> Maybe (Y -> ChannelMessage)
forall a. a -> Maybe a
Just ((Y -> ChannelMessage) -> Maybe (Y -> ChannelMessage))
-> (Y -> ChannelMessage) -> Maybe (Y -> ChannelMessage)
forall a b. (a -> b) -> a -> b
$ ControlValue -> ControlValue -> ChannelMessage
Midi.ControlChange ControlValue
cc (ControlValue -> ChannelMessage)
-> (Y -> ControlValue) -> Y -> ChannelMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Y -> ControlValue
val_to_cval
    | Just ControlValue
cc <- Control -> ControlMap -> Maybe ControlValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Control
cont ControlMap
universal_control_map =
        (Y -> ChannelMessage) -> Maybe (Y -> ChannelMessage)
forall a. a -> Maybe a
Just ((Y -> ChannelMessage) -> Maybe (Y -> ChannelMessage))
-> (Y -> ChannelMessage) -> Maybe (Y -> ChannelMessage)
forall a b. (a -> b) -> a -> b
$ ControlValue -> ControlValue -> ChannelMessage
Midi.ControlChange ControlValue
cc (ControlValue -> ChannelMessage)
-> (Y -> ControlValue) -> Y -> ChannelMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Y -> ControlValue
val_to_cval
    | Control
cont Control -> Control -> Bool
forall a. Eq a => a -> a -> Bool
== Control
Controls.pressure = (Y -> ChannelMessage) -> Maybe (Y -> ChannelMessage)
forall a. a -> Maybe a
Just ((Y -> ChannelMessage) -> Maybe (Y -> ChannelMessage))
-> (Y -> ChannelMessage) -> Maybe (Y -> ChannelMessage)
forall a b. (a -> b) -> a -> b
$ ControlValue -> ChannelMessage
Midi.ChannelPressure (ControlValue -> ChannelMessage)
-> (Y -> ControlValue) -> Y -> ChannelMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Y -> ControlValue
val_to_cval
    | Control
cont Control -> Control -> Bool
forall a. Eq a => a -> a -> Bool
== Control
Controls.aftertouch = (Y -> ChannelMessage) -> Maybe (Y -> ChannelMessage)
forall a. a -> Maybe a
Just ((Y -> ChannelMessage) -> Maybe (Y -> ChannelMessage))
-> (Y -> ChannelMessage) -> Maybe (Y -> ChannelMessage)
forall a b. (a -> b) -> a -> b
$ Key -> ControlValue -> ChannelMessage
Midi.Aftertouch Key
key (ControlValue -> ChannelMessage)
-> (Y -> ControlValue) -> Y -> ChannelMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Y -> ControlValue
val_to_cval
    | Bool
otherwise = Maybe (Y -> ChannelMessage)
forall a. Maybe a
Nothing

-- | True if the given control will be used by the MIDI performer.
-- Takes a ScoreT.Control because being a MIDI control is a precondition for
-- conversion into 'Control'.
is_midi_control :: ControlMap -> ScoreT.Control -> Bool
is_midi_control :: ControlMap -> Control -> Bool
is_midi_control ControlMap
cmap Control
control =
    Control -> ControlMap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Control
control ControlMap
universal_control_map
    Bool -> Bool -> Bool
|| Control -> ControlMap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Control
control ControlMap
cmap
    Bool -> Bool -> Bool
|| Control
control Control -> Control -> Bool
forall a. Eq a => a -> a -> Bool
== Control
Controls.pressure Bool -> Bool -> Bool
|| Control
control Control -> Control -> Bool
forall a. Eq a => a -> a -> Bool
== Control
Controls.aftertouch

-- | True for controls that must have a channel to themselves.  Midi controls
-- are a subset of what I consider controls, since I include all variable note
-- parameters.
is_channel_control :: ScoreT.Control -> Bool
is_channel_control :: Control -> Bool
is_channel_control = (Control -> Control -> Bool
forall a. Eq a => a -> a -> Bool
/= Control
Controls.aftertouch)

-- | Given a NoteNumber, return the midi note number and pitch bend amount to
-- sound at the pitch.
pitch_to_midi :: PbRange -> Pitch.NoteNumber
    -> Maybe (Midi.Key, Midi.PitchBendValue)
pitch_to_midi :: PbRange -> NoteNumber -> Maybe (Key, PitchBendValue)
pitch_to_midi PbRange
pb_range NoteNumber
nn
    -- Signals default to 0 so 0 probably means the pitch signal was empty.
    | NoteNumber
nn NoteNumber -> NoteNumber -> Bool
forall a. Ord a => a -> a -> Bool
<= NoteNumber
0 Bool -> Bool -> Bool
|| NoteNumber
nn NoteNumber -> NoteNumber -> Bool
forall a. Ord a => a -> a -> Bool
> NoteNumber
127 = Maybe (Key, PitchBendValue)
forall a. Maybe a
Nothing
    -- Due to floating point imprecision, I can end up with nns that are
    -- supposed be integral, but are sightly off.  So if the difference is
    -- below the level of perception, just round to 0.
    | NoteNumber -> NoteNumber
forall a. Num a => a -> a
abs (Integer -> NoteNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NoteNumber -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round NoteNumber
nn) NoteNumber -> NoteNumber -> NoteNumber
forall a. Num a => a -> a -> a
- NoteNumber
nn) NoteNumber -> NoteNumber -> Bool
forall a. Ord a => a -> a -> Bool
< NoteNumber
0.005 =
        (Key, PitchBendValue) -> Maybe (Key, PitchBendValue)
forall a. a -> Maybe a
Just (Integer -> Key
forall a. Integral a => a -> Key
Midi.to_key (NoteNumber -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round NoteNumber
nn), PitchBendValue
0)
    | Bool
otherwise = (Key, PitchBendValue) -> Maybe (Key, PitchBendValue)
forall a. a -> Maybe a
Just (Key
key, PbRange -> Key -> NoteNumber -> PitchBendValue
pb_from_nn PbRange
pb_range Key
key NoteNumber
nn)
    where key :: Key
key = Integer -> Key
forall a. Integral a => a -> Key
Midi.to_key (NoteNumber -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor NoteNumber
nn)

pb_from_nn :: PbRange -> Midi.Key -> Pitch.NoteNumber -> Midi.PitchBendValue
pb_from_nn :: PbRange -> Key -> NoteNumber -> PitchBendValue
pb_from_nn PbRange
pb_range Key
key (Pitch.NoteNumber Y
nn)
    | Y
bend Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
> Y
0 = if Y
high Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
> Y
0 then Y -> PitchBendValue
Num.d2f (Y -> PitchBendValue) -> Y -> PitchBendValue
forall a b. (a -> b) -> a -> b
$ Y
bend Y -> Y -> Y
forall a. Fractional a => a -> a -> a
/ Y
high else PitchBendValue
0
    | Bool
otherwise = if Y
low Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
< Y
0 then Y -> PitchBendValue
Num.d2f (Y -> PitchBendValue) -> Y -> PitchBendValue
forall a b. (a -> b) -> a -> b
$ Y
bend Y -> Y -> Y
forall a. Fractional a => a -> a -> a
/ (-Y
low) else PitchBendValue
0
    where
    (Y
low, Y
high) = (Int -> Y) -> (Int -> Y) -> PbRange -> (Y, Y)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Int -> Y
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int -> Y
forall a b. (Integral a, Num b) => a -> b
fromIntegral PbRange
pb_range
    bend :: Y
bend = Y -> Y -> Y -> Y
forall a. Ord a => a -> a -> a -> a
Num.clamp Y
low Y
high (Y
nn Y -> Y -> Y
forall a. Num a => a -> a -> a
- Key -> Y
forall a. Num a => Key -> a
Midi.from_key Key
key)

-- ** cc controls

-- | This map is used by both input and outpt.  On input, InputNote maps
-- a midi cc to a symbolic control name, and on output, maps it back again.
-- Of course it may very well be mapped to and from a higher level control
-- name but the defaults are always available.
--
-- On output, the \"standard\" set of symbolic names are understood, but the
-- low level cc## names work uniformly.
--
-- This will also be checked by 'control_constructor', so these are controls
-- that every instrument will respond to.  Of course it may override some of
-- these names if it wishes.
universal_control_map :: ControlMap
universal_control_map :: ControlMap
universal_control_map = [(ControlValue, Control)] -> ControlMap
control_map ([(ControlValue, Control)] -> ControlMap)
-> [(ControlValue, Control)] -> ControlMap
forall a b. (a -> b) -> a -> b
$
    [(ControlValue
n, Text -> Control
ScoreT.unchecked_control (Text -> Control) -> Text -> Control
forall a b. (a -> b) -> a -> b
$ Text
"cc" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ControlValue -> Text
forall a. Show a => a -> Text
showt ControlValue
n) | ControlValue
n <- [ControlValue
0..ControlValue
127]] [(ControlValue, Control)]
-> [(ControlValue, Control)] -> [(ControlValue, Control)]
forall a. [a] -> [a] -> [a]
++
    [ (ControlValue
1, Control
"mod")
    , (ControlValue
2, Control
"breath")
    , (ControlValue
4, Control
"foot")
    , (ControlValue
7, Control
"vol")
    , (ControlValue
8, Control
"balance")
    , (ControlValue
10, Control
"pan")
    , (ControlValue
64, Control
"pedal")
    , (ControlValue
65, Control
"porta-pedal")
    , (ControlValue
66, Control
"sost-pedal")
    , (ControlValue
67, Control
"soft-pedal")
    ]

cc_to_control :: Midi.Control -> ScoreT.Control
cc_to_control :: ControlValue -> Control
cc_to_control = Text -> Control
ScoreT.Control (Text -> Control)
-> (ControlValue -> Text) -> ControlValue -> Control
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"cc"<>) (Text -> Text) -> (ControlValue -> Text) -> ControlValue -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlValue -> Text
forall a. Show a => a -> Text
showt

-- * util

val_to_pb :: Signal.Y -> Int
val_to_pb :: Y -> Int
val_to_pb Y
val = Y -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Y -> Int) -> Y -> Int
forall a b. (a -> b) -> a -> b
$ (Y -> Y -> Y -> Y
forall a. Ord a => a -> a -> a -> a
Num.clamp (-Y
1) Y
1 Y
val Y -> Y -> Y
forall a. Num a => a -> a -> a
+ Y
1) Y -> Y -> Y
forall a. Num a => a -> a -> a
* Y
0x2000 Y -> Y -> Y
forall a. Num a => a -> a -> a
- Y
0x2000

val_to_cval :: Signal.Y -> Midi.ControlValue
val_to_cval :: Y -> ControlValue
val_to_cval Y
val = Y -> ControlValue
forall a b. (RealFrac a, Integral b) => a -> b
round (Y -> ControlValue) -> Y -> ControlValue
forall a b. (a -> b) -> a -> b
$ Y -> Y -> Y -> Y
forall a. Ord a => a -> a -> a -> a
Num.clamp Y
0 Y
1 Y
val Y -> Y -> Y
forall a. Num a => a -> a -> a
* Y
0x7f

cval_to_val :: Midi.ControlValue -> Signal.Y
cval_to_val :: ControlValue -> Y
cval_to_val ControlValue
v = ControlValue -> Y
forall a b. (Integral a, Num b) => a -> b
fromIntegral ControlValue
v Y -> Y -> Y
forall a. Fractional a => a -> a -> a
/ Y
0x7f