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

{-# LANGUAGE CPP #-}
module Perform.Sc.Convert (
    default_srate, convert
#ifdef TESTING
    , module Perform.Sc.Convert
#endif
) where
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text

import qualified Util.Log as Log
import qualified Cmd.Cmd as Cmd
import qualified Derive.LEvent as LEvent
import qualified Derive.Score as Score
import qualified Derive.ScoreT as ScoreT

import qualified Instrument.Common as Common
import qualified Perform.ConvertUtil as ConvertUtil
import qualified Perform.Midi.MSignal as MSignal
import qualified Perform.Sc.Note as Note
import qualified Perform.Sc.Patch as Patch
import qualified Perform.Signal as Signal

import           Global
import           Types


-- Technically SC should not need this, since it should be able to do
-- interpolation on its own side like with im, but in practice SC patches
-- are probably set up like MIDI ones.
default_srate :: RealTime
default_srate :: RealTime
default_srate = RealTime
1 forall a. Fractional a => a -> a -> a
/ RealTime
0.015 -- TODO set to PlayUtil.initial_environ[srate]

-- | Convert Score events to Sc Notes.
convert :: RealTime -> (ScoreT.Instrument -> Maybe Cmd.ResolvedInstrument)
    -> [Score.Event] -> Note.Notes
convert :: RealTime
-> (Instrument -> Maybe ResolvedInstrument) -> [Event] -> Notes
convert RealTime
srate = forall a.
(Event -> ResolvedInstrument -> [LEvent a])
-> (Instrument -> Maybe ResolvedInstrument)
-> [Event]
-> [LEvent a]
ConvertUtil.convert forall a b. (a -> b) -> a -> b
$ \Event
event ResolvedInstrument
resolved ->
    case ResolvedInstrument -> Backend
Cmd.inst_backend ResolvedInstrument
resolved of
        Cmd.Sc Patch
patch -> RealTime -> Patch -> Bool -> Event -> Notes
convert_event RealTime
srate Patch
patch Bool
triggered Event
event
            where
            triggered :: Bool
triggered = Flag
Common.Triggered forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Flag
flags
            flags :: Set Flag
flags = forall code. Common code -> Set Flag
Common.common_flags forall a b. (a -> b) -> a -> b
$ ResolvedInstrument -> Common InstrumentCode
Cmd.inst_common ResolvedInstrument
resolved
        Backend
_ -> []

convert_event :: RealTime -> Patch.Patch -> Bool -> Score.Event -> Note.Notes
convert_event :: RealTime -> Patch -> Bool -> Event -> Notes
convert_event RealTime
srate Patch
patch Bool
triggered Event
event = forall a. LogId a -> [LEvent a]
run forall a b. (a -> b) -> a -> b
$ do
    Maybe NoteNumber
pitch <- if forall k a. Ord k => k -> Map k a -> Bool
Map.member Control
Patch.c_pitch (Patch -> Map Control ControlId
Patch.controls Patch
patch)
        then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). LogMonad m => Event -> m NoteNumber
convert_pitch Event
event
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    let controls :: ControlMap
controls = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall {k1} {k2} {k} {kind1 :: k1} {kind2 :: k2}.
Ord k =>
k
-> Signal kind1
-> Map k (Typed (Signal kind2))
-> Map k (Typed (Signal kind2))
add_control Control
Patch.c_pitch) Maybe NoteNumber
pitch forall a b. (a -> b) -> a -> b
$
            Event -> ControlMap
Score.event_controls Event
event
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Note.Note
        { patch :: PatchName
patch = Patch -> PatchName
Patch.name Patch
patch
        , start :: RealTime
start = Event -> RealTime
Score.event_start Event
event
        , controls :: Map ControlId Signal
controls = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ControlId
Note.gate_id Signal
gate forall a b. (a -> b) -> a -> b
$
            RealTime
-> Map Control ControlId
-> RealTime
-> RealTime
-> ControlMap
-> Map ControlId Signal
convert_controls RealTime
srate (Patch -> Map Control ControlId
Patch.controls Patch
patch)
                (Event -> RealTime
Score.event_start Event
event) (Event -> RealTime
Score.event_end Event
event) ControlMap
controls
        }
    where
    add_control :: k
