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

{-# LANGUAGE CPP #-}
{- | Utilities for "Derive.Call.Block".

    Derivation of a block is much more complicated than it might first appear.
    This can cause score code to be evaluated more times than you think it
    should be.

    One culprit is evaluating tracks for control signals for signal render.
    Under some circumstances, the track's normal control output can be directly
    reused as the signal render, but in many cases it has to be evaluated
    again.  This is further complicated by the presence of inversion and
    orphans.
-}
module Derive.Call.BlockUtil (
    note_deriver, control_deriver
    , capture_null_control
    , derive_tracks
    , has_top_tempo_track

#ifdef TESTING
    , derive_tree
#endif
) where
import qualified Data.Tree as Tree

import qualified Util.Lists as Lists
import qualified Util.Log as Log
import qualified Util.Trees as Trees

import qualified Derive.Cache as Cache
import qualified Derive.Control as Control
import qualified Derive.Controls as Controls
import qualified Derive.Derive as Derive
import qualified Derive.Deriver.Internal as Internal
import qualified Derive.EnvKey as EnvKey
import qualified Derive.EvalTrack as EvalTrack
import qualified Derive.Expr as Expr
import qualified Derive.LEvent as LEvent
import qualified Derive.Note as Note
import qualified Derive.PSignal as PSignal
import qualified Derive.ParseTitle as ParseTitle
import qualified Derive.Score as Score
import qualified Derive.ScoreT as ScoreT
import qualified Derive.ShowVal as ShowVal
import qualified Derive.Stack as Stack
import qualified Derive.Stream as Stream
import qualified Derive.Tempo as Tempo

import qualified Perform.Signal as Signal
import qualified Ui.Event as Event
import qualified Ui.Events as Events
import qualified Ui.TrackTree as TrackTree
import qualified Ui.Ui as Ui
import qualified Ui.UiConfig as UiConfig

import           Global
import           Types


note_deriver :: BlockId -> Derive.NoteDeriver
note_deriver :: BlockId -> NoteDeriver
note_deriver BlockId
block_id = do
    (EventsTree
tree, (TrackTime, TrackTime)
block_range) <- forall a. HasCallStack => StateId a -> Deriver a
Derive.eval_ui forall a b. (a -> b) -> a -> b
$
        (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => BlockId -> m EventsTree
TrackTree.block_events_tree BlockId
block_id
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). M m => BlockId -> m (TrackTime, TrackTime)
Ui.block_logical_range BlockId
block_id
    forall a. TrackTime -> Deriver a -> Deriver a
with_per_block_state (forall a b. (a, b) -> b
snd (TrackTime, TrackTime)
block_range) forall a b. (a -> b) -> a -> b
$ (TrackTime, TrackTime) -> EventsTree -> NoteDeriver
derive_tree (TrackTime, TrackTime)
block_range EventsTree
tree

-- | Reset Dynamic state for a new block.
with_per_block_state :: TrackTime -> Derive.Deriver a -> Derive.Deriver a
with_per_block_state :: forall a. TrackTime -> Deriver a -> Deriver a
with_per_block_state TrackTime
end = forall {a}. Deriver a -> Deriver a
clear forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall val a. ToVal val => Text -> val -> Deriver a -> Deriver a
Derive.with_val Text
EnvKey.block_end TrackTime
end
    where
    clear :: Deriver a -> Deriver a
clear = forall a. (Dynamic -> Dynamic) -> Deriver a -> Deriver a
Internal.local forall a b. (a -> b) -> a -> b
$ \Dynamic
state -> Dynamic
state
        { state_note_track :: Maybe (BlockId, TrackId)
Derive.state_note_track = forall a. Maybe a
Nothing
        , state_pitch_map :: Maybe (Maybe PSignal, [Msg])
Derive.state_pitch_map = forall a. Maybe a
Nothing -- set by 'with_pitch_map' below
        }

-- * control deriver

-- | Control blocks are very restricted: they should consist of a single
-- branch ending in a track with a @%@ title, which is the default control,
-- which should have been set by the calling track.  If the requirements are
-- met, a fake note track will be appended to make this a valid note block,
-- with a single note event whose only job is to collect the the default
-- control.
control_deriver :: BlockId -> Ui.StateId Derive.ControlDeriver
control_deriver :: BlockId -> StateId ControlDeriver
control_deriver BlockId
block_id = do
    EventsTree
tree <- forall (m :: * -> *). M m => BlockId -> m EventsTree
TrackTree.block_events_tree BlockId
block_id
    (TrackTime, TrackTime)
block_range <- forall (m :: * -> *). M m => BlockId -> m (TrackTime, TrackTime)
Ui.block_logical_range BlockId
block_id
    case TrackTime -> EventsTree -> Either Text EventsTree
check_control_tree (forall a b. (a, b) -> b
snd (TrackTime, TrackTime)
block_range) EventsTree
tree of
        Left Text
err -> forall (m :: * -> *) a. (HasCallStack, M m) => Text -> m a
Ui.throw forall a b. (a -> b) -> a -> b
$ Text
"control block skeleton malformed: " forall a. Semigroup a => a -> a -> a
<> Text
err
        Right EventsTree
tree -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. TrackTime -> Deriver a -> Deriver a
with_per_block_state (forall a b. (a, b) -> b
snd (TrackTime, TrackTime)
block_range) forall a b. (a -> b) -> a -> b
$
            (TrackTime, TrackTime) -> EventsTree -> ControlDeriver
derive_control_tree (TrackTime, TrackTime)
block_range EventsTree
tree

-- | Name of the call for the control deriver hack.
capture_null_control :: Expr.Symbol
capture_null_control :: Symbol
capture_null_control = Symbol
"capture-null-control"

-- | Ensure the tree meets the requirements documented by 'control_deriver'
-- and append the fake note track if it does.
check_control_tree :: ScoreTime -> TrackTree.EventsTree
    -> Either Text TrackTree.EventsTree
check_control_tree :: TrackTime -> EventsTree -> Either Text EventsTree
check_control_tree TrackTime
block_end EventsTree
forest = case EventsTree
forest of
    [] -> forall a b. a -> Either a b
Left Text
"empty block"
    [Tree.Node Track
track []]
        | Track -> Text
TrackTree.track_title Track
track forall a. Eq a => a -> a -> Bool
== Text
"%" ->
            forall a b. b -> Either a b
Right [forall a. a -> [Tree a] -> Tree a
Tree.Node Track
track [forall a. a -> [Tree a] -> Tree a
Tree.Node Track
capture_track []]]
        | Bool
otherwise -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"skeleton must end in % track, ends with "
            forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (Track -> Text
TrackTree.track_title Track
track)
    [Tree.Node Track
track EventsTree
subs] -> do
        EventsTree
subs <- TrackTime -> EventsTree -> Either Text EventsTree
check_control_tree TrackTime
block_end EventsTree
subs
        forall (m :: * -> *) a. Monad m => a -> m a
return [forall a. a -> [Tree a] -> Tree a
Tree.Node Track
track EventsTree
subs]
    EventsTree
tracks -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"skeleton must have only a single branch, "
        forall a. Semigroup a => a -> a -> a
<> Text
"but there are multiple children: "
        forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (forall a b. (a -> b) -> [a] -> [b]
map (Track -> Text
TrackTree.track_title forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> a
Tree.rootLabel) EventsTree
tracks)
    where
    events :: Events
events = Event -> Events
Events.singleton forall a b. (a -> b) -> a -> b
$
        TrackTime -> TrackTime -> Text -> Event
Event.event TrackTime
0 TrackTime
block_end (Symbol -> Text
Expr.unsym Symbol
capture_null_control)
    capture_track :: Track
capture_track = Text -> Events -> TrackTime -> Track
TrackTree.make_track Text
">" Events
events TrackTime
block_end

derive_control_tree :: (ScoreTime, ScoreTime) -> TrackTree.EventsTree
    -> Derive.ControlDeriver
derive_control_tree :: (TrackTime, TrackTime) -> EventsTree -> ControlDeriver
derive_control_tree (TrackTime, TrackTime)
block_range EventsTree
tree = do
    -- There are an awful lot of things that can go wrong.  I guess that's why
    -- this is a hack.
    Stream Event
events <- (TrackTime, TrackTime) -> EventsTree -> NoteDeriver
derive_tree (TrackTime, TrackTime)
block_range EventsTree
tree
    case forall a. Stream a -> ([a], [Msg])
Stream.partition Stream Event
events of
        ([Event
event], [Msg]
logs) -> case Control -> Event -> Maybe (Typed Control)
Score.event_control Control
Controls.null Event
event of
            Maybe (Typed Control)
Nothing -> forall a. HasCallStack => Text -> Deriver a
Derive.throw Text
"control call didn't emit Controls.null"
            Just Typed Control
signal -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [LEvent a] -> Stream a
Stream.from_sorted_list forall a b. (a -> b) -> a -> b
$
                -- The calling control itself will be providing the type since
                -- types are at the level of the signal as a whole.
                forall a. a -> LEvent a
LEvent.Event (forall a. Typed a -> a
ScoreT.val_of Typed Control
signal) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Msg -> LEvent a
LEvent.Log [Msg]
logs
        ([Event]
events, [Msg]
logs) -> do
            Msg
msg <- forall {a}. Show a => a -> Deriver Msg
complain [Event]
events
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [Msg] -> Stream a
Stream.from_logs forall a b. (a -> b) -> a -> b
$ Msg
msg forall a. a -> [a] -> [a]
: [Msg]
logs
    where
    -- Or I could throw, but this way any other logs the block emitted will
    -- also be visible, and they might have something interesting.
    complain :: a -> Deriver Msg
complain a
events = Msg -> Deriver Msg
Derive.initialize_log_msg forall a b. (a -> b) -> a -> b
$ HasCallStack => Priority -> Maybe Stack -> Text -> Msg
Log.msg Priority
Log.Warn forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$
        Text
"control call should have emitted a single call to "
        forall a. Semigroup a => a -> a -> a
<> forall a. ShowVal a => a -> Text
ShowVal.show_val Symbol
capture_null_control
        forall a. Semigroup a => a -> a -> a
<> Text
" which produces a single event, but got events: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt a
events

-- ** implementation

derive_tree :: (ScoreTime, ScoreTime) -> TrackTree.EventsTree
    -> Derive.NoteDeriver
derive_tree :: (TrackTime, TrackTime) -> EventsTree -> NoteDeriver
derive_tree (TrackTime, TrackTime)
block_range EventsTree
tree
    | Just Tree Track
node <- EventsTree -> Maybe (Tree Track)
has_top_tempo_track EventsTree
tree = Bool -> Tree Track -> NoteDeriver
derive_track Bool
True Tree Track
node
    | Bool
otherwise = do
        -- Every block must have a tempo track as the topmost track.  This is
        -- because Tempo.with_tempo sets up some stuff that every block needs,
        -- and because I need a TrackWarp for the tracks below.
        Y
tempo <- Deriver State Error Y
get_tempo
        forall a.
Monoid a =>
Bool
-> Maybe (TrackTime, TrackTime)
-> Maybe TrackId
-> Tempo
-> Deriver a
-> Deriver a
Tempo.with_tempo Bool
True (forall a. a -> Maybe a
Just (TrackTime, TrackTime)
block_range) forall a. Maybe a
Nothing (forall {k} (kind :: k). Y -> Signal kind
Signal.constant Y
tempo)
            (EventsTree -> NoteDeriver
derive_tracks EventsTree
tree)
    where
    get_tempo :: Deriver State Error Y
get_tempo = forall a. Typecheck a => Text -> Deriver (Maybe a)
Derive.lookup_val Text
EnvKey.tempo forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Y
Nothing -> forall a. (Config -> a) -> Deriver a
Derive.get_ui_config forall a b. (a -> b) -> a -> b
$
            Default -> Y
UiConfig.default_tempo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Default
UiConfig.config_default
        Just Y
tempo -> forall (m :: * -> *) a. Monad m => a -> m a
return Y
tempo

-- | Derive an EventsTree.
derive_tracks :: TrackTree.EventsTree -> Derive.NoteDeriver
derive_tracks :: EventsTree -> NoteDeriver
derive_tracks = forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap (Bool -> Tree Track -> NoteDeriver
derive_track Bool
False)

-- | Derive a single track node and any tracks below it.
derive_track :: Bool -- ^ True if this is the single topmost track and is
    -- a tempo track.  Ultimately this flag gets threaded all the way down to
    -- "Derive.Tempo".
    -> TrackTree.EventsNode -> Derive.NoteDeriver
derive_track :: Bool -> Tree Track -> NoteDeriver
derive_track Bool
toplevel node :: Tree Track
node@(Tree.Node Track
track EventsTree
subs)
    | Text -> Bool
ParseTitle.is_note_track (Track -> Text
TrackTree.track_title Track
track) =
        forall {a}. Deriver a -> Deriver a
with_stack forall a b. (a -> b) -> a -> b
$ forall d.
Cacheable d =>
Track -> Set TrackId -> Deriver (Stream d) -> Deriver (Stream d)
Cache.track Track
track (Tree Track -> Set TrackId
TrackTree.track_children Tree Track
node) forall a b. (a -> b) -> a -> b
$ do
            Stream Event
events <- forall {a}. Track -> Deriver a -> Deriver a
with_voice Track
track forall a b. (a -> b) -> a -> b
$ forall a. Track -> EventsTree -> Deriver a -> Deriver a
with_pitch_map Track
track EventsTree
subs forall a b. (a -> b) -> a -> b
$
                forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. TrackId -> Deriver a -> Deriver a
with_note_track (Track -> Maybe TrackId
TrackTree.track_id Track
track) forall a b. (a -> b) -> a -> b
$
                (EventsTree -> NoteDeriver) -> Tree Track -> NoteDeriver
Note.d_note_track EventsTree -> NoteDeriver
derive_tracks Tree Track
node
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Track -> Sliced
TrackTree.track_sliced Track
track forall a. Eq a => a -> a -> Bool
== Sliced
TrackTree.NotSliced)
                Deriver State Error ()
