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

{- | Event editing commands.  This is where generic event editing commands go.
    More specialized ones, like copy and paste and control or note track
    commands, go in their own modules.
-}
module Cmd.Edit (
    -- * global editing state
    cmd_toggle_val_edit
    , cmd_toggle_method_edit
    , cmd_toggle_kbd_entry
    , cmd_toggle_val_edit_kbd_entry
    , set_step_rank
    , set_step
    , toggle_absolute_relative_step
    , cmd_toggle_note_orientation
    , cmd_modify_octave
    , toggle_advance
    , toggle_chord

    -- * event start and duration
    , cmd_move_event_forward, cmd_move_event_backward
    , cmd_set_duration
    , cmd_toggle_zero_timestep
    , cmd_set_start
    , modify_dur
    , cmd_join_events
    , cmd_split_events
    , cmd_insert_time
    , cmd_delete_time
    , delete_block_time
    , cmd_clear_selected
    , clear_range
    , cmd_clear_and_advance
    , toggle_note_duration
    , cmd_set_call_duration
    , cmd_invert_orientation

    -- * modify text
    , cmd_toggle_commented
    , strip_transformer

    -- * record action
    , save_last_action_to
    , run_action_at

    -- * floating text input
    , handle_floating_input
    , append_text
    , prepend_text
    , replace_last_call
    , replace_first_call
) where
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as Map
import qualified Data.Text as Text

import qualified Util.Lists as Lists
import qualified App.Config as Config
import qualified Cmd.Cmd as Cmd
import qualified Cmd.EditUtil as EditUtil
import qualified Cmd.ModifyEvents as ModifyEvents
import qualified Cmd.ModifyNotes as ModifyNotes
import qualified Cmd.Msg as Msg
import qualified Cmd.Perf as Perf
import qualified Cmd.Selection as Selection
import qualified Cmd.TimeStep as TimeStep

import qualified Derive.Derive as Derive
import qualified Derive.ParseTitle as ParseTitle
import qualified Perform.Pitch as Pitch
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.ScoreTime as ScoreTime
import qualified Ui.Sel as Sel
import qualified Ui.Types as Types
import qualified Ui.Ui as Ui
import qualified Ui.UiMsg as UiMsg
import qualified Ui.Zoom as Zoom

import           Global
import           Types


-- * global editing state

-- | Unlike the other toggle commands, val edit, being the \"default\" toggle,
-- always turns other modes off.  So you can't switch directly from some other
-- kind of edit to val edit.
cmd_toggle_val_edit :: Cmd.M m => m ()
cmd_toggle_val_edit :: forall (m :: * -> *). M m => m ()
cmd_toggle_val_edit = forall (m :: * -> *). M m => (EditMode -> EditMode) -> m ()
modify_edit_mode forall a b. (a -> b) -> a -> b
$ \EditMode
m -> case EditMode
m of
    EditMode
Cmd.NoEdit -> EditMode
Cmd.ValEdit
    EditMode
_ -> EditMode
Cmd.NoEdit

cmd_toggle_method_edit :: Cmd.M m => m ()
cmd_toggle_method_edit :: forall (m :: * -> *). M m => m ()
cmd_toggle_method_edit = forall (m :: * -> *). M m => (EditMode -> EditMode) -> m ()
modify_edit_mode forall a b. (a -> b) -> a -> b
$ \EditMode
m -> case EditMode
m of
    EditMode
Cmd.MethodEdit -> EditMode
Cmd.ValEdit
    EditMode
Cmd.ValEdit -> EditMode
Cmd.MethodEdit
    EditMode
_ -> EditMode
m

-- | Toggle kbd entry mode, putting a K in the edit box as a reminder.  This is
-- orthogonal to the previous edit modes.
cmd_toggle_kbd_entry :: Cmd.M m => m ()
cmd_toggle_kbd_entry :: forall (m :: * -> *). M m => m ()
cmd_toggle_kbd_entry = forall (m :: * -> *). M m => (EditState -> EditState) -> m ()
Cmd.modify_edit_state forall a b. (a -> b) -> a -> b
$ \EditState
st ->
    EditState
st { state_kbd_entry :: Bool
Cmd.state_kbd_entry = Bool -> Bool
not (EditState -> Bool
Cmd.state_kbd_entry EditState
st) }

cmd_toggle_val_edit_kbd_entry :: Cmd.M m => m ()
cmd_toggle_val_edit_kbd_entry :: forall (m :: * -> *). M m => m ()
cmd_toggle_val_edit_kbd_entry = forall (m :: * -> *). M m => (EditState -> EditState) -> m ()
Cmd.modify_edit_state forall a b. (a -> b) -> a -> b
$ \EditState
st ->
    if EditState -> EditMode
Cmd.state_edit_mode EditState
st forall a. Eq a => a -> a -> Bool
== EditMode
Cmd.ValEdit
        then EditState
st
            { state_edit_mode :: EditMode
Cmd.state_edit_mode = EditMode
Cmd.NoEdit
            , state_kbd_entry :: Bool
Cmd.state_kbd_entry = Bool
False
            }
        else EditState
st
            { state_edit_mode :: EditMode
Cmd.state_edit_mode = EditMode
Cmd.ValEdit
            , state_kbd_entry :: Bool
Cmd.state_kbd_entry = Bool
True
            }

-- | If the TimeStep is AbsoluteMark or RelativeMark, set its rank.  Otherwise,
-- set it to the deflt.  This means the marklist names are sticky, so if you
-- set it manually the default bindings won't mess it up.
set_step_rank :: Cmd.M m => TimeStep.TimeStep -> Meter.Rank -> m ()
set_step_rank :: forall (m :: * -> *). M m => TimeStep -> Rank -> m ()
set_step_rank TimeStep
deflt Rank
rank = forall (m :: * -> *). M m => (EditState -> EditState) -> m ()
Cmd.modify_edit_state forall a b. (a -> b) -> a -> b
$ \EditState
st ->
    EditState
st { state_time_step :: TimeStep
Cmd.state_time_step =
        [Step] -> TimeStep
set (TimeStep -> [Step]
TimeStep.to_list (EditState -> TimeStep
Cmd.state_time_step EditState
st)) }
    where
    set :: [Step] -> TimeStep
set [TimeStep.AbsoluteMark MarklistMatch
names Rank
_] =
        Step -> TimeStep
TimeStep.time_step (MarklistMatch -> Rank -> Step
TimeStep.AbsoluteMark MarklistMatch
names Rank
rank)
    set [TimeStep.RelativeMark MarklistMatch
names Rank
_] =
        Step -> TimeStep
TimeStep.time_step (MarklistMatch -> Rank -> Step
TimeStep.RelativeMark MarklistMatch
names Rank
rank)
    set [Step]
_ = TimeStep
deflt

set_step :: Cmd.M m => TimeStep.TimeStep -> m ()
set_step :: forall (m :: * -> *). M m => TimeStep -> m ()
set_step TimeStep
step = forall (m :: * -> *). M m => (EditState -> EditState) -> m ()
Cmd.modify_edit_state forall a b. (a -> b) -> a -> b
$ \EditState
st -> EditState
st { state_time_step :: TimeStep
Cmd.state_time_step = TimeStep
step }

-- | Toggle between absolute and relative mark step.
toggle_absolute_relative_step :: Cmd.M m => m ()
toggle_absolute_relative_step :: forall (m :: * -> *). M m => m ()
toggle_absolute_relative_step = forall (m :: * -> *). M m => (EditState -> EditState) -> m ()
Cmd.modify_edit_state forall a b. (a -> b) -> a -> b
$ \EditState
st ->
        EditState
st { state_time_step :: TimeStep
Cmd.state_time_step = TimeStep -> TimeStep
toggle (EditState -> TimeStep
Cmd.state_time_step EditState
st) }
    where
    toggle :: TimeStep -> TimeStep
toggle TimeStep
step = case TimeStep -> [Step]
TimeStep.to_list TimeStep
step of
        [TimeStep.AbsoluteMark MarklistMatch
names Rank
rank] ->
            Step -> TimeStep
TimeStep.time_step (MarklistMatch -> Rank -> Step
TimeStep.RelativeMark MarklistMatch
names Rank
rank)
        [TimeStep.RelativeMark MarklistMatch
names Rank
rank] ->
            Step -> TimeStep
TimeStep.time_step (MarklistMatch -> Rank -> Step
TimeStep.AbsoluteMark MarklistMatch
names Rank
rank)
        [Step]
_ -> TimeStep
step

cmd_toggle_note_orientation :: Cmd.M m => m ()
cmd_toggle_note_orientation :: forall (m :: * -> *). M m => m ()
cmd_toggle_note_orientation = forall (m :: * -> *). M m => (EditState -> EditState) -> m ()
Cmd.modify_edit_state forall a b. (a -> b) -> a -> b
$ \EditState
st -> EditState
st
    { state_note_orientation :: Orientation
Cmd.state_note_orientation = Orientation -> Orientation
Types.invert (EditState -> Orientation
Cmd.state_note_orientation EditState
st)
    }

cmd_modify_octave :: Cmd.M m => (Pitch.Octave -> Pitch.Octave) -> m ()
cmd_modify_octave :: forall (m :: * -> *). M m => (Int -> Int) -> m ()
cmd_modify_octave Int -> Int
f = forall (m :: * -> *). M m => (EditState -> EditState) -> m ()
Cmd.modify_edit_state forall a b. (a -> b) -> a -> b
$ \EditState
st -> EditState
st
    { state_kbd_entry_octave :: Int
Cmd.state_kbd_entry_octave = Int -> Int
f (EditState -> Int
Cmd.state_kbd_entry_octave EditState
st) }

-- ** util

modify_edit_mode :: Cmd.M m => (Cmd.EditMode -> Cmd.EditMode) -> m ()
modify_edit_mode :: forall (m :: * -> *). M m => (EditMode -> EditMode) -> m ()
modify_edit_mode EditMode -> EditMode
f = forall (m :: * -> *). M m => (EditState -> EditState) -> m ()
Cmd.modify_edit_state forall a b. (a -> b) -> a -> b
$ \EditState
st ->
    EditState
