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

-- | Cmds that affect global block config but don't fit into any of the
-- more specefic modules.
module Cmd.BlockConfig (
    cmd_toggle_edge
    , toggle_merge_all
    , toggle_merge_selected
    , cmd_open_block
    , cmd_add_block_title
    , clip
    , collapse_children
    , expand_children
    , append
    , cmd_toggle_flag
    , toggle_collapse_empty
    , cmd_set_solo
    , cmd_mute_or_unsolo
    , cmd_expand_track
    , cmd_move_tracks
    , move_tracks
) 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 Util.Log as Log
import qualified Util.Rect as Rect
import qualified Util.Lists as Lists
import qualified Util.Trees as Trees

import qualified Cmd.Cmd as Cmd
import qualified Cmd.Create as Create
import qualified Cmd.Info as Info
import qualified Cmd.Msg as Msg
import qualified Cmd.NoteTrackParse as NoteTrackParse
import qualified Cmd.Ruler.RulerUtil as RulerUtil
import qualified Cmd.Selection as Selection
import qualified Cmd.Views as Views

import qualified Derive.ParseTitle as ParseTitle
import qualified Ui.Block as Block
import qualified Ui.Event as Event
import qualified Ui.Events as Events
import qualified Ui.Meter.Meter as Meter
import qualified Ui.Skeleton as Skeleton
import qualified Ui.TrackTree as TrackTree
import qualified Ui.Ui as Ui
import qualified Ui.Update as Update

import           Global
import           Types


-- * skeleton

-- | Toggle an edge from the selected parent to the clicked child.
cmd_toggle_edge :: Cmd.M m => Msg.Msg -> m ()
cmd_toggle_edge :: forall (m :: * -> *). M m => Msg -> m ()
cmd_toggle_edge Msg
msg = do
    (BlockId
block_id, TrackNum
sel_tracknum, TrackId
_, TrackTime
_) <- forall (m :: * -> *).
M m =>
m (BlockId, TrackNum, TrackId, TrackTime)
Selection.get_insert
    TrackNum
clicked_tracknum <- forall (m :: * -> *) a. M m => Maybe a -> m a
Cmd.abort_unless forall a b. (a -> b) -> a -> b
$ Msg -> Maybe TrackNum
clicked_track Msg
msg
    -- The click order goes in the arrow direction, parent to child.
    let edge :: (TrackNum, TrackNum)
edge = (TrackNum
sel_tracknum, TrackNum
clicked_tracknum)
    Bool
success <- forall (m :: * -> *).
M m =>
Bool -> BlockId -> (TrackNum, TrackNum) -> m Bool
Ui.toggle_skeleton_edge Bool
False BlockId
block_id (TrackNum, TrackNum)
edge
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
success forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). (Stack, LogMonad m) => Text -> m ()
Log.warn forall a b. (a -> b) -> a -> b
$ Text
"refused to add cycle-creating edge: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (TrackNum, TrackNum)
edge
    -- The shift below is incorrect.  Anyway, a common case is to splice
    -- a track above and then delete the unwanted edges, and moving the
    -- selection makes that inconvenient.
    -- let shift = clicked_tracknum - sel_tracknum
    -- if success
    --     then Selection.cmd_shift_selection Config.insert_selnum shift False
    --     else Log.warn $ "refused to add cycle-creating edge: " ++ show edge

clicked_track :: Msg.Msg -> Maybe TrackNum
clicked_track :: Msg -> Maybe TrackNum
clicked_track Msg
msg = case (Msg -> Bool
Msg.mouse_down Msg
msg, Msg -> Maybe (TrackNum, Track)
Msg.context_track Msg
msg) of
    (Bool
True, Just (TrackNum
tracknum, Track
_)) -> forall a. a -> Maybe a
Just TrackNum
tracknum
    (Bool, Maybe (TrackNum, Track))
_ -> forall a. Maybe a
Nothing

-- * merge