defragment
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Stream Event -> Track -> Deriver State Error ()
Note.stash_signal_if_wanted Stream Event
events)
                (Track -> EventsTree -> [Track]
note_signal_tracks Track
track EventsTree
subs)
            forall (m :: * -> *) a. Monad m => a -> m a
return Stream Event
events
    | Bool
otherwise = forall {a}. Deriver a -> Deriver a
with_stack forall a b. (a -> b) -> a -> b
$
        Config -> Track -> NoteDeriver -> NoteDeriver
Control.d_control_track (Bool -> Bool -> Config
Control.Config Bool
toplevel Bool
True) Track
track
            (EventsTree -> NoteDeriver
derive_tracks EventsTree
subs)
    where
    with_voice :: Track -> Deriver a -> Deriver a
with_voice = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall val a. ToVal val => Text -> val -> Deriver a -> Deriver a
Derive.with_val Text
EnvKey.track_voice)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Track -> Maybe Int
TrackTree.track_voice
    defragment :: Deriver State Error ()
defragment = do
        Warp
warp <- Deriver Warp
Internal.get_warp
        (Collect -> Collect) -> Deriver State Error ()
Internal.modify_collect forall a b. (a -> b) -> a -> b
$ Warp -> Collect -> Collect
EvalTrack.defragment_track_signals Warp
warp
    with_stack :: Deriver a -> Deriver a
