-- 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 incoming MIDI (and other inputs) to the internal note
    representation.  This has two purposes: note entry, and midi thru.

    This module is, in a way, dual to "Perform.Midi.Perform".  It takes MIDI
    input to the internal 'Input' representation and back again, while Perform
    takes the internal representation, in the form of
    'Perform.Midi.Perform.Event', to MIDI output.

    The overlapping part is that this module maps 'Derive.ScoreT.Control's to
    and from MIDI while Play uses 'Perform.Midi.Control.Control'.  They
    use the same control names, though, so I can reuse code from Control.

    One significant difference between 'Input' and MIDI is that MIDI supports
    two levels of control addressing: note and channel, while 'Input' can
    only represent note addressing through 'NoteId'.  MIDI controls almost
    all apply at the channel level, but of course these controls all apply
    at the note level.  The result is that a MIDI control that on a keyboard
    affects the whole channel will only affect the last played note here.  When
    the input is converted back to MIDI it may wind up sharing a channel
    anyway, at which point the control will go back to being channel global,
    but if the instrument has multiple channels, I try to distribute between
    them to keep note_ids on separate channels.  This way, multiple channel
    emitting controls can be mapped to multiple channel using instruments.

    This is basically a simplified version of the channel allocation algorithm
    in "Perform.Midi.Perform".  It's hard to reuse that algorithm directly
    because this one has to operate in realtime and can't see which controls
    the note is going to use.
-}
module Cmd.InputNote where
import qualified Data.Map as Map
import qualified Data.Text as Text

import qualified Util.Maps as Maps
import qualified Util.Num as Num
import qualified App.Config as Config
import qualified Derive.Controls as Controls
import qualified Derive.Scale.Theory as Theory
import qualified Derive.ScoreT as ScoreT

import qualified Midi.Midi as Midi
import qualified Perform.Midi.Control as Control
import qualified Perform.Pitch as Pitch
import qualified Perform.Signal as Signal

import           Global


-- | Since the ASCII keyboard isn't pressure sensitive, this is the default
-- velocity.  Hopefully it's strong but not so strong as to be hard on the
-- ears.
keyboard_velocity :: Signal.Y
keyboard_velocity :: Y
keyboard_velocity = Y
0.75

type Input = GenericInput Pitch.Input

-- | An input with a plain NoteNumber pitch instead of a 'Pitch.Input'.
type InputNn = GenericInput Pitch.NoteNumber

data GenericInput pitch =
    -- | The Input and val (velocity) could be sent separately, but that
    -- would make converting this back into midi for thru harder.
    NoteOn NoteId pitch Signal.Y
    | NoteOff NoteId Signal.Y
    -- | Controls coming from MIDI are mapped to control names, since this is
    -- a superset of MIDI CC numbers, and may include non-MIDI as well.  But
    -- for MidiThru to map back to a CC number, I need 1:1 mapping between
    -- ScoreT.Controls and CC numbers.  This is what 'cc_to_control' and
    -- 'control_to_cc' provide.
    | Control NoteId ScoreT.Control Signal.Y
    -- | Pitch could also be a Control, but this way the pitch is typed.
    | PitchChange NoteId pitch
    deriving (GenericInput pitch -> GenericInput pitch -> Bool
forall pitch.
Eq pitch =>
GenericInput pitch -> GenericInput pitch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericInput pitch -> GenericInput pitch -> Bool
$c/= :: forall pitch.
Eq pitch =>
GenericInput pitch -> GenericInput pitch -> Bool
== :: GenericInput pitch -> GenericInput pitch -> Bool
$c== :: forall pitch.
Eq pitch =>
GenericInput pitch -> GenericInput pitch -> Bool
Eq, Int -> GenericInput pitch -> ShowS
forall pitch. Show pitch => Int -> GenericInput pitch -> ShowS
forall pitch. Show pitch => [GenericInput pitch] -> ShowS
forall pitch. Show pitch => GenericInput pitch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericInput pitch] -> ShowS
$cshowList :: forall pitch. Show pitch => [GenericInput pitch] -> ShowS
show :: GenericInput pitch -> String
$cshow :: forall pitch. Show pitch => GenericInput pitch -> String
showsPrec :: Int -> GenericInput pitch -> ShowS
$cshowsPrec :: forall pitch. Show pitch => Int -> GenericInput pitch -> ShowS
Show)

