-- 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 for track level operations.
module Cmd.Repl.LTrack where
import qualified Data.List as List
import qualified Data.Set as Set
import qualified Data.Text as Text

import qualified Util.Lists as Lists
import qualified Cmd.Cmd as Cmd
import qualified Cmd.Create as Create
import qualified Cmd.ModifyEvents as ModifyEvents
import qualified Cmd.Selection as Selection

import qualified Derive.ParseTitle as ParseTitle
import qualified Derive.ScoreT as ScoreT
import qualified Ui.Block as Block
import qualified Ui.Event as Event
import qualified Ui.Events as Events
import qualified Ui.Track as Track
import qualified Ui.TrackTree as TrackTree
import qualified Ui.Types as Types
import qualified Ui.Ui as Ui

import           Global
import           Types


-- | List all tracks, along with the number of blocks each one appears in.
list :: Cmd.CmdL [(TrackId, Int)]
list :: CmdL [(TrackId, Int)]
list = do
    [TrackId]
track_ids <- forall (m :: * -> *). M m => m [TrackId]
Ui.all_track_ids
    [Int]
counts <- forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
M m =>
TrackId -> m [(BlockId, [(Int, TracklikeId)])]
Ui.blocks_with_track_id [TrackId]
track_ids
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [TrackId]
track_ids [Int]
counts

gc :: Cmd.CmdL [TrackId]
gc :: CmdL [TrackId]
gc = do
    [TrackId]
tids <- CmdL [TrackId]
orphans
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). M m => TrackId -> m ()
Ui.destroy_track [TrackId]
tids
    forall (m :: * -> *) a. Monad m => a -> m a
return [TrackId]
tids

-- | Tracks that don't appear in any block.
orphans :: Cmd.CmdL [TrackId]
orphans :: CmdL [TrackId]
orphans = forall a. Set a -> [a]
Set.elems forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => m (Set TrackId)
Create.orphan_tracks

-- | Remove tracks with no events from the given block.
remove_empty :: BlockId -> Cmd.CmdL ()
remove_empty :: BlockId -> CmdL ()
remove_empty BlockId
block_id = do
    [TrackId]
track_ids <- Block -> [TrackId]
Block.block_track_ids 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) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). M m => TrackId -> m ()
Ui.destroy_track
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (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) [TrackId]
track_ids

remove_all_empty :: Cmd.CmdL ()
remove_all_empty :: CmdL ()
remove_all_empty = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ BlockId -> CmdL ()
remove_empty forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m [BlockId]
Ui.all_block_ids

map_widths :: (Text -> Bool) -> (Types.Width -> Types.Width) -> Cmd.CmdL ()
map_widths :: (Text -> Bool) -> (Int -> Int) -> CmdL ()
map_widths Text -> Bool
wanted Int -> Int
f = do
    [BlockId]
block_ids <- forall (m :: * -> *). M m => m [BlockId]
Ui.all_block_ids
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BlockId]
block_ids forall a b. (a -> b) -> a -> b
$ \BlockId
block_id -> do
        [Int]
tracknums <- forall a b. (a -> b) -> [a] -> [b]
map TrackInfo -> Int
Ui.track_tracknum
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Bool
wanted forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackInfo -> Text
Ui.track_title) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                forall (m :: * -> *). M m => BlockId -> m [TrackInfo]
TrackTree.tracks_of BlockId
block_id
        [Int]
widths <- forall a b. (a -> b) -> [a] -> [b]
map Track -> Int
Block.track_width forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *). M m => BlockId -> Int -> m Track
Ui.get_block_track_at BlockId
block_id) [Int]
tracknums
        forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (forall (m :: * -> *). M m => BlockId -> Int -> Int -> m ()
Ui.set_track_width BlockId
block_id)
            [Int]
tracknums (forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
f [Int]
widths)

-- | Transform all track titles.
map_titles :: (Text -> Text) -> Cmd.CmdL ()
map_titles :: (Text -> Text) -> CmdL ()
map_titles Text -> Text
f = do
    [TrackId]
tids <- forall (m :: * -> *). M m => m [TrackId]
Ui.all_track_ids
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *). M m => TrackId -> (Text -> Text) -> m ()
Ui.modify_track_title Text -> Text
f) [TrackId]
tids

rename_instruments :: [(Text, Text)] -> Cmd.CmdL ()
rename_instruments :: [(Text, Text)] -> CmdL ()
rename_instruments [(Text, Text)]
renames = (Text -> Text) -> CmdL ()
map_titles forall a b. (a -> b) -> a -> b
$ \Text
t -> forall a. a -> Maybe a -> a
fromMaybe Text
t forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
t [(Text, Text)]
renames

replace :: Text -> Text -> Cmd.CmdL ()
replace :: Text -> Text -> CmdL ()
replace Text
from Text
to = (Text -> Text) -> CmdL ()
map_titles forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> Text -> Text
Text.replace Text
from Text
to