with_stack = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. TrackId -> Deriver a -> Deriver a
Internal.with_stack_track (Track -> Maybe TrackId
TrackTree.track_id Track
track)

with_note_track :: TrackId -> Derive.Deriver a -> Derive.Deriver a
with_note_track :: forall a. TrackId -> Deriver a -> Deriver a
with_note_track TrackId
track_id Deriver a
deriver = do
    Maybe BlockId
maybe_block_id <- forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Frame -> Maybe BlockId
Stack.block_of forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack -> [Frame]
Stack.innermost forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Deriver Stack
Internal.get_stack
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall {a}. BlockId -> Deriver a -> Deriver a
with Maybe BlockId
maybe_block_id Deriver a
deriver
    where
    with :: BlockId -> Deriver a -> Deriver a
with BlockId
block_id = forall a. (Dynamic -> Dynamic) -> Deriver a -> Deriver a
Internal.local forall a b. (a -> b) -> a -> b
$ \Dynamic
state -> Dynamic
state
        { state_note_track :: Maybe (BlockId, TrackId)
Derive.state_note_track = forall a. a -> Maybe a
Just (BlockId
block_id, TrackId
track_id) }

-- | Extract tracks that might want to stash a signal.
--
-- A note track can display a signal, extracted from the events it generates.
-- But if the track has orphan sub-tracks, its events will be evaluated
-- separately, either directly as orphans, or indirectly as the children of the
-- non-orphan sections.  At the moment it seems simpler to collect all the
-- events of the whole set of tracks and consider them the output of all of
-- them.
note_signal_tracks :: TrackTree.Track -> TrackTree.EventsTree
    -> [TrackTree.Track]