instance (Show pitch, Pretty pitch) => Pretty (GenericInput pitch) where
    pretty :: GenericInput pitch -> Text
pretty (NoteOn NoteId
id pitch
pitch Y
vel) = [Text] -> Text
Text.unwords
        [Text
"NoteOn", Text
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt NoteId
id forall a. Semigroup a => a -> a -> a
<> Text
")", forall a. Pretty a => a -> Text
pretty pitch
pitch, forall a. Pretty a => a -> Text
pretty Y
vel]
    pretty GenericInput pitch
input = forall a. Show a => a -> Text
showt GenericInput pitch
input

input_id :: GenericInput x -> NoteId
input_id :: forall x. GenericInput x -> NoteId
input_id GenericInput x
input = case GenericInput x
input of
    NoteOn NoteId
note_id x
_ Y
_ -> NoteId
note_id
    NoteOff NoteId
note_id Y
_ -> NoteId
note_id
    Control NoteId
note_id Control
_ Y
_ -> NoteId
note_id
    PitchChange NoteId
note_id x
_ -> NoteId
note_id

-- | Modify the NodeId so that it won't collide with other NodeIds.
--
-- NoteIds are supposed to be unique for each Input.  However, in practice they
-- wind up being the MIDI NoteOn 'Midi.Key', for reasons described in 'NoteId'.
-- So if you want to emit MIDI thru for two notes with the same pitch (e.g.
-- dispatch a single pitch to two instruments), you need to give them different
-- NoteIds.  This function multiplies them such that they won't collide.
--
-- TODO This is a grody hack.  A better solution might be to make NoteId into
-- a (Channel, Int) pair.
offset_note_id :: Int -> GenericInput x -> GenericInput x
offset_note_id :: forall x. Int -> GenericInput x -> GenericInput x
offset_note_id Int
multiplier GenericInput x
input = case GenericInput x
input of
    NoteOn NoteId
note_id x
pitch Y
vel -> forall pitch. NoteId -> pitch -> Y -> GenericInput pitch
NoteOn (NoteId -> NoteId
modify NoteId
note_id) x
pitch Y
vel
    NoteOff NoteId
note_id Y
vel -> forall pitch. NoteId -> Y -> GenericInput pitch
NoteOff (NoteId -> NoteId
modify NoteId
note_id) Y
vel
    Control NoteId
note_id Control
control Y
val -> forall pitch. NoteId -> Control -> Y -> GenericInput pitch
Control (NoteId -> NoteId
modify NoteId
note_id) Control
control Y
val
    PitchChange NoteId
note_id x
pitch -> forall pitch. NoteId -> pitch -> GenericInput pitch
PitchChange (NoteId -> NoteId
modify NoteId
note_id) x
pitch
    where
    modify :: NoteId -> NoteId
modify (NoteId Int
n) = Int -> NoteId
NoteId (Int
n forall a. Num a => a -> a -> a
+ Int
1000 forall a. Num a => a -> a -> a
* Int
multiplier)