-- | Merge all adjacent note/pitch pairs.  If they're already all merged,
-- unmerge them all.
toggle_merge_all :: Ui.M m => BlockId -> m ()
toggle_merge_all :: forall (m :: * -> *). M m => BlockId -> m ()
toggle_merge_all BlockId
block_id = forall (m :: * -> *). M m => BlockId -> [Track] -> m ()
toggle_merge BlockId
block_id forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => BlockId -> m [Track]
Info.block_tracks BlockId
block_id

toggle_merge_selected :: Cmd.M m => m ()
toggle_merge_selected :: forall (m :: * -> *). M m => m ()
toggle_merge_selected = do
    (BlockId
block_id, [TrackNum]
tracknums) <- forall (m :: * -> *). M m => m (BlockId, [TrackNum])
Selection.tracknums
    [Track]
tracks <- forall (m :: * -> *). M m => BlockId -> m [Track]
Info.block_tracks BlockId
block_id
    forall (m :: * -> *). M m => BlockId -> [Track] -> m ()
toggle_merge BlockId
block_id forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter
        ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TrackNum]
tracknums) 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
. Track -> TrackInfo
Info.track_info) [Track]
tracks

toggle_merge :: Ui.M m => BlockId -> [Info.Track] -> m ()
toggle_merge :: forall (m :: * -> *). M m => BlockId -> [Track] -> m ()
toggle_merge BlockId
block_id [Track]
tracks = do
    [TrackNum]
tracknums <- forall (m :: * -> *). M m => BlockId -> [TrackNum] -> m [TrackNum]
mergeable BlockId
block_id forall a b. (a -> b) -> a -> b
$ forall {a}. (Eq a, Num a) => [a] -> [a]
no_parents
        [ TrackInfo -> TrackNum
Ui.track_tracknum TrackInfo
note
        | Info.Track TrackInfo
note (Info.Note {}) <- [Track]
tracks
        ]
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
allM (forall (m :: * -> *). M m => BlockId -> TrackNum -> m Bool
Ui.track_merged BlockId
block_id) [TrackNum]
tracknums)
        (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *). M m => BlockId -> TrackNum -> m ()
Ui.unmerge_track BlockId
block_id) [TrackNum]
tracknums)
        (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\TrackNum
t -> forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackNum -> m ()
Ui.merge_track BlockId
block_id TrackNum
t (TrackNum
tforall a. Num a => a -> a -> a
+TrackNum
1)) [TrackNum]
tracknums)
    where
    -- A note track parent can't merge, so don't count it.
    no_parents :: [a] -> [a]
no_parents (a
t1:a
t2:[a]
ts) | a
t1 forall a. Num a => a -> a -> a
+ a
1 forall a. Eq a => a -> a -> Bool
== a
t2 = [a] -> [a]
no_parents (a
t2forall a. a -> [a] -> [a]
:[a]
ts)
    no_parents (a
t:[a]
ts) = a
t forall a. a -> [a] -> [a]
: [a] -> [a]
no_parents [a]
ts
    no_parents [] = []

mergeable :: Ui.M m => BlockId -> [TrackNum] -> m [TrackNum]
mergeable :: forall (m :: * -> *). M m => BlockId -> [TrackNum] -> m [TrackNum]
mergeable BlockId
block_id =
    forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM forall a b. (a -> b) -> a -> b
$ \TrackNum
tracknum -> forall (m :: * -> *).
M m =>
TrackNum -> BlockId -> TrackNum -> m Bool
is_control_or_pitch TrackNum
tracknum BlockId
block_id (TrackNum
tracknum forall a. Num a => a -> a -> a
+ TrackNum
1)

-- | True if the track is a control or pitch track, and a child of the given
-- tracknum.
is_control_or_pitch :: Ui.M m => TrackNum -> BlockId -> TrackNum -> m Bool
is_control_or_pitch :: forall (m :: * -> *).
M m =>
TrackNum -> BlockId -> TrackNum -> m Bool
is_control_or_pitch TrackNum
parent BlockId
block_id TrackNum
tracknum =
    forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> m (Maybe TrackId)
