-- 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 #-}
{- | Implement a clipboard, and copy and paste from a selection.

    Who knew copy and paste was so complicated?  Copying is complicated because
    the structure isn't flat, i.e. a block has references to tracks and rulers.
    Pasting is complicated because the clipboard events have to be shifted and
    clipped according to the destination selection.

    Also, the tracks are typed in that it's not appropriate to paste control
    events into a note track.  However, I'm going to ignore that and assume the
    user won't paste them if he didn't mean it.

    Instead of having a special case clipboard, the clipboard is implemented
    as a normal block and tracks (rulers are not copied), in a clipboard
    namespace.  That way, you can have multiple clipboards by copying them to
    different clipboard namespaces, edit clipboards in place, and the paste
    code is the same as the code that merges another project from disk.

    Further ideas:

    - use two selections and a \"swap\" command

    - mouse chording for copy paste

    - different mouse buttons are hard to do on the mac, so use standard for
    now

    - merge with function... I think I can just do it at the REPL

    More complicated pastes should be implemented as derivers, which are more
    flexible than editing operations.  However, there could be a "derive in
    place" cmd to flatten deriver structure.
-}
module Cmd.Clip (
    clip_namespace
    , state_to_clip, clear_clip
    , cmd_cut_selection, cmd_copy_selection
    , cmd_paste_overwrite, cmd_paste_merge, cmd_paste_soft_merge
    , cmd_paste_insert, cmd_paste_stretch
#ifdef TESTING
    , state_to_namespace
#endif
) where
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe

import qualified Util.Lists as Lists
import qualified App.Config as Config
import qualified Cmd.Cmd as Cmd
import qualified Cmd.Create as Create
import qualified Cmd.Edit as Edit
import qualified Cmd.ModifyEvents as ModifyEvents
import qualified Cmd.Selection as Selection
import qualified Cmd.Simple as Simple

import qualified Ui.Block as Block
import qualified Ui.Event as Event
import qualified Ui.Events as Events
import qualified Ui.Id as Id
import qualified Ui.Track as Track
import qualified Ui.Transform as Transform
import qualified Ui.Ui as Ui

import           Global
import           Types


-- * clipboard ops

clip_namespace :: Id.Namespace
clip_namespace :: Namespace
clip_namespace = Text -> Namespace
Id.namespace Text
Config.clip_namespace

clip_block_id :: BlockId
clip_block_id :: BlockId
clip_block_id = Id -> BlockId
Id.BlockId forall a b. (a -> b) -> a -> b
$ Namespace -> Text -> Id
Id.id Namespace
clip_namespace Text
Config.clip_block_name

-- | Replace the clipboard with the given state.  This can be used to load
-- another score and use the clipboard as a staging area.
state_to_clip :: Cmd.M m => Ui.State -> m ()
state_to_clip :: forall (m :: * -> *). M m => State -> m ()
state_to_clip State
state =
    forall (m :: * -> *) a. M m => Namespace -> m a -> m a
reopen_views Namespace
clip_namespace forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => State -> Namespace -> m ()
state_to_namespace State
state Namespace
clip_namespace

clear_clip :: Cmd.M m => m ()
clear_clip :: forall (m :: * -> *). M m => m ()
clear_clip = forall (m :: * -> *). M m => Namespace -> m ()
Transform.destroy_namespace Namespace
clip_namespace

load_block_to_clip :: FilePath -> Cmd.CmdT IO ()
load_block_to_clip :: FilePath -> CmdT IO ()
load_block_to_clip FilePath
fn = forall (m :: * -> *). M m => State -> m ()
state_to_clip forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> CmdT IO State
Simple.read_block FilePath
fn

-- * copy

-- | Like 'cmd_copy_selection', but clear the selection after copying it.
cmd_cut_selection :: Cmd.M m => m ()
cmd_cut_selection :: forall (m :: * -> *). M m => m ()
cmd_cut_selection = do
    forall (m :: * -> *). M m => m ()
cmd_copy_selection
    forall (m :: * -> *). M m => m ()
Edit.cmd_clear_selected