-- | In theory, NoteId is an arbitrary ID, but in practice it's the same as
-- the initial note on Midi.Key.  The reason is that pitch bend needs to
-- know the original key so it knows what the pitch bend is relative to.  I
-- could store the original key separately, but it's convenient to put them
-- both into NoteId, and I can't think of any instances where I'd want them
-- to be different.
--
-- In addition, when a MIDI NoteOff comes in I have to know what NoteId it
-- applies to.  Since MIDI's NoteId is the key number, I have no choice but to
-- use that.
newtype NoteId = NoteId Int deriving (NoteId -> NoteId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoteId -> NoteId -> Bool
$c/= :: NoteId -> NoteId -> Bool
== :: NoteId -> NoteId -> Bool
$c== :: NoteId -> NoteId -> Bool
Eq, Eq NoteId
NoteId -> NoteId -> Bool
NoteId -> NoteId -> Ordering
NoteId -> NoteId -> NoteId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NoteId -> NoteId -> NoteId
$cmin :: NoteId -> NoteId -> NoteId
max :: NoteId -> NoteId -> NoteId
$cmax :: NoteId -> NoteId -> NoteId
>= :: NoteId -> NoteId -> Bool
$c>= :: NoteId -> NoteId -> Bool
> :: NoteId -> NoteId -> Bool
$c> :: NoteId -> NoteId -> Bool
<= :: NoteId -> NoteId -> Bool
$c<= :: NoteId -> NoteId -> Bool
< :: NoteId -> NoteId -> Bool
$c< :: NoteId -> NoteId -> Bool
compare :: NoteId -> NoteId -> Ordering
$ccompare :: NoteId -> NoteId -> Ordering
Ord, Int -> NoteId -> ShowS
[NoteId] -> ShowS
NoteId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoteId] -> ShowS
$cshowList :: [NoteId] -> ShowS
show :: NoteId -> String
$cshow :: NoteId -> String
showsPrec :: Int -> NoteId -> ShowS
$cshowsPrec :: Int -> NoteId -> ShowS
Show)

key_to_id :: Midi.Key -> NoteId
key_to_id :: Key -> NoteId
key_to_id = Int -> NoteId
NoteId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Key -> a
Midi.from_key

id_to_key :: NoteId -> Midi.Key
id_to_key :: NoteId -> Key
id_to_key (NoteId Int
key) = forall a. Integral a => a -> Key
Midi.to_key Int
key

-- * from midi

type Addr = (Midi.ReadDevice, Midi.Channel)

-- | Keep track of the state of each 'Midi.ReadDevice'.
newtype ReadDeviceState = ReadDeviceState (Map Midi.ReadDevice ControlState)
    deriving (ReadDeviceState -> ReadDeviceState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadDeviceState -> ReadDeviceState -> Bool
$c/= :: ReadDeviceState -> ReadDeviceState -> Bool
== :: ReadDeviceState -> ReadDeviceState -> Bool
$c== :: ReadDeviceState -> ReadDeviceState -> Bool
Eq, Int -> ReadDeviceState -> ShowS
[ReadDeviceState] -> ShowS
ReadDeviceState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadDeviceState] -> ShowS
$cshowList :: [ReadDeviceState] -> ShowS
show :: ReadDeviceState -> String
$cshow :: ReadDeviceState -> String
showsPrec :: Int -> ReadDeviceState -> ShowS
$cshowsPrec :: Int -> ReadDeviceState -> ShowS
Show)

empty_rdev_state :: ReadDeviceState
empty_rdev_state :: ReadDeviceState
empty_rdev_state = Map ReadDevice ControlState -> ReadDeviceState
ReadDeviceState forall a. Monoid a => a
mempty

next_state :: Midi.ReadDevice -> ControlState -> ReadDeviceState
    -> ReadDeviceState
next_state :: ReadDevice -> ControlState -> ReadDeviceState -> ReadDeviceState
next_state ReadDevice
rdev ControlState
cstate (ReadDeviceState Map ReadDevice ControlState
state) =
    Map ReadDevice ControlState -> ReadDeviceState
ReadDeviceState forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ReadDevice
rdev ControlState
cstate Map ReadDevice ControlState
state

