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

{- | Functions to get higher level information about blocks and tracks.

    This builds on "Derive.ParseTitle" but the Derive module only has functions
    needed by derivation, and doesn't run in the State monad.
-}
module Cmd.Info where
import qualified Data.List as List
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Tree as Tree

import qualified Text.Printf as Printf

import qualified Util.Lists as Lists
import qualified Util.Pretty as Pretty
import qualified Util.Trees as Trees

import qualified Cmd.Cmd as Cmd
import qualified Cmd.Perf as Perf
import qualified Derive.ParseTitle as ParseTitle
import qualified Derive.ScoreT as ScoreT
import qualified Perform.Midi.Patch as Patch
import qualified Ui.Block as Block
import qualified Ui.Skeleton as Skeleton
import qualified Ui.Track as Track
import qualified Ui.TrackTree as TrackTree
import qualified Ui.Ui as Ui
import qualified Ui.UiConfig as UiConfig

import           Global
import           Types


-- * track info

data Track = Track {
    Track -> TrackInfo
track_info :: Ui.TrackInfo
    , Track -> TrackType
track_type :: TrackType
    } deriving (TrackNum -> Track -> ShowS
[Track] -> ShowS
Track -> String
forall a.
(TrackNum -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Track] -> ShowS
$cshowList :: [Track] -> ShowS
show :: Track -> String
$cshow :: Track -> String
showsPrec :: TrackNum -> Track -> ShowS
$cshowsPrec :: TrackNum -> Track -> ShowS
Show, Track -> Track -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Track -> Track -> Bool
$c/= :: Track -> Track -> Bool
== :: Track -> Track -> Bool
$c== :: Track -> Track -> Bool
Eq)

data TrackType =
    -- | A note track has a list of control tracks, and a list of child note
    -- tracks.  The controls start with the children and continues with its
    -- parents.  However, it stops at another note track or as soon as a parent
    -- has more than one child, because that control track doesn't belong to
    -- just this note track.
    Note [Ui.TrackInfo] [Ui.TrackInfo]
    -- | The note track for this pitch track.
    | Pitch (Maybe Ui.TrackInfo)
    -- | Tracks this control track has scope over.  This means all its
    -- children, but because of inversion, also a parent note track, if there
    -- is one.
    | Control [Ui.TrackInfo]
    deriving (TrackNum -> TrackType -> ShowS
[TrackType] -> ShowS
TrackType -> String
forall a.
(TrackNum -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrackType] -> ShowS
$cshowList :: [TrackType] -> ShowS
show :: TrackType -> String
$cshow :: TrackType -> String
showsPrec :: TrackNum -> TrackType -> ShowS
$cshowsPrec :: TrackNum -> TrackType -> ShowS
Show, TrackType -> TrackType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrackType -> TrackType -> Bool
$c/= :: TrackType -> TrackType -> Bool
== :: TrackType -> TrackType -> Bool
$c== :: TrackType -> TrackType -> Bool
Eq)

instance Pretty TrackType where
    format :: TrackType -> Doc
format = \case
        Note [TrackInfo]
controls [TrackInfo]
children -> Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"Note"
            [ (Text
"controls", forall a. Pretty a => a -> Doc
Pretty.format [TrackInfo]
controls)
            , (Text
"children", forall a. Pretty a => a -> Doc
Pretty.format [TrackInfo]
children)
            ]
        Pitch Maybe TrackInfo
tinfo -> Doc
"Pitch" Doc -> Doc -> Doc
Pretty.<+> forall a. Pretty a => a -> Doc
Pretty.format Maybe TrackInfo
tinfo
        Control [TrackInfo]
children -> Doc
"Control" Doc -> Doc -> Doc
Pretty.<+> forall a. Pretty a => a -> Doc
Pretty.format [TrackInfo]
children

get_track_type :: Ui.M m => BlockId -> TrackNum -> m Track
get_track_type :: forall (m :: * -> *). M m => BlockId -> TrackNum -> m Track
get_track_type BlockId
block_id TrackNum
tracknum = forall (m :: * -> *) a. (Stack, M m) => Text -> Maybe a -> m a
Ui.require
    (Text
"get_track_type: bad tracknum: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (BlockId
block_id, TrackNum
tracknum))
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => BlockId -> TrackNum -> m (Maybe Track)
lookup_track_type BlockId
block_id TrackNum
tracknum