note_signal_tracks :: Track -> EventsTree -> [Track]
note_signal_tracks Track
track EventsTree
subs = case Track -> Sliced
TrackTree.track_sliced Track
track of
    Sliced
TrackTree.NotSliced -> Track
track forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter Track -> Bool
is_note (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Tree a -> [a]
Tree.flatten EventsTree
subs)
    Sliced
_ -> []
    where is_note :: Track -> Bool
is_note = Text -> Bool
ParseTitle.is_note_track forall b c a. (b -> c) -> (a -> b) -> a -> c
. Track -> Text
TrackTree.track_title

-- | The tempo track, if the top level track is a tempo track.
has_top_tempo_track :: [Tree.Tree TrackTree.Track]
    -> Maybe (Tree.Tree TrackTree.Track)
has_top_tempo_track :: EventsTree -> Maybe (Tree Track)
has_top_tempo_track EventsTree
tree = case EventsTree
tree of
    [node :: Tree Track
node@(Tree.Node Track
track EventsTree
_)] | Track -> Bool
is_tempo Track
track -> forall a. a -> Maybe a
Just Tree Track
node
    EventsTree
_ -> forall a. Maybe a
Nothing
    where
    is_tempo :: Track -> Bool
is_tempo = Text -> Bool
ParseTitle.is_tempo_track forall b c a. (b -> c) -> (a -> b) -> a -> c
. Track -> Text
TrackTree.track_title

