-- 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 = Map.fromList . map Tuple.swap

empty_map :: ControlMap
empty_map = 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 cmap cont key
    | Just cc <- Map.lookup cont cmap =
        Just $ Midi.ControlChange cc . val_to_cval
    | Just cc <- Map.lookup cont universal_control_map =
        Just $ Midi.ControlChange cc . val_to_cval
    | cont == Controls.pressure = Just $ Midi.ChannelPressure . val_to_cval
    | cont == Controls.aftertouch = Just $ Midi.Aftertouch key . val_to_cval
    | otherwise = 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 cmap control =
    Map.member control universal_control_map
    || Map.member control cmap
    || control == Controls.pressure || 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 = (/= 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 pb_range nn
    -- Signals default to 0 so 0 probably means the pitch signal was empty.
    | nn <= 0 || nn > 127 = 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.
    | abs (fromIntegral (round nn) - nn) < 0.005 =
        Just (Midi.to_key (round nn), 0)
    | otherwise = Just (key, pb_from_nn pb_range key nn)
    where key = Midi.to_key (floor nn)

pb_from_nn :: PbRange -> Midi.Key -> Pitch.NoteNumber -> Midi.PitchBendValue
pb_from_nn pb_range key (Pitch.NoteNumber nn)
    | bend > 0 = if high > 0 then Num.d2f $ bend / high else 0
    | otherwise = if low < 0 then Num.d2f $ bend / (-low) else 0
    where
    (low, high) = bimap fromIntegral fromIntegral pb_range
    bend = Num.clamp low high (nn - Midi.from_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 = control_map $
    [(n, ScoreT.unchecked_control $ "cc" <> showt n) | n <- [0..127]] ++
    [ (1, "mod")
    , (2, "breath")
    , (4, "foot")
    , (7, "vol")
    , (8, "balance")
    , (10, "pan")
    , (64, "pedal")
    , (65, "porta-pedal")
    , (66, "sost-pedal")
    , (67, "soft-pedal")
    ]

cc_to_control :: Midi.Control -> ScoreT.Control
cc_to_control = ScoreT.Control . ("cc"<>) . showt

-- * util

val_to_pb :: Signal.Y -> Int
val_to_pb val = round $ (Num.clamp (-1) 1 val + 1) * 0x2000 - 0x2000

val_to_cval :: Signal.Y -> Midi.ControlValue
val_to_cval val = round $ Num.clamp 0 1 val * 0x7f

cval_to_val :: Midi.ControlValue -> Signal.Y
cval_to_val v = fromIntegral v / 0x7f