lookup_track_type :: Ui.M m => BlockId -> TrackNum -> m (Maybe Track)
lookup_track_type :: forall (m :: * -> *). M m => BlockId -> TrackNum -> m (Maybe Track)
lookup_track_type BlockId
block_id TrackNum
tracknum = do
    TrackTree
track_tree <- forall (m :: * -> *). M m => BlockId -> m TrackTree
TrackTree.track_tree_of BlockId
block_id
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Tree TrackInfo, TrackTree) -> Track
make_track forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall a. (a -> Bool) -> [Tree a] -> Maybe (Tree a, [Tree a])
Trees.findWithParents ((forall a. Eq a => a -> a -> Bool
==TrackNum
tracknum) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackInfo -> TrackNum
Ui.track_tracknum) TrackTree
track_tree

-- | Get all the Tracks in a block, sorted by tracknum.
block_tracks :: Ui.M m => BlockId -> m [Track]
block_tracks :: forall (m :: * -> *). M m => BlockId -> m [Track]
block_tracks BlockId
block_id = forall k a. Ord k => (a -> k) -> [a] -> [a]
Lists.sortOn (TrackInfo -> TrackNum
Ui.track_tracknum forall b c a. (b -> c) -> (a -> b) -> a -> c
. Track -> TrackInfo
track_info)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Tree TrackInfo, TrackTree) -> Track
make_track forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Tree a] -> [(Tree a, [Tree a])]
Trees.paths forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => BlockId -> m TrackTree
TrackTree.track_tree_of BlockId
block_id

make_track :: (Tree.Tree Ui.TrackInfo, TrackTree.TrackTree) -> Track
make_track :: (Tree TrackInfo, TrackTree) -> Track
make_track (Tree TrackInfo
tree, TrackTree
parents) =
    TrackInfo -> TrackType -> Track
Track (forall a. Tree a -> a
Tree.rootLabel Tree TrackInfo
tree) ((Tree TrackInfo, TrackTree) -> TrackType
track_type_of (Tree TrackInfo
tree, TrackTree
parents))

track_type_of :: (Tree.Tree Ui.TrackInfo, TrackTree.TrackTree) -> TrackType
track_type_of :: (Tree TrackInfo, TrackTree) -> TrackType
track_type_of (Tree.Node TrackInfo
track TrackTree
subs, TrackTree
parents)
    | Text -> Bool
ParseTitle.is_note_track Text
title = [TrackInfo] -> [TrackInfo] -> TrackType
Note
        (forall a. (a -> Bool) -> [a] -> [a]
takeWhile TrackInfo -> Bool
is_control [TrackInfo]
children forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
takeWhile TrackInfo -> Bool
is_control
            (forall a b. (a -> b) -> [a] -> [b]
map forall a. Tree a -> a
Tree.rootLabel (forall a. (a -> Bool) -> [a] -> [a]
takeWhile forall {a}. Tree a -> Bool
is_single TrackTree
parents)))
        (forall a. (a -> Bool) -> [a] -> [a]
filter TrackInfo -> Bool
is_note [TrackInfo]
children)
    | Text -> Bool
ParseTitle.is_pitch_track Text
title =
        Maybe TrackInfo -> TrackType
Pitch forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find TrackInfo -> Bool
is_note ([TrackInfo]
children forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a. Tree a -> a
Tree.rootLabel TrackTree
parents)
    | Bool
otherwise = [TrackInfo] -> TrackType
Control forall a b. (a -> b) -> a -> b
$ [TrackInfo]
children
        -- If there is a note track above assume it will invert itself below
        -- the control stack.
        forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. a -> [a] -> [a]
:[]) (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find TrackInfo -> Bool
is_note (forall a b. (a -> b) -> [a] -> [b]
map forall a. Tree a -> a
Tree.rootLabel TrackTree
parents))
    where
    children :: [TrackInfo]
children = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Tree a -> [a]
Tree.flatten TrackTree
subs
    is_single :: Tree a -> Bool
is_single (Tree.Node a
_ [Tree a
_]) = Bool
True
    is_single Tree a
_ = Bool
False
    is_control :: TrackInfo -> Bool
is_control TrackInfo
track =
        Text -> Bool
ParseTitle.is_control_track Text
t Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
ParseTitle.is_tempo_track Text
t)
        where t :: Text
t = TrackInfo -> Text
Ui.track_title TrackInfo
track
    title :: Text
title = TrackInfo -> Text
Ui.track_title TrackInfo
track
    is_note :: TrackInfo -> Bool