st { state_edit_mode :: EditMode
Cmd.state_edit_mode = EditMode -> EditMode
f (EditState -> EditMode
Cmd.state_edit_mode EditState
st) }

toggle_advance :: Cmd.M m => m ()
toggle_advance :: forall (m :: * -> *). M m => m ()
toggle_advance = forall (m :: * -> *). M m => (Bool -> Bool) -> m ()
modify_advance Bool -> Bool
not

modify_advance :: Cmd.M m => (Bool -> Bool) -> m ()
modify_advance :: forall (m :: * -> *). M m => (Bool -> Bool) -> m ()
modify_advance Bool -> Bool
f = forall (m :: * -> *). M m => (EditState -> EditState) -> m ()
Cmd.modify_edit_state forall a b. (a -> b) -> a -> b
$ \EditState
st ->
    EditState
st { state_advance :: Bool
Cmd.state_advance = Bool -> Bool
f (EditState -> Bool
Cmd.state_advance EditState
st) }

toggle_chord :: Cmd.M m => m ()
toggle_chord :: forall (m :: * -> *). M m => m ()
toggle_chord = forall (m :: * -> *). M m => (Bool -> Bool) -> m ()
modify_chord Bool -> Bool
not

modify_chord :: Cmd.M m => (Bool -> Bool) -> m ()
modify_chord :: forall (m :: * -> *). M m => (Bool -> Bool) -> m ()
modify_chord Bool -> Bool
f = forall (m :: * -> *). M m => (EditState -> EditState) -> m ()
Cmd.modify_edit_state forall a b. (a -> b) -> a -> b
$ \EditState
st ->
    EditState
st { state_chord :: Bool
Cmd.state_chord = Bool -> Bool
f (EditState -> Bool
Cmd.state_chord EditState
st) }

toggle_record_velocity :: Cmd.CmdL ()
toggle_record_velocity :: CmdL ()
toggle_record_velocity = (Bool -> Bool) -> CmdL ()
modify_record_velocity Bool -> Bool
not

modify_record_velocity :: (Bool -> Bool) -> Cmd.CmdL ()
modify_record_velocity :: (Bool -> Bool) -> CmdL ()
modify_record_velocity Bool -> Bool
f = forall (m :: * -> *). M m => (EditState -> EditState) -> m ()
Cmd.modify_edit_state forall a b. (a -> b) -> a -> b
$ \EditState
st ->
    EditState
st { state_record_velocity :: Bool
Cmd.state_record_velocity = Bool -> Bool
f (EditState -> Bool
Cmd.state_record_velocity EditState
st) }

-- * event start and duration

-- | Insert an event at the current insert pos.
insert_event :: Cmd.M m => Text -> ScoreTime -> m ()
insert_event :: forall (m :: * -> *). M m => Text -> TrackTime -> m ()
insert_event Text
text TrackTime
dur = do
    (BlockId
block_id, Int
_, TrackId
track_id, TrackTime
pos) <- forall (m :: * -> *). M m => m (BlockId, Int, TrackId, TrackTime)
Selection.get_insert
    forall (m :: * -> *). M m => BlockId -> TrackId -> [Event] -> m ()
Ui.insert_block_events BlockId
block_id TrackId
track_id [TrackTime -> TrackTime -> Text -> Event
Event.event TrackTime
pos TrackTime
dur Text
text]

-- | Different from 'cmd_insert_time' and 'cmd_delete_time' since it only
-- moves some events.  Move back the next event, or move forward the previous
-- event.  Move the next or previous event for a point selection, or the
-- selected events.
cmd_move_event_forward :: Cmd.M m => m ()
cmd_move_event_forward :: forall (m :: * -> *). M m => m ()
cmd_move_event_forward = forall (m :: * -> *). M m => Direction -> m ()
move_events Direction
TimeStep.Advance

cmd_move_event_backward :: Cmd.M m => m ()
cmd_move_event_backward :: forall (m :: * -> *). M m => m ()
cmd_move_event_backward = forall (m :: * -> *). M m => Direction -> m ()
move_events Direction
TimeStep.Rewind

{- |
    . If selection is a point, expand it to the next or prev event.
    . Delete events from pos to end of selection.
    . Select all events in selection, move by pos - Event.start affected.
-}
move_events :: Cmd.M m => TimeStep.Direction -> m ()
move_events :: forall (m :: * -> *). M m => Direction -> m ()
move_events Direction
dir = do
    (BlockId
block_id, [Int]
_, [TrackId]
track_ids, Range
range) <- forall (m :: * -> *). M m => m (BlockId, [Int], [TrackId], Range)
Selection.tracks
    [(TrackId, Events)]
tracks <- forall a b. [a] -> [b] -> [(a, b)]
zip [TrackId]
track_ids 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 Events
Ui.get_events [TrackId]
track_ids
    -- Use the first selected track as the reference for how much to move.
    -- This is predictable so let's try this for now.
    Range
event_range <- Range -> Events -> Range
expand Range
range forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. M m => Maybe a -> m a
Cmd.abort_unless (forall a. [a] -> Maybe a
Lists.head [(TrackId, Events)]
tracks)
    NonEmpty Event
affected <- forall (m :: * -> *) a. M m => Maybe a -> m a
Cmd.abort_unless forall a b. (a -> b) -> a -> b
$
        forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events -> [Event]
Events.ascending forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Events -> Events
Events.in_range Range
event_range forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
            forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. [a] -> Maybe a
Lists.head [(TrackId, Events)]
tracks
    let pos :: TrackTime
pos = case Direction
dir of
            Direction
TimeStep.Rewind -> Range -> TrackTime
Events.range_start Range
range
            Direction
TimeStep.Advance -> Range -> TrackTime
Events.range_end Range
range
    let delta :: TrackTime
delta = (TrackTime
pos -) forall a b. (a -> b) -> a -> b
$ Event -> TrackTime
Event.start forall a b. (a -> b) -> a -> b
$ case Direction
dir of
            Direction
TimeStep.Rewind -> forall a. NonEmpty a -> a
NonEmpty.head NonEmpty Event
affected
            Direction
TimeStep.Advance -> forall a. NonEmpty a -> a
NonEmpty.last NonEmpty Event
affected
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TrackTime
delta forall a. Eq a => a -> a -> Bool
/= TrackTime
0) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(TrackId, Events)]
tracks forall a b. (a -> b) -> a -> b
$ \(TrackId
tid, Events
events) -> do
        forall (m :: * -> *). M m => TrackId -> Range -> m ()
Ui.remove_events_range TrackId
tid Range
event_range
        forall (m :: * -> *). M m => BlockId -> TrackId -> [Event] -> m ()
Ui.insert_block_events BlockId
block_id TrackId
tid forall a b. (a -> b) -> a -> b
$
            forall a b. (a -> b) -> [a] -> [b]
map (Lens Event TrackTime
Event.start_ forall f a. Lens f a -> (a -> a) -> f -> f
%= (forall a. Num a => a -> a -> a
+TrackTime
delta)) forall a b. (a -> b) -> a -> b
$ Events -> [Event]
Events.ascending forall a b. (a -> b) -> a -> b
$
            Range -> Events -> Events
Events.in_range Range
event_range Events
events
    where
    expand :: Range -> Events -> Range
expand Range
range Events
events = case Range
range of
        Events.Point TrackTime
pos Orientation
_orient ->
            forall b a. b -> (a -> b) -> Maybe a -> b
maybe Range
range Event -> Range
Events.event_range forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
Lists.head forall a b. (a -> b) -> a -> b
$ case Direction
dir of
                Direction
TimeStep.Rewind -> TrackTime -> Events -> [Event]
Events.at_after TrackTime
pos Events
events
                Direction
TimeStep.Advance -> TrackTime -> Events -> [Event]
Events.at_before TrackTime
pos Events
events
        Events.Range {} -> Range
range

-- | Extend the events in the selection to either the end of the selection or
-- the beginning of the next note, whichever is shorter.
--
-- If the selection is on an event, the previous or next one (depending on
-- 'Types.Orientation') is extended instead.  This is more useful than reducing
-- the event to 0, which has its own cmd anyway.  If the selection is between
-- a positive and negative event, the one corresponding to 'Sel.orientation' is
-- selected.
cmd_set_duration :: Cmd.M m => m ()
cmd_set_duration :: forall (m :: * -> *). M m => m ()
cmd_set_duration = forall (m :: * -> *).
M m =>
((TrackTime, TrackTime) -> Event -> Event) -> Context -> m ()
modify_neighbor (TrackTime, TrackTime) -> Event -> Event
modify forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m Context
Selection.context
    where
    modify :: (TrackTime, TrackTime) -> Event -> Event
modify (TrackTime
start, TrackTime
end) Event
event
        | Event -> Bool
Event.is_negative Event
event = TrackTime -> Event -> Event
set_dur (TrackTime
start forall a. Num a => a -> a -> a
- Event -> TrackTime
Event.start Event
event) Event
event
        | Bool
otherwise = TrackTime -> Event -> Event
set_dur (TrackTime
end forall a. Num a => a -> a -> a
- Event -> TrackTime
Event.start Event
event) Event
event

-- | Similar to 'ModifyEvents.event', but if the selection is a point, modify
-- the previous or next event, depending on if it's positive or negative.
modify_neighbor :: Ui.M m
    => ((ScoreTime, ScoreTime) -> Event.Event -> Event.Event)
    -> Selection.Context -> m ()
modify_neighbor :: forall (m :: * -> *).
M m =>
((TrackTime, TrackTime) -> Event -> Event) -> Context -> m ()
modify_neighbor (TrackTime, TrackTime) -> Event -> Event
modify Context
ctx
    | Selection -> Bool
Sel.is_point Selection
sel = forall {m :: * -> *}. M m => TrackTime -> m ()
prev_or_next (Selection -> TrackTime
Selection.sel_point Selection
sel)
    | Bool
otherwise = forall {m :: * -> *}. M m => (TrackTime, TrackTime) -> m ()
selection (Selection -> (TrackTime, TrackTime)
Sel.range Selection
sel)
    where
    sel :: Selection
sel = Context -> Selection
Selection.ctx_selection Context
ctx
    -- TODO Should I integrate this into ModifyEvents?
    prev_or_next :: TrackTime -> m ()
