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

-- | Basic types for "Perform.Midi.Perform".
module Perform.Midi.Types where
import qualified Control.DeepSeq as DeepSeq
import qualified Data.Set as Set

import qualified Util.Pretty as Pretty
import qualified Util.TimeVector as TimeVector
import qualified Derive.ScoreT as ScoreT
import qualified Derive.Stack as Stack
import qualified Perform.Midi.Control as Control
import qualified Perform.Midi.MSignal as MSignal
import qualified Perform.Midi.Patch as Patch
import qualified Perform.Pitch as Pitch

import           Global
import           Types


-- | The Patch is derived from a 'Patch.Patch' and contains all the data
-- necessary to render a 'Perform.Midi.Perform.Event' to a midi message.  Each
-- Event has an attached Patch.
data Patch = Patch {
    -- | The name for the instrument as used in the score.  It should globally
    -- identify the instrument within this score.
    Patch -> Instrument
patch_name :: !ScoreT.Instrument
    -- | Keyswitches required by this instrument.  At higher levels, a single
    -- instrument can respond to a variety of keyswitches, but at the perform
    -- level, each instrument of each note is specialized to the particular
    -- keyswitches intended.  So this is normally empty, but filled in by
    -- convert prior to perform.
    , Patch -> [Keyswitch]
patch_keyswitches :: ![Patch.Keyswitch]
    -- | If true, the keysitch has to be held while the note is playing.
    -- Otherwise, it will just be tapped before the note starts.
    , Patch -> Bool
patch_hold_keyswitches :: !Bool

    -- | Map control names to a control number.  Some controls are shared by
    -- all midi instruments, but some instruments have special controls.
    , Patch -> ControlMap
patch_control_map :: !Control.ControlMap
    , Patch -> PbRange
patch_pitch_bend_range :: !Control.PbRange
    -- | Time from NoteOff to inaudible, in seconds.  This can be used to
    -- figure out how long to generate control messages, or possibly determine
    -- overlap for channel allocation, though I use LRU so it shouldn't matter.
    , Patch -> Maybe RealTime
patch_decay :: !(Maybe RealTime)
    } deriving (Patch -> Patch -> Bool
(Patch -> Patch -> Bool) -> (Patch -> Patch -> Bool) -> Eq Patch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Patch -> Patch -> Bool
$c/= :: Patch -> Patch -> Bool
== :: Patch -> Patch -> Bool
$c== :: Patch -> Patch -> Bool
Eq, Eq Patch
Eq Patch
-> (Patch -> Patch -> Ordering)
-> (Patch -> Patch -> Bool)
-> (Patch -> Patch -> Bool)
-> (Patch -> Patch -> Bool)
-> (Patch -> Patch -> Bool)
-> (Patch -> Patch -> Patch)
-> (Patch -> Patch -> Patch)
-> Ord Patch
Patch -> Patch -> Bool
Patch -> Patch -> Ordering
Patch -> Patch -> Patch
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 :: Patch -> Patch -> Patch
$cmin :: Patch -> Patch -> Patch
max :: Patch -> Patch -> Patch
$cmax :: Patch -> Patch -> Patch
>= :: Patch -> Patch -> Bool
$c>= :: Patch -> Patch -> Bool
> :: Patch -> Patch -> Bool
$c> :: Patch -> Patch -> Bool
<= :: Patch -> Patch -> Bool
$c<= :: Patch -> Patch -> Bool
< :: Patch -> Patch -> Bool
$c< :: Patch -> Patch -> Bool
compare :: Patch -> Patch -> Ordering
$ccompare :: Patch -> Patch -> Ordering
Ord, Int -> Patch -> ShowS
[Patch] -> ShowS
Patch -> String
(Int -> Patch -> ShowS)
-> (Patch -> String) -> ([Patch] -> ShowS) -> Show Patch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Patch] -> ShowS
$cshowList :: [Patch] -> ShowS
show :: Patch -> String
$cshow :: Patch -> String
showsPrec :: Int -> Patch -> ShowS
$cshowsPrec :: Int -> Patch -> ShowS
Show)