is_note = Text -> Bool
ParseTitle.is_note_track forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackInfo -> Text
Ui.track_title

-- ** specialized lookups

-- | Pitch track of a note track, if any.
pitch_of_note :: Ui.M m => BlockId -> TrackNum -> m (Maybe Ui.TrackInfo)
pitch_of_note :: forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> m (Maybe TrackInfo)
pitch_of_note BlockId
block_id TrackNum
tracknum = do
    Maybe Track
maybe_track <- forall (m :: * -> *). M m => BlockId -> TrackNum -> m (Maybe Track)
lookup_track_type BlockId
block_id TrackNum
tracknum
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe Track
maybe_track of
        Just (Track TrackInfo
_ (Note [TrackInfo]
controls [TrackInfo]
_)) ->
            forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Text -> Bool
ParseTitle.is_pitch_track forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackInfo -> Text
Ui.track_title) [TrackInfo]
controls
        Maybe Track
_ -> forall a. Maybe a
Nothing

-- | Note track of a pitch track, if any.
note_of_pitch :: Ui.M m => BlockId -> TrackNum -> m (Maybe Ui.TrackInfo)
note_of_pitch :: forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> m (Maybe TrackInfo)
note_of_pitch BlockId
block_id TrackNum
tracknum = do
    Maybe Track
maybe_track <- forall (m :: * -> *). M m => BlockId -> TrackNum -> m (Maybe Track)
lookup_track_type BlockId
block_id TrackNum
tracknum
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe Track
maybe_track of
        Just (Track TrackInfo
_ (Pitch Maybe TrackInfo
note)) -> Maybe TrackInfo
note
        Maybe Track
_ -> forall a. Maybe a
Nothing

-- | True if this has any note track children.  It should be the same as
-- 'get_track_type' then match Track _ children | not (null children),
-- but more efficient.
has_note_children :: Ui.M m => BlockId -> TrackNum -> m Bool
has_note_children :: forall (m :: * -> *). M m => BlockId -> TrackNum -> m Bool
has_note_children BlockId
block_id TrackNum
tracknum = do
    Skeleton
skel <- forall (m :: * -> *). M m => BlockId -> m Skeleton
Ui.get_skeleton BlockId
block_id
    forall {m :: * -> *}. M m => Skeleton -> TrackNum -> m Bool
go Skeleton
skel TrackNum
tracknum
    where
    go :: Skeleton -> TrackNum -> m Bool
go Skeleton
skel TrackNum
tracknum = do
        let cs :: [TrackNum]
cs = Skeleton -> TrackNum -> [TrackNum]
Skeleton.children Skeleton
skel TrackNum
tracknum
        forall (m :: * -> *). Monad m => [m Bool] -> m Bool
orM forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {f :: * -> *}. M f => TrackNum -> f Bool
is_note [TrackNum]
cs forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Skeleton -> TrackNum -> m Bool
go Skeleton
skel) [TrackNum]
cs
    is_note :: TrackNum -> f Bool
is_note TrackNum
tnum = Text -> Bool
ParseTitle.is_note_track forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (forall (m :: * -> *). M m => TrackId -> m Text
Ui.get_track_title forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => BlockId -> TrackNum -> m TrackId
Ui.get_event_track_at BlockId
block_id TrackNum
tnum)


-- * misc

-- | Get the instrument of a track, or fail if it's not a note track.  This is
-- different than 'Perf.lookup_instrument' because it looks at the track title
-- first.  This is useful for new tracks which don't have a performance yet.
-- But if the track title doesn't specify an instrument it falls back on
-- 'Perf.lookup_instrument'.
get_instrument_of :: Cmd.M m => BlockId -> TrackNum -> m ScoreT.Instrument
get_instrument_of :: forall (m :: * -> *). M m => BlockId -> TrackNum -> m Instrument
get_instrument_of BlockId
block_id TrackNum
tracknum =
    forall (m :: * -> *) a. (Stack, M m) => Text -> Maybe a -> m a
Ui.require (Text
"get_instrument_of expected a note track: "
            forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (BlockId
block_id, TrackNum
tracknum))
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> m (Maybe Instrument)
lookup_instrument_of BlockId
block_id TrackNum
tracknum

lookup_instrument_of :: Cmd.M m => BlockId -> TrackNum
    -> m (Maybe ScoreT.Instrument)