prev_or_next TrackTime
pos = do
        let block_id :: BlockId
block_id = Context -> BlockId
Selection.ctx_block_id Context
ctx
        [(TrackId, Event)]
tracks <- forall (m :: * -> *). M m => Context -> m [(TrackId, Event)]
avoid_exact_match Context
ctx
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(TrackId, Event)]
tracks forall a b. (a -> b) -> a -> b
$ \(TrackId
track_id, Event
event) -> do
            Int
tracknum <- forall (m :: * -> *). M m => BlockId -> TrackId -> m Int
Ui.get_tracknum_of BlockId
block_id TrackId
track_id
            -- It's confusing to modify collapsed tracks because you don't
            -- see the change.  TODO this is recreating the stuff in
            -- ModifyEvents.
            forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (forall (m :: * -> *). M m => BlockId -> Int -> m Bool
Ui.track_collapsed BlockId
block_id Int
tracknum) forall a b. (a -> b) -> a -> b
$ do
                forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.remove_event TrackId
track_id Event
event
                forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.insert_event TrackId
track_id forall a b. (a -> b) -> a -> b
$ (TrackTime, TrackTime) -> Event -> Event
modify (TrackTime
pos, TrackTime
pos) Event
event
    selection :: (TrackTime, TrackTime) -> m ()
selection (TrackTime, TrackTime)
range = forall (m :: * -> *). M m => Track m -> Context -> m ()
ModifyEvents.ctx_selection_visible
        (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 a b. (a -> b) -> [a] -> [b]
map ((TrackTime, TrackTime) -> Event -> Event
modify (TrackTime, TrackTime)
range)) Context
ctx

-- | Like 'Selection.events_around', but if a point selection is on an event
-- start, find a neighbor instead of matching that event.
avoid_exact_match :: Ui.M m => Selection.Context -> m [(TrackId, Event.Event)]
avoid_exact_match :: forall (m :: * -> *). M m => Context -> m [(TrackId, Event)]
avoid_exact_match Context
ctx =
    forall b b2 a. (b -> Maybe b2) -> [(a, b)] -> [(a, b2)]
Lists.mapMaybeSnd ([Event], [Event], [Event]) -> Maybe Event
select forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => Context -> m SelectedAround
Selection.ctx_events_around Context
ctx
    where
    point :: TrackTime
point = Selection -> TrackTime
Selection.sel_point (Context -> Selection
Selection.ctx_selection Context
ctx)
    select :: ([Event], [Event], [Event]) -> Maybe Event
select ([Event], [Event], [Event])
triple = case ([Event], [Event], [Event])
triple of
        ([Event]
_, [Event
within], [Event]
_) | Event -> TrackTime
Event.start Event
within forall a. Eq a => a -> a -> Bool
/= TrackTime
point -> forall a. a -> Maybe a
Just Event
within
        (Event
prev:[Event]
_, [Event
within], [Event]
_) | Event -> Bool
positive Event
within Bool -> Bool -> Bool
&& Event -> Bool
positive Event
prev -> forall a. a -> Maybe a
Just Event
prev
        ([Event]
_, [Event
within], Event
next:[Event]
_) | Event -> Bool
negative Event
within Bool -> Bool -> Bool
&& Event -> Bool
negative Event
next -> forall a. a -> Maybe a
Just Event
next
        ([Event], [Event], [Event])
_ -> forall a. Maybe a
Nothing
    positive :: Event -> Bool
positive = Event -> Bool
Event.is_positive
    negative :: Event -> Bool
negative = Event -> Bool
Event.is_negative

{- | Toggle duration between zero and non-zero.

    If the event is non-zero, then make it zero.  Otherwise, set its end to the
    cursor.  Unless the cursor is on the event start, and then extend it by
    a timestep.

    Also I previously used the same event selection strategy as
    'cmd_set_duration', which avoided the awkward point selection on zero-dur
    event case, but it turned out to be unintuitive to use in practice, because
    to toggle an event I'd have to put the selection on the next event.
-}
cmd_toggle_zero_timestep :: Cmd.M m => m ()
cmd_toggle_zero_timestep :: forall (m :: * -> *). M m => m ()
cmd_toggle_zero_timestep = do
    Selection
sel <- forall (m :: * -> *). M m => m Selection
Selection.get
    forall (m :: * -> *). M m => Track m -> m ()
ModifyEvents.selection_visible forall a b. (a -> b) -> a -> b
$ \BlockId
block_id TrackId
track_id [Event]
events -> do
        Int
tracknum <- forall (m :: * -> *). M m => BlockId -> TrackId -> m Int
Ui.get_tracknum_of BlockId
block_id TrackId
track_id
        let (TrackTime
start, TrackTime
end) = Selection -> (TrackTime, TrackTime)
Sel.range Selection
sel
        forall a. a -> Maybe a
Just 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 -> TrackTime -> TrackTime -> Event -> m Event
toggle_zero_timestep BlockId
block_id Int
tracknum TrackTime
start TrackTime
end) [Event]
events

toggle_zero_timestep :: Cmd.M m => BlockId -> TrackNum
    -> TrackTime -> TrackTime -> Event.Event -> m Event.Event
toggle_zero_timestep :: forall (m :: * -> *).
M m =>
BlockId -> Int -> TrackTime -> TrackTime -> Event -> m Event
toggle_zero_timestep BlockId
block_id Int
tracknum TrackTime
start TrackTime
end Event
event
    | Event -> TrackTime
Event.duration Event
event forall a. Eq a => a -> a -> Bool
/= TrackTime
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        Lens Event TrackTime
Event.duration_ forall f a. Lens f a -> a -> f -> f
#= (if Event -> Bool
Event.is_negative Event
event then -TrackTime
0 else TrackTime
0) forall a b. (a -> b) -> a -> b
$ Event
event
    | TrackTime
start forall a. Eq a => a -> a -> Bool
== TrackTime
end Bool -> Bool -> Bool
&& TrackTime
start forall a. Eq a => a -> a -> Bool
== Event -> TrackTime
Event.start Event
event = do
        TimeStep
step <- forall (m :: * -> *). M m => m TimeStep
Cmd.get_current_step
        Maybe TrackTime
maybe_pos <- forall (m :: * -> *).
M m =>
Int
-> TimeStep -> BlockId -> Int -> TrackTime -> m (Maybe TrackTime)
TimeStep.step_from
            (if Event -> Bool
Event.is_negative Event
event then -Int
1 else Int
1) TimeStep
step BlockId
block_id Int
tracknum
            TrackTime
start
        case Maybe TrackTime
maybe_pos of
            Maybe TrackTime
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Event
event
            Just TrackTime
pos -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TrackTime -> Event -> Event
Event.set_end TrackTime
pos Event
event
    | Event -> Bool
Event.is_negative Event
event =
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Lens Event TrackTime
Event.duration_ forall f a. Lens f a -> a -> f -> f
#= (TrackTime
start forall a. Num a => a -> a -> a
- Event -> TrackTime
Event.start Event
event) forall a b. (a -> b) -> a -> b
$ Event
event
    | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Lens Event TrackTime
Event.duration_ forall f a. Lens f a -> a -> f -> f
#= (TrackTime
end forall a. Num a => a -> a -> a
- Event -> TrackTime
Event.start Event
event) forall a b. (a -> b) -> a -> b
$ Event
event

-- | Move only the beginning of an event.  As is usual for zero duration
-- events, their duration will not be changed so this is equivalent to a move.
--
-- Other cmds are biased towards the previous event, i.e. they affect the
-- previous event if nothing is selected.  This cmd is a little different:
-- if it overlaps with an event, it will affect that one.  Otherwise, it
-- affects the next positive event or the previous negative event.  The idea
-- is that it's not very useful to clip an event to 0 by moving it past its
-- end, so let's not do that.  So it's like set_duration backwards: at does
-- nothing, otherwise get next positive or prev negative.
--
-- Unlike 'cmd_set_duration', I can't think of a way for this to make sense
-- with a non-point selection, so it uses the point position.
--
-- TODO for zero duration events, this is equivalent to
-- 'cmd_move_event_backward'.  I'm not totally happy about the overlap, is
-- there a more orthogonal organization?
cmd_set_start :: Cmd.M m => m ()
cmd_set_start :: forall (m :: * -> *). M m => m ()
cmd_set_start = do
    TrackTime
pos <- forall (m :: * -> *). M m => m TrackTime
Selection.point
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {m :: * -> *}. M m => TrackTime -> (TrackId, Event) -> m ()
process TrackTime
pos) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m [(TrackId, Event)]
Selection.opposite_neighbor
    where
    process :: TrackTime -> (TrackId, Event) -> m ()
process TrackTime
pos (TrackId
track_id, Event
event) = do
        forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.remove_event TrackId
track_id Event
event
        forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.insert_event TrackId
track_id forall a b. (a -> b) -> a -> b
$ TrackTime -> Event -> Event
set_start TrackTime
pos Event
event
    set_start :: TrackTime -> Event -> Event
set_start TrackTime
p Event
event
        | Event -> TrackTime
Event.duration Event
event forall a. Eq a => a -> a -> Bool
== TrackTime
0 = Lens Event TrackTime
Event.start_ forall f a. Lens f a -> a -> f -> f
#= TrackTime
p forall a b. (a -> b) -> a -> b
$ Event
event
        | Bool
otherwise = TrackTime -> Event -> Event
Event.set_start TrackTime
p Event
event

-- | Modify event durations by applying a function to them.  0 durations
-- are passed through, so you can't accidentally give control events duration.
modify_dur :: Cmd.M m => (ScoreTime -> ScoreTime) -> m ()
modify_dur :: forall (m :: * -> *). M m => (TrackTime -> TrackTime) -> m ()
modify_dur TrackTime -> TrackTime
f = forall (m :: * -> *). M m => Track m -> m ()
ModifyEvents.selection_visible forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => (Event -> Event) -> Track m
ModifyEvents.event forall a b. (a -> b) -> a -> b
$
    Lens Event TrackTime
Event.duration_ forall f a. Lens f a -> (a -> a) -> f -> f
%= TrackTime -> TrackTime
apply
    where apply :: TrackTime -> TrackTime