Ui.event_track_at BlockId
block_id TrackNum
tracknum forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe TrackId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Just TrackId
track_id -> forall (m :: * -> *). Monad m => [m Bool] -> m Bool
andM
            [ (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Type
ParseTitle.ControlTrack, Type
ParseTitle.PitchTrack]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                Text -> Type
ParseTitle.track_type forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => TrackId -> m Text
Ui.get_track_title TrackId
track_id
            , forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackNum -> m Bool
TrackTree.is_child_of BlockId
block_id TrackNum
parent TrackNum
tracknum
            ]

-- * misc

cmd_open_block :: Cmd.M m => Bool -> m ()
cmd_open_block :: forall (m :: * -> *). M m => Bool -> m ()
cmd_open_block Bool
align_new_view = do
    SelectedEvents
sel <- forall (m :: * -> *). M m => m SelectedEvents
Selection.events
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    View
parent <- forall (m :: * -> *). M m => ViewId -> m View
Ui.get_view forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m ViewId
Cmd.get_focused_view
    let block_calls :: Event -> m [BlockId]
block_calls = forall (m :: * -> *). M m => Bool -> BlockId -> Text -> m [BlockId]
NoteTrackParse.expr_block_calls Bool
True BlockId
block_id forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Text
Event.text
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ SelectedEvents
sel forall a b. (a -> b) -> a -> b
$ \(TrackId
_, [Event]
events) -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Event]
events forall a b. (a -> b) -> a -> b
$ \Event
event ->
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {m :: * -> *}. M m => View -> Event -> BlockId -> m ()
open View
parent Event
event) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Event -> m [BlockId]
block_calls Event
event
    where
    open :: View -> Event -> BlockId -> m ()
open View
parent Event
event BlockId
block_id = do
        Maybe ViewId
new_view <- forall (m :: * -> *). M m => BlockId -> m (Maybe ViewId)
Create.view_or_focus BlockId
block_id
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
align_new_view forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe ViewId
new_view forall a b. (a -> b) -> a -> b
$ \ViewId
view_id ->
            forall (m :: * -> *).
M m =>
View -> TrackTime -> TrackTime -> ViewId -> m ()
align_view_to View
parent (Event -> TrackTime
Event.start Event
event) (Event -> TrackTime
Event.end Event
event) ViewId
view_id

-- | Line the ViewId up to be right next to the given parent view and fit into
-- the given time range.
align_view_to :: Cmd.M m => Block.View -> TrackTime -> TrackTime -> ViewId
    -> m ()
align_view_to :: forall (m :: * -> *).
M m =>
View -> TrackTime -> TrackTime -> ViewId -> m ()
align_view_to View
parent TrackTime
start TrackTime
end ViewId
view_id = do
    let x :: TrackNum
x = Rect -> TrackNum
Rect.r forall a b. (a -> b) -> a -> b
$ View -> Rect
Block.view_rect View
parent
        top :: TrackNum
top = View -> TrackTime -> TrackNum
Block.screen_pixels View
parent TrackTime
start
        bottom :: TrackNum
bottom = View -> TrackTime -> TrackNum
Block.screen_pixels View
parent TrackTime
end
    TrackNum
width <- Rect -> TrackNum
Rect.w forall b c a. (b -> c) -> (a -> b) -> a -> c
. View -> Rect
Block.track_rect forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => ViewId -> m View
Ui.get_view ViewId
view_id
    forall (m :: * -> *). M m => ViewId -> Rect -> m ()
Views.set_track_rect ViewId
view_id forall a b. (a -> b) -> a -> b
$ TrackNum -> TrackNum -> TrackNum -> TrackNum -> Rect
Rect.xywh TrackNum
x TrackNum
top TrackNum
width (TrackNum
bottom forall a. Num a => a -> a -> a
- TrackNum
top)
    forall (m :: * -> *). M m => ViewId -> m ()