-- | The state of one 'Midi.ReadDevice'.
data ControlState = ControlState
    { ControlState -> Map Addr NoteId
state_note_id :: Map Addr NoteId -- ^ last note_id
    , ControlState -> Map Addr PitchBendValue
state_pb :: Map Addr Midi.PitchBendValue -- ^ last pb
    , ControlState -> PbRange
state_pb_range :: Control.PbRange
    } deriving (ControlState -> ControlState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControlState -> ControlState -> Bool
$c/= :: ControlState -> ControlState -> Bool
== :: ControlState -> ControlState -> Bool
$c== :: ControlState -> ControlState -> Bool
Eq, Int -> ControlState -> ShowS
[ControlState] -> ShowS
ControlState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControlState] -> ShowS
$cshowList :: [ControlState] -> ShowS
show :: ControlState -> String
$cshow :: ControlState -> String
showsPrec :: Int -> ControlState -> ShowS
$cshowsPrec :: Int -> ControlState -> ShowS
Show)

empty_control_state :: Control.PbRange -> ControlState
empty_control_state :: PbRange -> ControlState
empty_control_state PbRange
pb_range = ControlState
    { state_note_id :: Map Addr NoteId
state_note_id = forall k a. Map k a
Map.empty
    , state_pb :: Map Addr PitchBendValue
state_pb = forall k a. Map k a
Map.empty
    , state_pb_range :: PbRange
state_pb_range = PbRange
pb_range
    }

from_midi :: ReadDeviceState -> Midi.ReadDevice -> Midi.Message
    -> Maybe (Input, ReadDeviceState)
from_midi :: ReadDeviceState
-> ReadDevice -> Message -> Maybe (Input, ReadDeviceState)
from_midi (ReadDeviceState Map ReadDevice ControlState
state) ReadDevice
rdev (Midi.ChannelMessage Control
chan ChannelMessage
chan_msg) =
    case Maybe Input
maybe_input of
        Maybe Input
Nothing -> forall a. Maybe a
Nothing
        Just Input
input -> forall a. a -> Maybe a
Just (Input
input, ReadDeviceState
next_state)
    where
    next_state :: ReadDeviceState
next_state = Map ReadDevice ControlState -> ReadDeviceState
ReadDeviceState forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ReadDevice
rdev (Addr -> ChannelMessage -> ControlState -> ControlState
update_control_state Addr
addr ChannelMessage
chan_msg ControlState
cstate) Map ReadDevice ControlState
state
    cstate :: ControlState
cstate = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault
        (PbRange -> ControlState
empty_control_state PbRange
Config.read_device_pb_range) ReadDevice
rdev Map ReadDevice ControlState
state
    addr :: Addr
addr = (ReadDevice
rdev, Control
chan)
    last_pb :: PitchBendValue
last_pb = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault PitchBendValue
0 Addr
addr (ControlState -> Map Addr PitchBendValue
state_pb ControlState
cstate)
    with_last_id :: (NoteId -> b) -> Maybe b
with_last_id NoteId -> b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NoteId -> b
f (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Addr
addr (ControlState -> Map Addr NoteId
state_note_id ControlState
cstate))
    maybe_input :: Maybe Input
maybe_input = case ChannelMessage
chan_msg of
        Midi.NoteOn Key
key Control
vel -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
            forall pitch. NoteId -> pitch -> Y -> GenericInput pitch
NoteOn (Key -> NoteId
key_to_id Key
key) (PitchBendValue -> Key -> Input
to_pitch PitchBendValue
last_pb Key
key) (forall {a} {a}. (Fractional a, Integral a) => a -> a
to_val Control
vel)
        Midi.NoteOff Key
key Control
vel -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
            forall pitch. NoteId -> Y -> GenericInput pitch
NoteOff (Key -> NoteId
key_to_id Key
key) (forall {a} {a}. (Fractional a, Integral a) => a -> a
to_val Control
vel)
        Midi.ControlChange Control