apply TrackTime
dur = if TrackTime
dur forall a. Eq a => a -> a -> Bool
== TrackTime
0 then TrackTime
dur else TrackTime -> TrackTime
f TrackTime
dur

-- | If there is a following event, delete it and extend this one to its end.
--
-- Since 0 dur events are never lengthened, joining control events simply
-- deletes the later ones.
--
-- If it's a point, only join up to (and including) the nearest event start.
-- Otherwise, if there's a collapsed pitch track and the next event doesn't
-- have a pitch event, it's easy to wind up deleting a distance pitch and not
-- noticing.
cmd_join_events :: Cmd.M m => m ()
cmd_join_events :: forall (m :: * -> *). M m => m ()
cmd_join_events = forall {m :: * -> *}. M m => SelectedAround -> m ()
join_selected forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m SelectedAround
Selection.events_around
    where
    join_selected :: SelectedAround -> m ()
join_selected SelectedAround
tracks = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {m :: * -> *}.
M m =>
Maybe TrackTime -> (TrackId, ([Event], [Event], [Event])) -> m ()
join_track Maybe TrackTime
nearest) SelectedAround
tracks
        where nearest :: Maybe TrackTime
nearest = 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 -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. (a, ([Event], [Event], [Event])) -> Maybe TrackTime
nearest_of SelectedAround
tracks
    nearest_of :: (a, ([Event], [Event], [Event])) -> Maybe TrackTime
nearest_of (a
_, ([Event]
prevs, [Event
cur], [Event]
nexts))
        | Event -> Bool
Event.is_positive Event
cur =
            forall a. Num a => a -> a -> a
subtract (Event -> TrackTime
Event.start Event
cur) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> TrackTime
Event.start forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe a
Lists.head [Event]
nexts
        | Bool
otherwise =
            forall a. Num a => a -> a -> a
subtract (Event -> TrackTime
Event.start Event
cur) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> TrackTime
Event.start forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe a
Lists.head [Event]
prevs
    nearest_of (a, ([Event], [Event], [Event]))
_ = forall a. Maybe a
Nothing

    join_track :: Maybe TrackTime -> (TrackId, ([Event], [Event], [Event])) -> m ()
join_track Maybe TrackTime
distance (TrackId
track_id, ([Event], [Event], [Event])
selected) = case ([Event], [Event], [Event])
selected of
        ([Event]
_, [Event
cur], Event
next:[Event]
_) | Event -> Bool
Event.is_positive Event
cur
                Bool -> Bool -> Bool
&& forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Event -> TrackTime
Event.start Event
next <=) Maybe TrackTime
nearest ->
            forall {m :: * -> *}. M m => TrackId -> Event -> Event -> m ()
join TrackId
track_id Event
cur Event
next
            where nearest :: Maybe TrackTime
nearest = (Event -> TrackTime
Event.start Event
cur +) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TrackTime
distance
        (Event
prev:[Event]
_, [Event
cur], [Event]
_) | Event -> Bool
Event.is_negative Event
cur
                Bool -> Bool -> Bool
&& forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Event -> TrackTime
Event.start Event
prev >=) Maybe TrackTime
nearest ->
            forall {m :: * -> *}. M m => TrackId -> Event -> Event -> m ()
join TrackId
track_id Event
prev Event
cur
            where nearest :: Maybe TrackTime
nearest = (Event -> TrackTime
Event.start Event
cur +) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TrackTime
distance
        ([Event]
_, events :: [Event]
events@(Event
_:Event
_:[Event]
_), [Event]
_) -> forall {m :: * -> *}. M m => TrackId -> Event -> Event -> m ()
join TrackId
track_id (forall a. [a] -> a
head [Event]
events) (forall a. [a] -> a
last [Event]
events)
        ([Event], [Event], [Event])
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    join :: TrackId -> Event -> Event -> m ()
join TrackId
track_id Event
evt1 Event
evt2 =
        case (Event -> Bool
Event.is_positive Event
evt1, Event -> Bool
Event.is_positive Event
evt2) of
            (Bool
True, Bool
True) -> do
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.remove_event TrackId
track_id) [Event
evt1, Event
evt2]
                forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.insert_event TrackId
track_id forall a b. (a -> b) -> a -> b
$
                    TrackTime -> Event -> Event
set_dur (Event -> TrackTime
Event.end Event
evt2 forall a. Num a => a -> a -> a
- Event -> TrackTime
Event.start Event
evt1) Event
evt1
            (Bool
False, Bool
False) -> do
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.remove_event TrackId
track_id) [Event
evt1, Event
evt2]
                forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.insert_event TrackId
track_id forall a b. (a -> b) -> a -> b
$ if Event -> TrackTime
Event.duration Event
evt2 forall a. Eq a => a -> a -> Bool
== TrackTime
0
                    then Event
evt2
                    else TrackTime -> Event -> Event
Event.set_end (Event -> TrackTime
Event.end Event
evt1) Event
evt2
            (Bool, Bool)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return () -- no sensible way to join these


-- | Split the events under the cursor.
cmd_split_events :: Cmd.M m => m ()
cmd_split_events :: forall (m :: * -> *). M m => m ()
cmd_split_events = do
    TrackTime
p <- forall (m :: * -> *). M m => m TrackTime
Selection.point
    forall (m :: * -> *). M m => Track m -> m ()
ModifyEvents.overlapping 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 (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (TrackTime -> Event -> [Event]
split TrackTime
p)
    where
    split :: TrackTime -> Event -> [Event]
split TrackTime
p Event
event
        | Bool -> Bool
not (TrackTime -> Event -> Bool
Event.overlaps TrackTime
p Event
event) Bool -> Bool -> Bool
|| TrackTime
p forall a. Eq a => a -> a -> Bool
== Event -> TrackTime
Event.start Event
event = [Event
event]
        | Bool
otherwise =
            [ Lens Event TrackTime
Event.duration_ forall f a. Lens f a -> a -> f -> f
#= TrackTime
p forall a. Num a => a -> a -> a
- Event -> TrackTime
Event.start Event
event forall a b. (a -> b) -> a -> b
$  Event
event
            , TrackTime -> TrackTime -> Event -> Event
Event.place TrackTime
p (Event -> TrackTime
Event.end Event
event forall a. Num a => a -> a -> a
- TrackTime
p) Event
event
            ]

-- | The same as 'Event.set_duration' except don't modify a zero dur event.
set_dur :: TrackTime -> Event.Event -> Event.Event
set_dur :: TrackTime -> Event -> Event
set_dur TrackTime
dur Event
evt
    | Event -> TrackTime
Event.duration Event
evt forall a. Eq a => a -> a -> Bool
== TrackTime
0 = Event
evt
    | Bool
otherwise = Lens Event TrackTime
Event.duration_ forall f a. Lens f a -> a -> f -> f
#= TrackTime
dur forall a b. (a -> b) -> a -> b
$ Event
evt

-- | Insert empty space at the beginning of the selection for the length of
-- the selection, pushing subsequent events forwards.  If the selection is
-- a point, insert one timestep.
cmd_insert_time :: Cmd.M m => m ()
cmd_insert_time :: forall (m :: * -> *). M m => m ()
cmd_insert_time = do
    (BlockId
block_id, [Int]
tracknums, [TrackId]
track_ids, Range
range) <- forall (m :: * -> *). M m => m (BlockId, [Int], [TrackId], Range)
Selection.tracks
    let (TrackTime
start, TrackTime
end) = Range -> (TrackTime, TrackTime)
Events.range_times Range
range
    (TrackTime
start, TrackTime
end) <- forall (m :: * -> *).
M m =>
[Int] -> TrackTime -> TrackTime -> m (TrackTime, TrackTime)
point_to_timestep [Int]
tracknums TrackTime
start TrackTime
end
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TrackTime
end forall a. Ord a => a -> a -> Bool
> TrackTime
start) forall a b. (a -> b) -> a -> b
$ 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 -> do
        Events
events <- forall (m :: * -> *). M m => TrackId -> m Events
Ui.get_events TrackId
track_id
        case TrackTime -> Events -> ([Event], [Event])
Events.split_at_before TrackTime
start Events
events of
            ([Event]
_, []) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            ([Event]
_, events :: [Event]
events@(Event
event:[Event]
_)) -> do
                forall (m :: * -> *).
M m =>
TrackId -> TrackTime -> (Events -> Events) -> m ()
Ui.modify_events_from TrackId
track_id (forall a. Ord a => a -> a -> a
min (Event -> TrackTime
Event.start Event
event) TrackTime
start)
                    (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty)
                -- The above won't get a negative event at start.
                forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.remove_event TrackId
track_id Event
event
                forall (m :: * -> *). M m => BlockId -> TrackId -> [Event] -> m ()
Ui.insert_block_events BlockId
block_id TrackId
track_id forall a b. (a -> b) -> a -> b
$
                    forall a b. (a -> b) -> [a] -> [b]
map (TrackTime -> TrackTime -> Event -> Event
insert_event_time TrackTime
start (TrackTime
endforall a. Num a => a -> a -> a
-TrackTime
start)) [Event]
events

-- | Modify the event to insert time, lengthening it if the start time falls
-- within the event's duration.
insert_event_time :: TrackTime -> TrackTime -> Event.Event -> Event.Event
insert_event_time :: TrackTime -> TrackTime -> Event -> Event
insert_event_time TrackTime
start TrackTime
shift Event
event
    | Event -> Bool
Event.is_positive Event
event = if
        | TrackTime
start forall a. Ord a => a -> a -> Bool
<= Event -> TrackTime
Event.start Event
event -> Lens Event TrackTime
Event.start_ forall f a. Lens f a -> (a -> a) -> f -> f
%= (forall a. Num a => a -> a -> a
+TrackTime
shift) forall a b. (a -> b) -> a -> b
$ Event
event
        | TrackTime
start forall a. Ord a => a -> a -> Bool
< Event -> TrackTime
Event.end Event
event -> Lens Event TrackTime
Event.duration_ forall f a. Lens f a -> (a -> a) -> f -> f
%= (forall a. Num a => a -> a -> a
+TrackTime
shift) forall a b. (a -> b) -> a -> b
$ Event
event
        | Bool