-> Signal kind1
-> Map k (Typed (Signal kind2))
-> Map k (Typed (Signal kind2))
add_control k
c Signal kind1
sig = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
c (forall a. a -> Typed a
ScoreT.untyped (forall {k1} {k2} (kind1 :: k1) (kind2 :: k2).
Signal kind1 -> Signal kind2
Signal.coerce Signal kind1
sig))
    gate :: Signal
gate
        | Bool
triggered = [(RealTime, Y)] -> Signal
MSignal.from_pairs [(RealTime
start, Y
1), (RealTime
startforall a. Num a => a -> a -> a
+RealTime
srate, Y
0)]
        | Bool
otherwise =
            [(RealTime, Y)] -> Signal
MSignal.from_pairs [(RealTime
start, Y
1), (Event -> RealTime
Score.event_end Event
event, Y
0)]
        where start :: RealTime
start = Event -> RealTime
Score.event_start Event
event

run :: Log.LogId a -> [LEvent.LEvent a]
run :: forall a. LogId a -> [LEvent a]
run LogId a
action = forall a. a -> LEvent a
LEvent.Event a
note forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Msg -> LEvent a
LEvent.Log [Msg]
logs
    where (a
note, [Msg]
logs) = forall a. LogId a -> (a, [Msg])
Log.run_id LogId a
action

-- | Convert deriver controls to performance controls.  Drop all non-MIDI
-- controls, since those will inhibit channel sharing later.
convert_controls :: RealTime
    -> Map ScoreT.Control Note.ControlId -- ^ Patch control map.
    -> RealTime -> RealTime
    -> ScoreT.ControlMap -- ^ Controls to convert.
    -> Map Note.ControlId MSignal.Signal
convert_controls :: RealTime
-> Map Control ControlId
-> RealTime
-> RealTime
-> ControlMap
-> Map ControlId Signal
convert_controls RealTime
srate Map Control ControlId
patch_controls RealTime
start RealTime
end =
    forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {k} {kind :: k}.
(Control, Typed (Signal kind)) -> Maybe (ControlId, Signal)
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toAscList
    where
    -- TODO trim to start of the next note of this patch.  But this will be
    -- quite inefficient if there's a long signal and a short decay.
    convert :: (Control, Typed (Signal kind)) -> Maybe (ControlId, Signal)
convert (Control
control, Typed (Signal kind)
signal) = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Control
control Map Control ControlId
patch_controls of
        Maybe ControlId
Nothing -> forall a. Maybe a
Nothing
        Just ControlId
cid -> forall a. a -> Maybe a
Just
            ( ControlId
cid
            , forall {k} (kind :: k). RealTime -> Signal kind -> Signal
Signal.to_piecewise_constant RealTime
srate forall a b. (a -> b) -> a -> b
$
                forall {k} (kind :: k). RealTime -> Signal kind -> Signal kind
Signal.clip_after RealTime
end forall a b. (a -> b) -> a -> b
$ forall {k} (kind :: k). RealTime -> Signal kind -> Signal kind
Signal.clip_before RealTime
start forall a b. (a -> b) -> a -> b
$
                forall a. Typed a -> a
ScoreT.val_of Typed (Signal kind)
signal
            )
    -- TODO it might be more efficient to skip the MSignal and go directly to
    -- OSC.  Especially because I want just in dur range...  or I guess longer,
    -- to account for decay?

-- TODO same as Im.Convert.convert_pitch
convert_pitch :: Log.LogMonad m => Score.Event -> m Signal.NoteNumber
convert_pitch :: forall (m :: * -> *). LogMonad m => Event -> m NoteNumber
convert_pitch Event
event = do
    let (NoteNumber
sig, [(RealTime, Text)]
warns) = Event -> (NoteNumber, [(RealTime, Text)])
Score.nn_signal Event
event
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RealTime, Text)]
warns) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). (Stack, LogMonad m) => Text -> m ()
Log.warn forall a b. (a -> b) -> a -> b
$
        Text
"convert pitch: " forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Text
pretty [(RealTime, Text)]
warns)
    forall (m :: * -> *) a. Monad m => a -> m a
return NoteNumber
sig