cc Control
val -> forall {b}. (NoteId -> b) -> Maybe b
with_last_id forall a b. (a -> b) -> a -> b
$ \NoteId
last_id ->
            forall pitch. NoteId -> Control -> Y -> GenericInput pitch
Control NoteId
last_id (Control -> Control
cc_to_control Control
cc) (forall {a} {a}. (Fractional a, Integral a) => a -> a
to_val Control
val)
        Midi.PitchBend PitchBendValue
val -> forall {b}. (NoteId -> b) -> Maybe b
with_last_id forall a b. (a -> b) -> a -> b
$ \NoteId
last_id ->
            forall pitch. NoteId -> pitch -> GenericInput pitch
PitchChange NoteId
last_id (PitchBendValue -> Key -> Input
to_pitch PitchBendValue
val (NoteId -> Key
id_to_key NoteId
last_id))
        Midi.Aftertouch Key
key Control
val -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
            forall pitch. NoteId -> Control -> Y -> GenericInput pitch
Control (Key -> NoteId
key_to_id Key
key) Control
Controls.aftertouch (forall {a} {a}. (Fractional a, Integral a) => a -> a
to_val Control
val)
        Midi.ChannelPressure Control
val -> forall {b}. (NoteId -> b) -> Maybe b
with_last_id forall a b. (a -> b) -> a -> b
$ \NoteId
last_id ->
            forall pitch. NoteId -> Control -> Y -> GenericInput pitch
Control NoteId
last_id Control
Controls.pressure (forall {a} {a}. (Fractional a, Integral a) => a -> a
to_val Control
val)
        ChannelMessage
_ -> forall a. Maybe a
Nothing
    to_pitch :: PitchBendValue -> Key -> Input
to_pitch = PbRange -> PitchBendValue -> Key -> Input
pb_to_input (ControlState -> PbRange
state_pb_range ControlState
cstate)
    to_val :: a -> a
to_val a
v = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v forall a. Fractional a => a -> a -> a
/ a
127
from_midi ReadDeviceState
_ ReadDevice
_ Message
_ = forall a. Maybe a
Nothing

update_control_state :: Addr -> Midi.ChannelMessage -> ControlState
    -> ControlState
update_control_state :: Addr -> ChannelMessage -> ControlState -> ControlState
update_control_state Addr
addr ChannelMessage
chan_msg ControlState
state = ControlState
state
    { state_note_id :: Map Addr NoteId
state_note_id = case ChannelMessage -> Maybe NoteId
id_of ChannelMessage
chan_msg of
        Maybe NoteId
Nothing -> ControlState -> Map Addr NoteId
state_note_id ControlState
state
        Just NoteId
note_id -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Addr
addr NoteId
note_id (ControlState -> Map Addr NoteId
state_note_id ControlState
state)
    , state_pb :: Map Addr PitchBendValue
state_pb = case ChannelMessage -> Maybe PitchBendValue
pb_of ChannelMessage
chan_msg of
        Maybe PitchBendValue
Nothing -> ControlState -> Map Addr PitchBendValue
state_pb ControlState
state
        Just PitchBendValue
pb -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Addr
addr PitchBendValue
pb (ControlState -> Map Addr PitchBendValue
state_pb ControlState
state)
    }
    where
    pb_of :: ChannelMessage -> Maybe PitchBendValue
pb_of (Midi.PitchBend PitchBendValue
val) = forall a. a -> Maybe a
Just PitchBendValue
val
    pb_of ChannelMessage
_ = forall a. Maybe a
Nothing
    id_of :: ChannelMessage -> Maybe NoteId
id_of (Midi.NoteOn Key
key Control
_) = forall a. a -> Maybe a
Just (Key -> NoteId
key_to_id Key
key)
    id_of (Midi.NoteOff Key
key Control
_) = forall a. a -> Maybe a
Just (Key -> NoteId
key_to_id Key
key)
    id_of ChannelMessage
