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 []
type PbRange = (Int, Int)
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
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
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)
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
| 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
| 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)
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
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