Views.zoom_to_ruler ViewId
view_id

-- | Add an empty title and focus on it.  The text widget hides itself when
-- empty, so the space gets it to appear for focus.
cmd_add_block_title :: Cmd.M m => Msg.Msg -> m ()
cmd_add_block_title :: forall (m :: * -> *). M m => Msg -> m ()
cmd_add_block_title Msg
_ = do
    ViewId
view_id <- forall (m :: * -> *). M m => m ViewId
Cmd.get_focused_view
    BlockId
block_id <- View -> BlockId
Block.view_block forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => ViewId -> m View
Ui.get_view ViewId
view_id
    Text
title <- forall (m :: * -> *). M m => BlockId -> m Text
Ui.get_block_title BlockId
block_id
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
Text.null Text
title) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => BlockId -> Text -> m ()
Ui.set_block_title BlockId
block_id Text
" "
    forall (m :: * -> *). M m => UiDamage -> m ()
Ui.damage forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { _title_focus :: Maybe (ViewId, Maybe TrackNum)
Update._title_focus = forall a. a -> Maybe a
Just (ViewId
view_id, forall a. Maybe a
Nothing) }

-- | Clip a block to the selection.
clip :: Cmd.M m => m ()
clip :: forall (m :: * -> *). M m => m ()
clip = do
    (BlockId
block_id, TrackNum
_, TrackId
_, TrackTime
pos) <- forall (m :: * -> *).
M m =>
m (BlockId, TrackNum, TrackId, TrackTime)
Selection.get_insert
    forall (m :: * -> *). M m => BlockId -> TrackTime -> m ()
clip_to BlockId
block_id TrackTime
pos

clip_to :: Ui.M m => BlockId -> TrackTime -> m ()
clip_to :: forall (m :: * -> *). M m => BlockId -> TrackTime -> m ()
clip_to BlockId
block_id TrackTime
end = do
    forall (m :: * -> *).
M m =>
Scope -> BlockId -> (Meter -> Meter) -> m [RulerId]
RulerUtil.local_meter Scope
RulerUtil.Block BlockId
block_id forall a b. (a -> b) -> a -> b
$
        ([MSection] -> [MSection]) -> Meter -> Meter
Meter.modify_sections (TrackTime -> [MSection] -> [MSection]
Meter.sections_take TrackTime
end)
    [TrackId]
track_ids <- forall (m :: * -> *). M m => BlockId -> m [TrackId]
Ui.track_ids_of BlockId
block_id
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TrackId]
track_ids forall a b. (a -> b) -> a -> b
$ \TrackId
track_id ->
        forall (m :: * -> *). M m => TrackId -> (Events -> Events) -> m ()
Ui.modify_events TrackId
track_id forall a b. (a -> b) -> a -> b
$ Bool -> TrackTime -> Events -> Events
Events.clip Bool
True TrackTime
end

-- * collapse / expand tracks

-- | Collapse all the children of this track.
collapse_children :: Ui.M m => BlockId -> TrackId -> m ()
collapse_children :: forall (m :: * -> *). M m => BlockId -> TrackId -> m ()
collapse_children BlockId
block_id TrackId
track_id = do
    [TrackInfo]
children <- forall (m :: * -> *). M m => BlockId -> TrackId -> m [TrackInfo]
TrackTree.get_children_of BlockId
block_id TrackId
track_id
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TrackInfo]
children forall a b. (a -> b) -> a -> b
$ \TrackInfo
track -> forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackFlag -> m ()
Ui.add_track_flag
        BlockId
block_id (TrackInfo -> TrackNum
Ui.track_tracknum TrackInfo
track) TrackFlag
Block.Collapse

-- | Expand all collapsed children of this track.  Tracks that were merged
-- when they were collapsed will be left merged.
expand_children :: Ui.M m => BlockId -> TrackId -> m ()
expand_children :: forall (m :: * -> *). M m => BlockId -> TrackId -> m ()
expand_children BlockId
block_id TrackId
track_id = do
    [TrackInfo]