_ = forall a. Maybe a
Nothing

pb_to_input :: Control.PbRange -> Midi.PitchBendValue -> Midi.Key -> Pitch.Input
pb_to_input :: PbRange -> PitchBendValue -> Key -> Input
pb_to_input (Int
low, Int
high) PitchBendValue
pb Key
key =
    NoteNumber -> Input
nn_to_input forall a b. (a -> b) -> a -> b
$ forall a. Num a => Key -> a
Midi.from_key Key
key forall a. Num a => a -> a -> a
+ forall a. Real a => a -> NoteNumber
Pitch.nn Y
offset
    where
    offset :: Y
offset = PitchBendValue -> Y
Num.f2d forall a b. (a -> b) -> a -> b
$
        if PitchBendValue
pb forall a. Ord a => a -> a -> Bool
< PitchBendValue
0 then -PitchBendValue
pb forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
low else PitchBendValue
pb forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
high

nn_to_input :: Pitch.NoteNumber -> Pitch.Input
nn_to_input :: NoteNumber -> Input
nn_to_input NoteNumber
nn = KbdType -> Pitch -> Y -> Input
Pitch.Input KbdType
Pitch.PianoKbd Pitch
pitch Y
frac
    where
    pitch :: Pitch
pitch = Layout -> Int -> Pitch
Theory.semis_to_pitch_sharps Layout
Theory.piano_layout forall a b. (a -> b) -> a -> b
$
        Int -> Int
Theory.nn_to_semis Int
key
    (Int
key, Y
frac) = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (NoteNumber -> Y
Pitch.nn_to_double NoteNumber
nn)

input_to_nn :: Pitch.Input -> Pitch.NoteNumber
input_to_nn :: Input -> NoteNumber
input_to_nn (Pitch.Input KbdType
_ Pitch
pitch Y
frac) = NoteNumber
nn forall a. Num a => a -> a -> a
+ forall a. Real a => a -> NoteNumber
Pitch.nn Y
frac
    where nn :: NoteNumber
nn = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pitch -> Int
pitch_to_nn Pitch
pitch)

cc_to_control :: Midi.Control -> ScoreT.Control
cc_to_control :: Control -> Control
cc_to_control Control
cc = forall a. a -> Maybe a -> a
fromMaybe (Text -> Control
ScoreT.Control (Text
"cc" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Control
cc))
    (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Control
cc Map Control Control
cc_control)

control_to_cc :: ScoreT.Control -> Maybe Midi.Control
control_to_cc :: Control -> Maybe Control
control_to_cc = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map Control Control
control_cc

cc_control :: Map Midi.Control ScoreT.Control
cc_control :: Map Control Control
cc_control = forall a k. Ord a => Map k a -> Map a k
Maps.invert Map Control Control
control_cc

control_cc :: Map ScoreT.Control Midi.Control
control_cc :: Map Control Control
control_cc = Map Control Control
Control.universal_control_map

-- * from ascii

-- | Create an Input from an ascii keyboard Pitch.
from_ascii :: Bool -> Pitch.Pitch -> Input
from_ascii :: Bool -> Pitch -> Input
from_ascii Bool
down Pitch
pitch
    | Bool
down = forall pitch. NoteId -> pitch -> Y -> GenericInput pitch
NoteOn NoteId
note_id (KbdType -> Pitch -> Y -> Input
Pitch.Input KbdType
Pitch.AsciiKbd Pitch
pitch Y
0)
        Y
keyboard_velocity
    | Bool
otherwise = forall pitch. NoteId -> Y -> GenericInput pitch
NoteOff NoteId
note_id Y
keyboard_velocity
    where note_id :: NoteId
note_id = Int -> NoteId
NoteId (Pitch -> Int
pitch_to_nn Pitch
pitch)

