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

{- | Derive events on a note track.  This is the Derive equivalent of
    "Cmd.NoteTrack", but has a different name to avoid clashes.
-}
module Derive.Note (d_note_track, stash_signal_if_wanted, track_info) where
import qualified Data.Char as Char
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as Text
import qualified Data.Tree as Tree

import qualified Util.Lists as Lists
import qualified Derive.Control as Control
import qualified Derive.Derive as Derive
import qualified Derive.Deriver.Internal as Internal
import qualified Derive.Eval as Eval
import qualified Derive.EvalTrack as EvalTrack
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.Stream as Stream

import qualified Perform.Signal as Signal
import qualified Ui.Track as Track
import qualified Ui.TrackTree as TrackTree

import           Global
import           Types


-- * note track

-- | Top level deriver for note tracks.
{-# SCC d_note_track #-}
d_note_track :: ([TrackTree.EventsNode] -> Derive.NoteDeriver)
    -- ^ This is used to derive orphans, as documented by
    -- 'EvalTrack.derive_note_track'.
    -> TrackTree.EventsNode -> Derive.NoteDeriver
d_note_track :: ([EventsNode] -> NoteDeriver) -> EventsNode -> NoteDeriver
d_note_track [EventsNode] -> NoteDeriver
derive_tracks (Tree.Node Track
track [EventsNode]
subs) =
    NoteDeriver -> NoteDeriver
title forall a b. (a -> b) -> a -> b
$ ([EventsNode] -> NoteDeriver) -> TrackInfo Event -> NoteDeriver
derive_notes [EventsNode] -> NoteDeriver
derive_tracks (Track -> [EventsNode] -> TrackInfo Event
track_info Track
track [EventsNode]
subs)
    where
    title :: NoteDeriver -> NoteDeriver
title = [EventsNode] -> ScoreTime -> Text -> NoteDeriver -> NoteDeriver
with_title [EventsNode]
subs (Track -> ScoreTime
TrackTree.track_end Track
track)
        (Track -> Text
TrackTree.track_title Track
track)

-- | Note tracks can also have track signals, extracted from the events they
-- produce.
stash_signal_if_wanted :: Stream.Stream Score.Event -> TrackTree.Track
    -> Derive.Deriver ()
stash_signal_if_wanted :: Stream Event -> Track -> Deriver ()
stash_signal_if_wanted Stream Event
events Track
track =
    forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> (a -> m ()) -> m ()
whenJustM (Track -> Deriver (Maybe (BlockId, TrackId, Maybe RenderSource))
Control.render_of Track
track) forall a b. (a -> b) -> a -> b
$ \(BlockId
block_id, TrackId
track_id, Maybe RenderSource
maybe_source) ->
        forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe RenderSource
maybe_source forall a b. (a -> b) -> a -> b
$ \RenderSource
source ->
            BlockId -> TrackId -> RenderSource -> Stream Event -> Deriver ()
stash_signal BlockId
block_id TrackId
track_id RenderSource
source Stream Event
events

stash_signal :: BlockId -> TrackId -> Track.RenderSource
    -> Stream.Stream Score.Event -> Derive.Deriver ()
stash_signal :: BlockId -> TrackId -> RenderSource -> Stream Event -> Deriver ()
stash_signal BlockId
block_id TrackId
track_id RenderSource
source Stream Event
events =
    BlockId -> TrackId -> Control -> Deriver ()
Control.stash_signal BlockId
block_id TrackId
track_id forall a b. (a -> b) -> a -> b
$
        RenderSource -> [Event] -> Control
extract_track_signal RenderSource
source (forall a. Stream a -> [a]
Stream.events_of Stream Event
events)

-- | Extract the signals that 'Track.RenderSource' wants, trim them, and concat
-- into a single unwarped signal that can be stashed away for later display.
extract_track_signal :: Track.RenderSource -> [Score.Event] -> Signal.Control
extract_track_signal :: RenderSource -> [Event] -> Control
extract_track_signal RenderSource
source [Event]
events = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ case RenderSource
source of
    Track.Control Control
control -> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Control -> Event -> Maybe Control
extract_control Control
control) [Event]
events
    Track.Pitch PControl
control -> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall {k2} {kind2 :: k2}.
PControl -> Event -> Maybe (Signal kind2)
extract_pitch PControl
control) [Event]
events
    where
    -- Since these signals will be concatenated into one signal, I don't
    -- want one event's control at 0 to wipe out the previous events.
    extract_control :: Control -> Event -> Maybe Control