children <- forall (m :: * -> *). M m => BlockId -> TrackId -> m [TrackInfo]
TrackTree.get_children_of BlockId
block_id TrackId
track_id
    Set TrackId
merged <- forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap Track -> Set TrackId
Block.track_merged forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [Track]
Block.block_tracks
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => BlockId -> m Block
Ui.get_block BlockId
block_id
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TrackInfo]
children forall a b. (a -> b) -> a -> b
$ \TrackInfo
track ->
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Ord a => a -> Set a -> Bool
Set.member (TrackInfo -> TrackId
Ui.track_id TrackInfo
track) Set TrackId
merged) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackFlag -> m ()
Ui.remove_track_flag
                BlockId
block_id (TrackInfo -> TrackNum
Ui.track_tracknum TrackInfo
track) TrackFlag
Block.Collapse

-- * merge blocks

append :: Ui.M m => BlockId -> BlockId -> m ()
append :: forall (m :: * -> *). M m => BlockId -> BlockId -> m ()
append BlockId
dest BlockId
source = do
    -- By convention the first track is just a ruler.
    [Track]
tracks <- forall a. TrackNum -> [a] -> [a]
drop TrackNum
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [Track]
Block.block_tracks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => BlockId -> m Block
Ui.get_block BlockId
source
    TrackNum
tracknum <- forall (m :: * -> *). M m => BlockId -> m TrackNum
Ui.track_count BlockId
dest
    TrackNum
tracknum <- if TrackNum
tracknum forall a. Ord a => a -> a -> Bool
<= TrackNum
1 then forall (m :: * -> *) a. Monad m => a -> m a
return TrackNum
tracknum else do
        forall (m :: * -> *). M m => BlockId -> TrackNum -> Track -> m ()
Ui.insert_track BlockId
dest TrackNum
tracknum Track
Block.divider
        forall (m :: * -> *) a. Monad m => a -> m a
return (TrackNum
tracknum forall a. Num a => a -> a -> a
+ TrackNum
1)
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [TrackNum
tracknum..] [Track]
tracks) forall a b. (a -> b) -> a -> b
$ \(TrackNum
i, Track
track) ->
        forall (m :: * -> *). M m => BlockId -> TrackNum -> Track -> m ()
Ui.insert_track BlockId
dest TrackNum
i Track
track
    Skeleton
skel <- forall (m :: * -> *). M m => BlockId -> m Skeleton
Ui.get_skeleton BlockId
dest
    [(TrackNum, TrackNum)]
edges <- Skeleton -> [(TrackNum, TrackNum)]
Skeleton.flatten forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => BlockId -> m Skeleton
Ui.get_skeleton BlockId
source
    let offset :: TrackNum
offset = TrackNum
tracknum forall a. Num a => a -> a -> a
- TrackNum
1 -- -1 because I dropped the first track.
    Skeleton
skel <- forall (m :: * -> *) a. (Stack, M m) => Text -> Maybe a -> m a
Ui.require Text
"couldn't add edges to skel" forall a b. (a -> b) -> a -> b
$
        [(TrackNum, TrackNum)] -> Skeleton -> Maybe Skeleton
Skeleton.add_edges [(TrackNum
sforall a. Num a => a -> a -> a
+TrackNum
offset, TrackNum
eforall a. Num a => a -> a -> a
+TrackNum
offset) | (TrackNum
s, TrackNum
e) <- [(TrackNum, TrackNum)]
edges] Skeleton
skel
    forall (m :: * -> *). M m => BlockId -> Skeleton -> m ()
Ui.set_skeleton BlockId
dest Skeleton
skel

-- * track