-- * track pitch map

-- | Given an event track, look for a pitch track below it, and derive it
-- standalone.  If there is none, then take 'Derive.state_pitch'.  Put this
-- into 'Derive.state_pitch_map'.
with_pitch_map :: TrackTree.Track -> TrackTree.EventsTree -> Derive.Deriver a
    -> Derive.Deriver a
with_pitch_map :: forall a. Track -> EventsTree -> Deriver a -> Deriver a
with_pitch_map Track
track EventsTree
subs Deriver a
deriver = case Track -> Sliced
TrackTree.track_sliced Track
track of
    Sliced
TrackTree.NotSliced -> do
        (Maybe PSignal, [Msg])
pmap <- EventsTree -> Deriver (Maybe PSignal, [Msg])
get_pitch_map EventsTree
subs
        forall a. (Dynamic -> Dynamic) -> Deriver a -> Deriver a
Internal.local (\Dynamic
state -> Dynamic
state { state_pitch_map :: Maybe (Maybe PSignal, [Msg])
Derive.state_pitch_map = forall a. a -> Maybe a
Just (Maybe PSignal, [Msg])
pmap })
            Deriver a
deriver
    Sliced
_ -> Deriver a
deriver

get_pitch_map :: TrackTree.EventsTree
    -> Derive.Deriver (Maybe PSignal.PSignal, [Log.Msg])