-- | Find all tracks with the given string in their title.  You can use
-- 'Ui.blocks_with_track_id' to find the blocks with the tracks, and
-- 'map_titles' or 'replace' to change the titles.
find :: Cmd.M m => Text -> m [(TrackId, Text)]
find :: forall (m :: * -> *). M m => Text -> m [(TrackId, Text)]
find Text
search = forall (m :: * -> *). M m => (Text -> Bool) -> m [(TrackId, Text)]
find_f (Text
search `Text.isInfixOf`)

find_f :: Cmd.M m => (Text -> Bool) -> m [(TrackId, Text)]
find_f :: forall (m :: * -> *). M m => (Text -> Bool) -> m [(TrackId, Text)]
find_f Text -> Bool
matches = do
    [TrackId]
tids <- forall (m :: * -> *). M m => m [TrackId]
Ui.all_track_ids
    [Text]
titles <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). M m => TrackId -> m Text
Ui.get_track_title [TrackId]
tids
    forall (m :: * -> *) a. Monad m => a -> m a
return [(TrackId
tid, Text
title) | (TrackId
tid, Text
title) <- forall a b. [a] -> [b] -> [(a, b)]
zip [TrackId]
tids [Text]
titles, Text -> Bool
matches Text
title]

-- * manipulation

-- | Duplicate a track from one block to another.  The underlying track is
-- the same, so edits in one of its occurrances will be reflected in all of its
-- blocks.
duplicate :: Ui.M m => BlockId -> TrackNum -> BlockId -> TrackNum -> m ()
duplicate :: forall (m :: * -> *).
M m =>
BlockId -> Int -> BlockId -> Int -> m ()
duplicate BlockId
source_block Int
source_tracknum BlockId
dest_block Int
dest_tracknum = do
    Track
track <- forall (m :: * -> *). M m => BlockId -> Int -> m Track
Ui.get_block_track_at BlockId
source_block Int
source_tracknum
    forall (m :: * -> *). M m => BlockId -> Int -> Track -> m ()
Ui.insert_track BlockId
dest_block Int
dest_tracknum Track
track

-- * events

events :: Ui.M m => TrackId -> m [Event.Event]
events :: forall (m :: * -> *). M m => TrackId -> m [Event]
events = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Events -> [Event]
Events.ascending forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). M m => TrackId -> m Events
Ui.get_events

selected :: Cmd.M m => m [Event.Event]
selected :: forall (m :: * -> *). M m => m [Event]
selected = do
    (BlockId
_, [Int]
_, [TrackId]
track_ids, Range
range) <- forall (m :: * -> *). M m => m (BlockId, [Int], [TrackId], Range)
Selection.tracks
    TrackId
track_id <- forall (m :: * -> *) a.
(HasCallStack, M m) =>
Text -> Maybe a -> m a
Cmd.require Text
"selected track" (forall a. [a] -> Maybe a
Lists.head [TrackId]
track_ids)
    Events -> [Event]
Events.ascending forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Events -> Events
Events.in_range Range
range forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => TrackId -> m Events
Ui.get_events TrackId
track_id

events_range :: TrackId -> ScoreTime -> ScoreTime -> Cmd.CmdL [Event.Event]
events_range :: TrackId -> TrackTime -> TrackTime -> CmdL [Event]
events_range TrackId
track_id TrackTime
start TrackTime
end =
    Events -> [Event]
Events.ascending forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Events -> Events
Events.in_range (TrackTime -> TrackTime -> Range
Events.Range TrackTime
start TrackTime
end) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall (m :: * -> *). M m => TrackId -> m Events
Ui.get_events TrackId
track_id

selected_notation :: Cmd.M m => TrackTime -> m Text
selected_notation :: forall (m :: * -> *). M m => TrackTime -> m Text
selected_notation TrackTime
step = do
    [Event]
events <- forall (m :: * -> *). M m => m [Event]
selected
    (TrackTime
start, TrackTime
end) <- Range -> (TrackTime, TrackTime)
Events.range_times forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => m Range
Selection.range
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TrackTime -> TrackTime -> TrackTime -> [Event] -> Text
to_notation TrackTime
start TrackTime
step TrackTime
end [Event]
events

-- | Reduce event text to notation at a fixed time increment.  It only works
-- out if each event only has a single letter.
to_notation :: TrackTime -> TrackTime -> TrackTime -> [Event.Event] -> Text
to_notation :: TrackTime -> TrackTime -> TrackTime -> [Event] -> Text
to_notation TrackTime
start TrackTime
step TrackTime
end = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TrackTime] -> [Event] -> [Text]
go (forall a. (Num a, Ord a) => a -> a -> a -> [a]
Lists.range' TrackTime
start TrackTime
end TrackTime
step)
    where
    go :: [TrackTime] -> [Event] -> [Text]
go [TrackTime]
_ [] = []
    go [] [Event]
ts = forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Event]
ts) Text
" "
    go (TrackTime
t:[TrackTime]
ts) (Event
e:[Event]
es)
        | Event -> TrackTime
Event.start Event
e forall a. Ord a => a -> a -> Bool
> TrackTime
t = Text
" " forall a. a -> [a] -> [a]
: [TrackTime] -> [Event] -> [Text]
go [TrackTime]
ts (Event
eforall a. a -> [a] -> [a]
:[Event]
es)
        | Event -> TrackTime