-- | If the flag is set on any of the selected tracks, unset it.  Otherwise,
-- set it.  This is a bit more complicated than a simple toggle because if
-- you have a collapsed track where one is soloed and one isn't, a simple
-- toggle would just move the solo flag from one track to the other, leaving
-- the track as a whole soloed.
cmd_toggle_flag :: Cmd.M m => Block.TrackFlag -> m ()
cmd_toggle_flag :: forall (m :: * -> *). M m => TrackFlag -> m ()
cmd_toggle_flag TrackFlag
flag = do
    (BlockId
block_id, [TrackNum]
tracknums, [TrackId]
_, Range
_) <- forall (m :: * -> *).
M m =>
m (BlockId, [TrackNum], [TrackId], Range)
Selection.tracks
    [Set TrackFlag]
flags <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> m (Set TrackFlag)
Ui.track_flags BlockId
block_id) [TrackNum]
tracknums
    let set :: Bool
set = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Ord a => a -> Set a -> Bool
Set.member TrackFlag
flag) [Set TrackFlag]
flags
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TrackNum]
tracknums forall a b. (a -> b) -> a -> b
$ \TrackNum
tracknum -> if Bool
set
        then forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackFlag -> m ()
Ui.remove_track_flag BlockId
block_id TrackNum
tracknum TrackFlag
flag
        else forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackFlag -> m ()
Ui.add_track_flag BlockId
block_id TrackNum
tracknum TrackFlag
flag

-- | Collapse all tracks that are empty and have all empty children.  If
-- everything empty is collapsed, expand them all.  Don't consider
-- merge-collapsed.
toggle_collapse_empty :: Ui.M m => BlockId -> m ()
toggle_collapse_empty :: forall (m :: * -> *). M m => BlockId -> m ()
toggle_collapse_empty BlockId
block_id = do
    TrackTree
tracks <- forall (m :: * -> *). M m => BlockId -> m TrackTree
TrackTree.track_tree_of BlockId
block_id
    [Tree (TrackInfo, Bool)]
tracks <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\TrackInfo
t -> (TrackInfo
t,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TrackInfo -> m Bool
is_empty TrackInfo
t)) TrackTree
tracks
    let empty :: [TrackInfo]
empty = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. Tree (a, Bool) -> [a]
empty_tracks [Tree (TrackInfo, Bool)]
tracks
    Bool
all_collapsed <- forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
allM TrackInfo -> m Bool
is_collapsed [TrackInfo]
empty
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. (a -> b) -> [a] -> [b]
map TrackInfo -> TrackNum
Ui.track_tracknum [TrackInfo]
empty) forall a b. (a -> b) -> a -> b
$ \TrackNum
tracknum -> if Bool
all_collapsed
        then forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackFlag -> m ()
Ui.remove_track_flag BlockId
block_id TrackNum
tracknum TrackFlag
Block.Collapse
        else forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackFlag -> m ()
Ui.add_track_flag BlockId
block_id TrackNum
tracknum TrackFlag
Block.Collapse
    where
    is_empty :: TrackInfo -> m Bool
is_empty = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Events -> Bool
Events.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). M m => TrackId -> m Events
Ui.get_events forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackInfo -> TrackId
Ui.track_id
    is_collapsed :: TrackInfo -> m Bool
is_collapsed = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Set TrackFlag -> Bool
Block.is_collapsed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> m (Set TrackFlag)
Ui.track_flags BlockId
block_id
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackInfo -> TrackNum
Ui.track_tracknum
    empty_tracks :: Tree (a, Bool) -> [a]
empty_tracks (Tree.Node (a
track, Bool
empty) [Tree (a, Bool)]
children)
        | Bool
empty Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a b. (a, b) -> b
snd [(a, Bool)]
leaves = a
track forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(a, Bool)]
leaves
        | Bool
otherwise = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree (a, Bool) -> [a]
empty_tracks [Tree (a, Bool)]
children
        where leaves :: [(a, Bool)]
leaves = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Tree a -> [a]
Trees.leaves [Tree (a, Bool)]
children