-- | Copy events under the current selection into the buffer.
cmd_copy_selection :: Cmd.M m => m ()
cmd_copy_selection :: forall (m :: * -> *). M m => m ()
cmd_copy_selection = do
    Selected
selected <- forall (m :: * -> *). M m => Tracks -> m Selected
get_selection forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m Tracks
Selection.tracks
    forall (m :: * -> *) a. M m => Namespace -> m a -> m a
reopen_views Namespace
clip_namespace forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => BlockId -> Selected -> m ()
selected_to_block BlockId
clip_block_id Selected
selected

-- | (track_title, events) pairs for each copied track within the copied
-- selection.
type Selected = [(Text, Events.Events)]

-- | Destroy the existing clip namespace and replace it with a new block
-- containing the contents of the Selected.
selected_to_block :: Ui.M m => BlockId -> Selected -> m ()
selected_to_block :: forall (m :: * -> *). M m => BlockId -> Selected -> m ()
selected_to_block BlockId
block_id Selected
selected = do
    let ns :: Namespace
ns = Id -> Namespace
Id.id_namespace (forall a. Ident a => a -> Id
Id.unpack_id BlockId
block_id)
    forall (m :: * -> *). M m => Namespace -> m ()
Transform.destroy_namespace Namespace
ns
    BlockId
block_id <- forall (m :: * -> *). M m => Id -> Text -> [Track] -> m BlockId
Ui.create_block (forall a. Ident a => a -> Id
Id.unpack_id BlockId
block_id) Text
""
        [TracklikeId -> TrackNum -> Track
Block.track (RulerId -> TracklikeId
Block.RId RulerId
Ui.no_ruler) TrackNum
0]
    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
1..] Selected
selected) forall a b. (a -> b) -> a -> b
$ \(TrackNum
tracknum, (Text
title, Events
events)) ->
        forall (m :: * -> *).
M m =>
BlockId -> RulerId -> TrackNum -> TrackNum -> Track -> m TrackId
Create.track_events BlockId
block_id RulerId
Ui.no_ruler TrackNum
tracknum TrackNum
Config.track_width
            (Text -> Events -> Track
Track.track Text
title
                ((Event -> Event) -> Events -> Events
Events.map_events (Lens Event (Maybe Stack)
Event.stack_ forall f a. Lens f a -> a -> f -> f
#= forall a. Maybe a
Nothing) Events
events))

get_selection :: Cmd.M m => Selection.Tracks -> m Selected
get_selection :: forall (m :: * -> *). M m => Tracks -> m Selected
get_selection (BlockId
block_id, [TrackNum]
tracknums, [TrackId]
_, Range
range) = do
    [Track]
tracks <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). M m => TrackId -> m Track
Ui.get_track
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> m (Maybe TrackId)
Ui.event_track_at BlockId
block_id) [TrackNum]
tracknums
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Track -> (Text, Events)
extract [Track]
tracks
    where
    extract :: Track -> (Text, Events)
extract Track
track =
        ( Track -> Text
Track.track_title Track
track
        , Range -> Events -> Events
select_events Range
range (Track -> Events
Track.track_events Track
track)
        )

select_events :: Events.Range -> Events.Events -> Events.Events
select_events :: Range -> Events -> Events
select_events Range
range =
    (Event -> Event) -> Events -> Events
Events.map_events (Lens Event ScoreTime
Event.start_ forall f a. Lens f a -> (a -> a) -> f -> f
%= forall a. Num a => a -> a -> a
subtract (Range -> ScoreTime
Events.range_start Range
range))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Events -> Events
Events.in_range Range
range

-- * paste

-- $paste Insert events from the clipboard to the selection. If the selection
-- is a point it's the same as if it extended to the end of the block.

-- | The normal variety of paste that replaces the destination data.
cmd_paste_overwrite :: Cmd.M m => m ()
cmd_paste_overwrite :: forall (m :: * -> *). M m => m ()
cmd_paste_overwrite = do
    (ScoreTime
start, ScoreTime
end, [(TrackId, [Event])]
track_events) <- forall (m :: * -> *).
M m =>
m (ScoreTime, ScoreTime, [(TrackId, [Event])])
paste_info
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(TrackId, [Event])]
track_events forall a b. (a -> b) -> a -> b
$ \(TrackId
track_id, [Event]
events) -> do
        forall (m :: * -> *). M m => TrackId -> Range -> m ()
