-- 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 = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map 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 <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Control
cont ControlMap
cmap =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ControlValue -> ControlValue -> ChannelMessage
Midi.ControlChange ControlValue
cc forall b c a. (b -> c) -> (a -> b) -> a -> c
. Y -> ControlValue
val_to_cval
    | Just ControlValue
cc <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Control
cont ControlMap
universal_control_map =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ControlValue -> ControlValue -> ChannelMessage
Midi.ControlChange ControlValue
cc forall b c a. (b -> c) -> (a -> b) -> a -> c
. Y -> ControlValue
val_to_cval
    | Control
cont forall a. Eq a => a -> a -> Bool
== Control
Controls.pressure = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ControlValue -> ChannelMessage
Midi.ChannelPressure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Y -> ControlValue
val_to_cval
    | Control
cont forall a. Eq a => a -> a -> Bool
== Control
Controls.aftertouch = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Key -> ControlValue -> ChannelMessage
Midi.Aftertouch Key
key forall b c a. (b -> c) -> (a -> b) -> a -> c
. Y -> ControlValue
val_to_cval
    | Bool
otherwise = 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 =
    forall k a. Ord k => k -> Map k a -> Bool
Map.member Control
control ControlMap
universal_control_map
    Bool -> Bool -> Bool
|| forall k a. Ord k => k -> Map k a -> Bool
Map.member Control
control ControlMap
cmap
    Bool -> Bool -> Bool
|| Control
control forall a. Eq a => a -> a -> Bool
== Control
Controls.pressure Bool -> Bool -> Bool
|| Control
control 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 = (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 forall a. Ord a => a -> a -> Bool
<= NoteNumber
0 Bool -> Bool -> Bool
|| NoteNumber
nn forall a. Ord a => a -> a -> Bool
> NoteNumber
127 = 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.
    | forall a. Num a => a -> a
abs (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (RealFrac a, Integral b) => a -> b
round NoteNumber
nn) forall a. Num a => a -> a -> a
- NoteNumber
nn) forall a. Ord a => a -> a -> Bool
< NoteNumber
0.005 =
        forall a. a -> Maybe a
Just (forall a. Integral a => a -> Key
Midi.to_key (forall a b. (RealFrac a, Integral b) => a -> b
round NoteNumber
nn), PitchBendValue
0)
    | Bool
otherwise = 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 = forall a. Integral a => a -> Key
Midi.to_key (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 forall a. Ord a => a -> a -> Bool
> Y
0 = if Y
high forall a. Ord a => a -> a -> Bool
> Y
0 then Y -> PitchBendValue
Num.d2f forall a b. (a -> b) -> a -> b
$ Y
bend forall a. Fractional a => a -> a -> a
/ Y
high else PitchBendValue
0
    | Bool
otherwise = if Y
low forall a. Ord a => a -> a -> Bool
< Y
0 then Y -> PitchBendValue
Num.d2f forall a b. (a -> b) -> a -> b
$ Y
bend forall a. Fractional a => a -> a -> a
/ (-Y
low) else PitchBendValue
0
    where
    (Y
low, Y
high) = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (Integral a, Num b) => a -> b
fromIntegral PbRange
pb_range
    bend :: Y
bend = forall a. Ord a => a -> a -> a -> a
Num.clamp Y
low Y
high (Y
nn forall a. Num a => a -> a -> a
- 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 forall a b. (a -> b) -> a -> b
$
    [(ControlValue
n, Text -> Control
ScoreT.Control forall a b. (a -> b) -> a -> b
$ Text
"cc" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt ControlValue
n) | ControlValue
n <- [ControlValue
0..ControlValue
127]] 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"cc"<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
showt

-- * util

val_to_pb :: Signal.Y -> Int
val_to_pb :: Y -> Int
val_to_pb Y
val = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ (forall a. Ord a => a -> a -> a -> a
Num.clamp (-Y
1) Y
1 Y
val forall a. Num a => a -> a -> a
+ Y
1) forall a. Num a => a -> a -> a
* Y
0x2000 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 = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a -> a
Num.clamp Y
0 Y
1 Y
val 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral ControlValue
v forall a. Fractional a => a -> a -> a
/ Y
0x7f