Event.start Event
e forall a. Eq a => a -> a -> Bool
== TrackTime
t = Event -> Text
Event.text Event
e forall a. a -> [a] -> [a]
: [TrackTime] -> [Event] -> [Text]
go [TrackTime]
ts [Event]
es
        | Bool
otherwise = Text
" " forall a. a -> [a] -> [a]
: [TrackTime] -> [Event] -> [Text]
go (TrackTime
tforall a. a -> [a] -> [a]
:[TrackTime]
ts) [Event]
es

-- | 4 measures per line, 16 time steps per measure.
format_measures :: String -> [String]
format_measures :: [Char] -> [[Char]]
format_measures =
    forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"|") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [[a]]
Lists.chunked Int
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [[a]]
Lists.chunked Int
16


-- * strip controls

drop_dups :: Cmd.CmdL ()
drop_dups :: CmdL ()
drop_dups = forall (m :: * -> *). M m => Track m -> m ()
ModifyEvents.selection forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => ([Event] -> m [Event]) -> Track m
ModifyEvents.events forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Eq k => (a -> k) -> [a] -> [a]
Lists.dropDups Event -> Text
Event.text

-- * waveform

waveform :: Cmd.CmdT IO ()
waveform :: CmdL ()
waveform = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TrackId -> CmdL ()
toggle_waveform forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m [TrackId]
Selection.track_ids
    -- Invalidate to force it to add or remove waveforms.  It's a big hammer
    -- but it works and it should be uncommon to toggle this.
    forall (m :: * -> *). M m => m ()
Cmd.invalidate_performances

toggle_waveform :: TrackId -> Cmd.CmdT IO ()
toggle_waveform :: TrackId -> CmdL ()
toggle_waveform TrackId
track_id = forall (m :: * -> *). M m => TrackId -> (Bool -> Bool) -> m ()
Ui.modify_waveform TrackId
track_id Bool -> Bool
not


-- * signal render

filled :: Cmd.CmdL ()
filled :: CmdL ()
filled = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *). M m => RenderStyle -> TrackId -> m ()
Ui.set_render_style (Maybe RenderSource -> RenderStyle
Track.Filled forall a. Maybe a
Nothing))
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m [TrackId]
Selection.track_ids

line :: Cmd.CmdL ()
line :: CmdL ()
line = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *). M m => RenderStyle -> TrackId -> m ()
Ui.set_render_style (Maybe RenderSource -> RenderStyle
Track.Line forall a. Maybe a
Nothing))
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m [TrackId]
Selection.track_ids

note_pitch :: Cmd.CmdL ()
note_pitch :: CmdL ()
note_pitch = Text -> CmdL ()
nline Text
"#"

-- | Pass \"#\" for the pitch track.
nline :: Text -> Cmd.CmdL ()
nline :: Text -> CmdL ()
nline = forall (m :: * -> *).
M m =>
(Maybe RenderSource -> RenderStyle) -> Text -> m ()
note_render Maybe RenderSource -> RenderStyle
Track.Line

nfilled :: Text -> Cmd.CmdL ()
nfilled :: Text -> CmdL ()
nfilled = forall (m :: * -> *).
M m =>
(Maybe RenderSource -> RenderStyle) -> Text -> m ()
note_render Maybe RenderSource -> RenderStyle
Track.Filled

note_render :: Cmd.M m => (Maybe Track.RenderSource -> Track.RenderStyle)
    -> Text -- ^ Either a control name, or a #-prefixed pitch name.
    -> m ()
note_render :: forall (m :: * -> *).
M m =>
(Maybe RenderSource -> RenderStyle) -> Text -> m ()
note_render Maybe RenderSource -> RenderStyle
mode Text
control_name = do
    Either Control PControl
control <- forall (m :: * -> *) err a.
(HasCallStack, M m) =>
(err -> Text) -> Either err a -> m a
Cmd.require_right forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Either Control PControl)
ScoreT.parse_generic_control Text
control_name
    [TrackId]
track_ids <- forall (m :: * -> *). M m => m [TrackId]
Selection.track_ids
    [TrackId]
track_ids <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM TrackId -> m Bool
is_note [TrackId]
track_ids
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *). M m => RenderStyle -> TrackId -> m ()
Ui.set_render_style
        (Maybe RenderSource -> RenderStyle
mode (forall a. a -> Maybe a
Just (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Control -> RenderSource
Track.Control PControl -> RenderSource
Track.Pitch Either Control PControl
control)))) [TrackId]
track_ids
    where
    is_note :: TrackId -> m Bool
is_note = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Bool
ParseTitle.is_note_track forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). M m => TrackId -> m Text
Ui.get_track_title

no_render :: Cmd.CmdL ()
no_render :: CmdL ()
no_render = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *). M m => RenderStyle -> TrackId -> m ()
Ui.set_render_style RenderStyle
Track.NoRender) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m [TrackId]
Selection.track_ids