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