otherwise -> Event
event
    | Bool
otherwise = if
        | TrackTime
start forall a. Ord a => a -> a -> Bool
<= Event -> TrackTime
Event.end Event
event -> Lens Event TrackTime
Event.start_ forall f a. Lens f a -> (a -> a) -> f -> f
%= (forall a. Num a => a -> a -> a
+TrackTime
shift) forall a b. (a -> b) -> a -> b
$ Event
event
        | TrackTime
start forall a. Ord a => a -> a -> Bool
< Event -> TrackTime
Event.start Event
event ->
            TrackTime -> Event -> Event
Event.set_start (Event -> TrackTime
Event.start Event
event forall a. Num a => a -> a -> a
+ TrackTime
shift) Event
event
        | Bool
otherwise -> Event
event

-- | Remove the notes under the selection, and move everything else back.  If
-- the selection is a point, delete one timestep.
cmd_delete_time :: Cmd.M m => m ()
cmd_delete_time :: forall (m :: * -> *). M m => m ()
cmd_delete_time = do
    (BlockId
block_id, [Int]
tracknums, [TrackId]
track_ids, Range
range) <- forall (m :: * -> *). M m => m (BlockId, [Int], [TrackId], Range)
Selection.tracks
    let (TrackTime
start, TrackTime
end) = Range -> (TrackTime, TrackTime)
Events.range_times Range
range
    (TrackTime
start, TrackTime
end) <- forall (m :: * -> *).
M m =>
[Int] -> TrackTime -> TrackTime -> m (TrackTime, TrackTime)
point_to_timestep [Int]
tracknums TrackTime
start TrackTime
end
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TrackTime
end forall a. Ord a => a -> a -> Bool
> TrackTime
start) forall a b. (a -> b) -> a -> b
$ 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 =>
BlockId -> TrackId -> TrackTime -> TrackTime -> m ()
delete_time BlockId
block_id TrackId
track_id TrackTime
start (TrackTime
endforall a. Num a => a -> a -> a
-TrackTime
start)

-- | Delete the time range for all tracks in the block.
delete_block_time :: Ui.M m => BlockId -> TrackTime -> TrackTime -> m ()
delete_block_time :: forall (m :: * -> *).
M m =>
BlockId -> TrackTime -> TrackTime -> m ()
delete_block_time BlockId
block_id TrackTime
start TrackTime
dur = do
    [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 =>
BlockId -> TrackId -> TrackTime -> TrackTime -> m ()
delete_time BlockId
block_id TrackId
track_id TrackTime
start TrackTime
dur

delete_time :: Ui.M m => BlockId -> TrackId -> TrackTime -> TrackTime -> m ()
delete_time :: forall (m :: * -> *).
M m =>
BlockId -> TrackId -> TrackTime -> TrackTime -> m ()
delete_time BlockId
block_id TrackId
track_id TrackTime
start TrackTime
dur = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TrackTime
dur forall a. Ord a => a -> a -> Bool
< TrackTime
0) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. (Stack, M m) => Text -> m a
Ui.throw forall a b. (a -> b) -> a -> b
$ Text
"delete_time: negative dur " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty TrackTime
dur
    Events
events <- forall (m :: * -> *). M m => TrackId -> m Events
Ui.get_events TrackId
track_id
    case TrackTime -> Events -> ([Event], [Event])
Events.split_at_before TrackTime
start Events
events of
        ([Event]
_, []) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        ([Event]
_, events :: [Event]
events@(Event
event:[Event]
_)) -> do
            forall (m :: * -> *).
M m =>
TrackId -> TrackTime -> (Events -> Events) -> m ()
Ui.modify_events_from TrackId
track_id (forall a. Ord a => a -> a -> a
min (Event -> TrackTime
Event.start Event
event) TrackTime
start)
                (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty)
            -- The above won't get a negative event at start.
            forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.remove_event TrackId
track_id Event
event
            forall (m :: * -> *). M m => BlockId -> TrackId -> [Event] -> m ()
Ui.insert_block_events BlockId
block_id TrackId
track_id forall a b. (a -> b) -> a -> b
$
                forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (TrackTime -> TrackTime -> Event -> Maybe Event
delete_event_time TrackTime
start TrackTime
dur) [Event]
events

-- | Modify the event to delete time, shortening it the start time falls within
-- the event's duration, or removing it entirely if its 'Event.start' was
-- deleted.
--
-- This is more complicated than 'insert_event_time' because it can delete
-- events, and because the event may only be partially shortened if the range
-- overlaps its end.
delete_event_time :: TrackTime -> TrackTime -> Event.Event -> Maybe Event.Event
delete_event_time :: TrackTime -> TrackTime -> Event -> Maybe Event
delete_event_time TrackTime
start TrackTime
shift Event
event
    | Event -> Bool
Event.is_positive Event
event = if
        | TrackTime
end forall a. Ord a => a -> a -> Bool
<= Event -> TrackTime
Event.start Event
event ->
            forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Lens Event TrackTime
Event.start_ forall f a. Lens f a -> (a -> a) -> f -> f
%= forall a. Num a => a -> a -> a
subtract TrackTime
shift forall a b. (a -> b) -> a -> b
$ Event
event
        | TrackTime
start forall a. Ord a => a -> a -> Bool
< Event -> TrackTime
Event.start Event
event -> forall a. Maybe a
Nothing
        | TrackTime
start forall a. Ord a => a -> a -> Bool
< Event -> TrackTime
Event.end Event
event -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Lens Event TrackTime
Event.duration_ forall f a. Lens f a -> a -> f -> f
#=
            (forall a. Ord a => a -> a -> a
max (Event -> TrackTime
Event.duration Event
event forall a. Num a => a -> a -> a
- TrackTime
shift) (TrackTime
start forall a. Num a => a -> a -> a
- Event -> TrackTime
Event.start Event
event)) forall a b. (a -> b) -> a -> b
$
            Event
event
        | Bool
otherwise -> forall a. a -> Maybe a
Just Event
event
    | Bool
otherwise = if
        | TrackTime
end forall a. Ord a => a -> a -> Bool
<= Event -> TrackTime
Event.end Event
event ->
            forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Lens Event TrackTime
Event.start_ forall f a. Lens f a -> (a -> a) -> f -> f
%= forall a. Num a => a -> a -> a
subtract TrackTime
shift forall a b. (a -> b) -> a -> b
$ Event
event
        | TrackTime
end forall a. Ord a => a -> a -> Bool
< Event -> TrackTime
Event.start Event
event ->
            forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Lens Event TrackTime
Event.start_ forall f a. Lens f a -> (a -> a) -> f -> f
%= forall a. Num a => a -> a -> a
subtract TrackTime
shift forall a b. (a -> b) -> a -> b
$
                Lens Event TrackTime
Event.duration_ forall f a. Lens f a -> (a -> a) -> f -> f
%= (forall a. Num a => a -> a -> a
+ (forall a. Ord a => a -> a -> a
min (TrackTime
end forall a. Num a => a -> a -> a
- Event -> TrackTime
Event.end Event
event) TrackTime
shift)) forall a b. (a -> b) -> a -> b
$
                Event
event
        | TrackTime
start forall a. Ord a => a -> a -> Bool
< Event -> TrackTime
Event.start Event
event -> forall a. Maybe a
Nothing
        | Bool
otherwise -> forall a. a -> Maybe a
Just Event
event
    where end :: TrackTime
end = TrackTime
start forall a. Num a => a -> a -> a
+ TrackTime
shift

-- | If the range is a point, then expand it to one timestep.
point_to_timestep :: Cmd.M m => [TrackNum] -> TrackTime -> TrackTime
    -> m (TrackTime, TrackTime)
point_to_timestep :: forall (m :: * -> *).
M m =>
[Int] -> TrackTime -> TrackTime -> m (TrackTime, TrackTime)
point_to_timestep (Int
tracknum:[Int]
_) TrackTime
start TrackTime
end
    | TrackTime
start forall a. Eq a => a -> a -> Bool
== TrackTime
end = do
        BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
        TimeStep
step <- forall (m :: * -> *). M m => m TimeStep
Cmd.get_current_step
        Maybe TrackTime
pos <- forall (m :: * -> *).
M m =>
TimeStep -> BlockId -> Int -> TrackTime -> m (Maybe TrackTime)
TimeStep.advance TimeStep
step BlockId
block_id Int
tracknum TrackTime
end
        forall (m :: * -> *) a. Monad m => a -> m a
return (TrackTime
start, forall a. a -> Maybe a -> a
fromMaybe TrackTime
end Maybe TrackTime
pos)
    | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return (TrackTime
start, TrackTime
end)
point_to_timestep [] TrackTime
start TrackTime
end = forall (m :: * -> *) a. Monad m => a -> m a
return (TrackTime
start, TrackTime
end)

-- | If the insertion selection is a point, clear any event under it.  If it's
-- a range, clear all events within its half-open extent.
cmd_clear_selected :: Cmd.M m => m ()
cmd_clear_selected :: forall (m :: * -> *). M m => m ()
cmd_clear_selected = do
    (BlockId
_, [Int]
_, [TrackId]
track_ids, Range
range) <- forall (m :: * -> *). M m => m (BlockId, [Int], [TrackId], Range)
Selection.tracks
    forall (m :: * -> *). M m => [TrackId] -> Range -> m ()
clear_range [TrackId]
track_ids Range
range

clear_range :: Ui.M m => [TrackId] -> Events.Range -> m ()
clear_range :: forall (m :: * -> *). M m => [TrackId] -> Range -> m ()
clear_range [TrackId]
track_ids Range
range =
    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 -> Range -> m ()
Ui.remove_events_range TrackId
track_id Range
range

cmd_clear_and_advance :: Cmd.M m => m ()
cmd_clear_and_advance :: forall (m :: * -> *). M m => m ()
cmd_clear_and_advance = do
    Context
ctx <- forall (m :: * -> *). M m => m Context
Selection.context
    (BlockId
_, [Int]
_, [TrackId]
track_ids, Range
range) <- forall (m :: * -> *).
M m =>
Context -> m (BlockId, [Int], [TrackId], Range)
Selection.ctx_tracks Context
ctx
    let sel :: Selection