lookup_instrument_of :: forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> m (Maybe Instrument)
lookup_instrument_of BlockId
block_id TrackNum
tracknum = do
    TrackId
track_id <- forall (m :: * -> *). M m => BlockId -> TrackNum -> m TrackId
Ui.get_event_track_at BlockId
block_id TrackNum
tracknum
    Track
track <- forall (m :: * -> *). M m => TrackId -> m Track
Ui.get_track TrackId
track_id
    case Text -> Maybe Instrument
ParseTitle.title_to_instrument (Track -> Text
Track.track_title Track
track) of
        Maybe Instrument
Nothing -> forall (m :: * -> *). M m => Track -> m (Maybe Instrument)
Perf.lookup_instrument (BlockId
block_id, forall a. a -> Maybe a
Just TrackId
track_id)
        Just Instrument
inst -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
M m =>
BlockId -> TrackId -> Instrument -> m Instrument
get_default_instrument BlockId
block_id TrackId
track_id Instrument
inst

-- | If the instrument is 'ScoreT.empty_instrument', look up what it really is
-- in the performance.
get_default_instrument :: Cmd.M m => BlockId -> TrackId
    -> ScoreT.Instrument -> m ScoreT.Instrument
get_default_instrument :: forall (m :: * -> *).
M m =>
BlockId -> TrackId -> Instrument -> m Instrument
get_default_instrument BlockId
block_id TrackId
track_id Instrument
inst
    | Instrument
inst forall a. Eq a => a -> a -> Bool
== Instrument
ScoreT.empty_instrument =
        forall a. a -> Maybe a -> a
fromMaybe Instrument
inst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => Track -> m (Maybe Instrument)
Perf.lookup_instrument (BlockId
block_id, forall a. a -> Maybe a
Just TrackId
track_id)
    | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return Instrument
inst


-- * inst info

-- | Looks like: "wdev1 [1..3]; wdev2 [1,5]"
--
-- This adds 1 so MIDI channels are 1-based.
show_addrs :: [Patch.Addr] -> Text
show_addrs :: [Addr] -> Text
show_addrs [Addr]
addrs = [Text] -> Text
semicolon_list
    [ forall a. Pretty a => a -> Text
pretty WriteDevice
wdev
        forall a. Semigroup a => a -> a -> a
<> Text
" [" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"," (forall a. (Show a, Num a, Ord a) => [a] -> [Text]
show_runs (forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Num a => a -> a -> a
+Channel
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [Addr]
addrs))
        forall a. Semigroup a => a -> a -> a
<> Text
"]"
    | (WriteDevice
wdev, [Addr]
addrs) <- forall key a. Ord key => (a -> key) -> [a] -> [(key, [a])]
Lists.keyedGroupSort forall a b. (a, b) -> a
fst [Addr]
addrs
    ]

semicolon_list :: [Text] -> Text
semicolon_list :: [Text] -> Text
semicolon_list [] = Text
"[]"
semicolon_list [Text]
xs = Text -> [Text] -> Text
Text.intercalate Text
"; " [Text]
xs

show_runs :: (Show a, Num a, Ord a) => [a] -> [Text]
show_runs :: forall a. (Show a, Num a, Ord a) => [a] -> [Text]
show_runs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. Show a => [a] -> [Text]
show_run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
Lists.splitBetween (\a
a a
b -> a
aforall a. Num a => a -> a -> a
+a
1 forall a. Ord a => a -> a -> Bool
< a
b)
    where
    show_run :: [a] -> [Text]
show_run xs :: [a]
xs@(a
_:a
_:a
_:[a]
_) = [forall a. Show a => a -> Text
showt (forall a. [a] -> a
head [a]
xs) forall a. Semigroup a => a -> a -> a
<> Text
".." forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (forall a. [a] -> a
last [a]
xs)]
    show_run [a]
xs = forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> Text
showt [a]
xs


-- * set_instrument_status

-- | Stick some handy info about the current instrument into the status.
--
-- This should be run whenever the track focus changes, or tracks are expanded
-- or collapsed.
set_instrument_status :: Cmd.M m => BlockId -> TrackNum -> m ()
set_instrument_status :: forall (m :: * -> *). M m => BlockId -> TrackNum -> m ()
set_instrument_status BlockId
block_id TrackNum
tracknum = do
    Maybe Text
status <- forall (m :: * -> *). M m => BlockId -> TrackNum -> m (Maybe Text)
get_track_status BlockId
block_id TrackNum
tracknum
    forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Text
status forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => Text -> Text -> m ()
Cmd.set_global_status Text
"inst"

-- | Looks like:
-- title (tracknum): inst_name, allocation, [control tracks]
-- fm8/inst1 at 1: fm8:0,1,2, [vel {collapse 2}, pedal {expand 3}]
get_track_status :: Cmd.M m => BlockId -> TrackNum -> m (Maybe Text)
get_track_status :: forall (m :: * -> *). M m => BlockId -> TrackNum -> m (Maybe Text)
get_track_status BlockId
block_id TrackNum
tracknum = do
    TrackTree
tree <- forall (m :: * -> *). M m => BlockId -> m TrackTree
TrackTree.track_tree_of BlockId
block_id
    case TrackTree -> TrackNum -> Maybe (TrackInfo, Instrument)
find_note_track TrackTree
tree TrackNum
tracknum of
        Just (TrackInfo
track, Instrument
inst) -> do
            Instrument
inst <- forall (m :: * -> *).
M m =>
BlockId -> TrackId -> Instrument -> m Instrument
get_default_instrument BlockId
block_id (TrackInfo -> TrackId
Ui.track_id TrackInfo
track) Instrument
inst
            forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *}.
M m =>
BlockId -> TrackTree -> TrackNum -> Instrument -> m Text
status BlockId
block_id TrackTree
tree (TrackInfo -> TrackNum
Ui.track_tracknum TrackInfo
track) Instrument
inst
        Maybe (TrackInfo, Instrument)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    where
    status :: BlockId -> TrackTree -> TrackNum -> Instrument -> m Text
status BlockId
block_id TrackTree
tree TrackNum
note_tracknum Instrument
inst = do
        let controls :: [TrackInfo]
controls = TrackTree -> TrackNum -> [TrackInfo]
control_tracks_of TrackTree
tree TrackNum
note_tracknum
        [String]
track_descs <- forall (m :: * -> *). M m => BlockId -> [TrackInfo] -> m [String]
show_track_status BlockId
block_id [TrackInfo]
controls
        Maybe Allocation
alloc <- Instrument -> Lens State (Maybe Allocation)
Ui.allocation Instrument
inst forall (f :: * -> *) a b. Functor f => Lens a b -> f a -> f b
<#> forall (m :: * -> *). M m => m State
Ui.get
        let addrs :: [Addr]
addrs = case Allocation -> Backend
UiConfig.alloc_backend forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Allocation
alloc of
                Just (UiConfig.Midi Config
config) -> Config -> [Addr]
Patch.config_addrs Config
config
                Maybe Backend
_ -> []
        let title :: Text
title = Instrument -> Text
ParseTitle.instrument_to_title Instrument
inst
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Text
txt forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
Printf.printf String
"%s at %d: %s -- [%s]" (Text -> String
untxt Text
title)
            TrackNum
note_tracknum (Text -> String
untxt ([Addr] -> Text
show_addrs [Addr]
addrs))
            (forall a. Monoid a => a -> [a] -> a
Lists.join String
", " [String]
track_descs)

-- | Given a tracknum, find the note track associated with it.  Since there
-- may be multiple ones, pick the first one.  First try children, then
-- parents.
find_note_track :: TrackTree.TrackTree -> TrackNum
    -> Maybe (Ui.TrackInfo, ScoreT.Instrument)
find_note_track :: TrackTree -> TrackNum -> Maybe (TrackInfo, Instrument)
find_note_track TrackTree
tree TrackNum
tracknum = case TrackTree
-> TrackNum -> Maybe (TrackInfo, [TrackInfo], [TrackInfo])
paths_of TrackTree
tree TrackNum
tracknum of
        Maybe (TrackInfo, [TrackInfo], [TrackInfo])
Nothing -> forall a. Maybe a
Nothing
        Just (TrackInfo
track, [TrackInfo]
parents, [TrackInfo]
children) ->
            forall a. [a] -> Maybe a
Lists.head forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TrackInfo -> Maybe (TrackInfo, Instrument)
inst_of (TrackInfo
track forall a. a -> [a] -> [a]
: [TrackInfo]
children forall a. [a] -> [a] -> [a]
++ [TrackInfo]
parents)
    where
    inst_of :: TrackInfo -> Maybe (TrackInfo, Instrument)
inst_of TrackInfo
track =
        case Text -> Maybe Instrument
ParseTitle.title_to_instrument (TrackInfo -> Text
Ui.track_title TrackInfo
track) of
            Maybe Instrument