Ui.remove_events_range TrackId
track_id (ScoreTime -> ScoreTime -> Range
Events.Range ScoreTime
start ScoreTime
end)
        forall (m :: * -> *). M m => TrackId -> [Event] -> m ()
Ui.insert_events TrackId
track_id [Event]
events

cmd_paste_merge :: Cmd.M m => m ()
cmd_paste_merge :: forall (m :: * -> *). M m => m ()
cmd_paste_merge = do
    (ScoreTime
_, ScoreTime
_, [(TrackId, [Event])]
track_events) <- forall (m :: * -> *).
M m =>
m (ScoreTime, ScoreTime, [(TrackId, [Event])])
paste_info
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(TrackId, [Event])]
track_events forall a b. (a -> b) -> a -> b
$ \(TrackId
track_id, [Event]
events) ->
        forall (m :: * -> *). M m => TrackId -> [Event] -> m ()
Ui.insert_events TrackId
track_id [Event]
events

-- | Like 'cmd_paste_merge', except don't merge events that overlap with
-- existing ones.
cmd_paste_soft_merge :: Cmd.M m => m ()
cmd_paste_soft_merge :: forall (m :: * -> *). M m => m ()
cmd_paste_soft_merge = do
    (ScoreTime
_, ScoreTime
_, [(TrackId, [Event])]
track_events) <- forall (m :: * -> *).
M m =>
m (ScoreTime, ScoreTime, [(TrackId, [Event])])
paste_info
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(TrackId, [Event])]
track_events forall a b. (a -> b) -> a -> b
$ \(TrackId
track_id, [Event]
events) -> do
        Events
track_events <- forall (m :: * -> *). M m => TrackId -> m Events
Ui.get_events TrackId
track_id
        forall (m :: * -> *). M m => TrackId -> [Event] -> m ()
Ui.insert_events TrackId
track_id forall a b. (a -> b) -> a -> b
$
            forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events -> Event -> Bool
overlaps Events
track_events) [Event]
events
    where
    overlaps :: Events -> Event -> Bool
overlaps Events
events Event
event = forall a. Maybe a -> Bool
Maybe.isJust forall a b. (a -> b) -> a -> b
$
        ScoreTime -> Events -> Maybe Event
Events.overlapping (Event -> ScoreTime
Event.start Event
event) Events
events

-- | Insert the events after pushing events after the selection down by
-- the inserted length, which is the minimum of the insert selection and the
-- length of the buffer.
cmd_paste_insert :: Cmd.M m => m ()
cmd_paste_insert :: forall (m :: * -> *). M m => m ()
cmd_paste_insert = do
    (ScoreTime
start, ScoreTime
end, [(TrackId, [Event])]
track_events) <- forall (m :: * -> *).
M m =>
m (ScoreTime, ScoreTime, [(TrackId, [Event])])
paste_info
    -- Only shift the tracks that are in clip_events.
    ScoreTime
ruler_end <- forall (m :: * -> *). M m => BlockId -> m ScoreTime
Ui.block_ruler_end forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *).
M m =>
ScoreTime -> ScoreTime -> ScoreTime -> TrackId -> m ()
ModifyEvents.move_track_events ScoreTime
ruler_end ScoreTime
start (ScoreTime
endforall a. Num a => a -> a -> a
-ScoreTime
start) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
        [(TrackId, [Event])]
track_events
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(TrackId, [Event])]
track_events forall a b. (a -> b) -> a -> b
$ \(TrackId
track_id, [Event]
events) ->
        forall (m :: * -> *). M m => TrackId -> [Event] -> m ()
Ui.insert_events TrackId
track_id [Event]
events

-- | Paste the clipboard, but stretch or compress it to fit the selection.
cmd_paste_stretch :: Cmd.M m => m ()
cmd_paste_stretch :: forall (m :: * -> *). M m => m ()
cmd_paste_stretch = do
    ([TrackId]
track_ids, [TrackId]
clip_track_ids, ScoreTime
start, ScoreTime
end, ScoreTime
_) <- forall (m :: * -> *).
M m =>
m ([TrackId], [TrackId], ScoreTime, ScoreTime, ScoreTime)
get_paste_area
    [Events]