sel = Context -> Selection
Selection.ctx_selection Context
ctx
    let is_point :: Bool
is_point = Selection -> Bool
Sel.is_point Selection
sel Bool -> Bool -> Bool
&& Selection -> Int
Sel.start_track Selection
sel forall a. Eq a => a -> a -> Bool
== Selection -> Int
Sel.cur_track Selection
sel
    Bool
removed <- if Bool
is_point
        then Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events -> Bool
Events.null 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 (forall a. [a] -> a
head [TrackId]
track_ids)
        else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    forall (m :: * -> *). M m => [TrackId] -> Range -> m ()
clear_range [TrackId]
track_ids Range
range
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
is_point forall a b. (a -> b) -> a -> b
$ do
        -- Originally Cmd.NoteTrack deleted the pitch track too, but it seems
        -- more consistent to use the collapsed track if you want that.
        -- -- Clear out the pitch track too.
        -- maybe_pitch <- Info.pitch_of_note block_id sel_tracknum
        -- whenJust maybe_pitch $ \pitch -> EditUtil.remove_event_at
        --     (EditUtil.Pos block_id (Ui.track_tracknum pitch) pos 0)
        TimeStep
dur_step <- forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets forall a b. (a -> b) -> a -> b
$ EditState -> TimeStep
Cmd.state_note_duration forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EditState
Cmd.state_edit
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
removed Bool -> Bool -> Bool
&& TimeStep
dur_step forall a. Eq a => a -> a -> Bool
== TimeStep
TimeStep.event_edge) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *). M m => Context -> m ()
extend_previous Context
ctx
        forall (m :: * -> *). M m => m ()
Selection.advance

-- | Get previous event, if positive and its end >= pos, then set its end to
-- the next event or end of the block.  Or the reverse, if negative.
extend_previous :: Ui.M m => Selection.Context -> m ()
extend_previous :: forall (m :: * -> *). M m => Context -> m ()
extend_previous Context
ctx = do
    let block_id :: BlockId
block_id = Context -> BlockId
Selection.ctx_block_id Context
ctx
    Maybe TrackTime
prev <- forall (m :: * -> *).
M m =>
TimeStep -> BlockId -> Int -> TrackTime -> m (Maybe TrackTime)
TimeStep.rewind TimeStep
TimeStep.event_edge BlockId
block_id Int
tracknum TrackTime
pos
    Maybe TrackTime
next <- forall (m :: * -> *).
M m =>
TimeStep -> BlockId -> Int -> TrackTime -> m (Maybe TrackTime)
TimeStep.advance TimeStep
TimeStep.event_edge BlockId
block_id Int
tracknum TrackTime
pos
    forall (m :: * -> *).
M m =>
((TrackTime, TrackTime) -> Event -> Event) -> Context -> m ()
modify_neighbor (forall a b. a -> b -> a
const (Maybe TrackTime -> Maybe TrackTime -> Event -> Event
extend Maybe TrackTime
prev Maybe TrackTime
next)) Context
ctx
    where
    extend :: Maybe TrackTime -> Maybe TrackTime -> Event -> Event
extend Maybe TrackTime
prev Maybe TrackTime
next Event
event
        | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ TrackTime -> Event -> Bool
event_touches (Selection -> TrackTime
Selection.sel_point Selection
sel) Event
event = Event
event
        | Event -> Bool
Event.is_positive Event
event, Just TrackTime
next <- Maybe TrackTime
next =
            Lens Event TrackTime
Event.end_ forall f a. Lens f a -> a -> f -> f
#= TrackTime
next forall a b. (a -> b) -> a -> b
$ Event
event
        | Event -> Bool
Event.is_negative Event
event, Just TrackTime
prev <- Maybe TrackTime
prev =
            Lens Event TrackTime
Event.end_ forall f a. Lens f a -> a -> f -> f
#= TrackTime
prev forall a b. (a -> b) -> a -> b
$ Event
event
        | Bool
otherwise = Event
event
    sel :: Selection
sel = Context -> Selection
Selection.ctx_selection Context
ctx
    pos :: TrackTime
pos = Selection -> TrackTime
Selection.sel_point Selection
sel
    tracknum :: Int
tracknum = Selection -> Int
Selection.sel_point_track Selection
sel

event_touches :: TrackTime -> Event.Event -> Bool
event_touches :: TrackTime -> Event -> Bool
event_touches TrackTime
pos Event
event =
    Event -> TrackTime
Event.max Event
event TrackTime -> TrackTime -> Bool
ScoreTime.== TrackTime
pos Bool -> Bool -> Bool
|| Event -> TrackTime
Event.min Event
event TrackTime -> TrackTime -> Bool
ScoreTime.== TrackTime
pos

-- | Toggle the note duration between the end of the block, and the current
-- time step.
toggle_note_duration :: Cmd.M m => m ()
toggle_note_duration :: forall (m :: * -> *). M m => m ()
toggle_note_duration = do
    TimeStep
dur <- forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets forall a b. (a -> b) -> a -> b
$ EditState -> TimeStep
Cmd.state_note_duration forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EditState
Cmd.state_edit
    TimeStep
step <- forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets forall a b. (a -> b) -> a -> b
$ EditState -> TimeStep
Cmd.state_time_step forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EditState
Cmd.state_edit
    forall (m :: * -> *). M m => (EditState -> EditState) -> m ()
Cmd.modify_edit_state forall a b. (a -> b) -> a -> b
$ \EditState
st ->
        EditState
st { state_note_duration :: TimeStep
Cmd.state_note_duration = if TimeStep
dur forall a. Eq a => a -> a -> Bool
== TimeStep
to_end then TimeStep
step else TimeStep
to_end }
    where to_end :: TimeStep
to_end = TimeStep
TimeStep.event_edge

-- ** fancier start\/duration edits

cmd_set_call_duration :: Cmd.M m => m ()
cmd_set_call_duration :: forall (m :: * -> *). M m => m ()
cmd_set_call_duration = forall (m :: * -> *). M m => Track m -> m ()
ModifyEvents.selection_visible forall a b. (a -> b) -> a -> b
$
    \BlockId
block_id TrackId
track_id [Event]
events ->
        forall a. a -> Maybe a
Just 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 -> TrackId -> Event -> m Event
set_call_duration BlockId
block_id TrackId
track_id) [Event]
events

-- | Set the event duration to the CallDuration of its call.  For block calls,
-- this is the natural block duration.
set_call_duration :: Cmd.M m => BlockId -> TrackId -> Event.Event
    -> m Event.Event
set_call_duration :: forall (m :: * -> *). M m => BlockId -> TrackId -> Event -> m Event
set_call_duration BlockId
block_id TrackId
track_id Event
event =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe Event
event (\TrackTime
d -> Lens Event TrackTime
Event.duration_ forall f a. Lens f a -> a -> f -> f
#= TrackTime
d forall a b. (a -> b) -> a -> b
$ Event
event) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall (m :: * -> *).
M m =>
BlockId -> TrackId -> Event -> m (Maybe TrackTime)
lookup_call_duration BlockId
block_id TrackId
track_id Event
event

-- | Evaluate the given event to find its 'Derive.get_call_duration'.
lookup_call_duration :: Cmd.M m => BlockId -> TrackId -> Event.Event
    -> m (Maybe TrackTime)
lookup_call_duration :: forall (m :: * -> *).
M m =>
BlockId -> TrackId -> Event -> m (Maybe TrackTime)
lookup_call_duration BlockId
block_id TrackId
track_id Event
event =
    forall (m :: * -> *).
M m =>
BlockId -> TrackId -> Event -> m (Maybe NoteDeriver)
Perf.lookup_note_deriver BlockId
block_id TrackId
track_id Event
event forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe NoteDeriver
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        Just NoteDeriver
deriver -> do
            Either Error (CallDuration TrackTime)
result <- forall (m :: * -> *) a.
M m =>
BlockId -> TrackId -> Deriver a -> m a
Perf.derive_at_throw BlockId
block_id TrackId
track_id forall a b. (a -> b) -> a -> b
$
                forall a.
Deriver a -> Deriver (Either Error (CallDuration TrackTime))
Derive.get_score_duration NoteDeriver
deriver
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either Error (CallDuration TrackTime)
result of
                Left Error
_ -> forall a. Maybe a
Nothing
                Right CallDuration TrackTime
Derive.Unknown -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Event -> TrackTime
Event.duration Event
event
                Right (Derive.CallDuration TrackTime
dur) -> forall a. a -> Maybe a
Just TrackTime
dur

cmd_invert_orientation :: Cmd.M m => m ()
cmd_invert_orientation :: forall (m :: * -> *). M m => m ()
cmd_invert_orientation = do
    [TrackId]
track_ids <- forall (m :: * -> *). M m => m [TrackId]
Selection.track_ids
    let is_control :: TrackId -> m Bool
is_control = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Bool
ParseTitle.is_control_track forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). M m => TrackId -> m Text
Ui.get_track_title
    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 TrackId -> m Bool
is_control [TrackId]
track_ids) forall (m :: * -> *). M m => m ()
invert_events forall (m :: * -> *). M m => m ()
invert_notes

invert_events :: Cmd.M m => m ()
invert_events :: forall (m :: * -> *). M m => m ()
invert_events =
    forall (m :: * -> *).
M m =>
Collapsed -> Tracks m -> SelectedEvents -> m ()
ModifyEvents.modify_selected Collapsed
ModifyEvents.ExcludeCollapsed Tracks m
modify
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m SelectedEvents
Selection.events_at_point
    where
    modify :: Tracks m
modify = forall (m :: * -> *). Monad m => Track m -> Tracks m
ModifyEvents.track forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => (Event -> Event) -> Track m
ModifyEvents.event forall a b. (a -> b) -> a -> b
$ \Event
e ->
        Lens Event TrackTime
Event.start_ forall f a. Lens f a -> (a -> a) -> f -> f
%= (forall a. Num a => a -> a -> a
+ Event -> TrackTime
Event.duration Event
e) forall a b. (a -> b) -> a -> b
$ Lens Event TrackTime
Event.duration_ forall f a. Lens f a -> (a -> a) -> f -> f
%= forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ Event
e