Nothing -> forall a. Maybe a
Nothing
            Just Instrument
inst -> forall a. a -> Maybe a
Just (TrackInfo
track, Instrument
inst)

-- | Get the controls associated with the given track.  This means all
-- children until the next note track, and all parents with only one child
-- until the next note track.  Parents with multiple children are not
-- associated with a single track, so they're omitted.  Tempo tracks are always
-- omitted.
control_tracks_of :: TrackTree.TrackTree -> TrackNum -> [Ui.TrackInfo]
control_tracks_of :: TrackTree -> TrackNum -> [TrackInfo]
control_tracks_of TrackTree
tree TrackNum
tracknum =
    case forall a. (a -> Bool) -> [Tree a] -> Maybe (Tree a, [Tree a])
Trees.findWithParents ((forall a. Eq a => a -> a -> Bool
==TrackNum
tracknum) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackInfo -> TrackNum
Ui.track_tracknum) TrackTree
tree of
        Maybe (Tree TrackInfo, TrackTree)
Nothing -> []
        Just (Tree.Node TrackInfo
_ TrackTree
children, TrackTree
parents) ->
            forall a. (a -> Bool) -> [a] -> [a]
takeWhile TrackInfo -> Bool
is_control (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Tree a -> [a]
Tree.flatten TrackTree
children)
            forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
takeWhile TrackInfo -> Bool
is_control (forall a b. (a -> b) -> [a] -> [b]
map forall a. Tree a -> a
Tree.rootLabel
                (forall a. (a -> Bool) -> [a] -> [a]
takeWhile forall {a}. Tree a -> Bool
is_single TrackTree
parents))
    where
    is_single :: Tree a -> Bool
is_single (Tree.Node a
_ [Tree a
_]) = Bool
True
    is_single Tree a
_ = Bool
False
    is_control :: TrackInfo -> Bool
is_control TrackInfo
track =
        Text -> Bool
ParseTitle.is_control_track Text
t Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
ParseTitle.is_tempo_track Text
t)
        where t :: Text
t = TrackInfo -> Text
Ui.track_title TrackInfo
track

-- | Looks like: [vel {collapse 2}, pedal {expand 3}]
show_track_status :: Ui.M m => BlockId -> [Ui.TrackInfo] -> m [String]
show_track_status :: forall (m :: * -> *). M m => BlockId -> [TrackInfo] -> m [String]
show_track_status BlockId
block_id [TrackInfo]
status = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TrackInfo]
status forall a b. (a -> b) -> a -> b
$ \TrackInfo
info -> do
    let tracknum :: TrackNum
tracknum = TrackInfo -> TrackNum
Ui.track_tracknum TrackInfo
info
    Maybe Track
btrack <- forall (m :: * -> *). M m => BlockId -> TrackNum -> m (Maybe Track)
Ui.block_track_at BlockId
block_id TrackNum
tracknum
    let cmd_text :: String
        cmd_text :: String
cmd_text = case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Track -> Set TrackFlag
Block.track_flags Maybe Track
btrack of
            Maybe (Set TrackFlag)
Nothing -> String
"?"
            Just Set TrackFlag
flags
                | TrackFlag
Block.Collapse forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TrackFlag
flags -> String
"expand"
                | Bool
otherwise -> String
"collapse"
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
Printf.printf String
"%s {%s %d}"
        (Text -> String
untxt forall a b. (a -> b) -> a -> b
$ Text -> Text
ParseTitle.strip_expr forall a b. (a -> b) -> a -> b
$ TrackInfo -> Text
Ui.track_title TrackInfo
info)
        String
cmd_text TrackNum
tracknum

paths_of :: TrackTree.TrackTree -> TrackNum
    -> Maybe (Ui.TrackInfo, [Ui.TrackInfo], [Ui.TrackInfo])
    -- ^ (track, parents, children)
paths_of :: TrackTree
-> TrackNum -> Maybe (TrackInfo, [TrackInfo], [TrackInfo])
paths_of TrackTree
track_tree TrackNum
tracknum =
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((forall a. Eq a => a -> a -> Bool
==TrackNum
tracknum) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackInfo -> TrackNum
Ui.track_tracknum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(TrackInfo
a, [TrackInfo]
_, [TrackInfo]
_) -> TrackInfo
a))
        (forall a. [Tree a] -> [(a, [a], [a])]
Trees.flatPaths TrackTree
track_tree)