-- | Enable Solo on the track and disable Mute.  It's bound to a double click
-- so when this cmd fires I have to do undo the results of the single click.
-- Perhaps mute and solo should be exclusive in general.
cmd_set_solo :: Cmd.M m => Msg.Msg -> m ()
cmd_set_solo :: forall (m :: * -> *). M m => Msg -> m ()
cmd_set_solo Msg
msg = do
    TrackNum
tracknum <- forall (m :: * -> *) a. M m => Maybe a -> m a
Cmd.abort_unless forall a b. (a -> b) -> a -> b
$ Msg -> Maybe TrackNum
clicked_track Msg
msg
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackFlag -> m ()
Ui.remove_track_flag BlockId
block_id TrackNum
tracknum TrackFlag
Block.Mute
    forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackFlag -> m ()
Ui.toggle_track_flag BlockId
block_id TrackNum
tracknum TrackFlag
Block.Solo

-- | Unset solo if it's set, otherwise toggle the mute flag.
cmd_mute_or_unsolo :: Cmd.M m => Msg.Msg -> m ()
cmd_mute_or_unsolo :: forall (m :: * -> *). M m => Msg -> m ()
cmd_mute_or_unsolo Msg
msg = do
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    TrackNum
tracknum <- forall (m :: * -> *) a. M m => Maybe a -> m a
Cmd.abort_unless forall a b. (a -> b) -> a -> b
$ Msg -> Maybe TrackNum
clicked_track Msg
msg
    Set TrackFlag
flags <- forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> m (Set TrackFlag)
Ui.track_flags BlockId
block_id TrackNum
tracknum
    if TrackFlag
Block.Solo forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TrackFlag
flags
        then forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackFlag -> m ()
Ui.remove_track_flag BlockId
block_id TrackNum
tracknum TrackFlag
Block.Solo
        else forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackFlag -> m ()
Ui.toggle_track_flag BlockId
block_id TrackNum
tracknum TrackFlag
Block.Mute

cmd_expand_track :: Cmd.M m => Msg.Msg -> m ()
cmd_expand_track :: forall (m :: * -> *). M m => Msg -> m ()
cmd_expand_track Msg
msg = do
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    TrackNum
tracknum <- forall (m :: * -> *) a. M m => Maybe a -> m a
Cmd.abort_unless forall a b. (a -> b) -> a -> b
$ Msg -> Maybe TrackNum
clicked_track Msg
msg
    forall (m :: * -> *). M m => BlockId -> TrackNum -> m ()
expand_track BlockId
block_id TrackNum
tracknum

-- | Expand collapsed track.  If it's Merged, try to expand the one to the
-- left.  If a track with a merged is collapsed, this let's me click on either
-- to expand.
expand_track :: Ui.M m => BlockId -> TrackNum -> m ()
expand_track :: forall (m :: * -> *). M m => BlockId -> TrackNum -> m ()
expand_track BlockId
block_id TrackNum
tracknum = do
    Set TrackFlag
flags <- forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> m (Set TrackFlag)
Ui.track_flags BlockId
block_id TrackNum
tracknum
    forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackFlag -> m ()
Ui.remove_track_flag BlockId
block_id
        (if forall a. Ord a => a -> Set a -> Bool
Set.member TrackFlag
Block.Merge Set TrackFlag
flags then TrackNum
tracknum forall a. Num a => a -> a -> a
- TrackNum
1 else TrackNum
tracknum)
        TrackFlag
Block.Collapse

-- | Move selected tracks to the left of the clicked track.
cmd_move_tracks :: Cmd.M m => Msg.Msg -> m ()
cmd_move_tracks :: forall (m :: * -> *). M m => Msg -> m ()
cmd_move_tracks Msg
msg = do
    (BlockId
block_id, [TrackNum]
tracknums, [TrackId]
_, Range
_) <- forall (m :: * -> *).
M m =>
m (BlockId, [TrackNum], [TrackId], Range)
Selection.tracks
    TrackNum