invert_notes :: Cmd.M m => m ()
invert_notes :: forall (m :: * -> *). M m => m ()
invert_notes = forall (m :: * -> *). M m => ModifyNotes m -> m ()
ModifyNotes.selection forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => (Note -> Note) -> ModifyNotes m
ModifyNotes.note Note -> Note
invert
    where
    invert :: Note -> Note
invert Note
note = Note -> Note
invert_note forall a b. (a -> b) -> a -> b
$
        Note :-> Controls
ModifyNotes.controls forall f a. Lens f a -> (a -> a) -> f -> f
%= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Note -> Events -> Events
invert_control Note
note) forall a b. (a -> b) -> a -> b
$ Note
note
    invert_note :: Note -> Note
invert_note Note
note = Note :-> TrackTime
ModifyNotes.start forall f a. Lens f a -> (a -> a) -> f -> f
%= (forall a. Num a => a -> a -> a
+ Note -> TrackTime
ModifyNotes.note_duration Note
note) forall a b. (a -> b) -> a -> b
$
        Note :-> TrackTime
ModifyNotes.duration forall f a. Lens f a -> (a -> a) -> f -> f
%= forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ Note
note
    -- If there's exactly one event at the start time, I can flip it with the
    -- note.
    invert_control :: Note -> Events -> Events
invert_control Note
note Events
events = case Events -> [Event]
Events.ascending Events
events of
        [Event
event] | Event -> TrackTime
Event.duration Event
event forall a. Eq a => a -> a -> Bool
== TrackTime
0 Bool -> Bool -> Bool
&& Event -> TrackTime
Event.start Event
event forall a. Eq a => a -> a -> Bool
== TrackTime
start ->
            Event -> Events
Events.singleton forall a b. (a -> b) -> a -> b
$ Lens Event TrackTime
Event.duration_ forall f a. Lens f a -> a -> f -> f
#= TrackTime
dur forall a b. (a -> b) -> a -> b
$
                Lens Event TrackTime
Event.start_ forall f a. Lens f a -> a -> f -> f
#= Note -> TrackTime
ModifyNotes.note_end Note
note forall a b. (a -> b) -> a -> b
$ Event
event
        [Event]
_ -> Events
events
        where
        dur :: TrackTime
dur = case Note -> Orientation
ModifyNotes.note_orientation Note
note of
            Orientation
Types.Positive -> -TrackTime
0
            Orientation
Types.Negative -> TrackTime
0
        start :: TrackTime
start = Note -> TrackTime
ModifyNotes.note_start Note
note

-- * modify text

cmd_toggle_commented :: Cmd.M m => m ()
cmd_toggle_commented :: forall (m :: * -> *). M m => m ()
cmd_toggle_commented = forall (m :: * -> *). M m => Tracks m -> m ()
ModifyEvents.selection_tracks forall {m :: * -> *}.
Monad m =>
BlockId -> SelectedEvents -> m SelectedEvents
toggle
    where
    toggle :: BlockId -> SelectedEvents -> m SelectedEvents
toggle BlockId
block_id SelectedEvents
track_events
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Event -> Bool
is_commented) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) SelectedEvents
track_events =
            forall {m :: * -> *}. Monad m => (Text -> Text) -> m SelectedEvents
modify forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
cmt)
        | Bool
otherwise = forall {m :: * -> *}. Monad m => (Text -> Text) -> m SelectedEvents
modify forall a b. (a -> b) -> a -> b
$ \Text
t ->
            if Text
cmt Text -> Text -> Bool
`Text.isPrefixOf` Text
t then Text
t else Text
"--|" forall a. Semigroup a => a -> a -> a
<> Text
t
        where
        modify :: (Text -> Text) -> m SelectedEvents
modify Text -> Text
f = forall (m :: * -> *). Monad m => Track m -> Tracks m
ModifyEvents.track (forall (m :: * -> *). Monad m => (Text -> Text) -> Track m
ModifyEvents.text Text -> Text
f)
            BlockId
block_id SelectedEvents
track_events
    is_commented :: Event -> Bool