events <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). M m => TrackId -> m Events
Ui.get_events [TrackId]
clip_track_ids
    let m_clip_s :: Maybe ScoreTime
m_clip_s = forall a. Ord a => [a] -> Maybe a
Lists.minimum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Events -> ScoreTime
Events.time_begin forall a b. (a -> b) -> a -> b
$
            forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events -> Bool
Events.null) [Events]
events
        m_clip_e :: Maybe ScoreTime
m_clip_e = forall a. Ord a => [a] -> Maybe a
Lists.maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Events -> ScoreTime
Events.time_end forall a b. (a -> b) -> a -> b
$
            forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events -> Bool
Events.null) [Events]
events
    case (Maybe ScoreTime
m_clip_s, Maybe ScoreTime
m_clip_e) of
        (Just ScoreTime
clip_s, Just ScoreTime
clip_e) -> do
            let stretched :: [[Event]]
stretched = forall a b. (a -> b) -> [a] -> [b]
map ((ScoreTime, ScoreTime)
-> (ScoreTime, ScoreTime) -> [Event] -> [Event]
stretch (ScoreTime
start, ScoreTime
end) (ScoreTime
clip_s, ScoreTime
clip_e)
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events -> [Event]
Events.ascending) [Events]
events
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [TrackId]
track_ids [[Event]]
stretched) forall a b. (a -> b) -> a -> b
$ \(TrackId
track_id, [Event]
stretched) -> do
                forall (m :: * -> *). M m => TrackId -> Range -> m ()
Ui.remove_events_range TrackId
track_id (ScoreTime -> ScoreTime -> Range
Events.Range ScoreTime
start ScoreTime
end)
                forall (m :: * -> *). M m => TrackId -> [Event] -> m ()
Ui.insert_events TrackId
track_id [Event]
stretched
        (Maybe ScoreTime, Maybe ScoreTime)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

stretch :: (ScoreTime, ScoreTime) -> (ScoreTime, ScoreTime)
    -> [Event.Event] -> [Event.Event]
stretch :: (ScoreTime, ScoreTime)
-> (ScoreTime, ScoreTime) -> [Event] -> [Event]
stretch (ScoreTime
start, ScoreTime
end) (ScoreTime
clip_s, ScoreTime
clip_e) = forall a b. (a -> b) -> [a] -> [b]
map Event -> Event
reposition
    where
    reposition :: Event -> Event
reposition = (Lens Event ScoreTime
Event.start_ forall f a. Lens f a -> (a -> a) -> f -> f
%= (\ScoreTime
pos -> (ScoreTime
posforall a. Num a => a -> a -> a
-ScoreTime
clip_s) forall a. Num a => a -> a -> a
* ScoreTime
factor forall a. Num a => a -> a -> a
+ ScoreTime
start))
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens Event ScoreTime
Event.duration_ forall f a. Lens f a -> (a -> a) -> f -> f
%= (forall a. Num a => a -> a -> a
*ScoreTime
factor))
    factor :: ScoreTime
factor = (ScoreTime
end forall a. Num a => a -> a -> a
- ScoreTime
start) forall a. Fractional a => a -> a -> a
/ (ScoreTime
clip_e forall a. Num a => a -> a -> a
- ScoreTime
clip_s)


-- * implementation

-- ** copy

-- | Rename the blocks and tracks in the given state into the given namespace
-- and replace the IDs already in that namespace with it.  Rulers are ignored.
--
-- This means that if the given state has IDs in more than one namespace, they
-- will be flattened into one.  Any collisions will throw an exception.
state_to_namespace :: Ui.M m => Ui.State -> Id.Namespace -> m ()
state_to_namespace :: forall (m :: * -> *). M m => State -> Namespace -> m ()
state_to_namespace State
state Namespace
ns = do
    State
state <- forall (m :: * -> *). M m => Namespace -> State -> m State
set_namespace Namespace
ns State
state
    forall (m :: * -> *). M m => Namespace -> m ()