clicked <- forall (m :: * -> *) a. M m => Maybe a -> m a
Cmd.abort_unless forall a b. (a -> b) -> a -> b
$ Msg -> Maybe TrackNum
clicked_track Msg
msg
    TrackNum
dest <- forall (m :: * -> *).
M m =>
BlockId -> [TrackNum] -> TrackNum -> m TrackNum
move_tracks BlockId
block_id [TrackNum]
tracknums TrackNum
clicked
    -- Shift selection so it's still covering the tracks that moved.
    forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (forall k a. Ord k => (a -> k) -> [a] -> Maybe a
Lists.minimumOn forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (TrackNum
dest-) [TrackNum]
tracknums) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Bool -> Move -> TrackNum -> m ()
Selection.shift Bool
False Move
Selection.Move

move_tracks :: Ui.M m => BlockId -> [TrackNum] -> TrackNum -> m TrackNum
move_tracks :: forall (m :: * -> *).
M m =>
BlockId -> [TrackNum] -> TrackNum -> m TrackNum
move_tracks BlockId
block_id [TrackNum]
sources TrackNum
dest = do
    -- Avoid splitting a track from its merged neighbor.
    TrackNum
dest <- if forall a. a -> Maybe a
Just TrackNum
dest forall a. Ord a => a -> a -> Bool
> forall a. Ord a => [a] -> Maybe a
Lists.maximum [TrackNum]
sources
        then forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (forall (m :: * -> *). M m => BlockId -> TrackNum -> m Bool
is_merged_from_right BlockId
block_id TrackNum
dest)
            (forall (m :: * -> *) a. Monad m => a -> m a
return (TrackNum
destforall a. Num a => a -> a -> a
+TrackNum
1)) (forall (m :: * -> *) a. Monad m => a -> m a
return TrackNum
dest)
        else forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (forall (m :: * -> *). M m => BlockId -> TrackNum -> m Bool
is_merged_from_right BlockId
block_id (TrackNum
destforall a. Num a => a -> a -> a
-TrackNum
1))
            (forall (m :: * -> *) a. Monad m => a -> m a
return (TrackNum
destforall a. Num a => a -> a -> a
-TrackNum
1)) (forall (m :: * -> *) a. Monad m => a -> m a
return TrackNum
dest)
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackNum -> m ()
Ui.move_track BlockId
block_id)) forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Ord a => a -> a -> Bool
<TrackNum
dest) [TrackNum]
sources
        -- Start at the last source, then insert at the dest counting down.
        then forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare) [TrackNum]
sources) [TrackNum
dest, TrackNum
destforall a. Num a => a -> a -> a
-TrackNum
1 ..]
        -- Start at the first source, then insert at the dest counting up.
        else forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Ord a => [a] -> [a]
List.sort [TrackNum]
sources) [TrackNum
dest ..]
    forall (m :: * -> *) a. Monad m => a -> m a
return TrackNum
dest

-- | True if this has a merged track to its right.  Presumably that track will
-- be collapsed, but I don't check that.
is_merged_from_right :: Ui.M m => BlockId -> TrackNum -> m Bool
is_merged_from_right :: forall (m :: * -> *). M m => BlockId -> TrackNum -> m Bool
is_merged_from_right BlockId
block_id TrackNum
tracknum = do
    Set TrackId
merged <- Track -> Set TrackId
Block.track_merged forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall (m :: * -> *). M m => BlockId -> TrackNum -> m Track
Ui.get_block_track_at BlockId
block_id TrackNum
tracknum
    [TrackNum]
tracknums <- forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (forall (m :: * -> *).
M m =>
BlockId -> TrackId -> m (Maybe TrackNum)
Ui.tracknum_of BlockId
block_id) (forall a. Set a -> [a]
Set.toList Set TrackId
merged)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== TrackNum
tracknumforall a. Num a => a -> a -> a
+TrackNum
1) [TrackNum]
tracknums