patch :: ScoreT.Instrument -> Patch.Config -> Patch.Patch -> Patch
patch :: Instrument -> Config -> Patch -> Patch
patch Instrument
score_inst Config
config =
    Instrument -> Settings -> Patch -> Patch
patch_from_settings Instrument
score_inst (Config -> Settings
Patch.config_settings Config
config)

patch_from_settings :: ScoreT.Instrument -> Patch.Settings -> Patch.Patch
    -> Patch
patch_from_settings :: Instrument -> Settings -> Patch -> Patch
patch_from_settings Instrument
score_inst Settings
settings Patch
patch = Patch
    { patch_name :: Instrument
patch_name = Instrument
score_inst
    , patch_keyswitches :: [Keyswitch]
patch_keyswitches = []
    , patch_hold_keyswitches :: Bool
patch_hold_keyswitches = Bool -> (Set Flag -> Bool) -> Maybe (Set Flag) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Flag -> Set Flag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Flag
Patch.HoldKeyswitch)
        (Settings -> Maybe (Set Flag)
Patch.config_flags Settings
settings)
    , patch_control_map :: ControlMap
patch_control_map = Patch -> ControlMap
Patch.patch_control_map Patch
patch
    -- This should definitely be Just because the Patch.patch constructor
    -- requires it.  It's Maybe so Patch.config_settings can optionally replace
    -- it.
    , patch_pitch_bend_range :: PbRange
patch_pitch_bend_range = PbRange -> Maybe PbRange -> PbRange
forall a. a -> Maybe a -> a
fromMaybe (-Int
100, Int
100) (Maybe PbRange -> PbRange) -> Maybe PbRange -> PbRange
forall a b. (a -> b) -> a -> b
$
        Settings -> Maybe PbRange
Patch.config_pitch_bend_range Settings
settings
    , patch_decay :: Maybe RealTime
patch_decay = Settings -> Maybe RealTime
Patch.config_decay Settings
settings
    }

instance DeepSeq.NFData Patch where
    -- don't bother with the rest since instruments are constructed all at once
    rnf :: Patch -> ()
rnf Patch
inst = [Keyswitch] -> ()
forall a. NFData a => a -> ()
DeepSeq.rnf (Patch -> [Keyswitch]
patch_keyswitches Patch
inst)

instance Pretty Patch where
    format :: Patch -> Doc
format (Patch Instrument
name [Keyswitch]
keyswitches Bool
hold_keyswitches ControlMap
cmap PbRange
pb_range Maybe RealTime
decay) =
        Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"Patch"
            [ (Text
"name", Instrument -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Instrument
name)
            , (Text
"keyswitches", [Keyswitch] -> Doc
forall a. Pretty a => a -> Doc
Pretty.format [Keyswitch]
keyswitches)
            , (Text
"hold_keyswitches", Bool -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Bool
hold_keyswitches)
            , (Text
"control_map", ControlMap -> Doc
forall a. Pretty a => a -> Doc
Pretty.format ControlMap
cmap)
            , (Text
"pb_range", PbRange -> Doc
forall a. Pretty a => a -> Doc
Pretty.format PbRange
pb_range)
            , (Text
"decay", Maybe RealTime -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Maybe RealTime
decay)
            ]

-- | Somewhat conservative default decay which should suit most instruments.
-- 'decay' will probably only rarely be explicitly set.
default_decay :: RealTime
default_decay :: RealTime
default_decay = RealTime
1.0


-- * event

data Event = Event {
    Event -> RealTime
event_start :: !RealTime
    , Event -> RealTime
event_duration :: !RealTime
    , Event -> Patch
event_patch :: !Patch
    , Event -> Map Control Signal
event_controls :: !(Map ScoreT.Control MSignal.Signal)
    , Event -> Signal
event_pitch :: !MSignal.Signal
    , Event -> UnboxedY
event_start_velocity :: !MSignal.Y
    , Event -> UnboxedY
event_end_velocity :: !MSignal.Y
    , Event -> Stack
event_stack :: !Stack.Stack
    } deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show)