get_pitch_map :: EventsTree -> Deriver (Maybe PSignal, [Msg])
get_pitch_map EventsTree
subs = case EventsTree -> Maybe Track
pitch_map_track EventsTree
subs of
    Just Track
pitch_track -> do
        State
state <- forall st err. Deriver st err st
Derive.get
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ State -> Track -> (Maybe PSignal, [Msg])
derive_pitch_map State
state Track
pitch_track
    Maybe Track
Nothing -> do
        PSignal
sig <- forall a. (Dynamic -> a) -> Deriver a
Internal.get_dynamic Dynamic -> PSignal
Derive.state_pitch
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just PSignal
sig, [])

-- | Derive the given pitch track lazily.
--
-- It uses a hack similar to control blocks, e.g. 'derive_control_tree'.
derive_pitch_map :: Derive.State -> TrackTree.Track
    -> (Maybe PSignal.PSignal, [Log.Msg])
derive_pitch_map :: State -> Track -> (Maybe PSignal, [Msg])
derive_pitch_map State
state Track
pitch_track = case Either Error PSignal
result of
    Right PSignal
sig -> (forall a. a -> Maybe a
Just PSignal
sig, [Msg]
logs)
    Left Error
err -> (forall a. Maybe a
Nothing, Error -> Msg
Derive.error_to_warn Error
err forall a. a -> [a] -> [a]
: [Msg]
logs)
    where
    (Either Error PSignal
result, State
_, [Msg]
logs) = forall st err a. st -> Deriver st err a -> RunResult st err a
Derive.run State
stripped (Track -> Deriver State Error PSignal
derive Track
pitch_track)
    stripped :: State
stripped = State
state
        { state_dynamic :: Dynamic
Derive.state_dynamic = (State -> Dynamic
Derive.state_dynamic State
state)
            -- As documented by 'Derive.state_pitch_map'.
            { state_pitch_map :: Maybe (Maybe PSignal, [Msg])
Derive.state_pitch_map = forall a. Maybe a
Nothing }
        }
    derive :: Track -> Deriver State Error PSignal
derive Track
pitch_track = do
        ([Event]
events, [Msg]
logs) <- forall a. Stream a -> ([a], [Msg])
Stream.partition forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}. Deriver a -> Deriver a
Internal.in_real_time
            (Config -> Track -> NoteDeriver -> NoteDeriver
Control.d_control_track Config
config Track
pitch_track NoteDeriver
capture)
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). LogMonad m => Msg -> m ()
Log.write [Msg]
logs
        forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require Text
"get_pitch_map: no event" forall a b. (a -> b) -> a -> b
$
            Event -> PSignal
Score.event_pitch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe a
Lists.head [Event]
events
    config :: Config
config = Control.Config
        { config_toplevel_tempo :: Bool
config_toplevel_tempo = Bool
False
        , config_use_cache :: Bool
config_use_cache = Bool
False
        }
    capture :: Derive.NoteDeriver
    capture :: NoteDeriver
capture = do
        PSignal
pitch <- forall a. (Dynamic -> a) -> Deriver a
Internal.get_dynamic Dynamic -> PSignal
Derive.state_pitch
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Stream a
Stream.from_event forall a b. (a -> b) -> a -> b
$
            Event
Score.empty_event { event_pitch :: PSignal
Score.event_pitch = PSignal
pitch }

pitch_map_track :: TrackTree.EventsTree -> Maybe TrackTree.Track
pitch_map_track :: EventsTree -> Maybe Track
pitch_map_track = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Tree a -> a
Tree.rootLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [Tree a] -> Maybe (Tree a)
Trees.find Track -> Bool
is_pitch
    where is_pitch :: Track -> Bool
is_pitch = Text -> Bool
ParseTitle.is_pitch_track forall b c a. (b -> c) -> (a -> b) -> a -> c
. Track -> Text
TrackTree.track_title