is_commented = (Text
cmt `Text.isPrefixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Text
Event.text
    cmt :: Text
cmt = Text
"--|"

-- | Strip off the first transformer, and then the generator.
strip_transformer :: Cmd.M m => m ()
strip_transformer :: forall (m :: * -> *). M m => m ()
strip_transformer = do
    forall (m :: * -> *). M m => Track m -> m ()
ModifyEvents.selected_track forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). Monad m => (Text -> Text) -> Track m
ModifyEvents.text forall a b. (a -> b) -> a -> b
$ ([[Text]] -> [[Text]]) -> Text -> Text
ModifyEvents.pipeline forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1
    forall (m :: * -> *). M m => m ()
ModifyEvents.advance_if_point

-- * record action

-- | If you create a new event, and there is explicit duration, then use it.
make_action :: Maybe Text -> Text -> Maybe TrackTime -> Cmd.Action
make_action :: Maybe Text -> Text -> Maybe TrackTime -> Action
make_action Maybe Text
maybe_old Text
new Maybe TrackTime
dur = case Maybe Text
maybe_old of
    Maybe Text
Nothing -> Maybe TrackTime -> Text -> Action
Cmd.InsertEvent Maybe TrackTime
dur Text
new
    Just Text
old
        -- This is a way to record a ReplaceText for an existing event.
        | Text
old forall a. Eq a => a -> a -> Bool
== Text
new Bool -> Bool -> Bool
|| Text
old forall a. Eq a => a -> a -> Bool
== Text
"" -> Text -> Action
Cmd.ReplaceText Text
new
        | Text
old Text -> Text -> Bool
`Text.isPrefixOf` Text
new ->
            Text -> Action
Cmd.AppendText forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
old) Text
new
        | Text
old Text -> Text -> Bool
`Text.isSuffixOf` Text
new ->
            Text -> Action
Cmd.PrependText forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.take (Text -> Int
Text.length Text
new forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
old) Text
new
        | Bool
otherwise -> Text -> Action
Cmd.ReplaceText Text
new

insert_recorded_action :: Cmd.M m => Char -> Cmd.Action -> m ()
insert_recorded_action :: forall (m :: * -> *). M m => Char -> Action -> m ()
insert_recorded_action Char
key Action
action = forall (m :: * -> *). M m => (EditState -> EditState) -> m ()
Cmd.modify_edit_state forall a b. (a -> b) -> a -> b
$ \EditState
st -> EditState
st
    { state_recorded_actions :: RecordedActions
Cmd.state_recorded_actions =
        forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Char
key Action
action (EditState -> RecordedActions
Cmd.state_recorded_actions EditState
st)
    }

save_last_action_to :: Cmd.M m => Char -> m ()
save_last_action_to :: forall (m :: * -> *). M m => Char -> m ()
save_last_action_to Char
key = forall (m :: * -> *). M m => Char -> Action -> m ()
insert_recorded_action Char
key forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => Char -> m Action
get_action Char
'.'

run_action_at :: Cmd.M m => Char -> m ()
run_action_at :: forall (m :: * -> *). M m => Char -> m ()
run_action_at Char
key = forall (m :: * -> *). M m => Action -> m ()
run_action forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => Char -> m Action
get_action Char
key

get_action :: Cmd.M m => Char -> m Cmd.Action
get_action :: forall (m :: * -> *). M m => Char -> m Action
get_action Char
key = forall (m :: * -> *) a. M m => Maybe a -> m a
Cmd.abort_unless
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Char
key forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditState -> RecordedActions
Cmd.state_recorded_actions forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EditState
Cmd.state_edit)

run_action :: Cmd.M m => Cmd.Action -> m ()
run_action :: forall (m :: * -> *). M m => Action -> m ()
run_action Action
action = do
    Pos
pos <- forall (m :: * -> *). M m => m Pos
EditUtil.get_pos
    let modify :: Modify -> m ()
modify = forall (m :: * -> *). M m => Pos -> Bool -> Bool -> Modify -> m ()
EditUtil.modify_event_at Pos
pos Bool
False Bool
False
    case Action
action of
        Cmd.InsertEvent Maybe TrackTime
maybe_dur Text
text -> do
            let new_pos :: Pos
new_pos = case Pos
pos of
                    EditUtil.Pos BlockId
block_id Int
tracknum TrackTime
start TrackTime
_dur ->
                        BlockId -> Int -> TrackTime -> TrackTime -> Pos
EditUtil.Pos BlockId
block_id Int
tracknum TrackTime
start
                            (forall a. a -> Maybe a -> a
fromMaybe TrackTime
0 Maybe TrackTime
maybe_dur)
            forall (m :: * -> *). M m => Pos -> Bool -> Bool -> Modify -> m ()
EditUtil.modify_event_at Pos
new_pos (Maybe TrackTime
maybe_dur forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just TrackTime
0) Bool
True forall a b. (a -> b) -> a -> b
$
                forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just Text
text, Bool
True)
        Cmd.ReplaceText Text
text -> Modify -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just Text
text, Bool
True)
        Cmd.PrependText Text
text -> Modify -> m ()
modify forall a b. (a -> b) -> a -> b
$ \Maybe Text
old -> case Maybe Text
old of
            Maybe Text
Nothing -> (forall a. Maybe a
Nothing, Bool
False)
            Just Text
old -> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text
text forall a. Semigroup a => a -> a -> a
<> Text
old, Bool
True)
        Cmd.AppendText Text
text -> Modify -> m ()
modify forall a b. (a -> b) -> a -> b
$ \Maybe Text
old -> case Maybe Text
old of
            Maybe Text
Nothing -> (forall a. Maybe a
Nothing, Bool
False)
            Just Text
old -> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text
old forall a. Semigroup a => a -> a -> a
<> Text
text, Bool
True)

-- * floating text input

append_text :: Cmd.M m => m Cmd.Status
append_text :: forall (m :: * -> *). M m => m Status
append_text = forall (m :: * -> *). M m => (Text -> (Int, Int)) -> m Status
open_floating (\Text
text -> (Text -> Int
Text.length Text
text, Text -> Int
Text.length Text
text))

prepend_text :: Cmd.M m => m Cmd.Status
prepend_text :: forall (m :: * -> *). M m => m Status
prepend_text = forall (m :: * -> *). M m => (Text -> (Int, Int)) -> m Status
open_floating (forall a b. a -> b -> a
const (Int
0, Int
0))

-- | This will be fooled by a @|@ inside a string, but I'll fix that if it's
-- ever actually a problem.
replace_first_call :: Cmd.M m => m Cmd.Status
replace_first_call :: forall (m :: * -> *). M m => m Status
replace_first_call = forall (m :: * -> *). M m => (Text -> (Int, Int)) -> m Status
open_floating forall a b. (a -> b) -> a -> b
$ \Text
text -> case Stack => Text -> Text -> (Text, Text)
Text.breakOn Text
"|" Text
text of
    (Text
pre, Text
_) ->
        let space :: Bool
space = Text
" " Text -> Text -> Bool
`Text.isSuffixOf` Text
pre
        in (Int
0, Text -> Int
Text.length Text
pre forall a. Num a => a -> a -> a
- (if Bool
space then Int
1 else Int
0))

replace_last_call :: Cmd.M m => m Cmd.Status
replace_last_call :: forall (m :: * -> *). M m => m Status
replace_last_call = forall (m :: * -> *). M m => (Text -> (Int, Int)) -> m Status
open_floating forall a b. (a -> b) -> a -> b
$ \Text
text -> case Stack => Text -> Text -> (Text, Text)
Text.breakOnEnd Text
"|" Text
text of
    (Text
pre, Text
post) ->
        let space :: Bool
space = Text
" " Text -> Text -> Bool
`Text.isPrefixOf` Text
post
        in (Text -> Int
Text.length Text
pre forall a. Num a => a -> a -> a
+ (if Bool
space then Int
1 else Int
0), Text -> Int
Text.length Text
text)

-- | If a selection is used to create an event, this is where the event's start
-- is.
edit_point :: Sel.Selection -> TrackTime
edit_point :: Selection -> TrackTime
edit_point Selection
sel = case Selection -> Orientation
Sel.orientation Selection
sel of
    Orientation
Sel.Negative -> Selection -> TrackTime
Sel.max Selection
sel
    Orientation
_ -> Selection -> TrackTime
Sel.min Selection
sel

-- | Open a floating text entry with a selection set.
open_floating :: Cmd.M m => (Text -> (Int, Int)) -> m Cmd.Status
open_floating :: forall (m :: * -> *). M m => (Text -> (Int, Int)) -> m Status
open_floating Text -> (Int, Int)
selection = do
    (ViewId
view_id, Selection
sel) <- forall (m :: * -> *). M m => m (ViewId, Selection)
Selection.get_view_sel
    (BlockId
_, Int
tracknum, TrackId
track_id, TrackTime
_) <- forall (m :: * -> *). M m => m (BlockId, Int, TrackId, TrackTime)
Selection.get_insert
    let pos :: TrackTime
pos = Selection -> TrackTime
edit_point Selection
sel
    Maybe Event
maybe_event <- forall (m :: * -> *).
M m =>
TrackId -> TrackTime -> Orientation -> m (Maybe Event)
event_at TrackId
track_id TrackTime
pos (Selection -> Orientation
Sel.event_orientation Selection
sel)
    let text :: Text
text = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Event -> Text
Event.text Maybe Event
maybe_event
        orient :: Orientation
orient = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Selection -> Orientation
Sel.event_orientation Selection
sel) Event -> Orientation
Event.orientation Maybe Event
maybe_event
    Zoom
zoom <- View -> Zoom
Block.view_zoom 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
    -- If I'm editing or opening a negative event, move the input up since
    -- the text will also be above the trigger.
    let open_pos :: TrackTime
open_pos = TrackTime
pos forall a. Num a => a -> a -> a
- case Orientation
orient of
            Orientation
Types.Negative -> Zoom -> Int -> TrackTime
Zoom.to_time Zoom
zoom Int
Config.track_title_height
            Orientation
Types.Positive -> TrackTime
0
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FloatingInput -> Status
Cmd.FloatingInput forall a b. (a -> b) -> a -> b
$ ViewId -> Int -> TrackTime -> Text -> (Int, Int) -> FloatingInput
Cmd.FloatingOpen ViewId
view_id Int
tracknum TrackTime
open_pos Text
text
        (Text -> (Int, Int)
selection Text
text)

event_text_at :: Ui.M m => TrackId -> TrackTime -> Types.Orientation
    -> m (Maybe Text)
event_text_at :: forall (m :: * -> *).
M m =>
TrackId -> TrackTime -> Orientation -> m (Maybe Text)
event_text_at TrackId
track_id TrackTime
pos = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event -> Text
Event.text) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
M m =>
TrackId -> TrackTime -> Orientation -> m (Maybe Event)
event_at TrackId
track_id TrackTime
pos

event_at :: Ui.M m => TrackId -> TrackTime -> Types.Orientation
    -> m (Maybe Event.Event)
event_at :: forall (m :: * -> *).
M m =>
TrackId -> TrackTime -> Orientation -> m (Maybe Event)
event_at TrackId
track_id TrackTime
pos Orientation
orient = TrackTime -> Orientation -> Events -> Maybe Event
Events.at TrackTime
pos Orientation
orient 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

-- ** handle floating input msg

-- | Handle UpdateInput that comes back from the floating input.
--
-- A leading space will create a zero duration event.
handle_floating_input :: Cmd.M m =>
    Bool -- ^ True to always create a zero duration event.
    -> Msg.Msg -> m Cmd.Status
handle_floating_input :: forall (m :: * -> *). M m => Bool -> Msg -> m Status
handle_floating_input Bool
always_zero_dur Msg
msg = do
    Text
text <- forall (m :: * -> *) a. M m => Maybe a -> m a
Cmd.abort_unless forall a b. (a -> b) -> a -> b
$ Msg -> Maybe Text
floating_input_msg Msg
msg
    EditUtil.Pos BlockId
block_id Int
tracknum TrackTime
start TrackTime
dur <- forall (m :: * -> *). M m => m Pos
EditUtil.get_pos
    TrackId
track_id <- forall (m :: * -> *) a. (Stack, M m) => Text -> Maybe a -> m a
Cmd.require Text
"handle_floating_input on non-event track"
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => BlockId -> Int -> m (Maybe TrackId)
Ui.event_track_at BlockId
block_id Int
tracknum
    Maybe Text
old_text <- forall (m :: * -> *).
M m =>
TrackId -> TrackTime -> Orientation -> m (Maybe Text)
event_text_at TrackId
track_id TrackTime
start (TrackTime -> Orientation
Event.orientation_of TrackTime
dur)
    let zero_dur :: Bool
zero_dur = Bool
always_zero_dur Bool -> Bool -> Bool
|| Text
" " Text -> Text -> Bool
`Text.isPrefixOf` Text
text
    forall (m :: * -> *). M m => Pos -> Bool -> Bool -> Modify -> m ()
EditUtil.modify_event_at (BlockId -> Int -> TrackTime -> TrackTime -> Pos
EditUtil.Pos BlockId
block_id Int
tracknum TrackTime
start TrackTime
dur)
        Bool
zero_dur Bool
False (forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just (Text -> Text
Text.strip Text
text), Bool
False))
    -- 0 dur means a point selection, which means to use the time step.
    forall (m :: * -> *). M m => Char -> Action -> m ()
insert_recorded_action Char
'.' forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Maybe TrackTime -> Action
make_action Maybe Text
old_text (Text -> Text
Text.strip Text
text) forall a b. (a -> b) -> a -> b
$ if
        | Bool
zero_dur -> forall a. a -> Maybe a
Just (if TrackTime -> Bool
ScoreTime.is_negative TrackTime
dur then -TrackTime
0 else TrackTime
0)
        | TrackTime
dur forall a. Eq a => a -> a -> Bool
== TrackTime
0 -> forall a. Maybe a
Nothing
        | Bool
otherwise -> forall a. a -> Maybe a
Just TrackTime
dur
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Text
old_text forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
M m =>
BlockId -> TrackId -> TrackTime -> Orientation -> m ()
try_set_call_duration BlockId
block_id TrackId
track_id TrackTime
start (TrackTime -> Orientation
Event.orientation_of TrackTime
dur)
    forall (m :: * -> *) a. Monad m => a -> m a
return Status
Cmd.Done

-- | Set the event's duration to its CallDuration, if it has one.
try_set_call_duration :: Cmd.M m => BlockId -> TrackId -> TrackTime
    -> Types.Orientation -> m ()
try_set_call_duration :: forall (m :: * -> *).
M m =>
BlockId -> TrackId -> TrackTime -> Orientation -> m ()
try_set_call_duration BlockId
block_id TrackId
track_id TrackTime
pos Orientation
orient =
    forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> (a -> m ()) -> m ()
whenJustM (forall (m :: * -> *).
M m =>
TrackId -> TrackTime -> Orientation -> m (Maybe Event)
event_at TrackId
track_id TrackTime
pos Orientation
orient) forall a b. (a -> b) -> a -> b
$ \Event
event ->
        forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> (a -> m ()) -> m ()
whenJustM (forall (m :: * -> *).
M m =>
BlockId -> TrackId -> Event -> m (Maybe TrackTime)
lookup_call_duration BlockId
block_id TrackId
track_id Event
event) forall a b. (a -> b) -> a -> b
$ \TrackTime
dur ->
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TrackTime
dur forall a. Eq a => a -> a -> Bool
/= Event -> TrackTime
Event.duration Event
event) forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.insert_event TrackId
track_id (Lens Event TrackTime
Event.duration_ forall f a. Lens f a -> a -> f -> f
#= TrackTime
dur forall a b. (a -> b) -> a -> b
$ Event
event)

floating_input_msg :: Msg.Msg -> Maybe Text
floating_input_msg :: Msg -> Maybe Text
floating_input_msg (Msg.Ui (UiMsg.UiMsg Context
ctx
        (UiMsg.UiUpdate ViewId
_ (UiMsg.UpdateInput (Just Text
text)))))
    | Context -> Bool
UiMsg.ctx_floating_input Context
ctx = forall a. a -> Maybe a
Just Text
text
floating_input_msg Msg
_ = forall a. Maybe a
Nothing