instance DeepSeq.NFData Event where
    rnf :: Event -> ()
rnf (Event RealTime
start RealTime
dur Patch
inst Map Control Signal
controls Signal
pitch UnboxedY
_svel UnboxedY
_evel Stack
stack) =
        RealTime -> ()
forall a. NFData a => a -> ()
rnf RealTime
start () -> () -> ()
`seq` RealTime -> ()
forall a. NFData a => a -> ()
rnf RealTime
dur () -> () -> ()
`seq` Patch -> ()
forall a. NFData a => a -> ()
rnf Patch
inst () -> () -> ()
`seq` Map Control Signal -> ()
forall a. NFData a => a -> ()
rnf Map Control Signal
controls
        () -> () -> ()
`seq` Signal -> ()
forall a. NFData a => a -> ()
rnf Signal
pitch () -> () -> ()
`seq` Stack -> ()
forall a. NFData a => a -> ()
rnf Stack
stack
        where
        rnf :: DeepSeq.NFData a => a -> ()
        rnf :: forall a. NFData a => a -> ()
rnf = a -> ()
forall a. NFData a => a -> ()
DeepSeq.rnf

instance Pretty Event where
    format :: Event -> Doc
format (Event RealTime
start RealTime
dur Patch
patch Map Control Signal
controls Signal
pitch UnboxedY
svel UnboxedY
evel Stack
stack) =
        Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"Event"
            [ (Text
"start", RealTime -> Doc
forall a. Pretty a => a -> Doc
Pretty.format RealTime
start)
            , (Text
"duration", RealTime -> Doc
forall a. Pretty a => a -> Doc
Pretty.format RealTime
dur)
            , (Text
"patch", Instrument -> Doc
forall a. Pretty a => a -> Doc
Pretty.format (Patch -> Instrument
patch_name Patch
patch))
            , (Text
"keyswitches", [Keyswitch] -> Doc
forall a. Pretty a => a -> Doc
Pretty.format (Patch -> [Keyswitch]
patch_keyswitches Patch
patch))
            , (Text
"controls", Map Control Signal -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Map Control Signal
controls)
            , (Text
"pitch", Signal -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Signal
pitch)
            , (Text
"velocity", (UnboxedY, UnboxedY) -> Doc
forall a. Pretty a => a -> Doc
Pretty.format (UnboxedY
svel, UnboxedY
evel))
            , (Text
"stack", Stack -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Stack
stack)
            ]

-- | Pretty print the event more briefly than the Pretty instance.
show_short :: Event -> Text
show_short :: Event -> Text
show_short Event
event =
    (RealTime, RealTime, Instrument, Maybe NoteNumber,
 Map Control Signal)
-> Text
forall a. Pretty a => a -> Text
pretty (RealTime
start, Event -> RealTime
event_duration Event
event, Instrument
name, Maybe NoteNumber
pitch, Event -> Map Control Signal
event_controls Event
event)
    where
    start :: RealTime
start = Event -> RealTime
event_start Event
event
    name :: Instrument
name = Patch -> Instrument
patch_name (Event -> Patch
event_patch Event
event)
    pitch :: Maybe NoteNumber
pitch = UnboxedY -> NoteNumber
Pitch.NoteNumber (UnboxedY -> NoteNumber) -> Maybe UnboxedY -> Maybe NoteNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RealTime -> Signal -> Maybe UnboxedY
forall (v :: * -> *) y.
Vector v (Sample y) =>
RealTime -> v (Sample y) -> Maybe y
TimeVector.at RealTime
start (Event -> Signal
event_pitch Event
event)

event_end :: Event -> RealTime
event_end :: Event -> RealTime
event_end Event
event = Event -> RealTime
event_start Event
event RealTime -> RealTime -> RealTime
forall a. Num a => a -> a -> a
+ Event -> RealTime
event_duration Event
event

event_instrument :: Event -> ScoreT.Instrument
event_instrument :: Event -> Instrument
event_instrument = Patch -> Instrument
patch_name (Patch -> Instrument) -> (Event -> Patch) -> Event -> Instrument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Patch
event_patch