pitch_to_nn :: Pitch.Pitch -> Int
pitch_to_nn :: Pitch -> Int
pitch_to_nn = Int -> Int
Theory.semis_to_nn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Pitch -> Int
Theory.pitch_to_semis Layout
Theory.piano_layout

-- * to midi

-- | Convert an InputNn to MIDI.
to_midi :: Control.PbRange -> Map NoteId Midi.Key -> InputNn
    -> ([Midi.ChannelMessage], Map NoteId Midi.Key)
to_midi :: PbRange
-> Map NoteId Key -> InputNn -> ([ChannelMessage], Map NoteId Key)
to_midi PbRange
pb_range Map NoteId Key
id_to_key = \case
    NoteOn NoteId
note_id NoteNumber
nn Y
vel -> forall {a}.
RealFrac a =>
NoteId -> NoteNumber -> a -> ([ChannelMessage], Map NoteId Key)
note_on NoteId
note_id NoteNumber
nn Y
vel
    NoteOff NoteId
note_id Y
vel -> forall {a}.
NoteId -> (Key -> ([a], Map NoteId Key)) -> ([a], Map NoteId Key)
with_key NoteId
note_id forall a b. (a -> b) -> a -> b
$ \Key
key ->
        ([Key -> Control -> ChannelMessage
Midi.NoteOff Key
key (forall {a} {b}. (RealFrac a, Integral b) => a -> b
from_val Y
vel)], forall k a. Ord k => k -> Map k a -> Map k a
Map.delete NoteId
note_id Map NoteId Key
id_to_key)
    PitchChange NoteId
note_id NoteNumber
nn -> forall {a}.
NoteId -> (Key -> ([a], Map NoteId Key)) -> ([a], Map NoteId Key)
with_key NoteId
note_id forall a b. (a -> b) -> a -> b
$ \Key
key ->
        ([PitchBendValue -> ChannelMessage
Midi.PitchBend (PbRange -> Key -> NoteNumber -> PitchBendValue
Control.pb_from_nn PbRange
pb_range Key
key NoteNumber
nn)], Map NoteId Key
id_to_key)
    Control NoteId
_ Control
control Y
val -> case Control -> Maybe Control
control_to_cc Control
control of
        Maybe Control
Nothing -> ([], Map NoteId Key
id_to_key)
        Just Control
cc -> ([Control -> Control -> ChannelMessage
Midi.ControlChange Control
cc (forall {a} {b}. (RealFrac a, Integral b) => a -> b
from_val Y
val)], Map NoteId Key
id_to_key)
    where
    with_key :: NoteId -> (Key -> ([a], Map NoteId Key)) -> ([a], Map NoteId Key)
with_key NoteId
note_id Key -> ([a], Map NoteId Key)
f = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NoteId
note_id Map NoteId Key
id_to_key of
        Maybe Key
Nothing -> ([], Map NoteId Key
id_to_key)
        Just Key
key -> Key -> ([a], Map NoteId Key)
f Key
key
    from_val :: a -> b
from_val a
val = forall a b. (RealFrac a, Integral b) => a -> b
floor (a
val forall a. Num a => a -> a -> a
* a
127)
    note_on :: NoteId -> NoteNumber -> a -> ([ChannelMessage], Map NoteId Key)
note_on NoteId
note_id NoteNumber
nn a
vel = case PbRange -> NoteNumber -> Maybe (Key, PitchBendValue)
Control.pitch_to_midi PbRange
pb_range NoteNumber
nn of
        Maybe (Key, PitchBendValue)
Nothing -> ([], Map NoteId Key
id_to_key)
        Just (Key
key, PitchBendValue
pb) ->
            ( [PitchBendValue -> ChannelMessage
Midi.PitchBend PitchBendValue
pb, Key -> Control -> ChannelMessage
Midi.NoteOn Key
key (forall {a} {b}. (RealFrac a, Integral b) => a -> b
from_val a
vel)]
            , forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert NoteId
note_id Key
key Map NoteId Key
id_to_key
            )