Transform.destroy_namespace Namespace
ns
    State
global_st <- forall (m :: * -> *). M m => m State
Ui.get
    State
merged <- forall (m :: * -> *) err a.
(Stack, M m) =>
(err -> Text) -> Either err a -> m a
Ui.require_right ((Text
"merge states: "<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
showt)
        (State -> State -> Either Error State
Transform.merge_states State
global_st State
state)
    forall (m :: * -> *). M m => State -> m ()
Ui.put State
merged

reopen_views :: Ui.M m => Id.Namespace -> m a -> m a
reopen_views :: forall (m :: * -> *) a. M m => Namespace -> m a -> m a
reopen_views Namespace
ns m a
operation = do
    [View]
views <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==Namespace
ns) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ident a => a -> Namespace
Id.ident_namespace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall (m :: * -> *) a. M m => (State -> a) -> m a
Ui.gets (forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Map ViewId View
Ui.state_views)
    a
result <- m a
operation
    [BlockId]
block_ids <- forall (m :: * -> *). M m => m [BlockId]
Ui.all_block_ids
    let reopen :: [View]
reopen = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BlockId]
block_ids) forall b c a. (b -> c) -> (a -> b) -> a -> c
. View -> BlockId
Block.view_block) [View]
views
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [View]
reopen forall a b. (a -> b) -> a -> b
$ \View
view ->
        forall (m :: * -> *). M m => BlockId -> Rect -> m ViewId
Create.sized_view (View -> BlockId
Block.view_block View
view) (View -> Rect
Block.view_rect View
view)
    forall (m :: * -> *) a. Monad m => a -> m a
return a
result

-- | Set all the IDs in the state to be in the given namespace, except rulers.
-- Collisions will throw.  Rulers are omitted because copy and paste doesn't
-- mess with rulers.
set_namespace :: Ui.M m => Id.Namespace -> Ui.State -> m Ui.State
set_namespace :: forall (m :: * -> *). M m => Namespace -> State -> m State
set_namespace Namespace
ns State
state = do
    let state2 :: State
state2 = State
state { state_rulers :: Map RulerId Ruler
Ui.state_rulers = forall k a. Map k a
Map.empty }
    forall (m :: * -> *) err a.
(Stack, M m) =>
(err -> Text) -> Either err a -> m a
Ui.require_right ((Text
"set to clip namespace: "<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
showt) forall a b. (a -> b) -> a -> b
$
        forall a. State -> StateId a -> Either Error State
Ui.exec State
state2 forall a b. (a -> b) -> a -> b
$ do
            forall (m :: * -> *). M m => (Id -> Id) -> m ()
Transform.map_view_ids (Namespace -> Id -> Id
Id.set_namespace Namespace
ns)
            forall (m :: * -> *). M m => (Id -> Id) -> m ()
Transform.map_block_ids (Namespace -> Id -> Id
Id.set_namespace Namespace
ns)
            forall (m :: * -> *). M m => (Id -> Id) -> m ()
Transform.map_track_ids (Namespace -> Id -> Id
Id.set_namespace Namespace
ns)

-- ** paste

-- | Get the info necessary to paste from the clipboard: start and end pos,
-- the tracks in the destination selection, and the events from the clipboard
-- paired with the track it should go into.  The clipboard events are truncated
-- to start--end and shifted into the paste range.
paste_info :: Cmd.M m => m (ScoreTime, ScoreTime, [(TrackId, [Event.Event])])
paste_info :: forall (m :: * -> *).
M m =>
m (ScoreTime, ScoreTime, [(TrackId, [Event])])
paste_info = do
    ([TrackId]
track_ids, [TrackId]
clip_track_ids, ScoreTime
start, ScoreTime
sel_end, ScoreTime
event_end) <- forall (m :: * -> *).
M m =>
m ([TrackId], [TrackId], ScoreTime, ScoreTime, ScoreTime)
get_paste_area
    [Track]
tracks <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). M m => TrackId -> m Track
Ui.get_track [TrackId]
clip_track_ids
    let clip_and_move :: Track -> [Event]