extract_control Control
control Event
event =
        forall {k} (kind :: k). X -> Signal kind -> Signal kind
Signal.clip_before (Event -> X
Score.event_min Event
event) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typed a -> a
ScoreT.val_of forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Control -> Event -> Maybe (Typed Control)
Score.event_control Control
control Event
event
    extract_pitch :: PControl -> Event -> Maybe (Signal kind2)
extract_pitch PControl
pcontrol Event
event =
        forall {k2} {kind2 :: k2}. Event -> PSignal -> Signal kind2
convert Event
event forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PControl -> Event -> Maybe PSignal
Score.event_named_pitch PControl
pcontrol Event
event
    convert :: Event -> PSignal -> Signal kind2
convert Event
event PSignal
psig = forall {k1} {k2} (kind1 :: k1) (kind2 :: k2).
Signal kind1 -> Signal kind2
Signal.coerce forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ PSignal -> (Signal NoteNumberSig, [(X, Text)])
PSignal.to_nn forall a b. (a -> b) -> a -> b
$
        X -> PSignal -> PSignal
PSignal.clip_before (Event -> X
Score.event_min Event
event) forall a b. (a -> b) -> a -> b
$
        ControlMap -> PSignal -> PSignal
PSignal.apply_controls (Event -> ControlMap
Score.event_controls Event
event) PSignal
psig

with_title :: TrackTree.EventsTree -> ScoreTime -> Text -> Derive.NoteDeriver
    -> Derive.NoteDeriver
with_title :: [EventsNode] -> ScoreTime -> Text -> NoteDeriver -> NoteDeriver
with_title [EventsNode]
subs ScoreTime
end Text
title NoteDeriver
deriver
    | (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
Char.isSpace Text
title = NoteDeriver
deriver
    | Bool
otherwise = do
        Expr
track_expr <- forall err a.
HasCallStack =>
(err -> Text) -> Either err a -> Deriver a
Derive.require_right (Text
"track title: "<>) forall a b. (a -> b) -> a -> b
$
            Text -> Either Text Expr
ParseTitle.parse_note Text
title
        forall d.
(Callable (Transformer d), Taggable d) =>
Context d -> [Call] -> Deriver (Stream d) -> Deriver (Stream d)
Eval.eval_transformers forall {val}. Context val
ctx (forall a. NonEmpty a -> [a]
NonEmpty.toList Expr
track_expr) NoteDeriver
deriver
    where
    ctx :: Context val
ctx = (forall a. ScoreTime -> ScoreTime -> Text -> Context a
Derive.dummy_context ScoreTime
0 ScoreTime
end Text
"note track")
        { ctx_sub_tracks :: [EventsNode]
Derive.ctx_sub_tracks = [EventsNode]
subs }

derive_notes :: ([TrackTree.EventsNode] -> Derive.NoteDeriver)
    -> EvalTrack.TrackInfo Score.Event -> Derive.NoteDeriver
derive_notes :: ([EventsNode] -> NoteDeriver) -> TrackInfo Event -> NoteDeriver
derive_notes [EventsNode] -> NoteDeriver
derive_tracks TrackInfo Event
tinfo = do
    State
state <- forall st err. Deriver st err st
Derive.get
    let ([Stream Event]
streams, Threaded
threaded, Collect
collect) =
            ([EventsNode] -> NoteDeriver)
-> State -> TrackInfo Event -> ([Stream Event], Threaded, Collect)
EvalTrack.derive_note_track [EventsNode] -> NoteDeriver
derive_tracks State
state TrackInfo Event
tinfo
    Collect -> Deriver ()
Internal.merge_collect Collect
collect
    Threaded -> Deriver ()
Internal.set_threaded Threaded
threaded
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Stream Event] -> Stream Event
Stream.merge_asc_lists [Stream Event]
streams

track_info :: TrackTree.Track -> [TrackTree.EventsNode]
    -> EvalTrack.TrackInfo Score.Event
track_info :: Track -> [EventsNode] -> TrackInfo Event
track_info Track
track [EventsNode]
subs = EvalTrack.TrackInfo
    { tinfo_track :: Track
tinfo_track = Track
track
    , tinfo_sub_tracks :: [EventsNode]
tinfo_sub_tracks = [EventsNode]
subs
    , tinfo_type :: Type
tinfo_type = Type
ParseTitle.NoteTrack
    , tinfo_get_last_val :: GetLastVal Event
tinfo_get_last_val = forall a. [a] -> Maybe a
Lists.last
    }