clip_and_move = forall a b. (a -> b) -> [a] -> [b]
map (Lens Event ScoreTime
Event.start_ forall f a. Lens f a -> (a -> a) -> f -> f
%= (forall a. Num a => a -> a -> a
+ScoreTime
start))
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScoreTime -> ScoreTime -> [Event] -> [Event]
clip_to_selection ScoreTime
start ScoreTime
event_end
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events -> [Event]
Events.ascending forall b c a. (b -> c) -> (a -> b) -> a -> c
. Track -> Events
Track.track_events
    forall (m :: * -> *) a. Monad m => a -> m a
return (ScoreTime
start, ScoreTime
sel_end, forall a b. [a] -> [b] -> [(a, b)]
zip [TrackId]
track_ids (forall a b. (a -> b) -> [a] -> [b]
map Track -> [Event]
clip_and_move [Track]
tracks))

clip_to_selection :: ScoreTime -> ScoreTime -> [Event.Event] -> [Event.Event]
clip_to_selection :: ScoreTime -> ScoreTime -> [Event] -> [Event]
clip_to_selection ScoreTime
start ScoreTime
end
    -- A point selection should be able to paste a 0 dur event.
    | ScoreTime
start forall a. Eq a => a -> a -> Bool
== ScoreTime
end = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. a -> [a] -> [a]
:[])
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\Event
e -> Event -> ScoreTime
Event.start Event
e forall a. Eq a => a -> a -> Bool
== ScoreTime
0 Bool -> Bool -> Bool
&& Event -> ScoreTime
Event.duration Event
e forall a. Eq a => a -> a -> Bool
== ScoreTime
0)
    | Bool
otherwise = Bool -> ScoreTime -> [Event] -> [Event]
Events.clip_list Bool
False (ScoreTime
end forall a. Num a => a -> a -> a
- ScoreTime
start)

-- | Get the destination and clip tracks involved in a paste, along with the
-- paste selection.
--
-- During pastes, a point selection extends to the end of the last pasted
-- event.  However, the paste range is limited to the end of the ruler on the
-- block.  Otherwise, it's easy to paste events past the end of the block,
-- which are then difficult to edit.
get_paste_area :: Cmd.M m =>
    m ([TrackId], [TrackId], ScoreTime, ScoreTime, ScoreTime)
get_paste_area :: forall (m :: * -> *).
M m =>
m ([TrackId], [TrackId], ScoreTime, ScoreTime, ScoreTime)
get_paste_area = do
    (BlockId
block_id, [TrackNum]
tracknums, [TrackId]
track_ids, Range
range) <- forall (m :: * -> *). M m => m Tracks
Selection.tracks
    let (ScoreTime
start, ScoreTime
end) = Range -> (ScoreTime, ScoreTime)
Events.range_times Range
range
    ScoreTime
ruler_end <- forall (m :: * -> *). M m => BlockId -> m ScoreTime
Ui.block_ruler_end BlockId
block_id
    Block
clip_block <- forall (m :: * -> *). M m => BlockId -> m Block
Ui.get_block BlockId
clip_block_id
    -- If the clip block has any rulers or anything, I skip them.
    let clip_track_ids :: [TrackId]
clip_track_ids =
            forall a. TrackNum -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> TrackNum
length [TrackNum]
tracknums) (Block -> [TrackId]
Block.block_track_ids Block
clip_block)
    ScoreTime
clip_end <- forall (m :: * -> *). M m => BlockId -> m ScoreTime
Ui.block_event_end BlockId
clip_block_id
    -- If start==end, I have to set the end past the end of the clip in case
    -- the last event has dur 0.
    forall (m :: * -> *) a. Monad m => a -> m a
return ([TrackId]
track_ids, [TrackId]
clip_track_ids, ScoreTime
start,
        forall a. Ord a => a -> a -> a
min ScoreTime
ruler_end (if ScoreTime
start forall a. Eq a => a -> a -> Bool
== ScoreTime
end then ScoreTime
start forall a. Num a => a -> a -> a
+ ScoreTime
clip_end else ScoreTime
end),
        if ScoreTime
start forall a. Eq a => a -> a -> Bool
== ScoreTime
end then ScoreTime
ruler_end else ScoreTime
end)