-- 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 ViewPatterns #-}
{- | Cmds to add notes to a note track.

    This module is sister to "Derive.Note" since it edits events that
    Derive.Note parses.

    Note events are usually given a duration of the current time step.  If a
    "trigger only" instrument (e.g. percussion) is in scope, they are created
    with zero duration.  Also, starting a raw edit with space will create a
    zero duration event.
-}
module Cmd.NoteTrack (
    ControlTrack(..)
    , cmd_val_edit
    , cmd_method_edit
) where
import qualified Data.List as List
import qualified Data.Map as Map

import qualified Util.Lists as Lists
import qualified App.Config as Config
import qualified Cmd.Cmd as Cmd
import qualified Cmd.ControlTrack as ControlTrack
import qualified Cmd.Create as Create
import qualified Cmd.EditUtil as EditUtil
import qualified Cmd.Info as Info
import qualified Cmd.InputNote as InputNote
import qualified Cmd.Msg as Msg
import qualified Cmd.PitchTrack as PitchTrack
import qualified Cmd.Selection as Selection

import qualified Derive.Controls as Controls
import qualified Derive.ParseTitle as ParseTitle
import qualified Derive.ScoreT as ScoreT

import qualified Ui.Event as Event
import qualified Ui.Events as Events
import qualified Ui.Sel as Sel
import qualified Ui.Types as Types
import qualified Ui.Ui as Ui

import           Global
import           Types


-- * val edit

-- | A control track belonging to the note track.  This can be a pitch track,
-- or a dyn track.
data ControlTrack = ControlTrack {
    ControlTrack -> TrackNum
track_note :: TrackNum
    , ControlTrack -> TrackNum
track_control :: TrackNum
    } deriving (TrackNum -> ControlTrack -> ShowS
[ControlTrack] -> ShowS
ControlTrack -> String
forall a.
(TrackNum -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControlTrack] -> ShowS
$cshowList :: [ControlTrack] -> ShowS
show :: ControlTrack -> String
$cshow :: ControlTrack -> String
showsPrec :: TrackNum -> ControlTrack -> ShowS
$cshowsPrec :: TrackNum -> ControlTrack -> ShowS
Show, ControlTrack -> ControlTrack -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControlTrack -> ControlTrack -> Bool
$c/= :: ControlTrack -> ControlTrack -> Bool
== :: ControlTrack -> ControlTrack -> Bool
$c== :: ControlTrack -> ControlTrack -> Bool
Eq)

-- | The val edit for note tracks edits its pitch track (possibly creating one
-- if necessary), and creates a blank event on the note track.  It may also
-- edit multiple pitch tracks for chords, or record velocity in addition to
-- pitch.
--
-- If I'm in chord mode, try to find the next track and put notes there.  If
-- there is no appropriate next track, the cmd will throw an error.
cmd_val_edit :: Cmd.M m => Msg.Msg -> m Cmd.Status
cmd_val_edit :: forall (m :: * -> *). M m => Msg -> m Status
cmd_val_edit Msg
msg = forall (m :: * -> *) a. M m => EditMode -> Text -> m a -> m a
Cmd.suppress_history EditMode
Cmd.ValEdit Text
"note track val edit" forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *). M m => Fallthrough -> Msg -> m ()
EditUtil.fallthrough Fallthrough
EditUtil.NoBackspace Msg
msg
    EditUtil.Pos BlockId
block_id TrackNum
sel_tracknum TrackTime
pos TrackTime
dur <- forall (m :: * -> *). M m => m Pos
EditUtil.get_pos
    case Msg
msg of
        Msg.InputNote Input
input_note -> case Input
input_note of
            InputNote.NoteOn NoteId
note_id Input
input Y
vel -> do
                Note
note <- forall (m :: * -> *). M m => Input -> m Note
EditUtil.input_to_note Input
input
                forall {m :: * -> *}.
M m =>
BlockId
-> TrackNum
-> TrackTime
-> TrackTime
-> NoteId
-> Note
-> Y
-> m ()
note_on BlockId
block_id TrackNum
sel_tracknum TrackTime
pos TrackTime
dur NoteId
note_id Note
note Y
vel
            InputNote.PitchChange NoteId
note_id Input
input -> do
                (TrackNum
pitch_tracknum, TrackId
track_id) <- forall (m :: * -> *) a. (Stack, M m) => Text -> Maybe a -> m a
Cmd.require
                    (Text
"no track for note_id " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt NoteId
note_id)
                    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
M m =>
NoteId -> m (Maybe (TrackNum, TrackId))
find_pitch_track NoteId
note_id
                Note
note <- forall (m :: * -> *). M m => Input -> m Note
EditUtil.input_to_note Input
input
                -- If advance is set, the selection may have advanced past
                -- the pitch's position, so look for a previous event.
                TrackTime
pos <- forall (m :: * -> *). M m => TrackId -> TrackTime -> m TrackTime
event_pos_at_or_before TrackId
track_id TrackTime
pos
                forall (m :: * -> *). M m => Pos -> Note -> m ()
PitchTrack.val_edit_at
                    (BlockId -> TrackNum -> TrackTime -> TrackTime -> Pos
EditUtil.Pos BlockId
block_id TrackNum
pitch_tracknum TrackTime
pos TrackTime
dur) Note
note
            InputNote.NoteOff NoteId
note_id Y
_vel -> do
                forall {m :: * -> *}. M m => NoteId -> m ()
dissociate_note_id NoteId
note_id
                Bool
chord_done <- forall (m :: * -> *). Monad m => [m Bool] -> m Bool
andM [forall (m :: * -> *) a. M m => (EditState -> a) -> m a
get_state EditState -> Bool
Cmd.state_chord, forall (m :: * -> *). M m => m Bool
all_keys_up]
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
chord_done forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. M m => TrackTime -> Maybe TrackNum -> m ()
set_temp_sel TrackTime
pos forall a. Maybe a
Nothing
                forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall (m :: * -> *). Monad m => [m Bool] -> m Bool
andM [forall (m :: * -> *) a. Monad m => a -> m a
return Bool
chord_done, forall (m :: * -> *) a. M m => (EditState -> a) -> m a
get_state EditState -> Bool
Cmd.state_advance])
                    forall (m :: * -> *). M m => m ()
Selection.advance
            InputNote.Control {} -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Msg
_ -> forall (m :: * -> *) a. M m => m a
Cmd.abort
    forall (m :: * -> *) a. Monad m => a -> m a
return Status
Cmd.Done
    where
    -- NoteOn handling is especially complicated.
    note_on :: BlockId
-> TrackNum
-> TrackTime
-> TrackTime
-> NoteId
-> Note
-> Y
-> m ()
note_on BlockId
block_id TrackNum
sel_tracknum TrackTime
pos TrackTime
dur NoteId
note_id Note
note Y
vel = do
        Bool
chord_mode <- forall (m :: * -> *) a. M m => (EditState -> a) -> m a
get_state EditState -> Bool
Cmd.state_chord
        -- Pitch track.
        (ControlTrack
ctrack, Bool
create) <- if Bool
chord_mode
            then do
                (ControlTrack
ctrack, Bool
create, Maybe TrackNum
maybe_next) <-
                    forall (m :: * -> *).
M m =>
BlockId
-> TrackNum
-> (Text -> Bool)
-> m (ControlTrack, Bool, Maybe TrackNum)
next_control_track BlockId
block_id TrackNum
sel_tracknum Text -> Bool
is_pitch
                forall {m :: * -> *}. M m => TrackTime -> Maybe TrackNum -> m ()
set_temp_sel TrackTime
pos Maybe TrackNum
maybe_next
                forall (m :: * -> *) a. Monad m => a -> m a
return (ControlTrack
ctrack, Bool
create)
            else forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> (Text -> Bool) -> m (ControlTrack, Bool)
this_control_track BlockId
block_id TrackNum
sel_tracknum Text -> Bool
is_pitch
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
create forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => BlockId -> ControlTrack -> m ()
create_pitch_track BlockId
block_id ControlTrack
ctrack
        forall {m :: * -> *}. M m => BlockId -> TrackNum -> NoteId -> m ()
associate_note_id BlockId
block_id (ControlTrack -> TrackNum
track_control ControlTrack
ctrack) NoteId
note_id
        Orientation
orient <- forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets (EditState -> Orientation
Cmd.state_note_orientation forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EditState
Cmd.state_edit)
        let pitch_pos :: Pos
pitch_pos = BlockId -> TrackNum -> TrackTime -> TrackTime -> Pos
EditUtil.Pos BlockId
block_id (ControlTrack -> TrackNum
track_control ControlTrack
ctrack)
                TrackTime
pos (if Orientation
orient forall a. Eq a => a -> a -> Bool
== Orientation
Types.Positive then TrackTime
0 else -TrackTime
0)
        forall (m :: * -> *). M m => Pos -> Note -> m ()
PitchTrack.val_edit_at Pos
pitch_pos Note
note
        -- Dyn track.
        forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall (m :: * -> *) a. M m => (EditState -> a) -> m a
get_state EditState -> Bool
Cmd.state_record_velocity) forall a b. (a -> b) -> a -> b
$ do
            (ControlTrack
dtrack, Bool
create) <- if Bool
chord_mode
                then (\(ControlTrack
a, Bool
b, Maybe TrackNum
_) -> (ControlTrack
a, Bool
b)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    forall (m :: * -> *).
M m =>
BlockId
-> TrackNum
-> (Text -> Bool)
-> m (ControlTrack, Bool, Maybe TrackNum)
next_control_track BlockId
block_id TrackNum
sel_tracknum Text -> Bool
is_dyn
                else forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> (Text -> Bool) -> m (ControlTrack, Bool)
this_control_track BlockId
block_id TrackNum
sel_tracknum Text -> Bool
is_dyn
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
create forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => BlockId -> ControlTrack -> m ()
create_dyn_track BlockId
block_id ControlTrack
dtrack
            forall (m :: * -> *). M m => Pos -> Y -> m ()
ControlTrack.val_edit_at
                (BlockId -> TrackNum -> TrackTime -> TrackTime -> Pos
EditUtil.Pos BlockId
block_id (ControlTrack -> TrackNum
track_control ControlTrack
dtrack) TrackTime
pos TrackTime
0) Y
vel

        -- Create note and advance.
        forall (m :: * -> *). M m => Pos -> m ()
ensure_note_event (BlockId -> TrackNum -> TrackTime -> TrackTime -> Pos
EditUtil.Pos BlockId
block_id (ControlTrack -> TrackNum
track_note ControlTrack
ctrack) TrackTime
pos TrackTime
dur)
        Bool
advance_mode <- forall (m :: * -> *) a. M m => (EditState -> a) -> m a
get_state EditState -> Bool
Cmd.state_advance
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
advance_mode Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
chord_mode) forall (m :: * -> *). M m => m ()
Selection.advance

    is_pitch :: Text -> Bool
is_pitch = Text -> Bool
ParseTitle.is_pitch_track
    is_dyn :: Text -> Bool
is_dyn = (forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Control
Controls.dynamic) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Control
ParseTitle.title_to_control
    set_temp_sel :: TrackTime -> Maybe TrackNum -> m ()
set_temp_sel TrackTime
pos Maybe TrackNum
maybe_tracknum = forall (m :: * -> *). M m => TrackNum -> Maybe Selection -> m ()
Selection.set_current
        TrackNum
Config.temporary_insert_selnum forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TrackNum
num -> TrackNum -> TrackTime -> Orientation -> Selection
Sel.point TrackNum
num TrackTime
pos Orientation
Sel.Positive) Maybe TrackNum
maybe_tracknum
    dissociate_note_id :: NoteId -> m ()
dissociate_note_id NoteId
note_id = forall (m :: * -> *).
M m =>
(WriteDeviceState -> WriteDeviceState) -> m ()
Cmd.modify_wdev_state forall a b. (a -> b) -> a -> b
$ \WriteDeviceState
st -> WriteDeviceState
st
        { wdev_pitch_track :: Map NoteId (BlockId, TrackNum)
Cmd.wdev_pitch_track = forall k a. Ord k => k -> Map k a -> Map k a
Map.delete NoteId
note_id (WriteDeviceState -> Map NoteId (BlockId, TrackNum)
Cmd.wdev_pitch_track WriteDeviceState
st) }
    associate_note_id :: BlockId -> TrackNum -> NoteId -> m ()
associate_note_id BlockId
block_id TrackNum
tracknum NoteId
note_id = forall (m :: * -> *).
M m =>
(WriteDeviceState -> WriteDeviceState) -> m ()
Cmd.modify_wdev_state forall a b. (a -> b) -> a -> b
$
        \WriteDeviceState
st -> WriteDeviceState
st { wdev_pitch_track :: Map NoteId (BlockId, TrackNum)
Cmd.wdev_pitch_track =
            forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert NoteId
note_id (BlockId
block_id, TrackNum
tracknum) (WriteDeviceState -> Map NoteId (BlockId, TrackNum)
Cmd.wdev_pitch_track WriteDeviceState
st) }

-- | Find the next available control track.  Available means it is the given
-- track or is to its right, has either the same instrument or has the default
-- instrument, and doesn't already have a note_id associated with it.
--
-- If none is found, return the tracknum at which one should be created.
next_control_track :: Cmd.M m => BlockId -> TrackNum -> (Text -> Bool)
    -> m (ControlTrack, Bool, Maybe TrackNum)
    -- ^ (selected_track_pair, should_create, next_control_track)
next_control_track :: forall (m :: * -> *).
M m =>
BlockId
-> TrackNum
-> (Text -> Bool)
-> m (ControlTrack, Bool, Maybe TrackNum)
next_control_track BlockId
block_id TrackNum
tracknum Text -> Bool
is_control = do
    WriteDeviceState
wdev <- forall (m :: * -> *). M m => m WriteDeviceState
Cmd.get_wdev_state
    let associated :: [TrackNum]
associated =
            [TrackNum
tracknum | (BlockId
_, TrackNum
tracknum) <- forall k a. Map k a -> [a]
Map.elems (WriteDeviceState -> Map NoteId (BlockId, TrackNum)
Cmd.wdev_pitch_track WriteDeviceState
wdev)]
    [Track]
tracks <- forall (m :: * -> *). M m => BlockId -> m [Track]
Info.block_tracks BlockId
block_id
    Instrument
inst <- forall (m :: * -> *). M m => BlockId -> TrackNum -> m Instrument
Info.get_instrument_of BlockId
block_id TrackNum
tracknum
    let find :: TrackNum -> m (Maybe Track)
find TrackNum
right_of = forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM (forall {m :: * -> *} {t :: * -> *}.
(Foldable t, M m) =>
Instrument -> t TrackNum -> TrackNum -> Track -> m Bool
candidate Instrument
inst [TrackNum]
associated TrackNum
right_of) [Track]
tracks
    Maybe Track
found <- forall {m :: * -> *}. M m => TrackNum -> m (Maybe Track)
find TrackNum
tracknum
    case Maybe Track
found of
        Maybe Track
Nothing -> forall (m :: * -> *) a. (Stack, M m) => Text -> m a
Cmd.throw forall a b. (a -> b) -> a -> b
$ Text
"no next note track in " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt BlockId
block_id
        Just Track
track -> do
            (ControlTrack
ctrack, Bool
create) <- forall (m :: * -> *).
M m =>
BlockId -> Track -> (Text -> Bool) -> m (ControlTrack, Bool)
should_create_control BlockId
block_id Track
track Text -> Bool
is_control
            Maybe Track
next <- forall {m :: * -> *}. M m => TrackNum -> m (Maybe Track)
find (ControlTrack -> TrackNum
track_control ControlTrack
ctrack forall a. Num a => a -> a -> a
+ TrackNum
1)
            forall (m :: * -> *) a. Monad m => a -> m a
return (ControlTrack
ctrack, Bool
create,
                TrackInfo -> TrackNum
Ui.track_tracknum forall b c a. (b -> c) -> (a -> b) -> a -> c
. Track -> TrackInfo
Info.track_info forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Track
next)
    where
    -- Wow, monads can be awkward.
    candidate :: Instrument -> t TrackNum -> TrackNum -> Track -> m Bool
candidate Instrument
inst t TrackNum
associated TrackNum
right_of
            (Info.Track TrackInfo
track (Info.Note [TrackInfo]
controls [TrackInfo]
_)) =
        forall (m :: * -> *). Monad m => [m Bool] -> m Bool
andM
            [ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TrackNum
tracknum forall a. Ord a => a -> a -> Bool
>= TrackNum
right_of
            , forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` t TrackNum
associated) Maybe TrackNum
pitch_tracknum
            , (forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Instrument
inst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> m (Maybe Instrument)
Info.lookup_instrument_of BlockId
block_id TrackNum
tracknum
            ]
        where
        tracknum :: TrackNum
tracknum = TrackInfo -> TrackNum
Ui.track_tracknum TrackInfo
track
        pitch_tracknum :: Maybe TrackNum
pitch_tracknum = TrackInfo -> TrackNum
Ui.track_tracknum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Text -> Bool
is_control forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackInfo -> Text
Ui.track_title) [TrackInfo]
controls
    candidate Instrument
_ t TrackNum
_ TrackNum
_ Track
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | The given track should be a note track.  Figure out if it has a control
-- track, or if one should be created.
this_control_track :: Cmd.M m => BlockId -> TrackNum -> (Text -> Bool)
    -> m (ControlTrack, Bool)
this_control_track :: forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> (Text -> Bool) -> m (ControlTrack, Bool)
this_control_track BlockId
block_id TrackNum
tracknum Text -> Bool
is_control = do
    Track
track <- forall (m :: * -> *). M m => BlockId -> TrackNum -> m Track
Info.get_track_type BlockId
block_id TrackNum
tracknum
    forall (m :: * -> *).
M m =>
BlockId -> Track -> (Text -> Bool) -> m (ControlTrack, Bool)
should_create_control BlockId
block_id Track
track Text -> Bool
is_control

-- | Find the ControlTrack of the given note Track.  If there is none, return
-- the tracknum where you should create one.
should_create_control :: Cmd.M m => BlockId -> Info.Track
    -> (Text -> Bool) -> m (ControlTrack, Bool)
should_create_control :: forall (m :: * -> *).
M m =>
BlockId -> Track -> (Text -> Bool) -> m (ControlTrack, Bool)
should_create_control BlockId
block_id Track
track Text -> Bool
is_control = case Track -> TrackType
Info.track_type Track
track of
    Info.Note [TrackInfo]
controls [TrackInfo]
_ -> case [TrackInfo] -> Maybe TrackInfo
find [TrackInfo]
controls of
        Maybe TrackInfo
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (TrackNum -> TrackNum -> ControlTrack
ControlTrack TrackNum
tracknum (TrackNum
tracknumforall a. Num a => a -> a -> a
+TrackNum
1), Bool
True)
        Just TrackInfo
control ->
            forall (m :: * -> *) a. Monad m => a -> m a
return (TrackNum -> TrackNum -> ControlTrack
ControlTrack TrackNum
tracknum (TrackInfo -> TrackNum
Ui.track_tracknum TrackInfo
control), Bool
False)
    TrackType
ttype -> forall (m :: * -> *) a. (Stack, M m) => Text -> m a
Cmd.throw forall a b. (a -> b) -> a -> b
$ Text
"expected a note track for "
        forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (BlockId
block_id, TrackNum
tracknum) forall a. Semigroup a => a -> a -> a
<> Text
" but got " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt TrackType
ttype
    where
    find :: [TrackInfo] -> Maybe TrackInfo
find = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Text -> Bool
is_control forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackInfo -> Text
Ui.track_title)
    tracknum :: TrackNum
tracknum = TrackInfo -> TrackNum
Ui.track_tracknum (Track -> TrackInfo
Info.track_info Track
track)

event_pos_at_or_before :: Cmd.M m => TrackId -> ScoreTime -> m ScoreTime
event_pos_at_or_before :: forall (m :: * -> *). M m => TrackId -> TrackTime -> m TrackTime
event_pos_at_or_before TrackId
track_id TrackTime
pos = do
    ([Event]
_, [Event]
events) <- TrackTime -> Events -> ([Event], [Event])
Events.split_at_before TrackTime
pos 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
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe TrackTime
pos Event -> TrackTime
Event.start (forall a. [a] -> Maybe a
Lists.head [Event]
events)

all_keys_up :: Cmd.M m => m Bool
all_keys_up :: forall (m :: * -> *). M m => m Bool
all_keys_up = do
    WriteDeviceState
st <- forall (m :: * -> *). M m => m WriteDeviceState
Cmd.get_wdev_state
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Map k a -> Bool
Map.null (WriteDeviceState -> Map NoteId (BlockId, TrackNum)
Cmd.wdev_pitch_track WriteDeviceState
st))

-- | Find the pitch track associated with the given NoteId, if one exists.
find_pitch_track :: Cmd.M m => InputNote.NoteId
    -> m (Maybe (TrackNum, TrackId))
find_pitch_track :: forall (m :: * -> *).
M m =>
NoteId -> m (Maybe (TrackNum, TrackId))
find_pitch_track NoteId
note_id = do
    WriteDeviceState
st <- forall (m :: * -> *). M m => m WriteDeviceState
Cmd.get_wdev_state
    let maybe_track :: Maybe (BlockId, TrackNum)
maybe_track = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NoteId
note_id (WriteDeviceState -> Map NoteId (BlockId, TrackNum)
Cmd.wdev_pitch_track WriteDeviceState
st)
    case Maybe (BlockId, TrackNum)
maybe_track of
        Maybe (BlockId, TrackNum)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        Just (BlockId
block_id, TrackNum
tracknum) -> do
            TrackId
track_id <- forall (m :: * -> *). M m => BlockId -> TrackNum -> m TrackId
Ui.get_event_track_at BlockId
block_id TrackNum
tracknum
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (TrackNum
tracknum, TrackId
track_id)


-- * method edit

-- | Method edit is redirected to the pitch track, creating one if necessary.
cmd_method_edit :: Cmd.M m => Msg.Msg -> m Cmd.Status
cmd_method_edit :: forall (m :: * -> *). M m => Msg -> m Status
cmd_method_edit Msg
msg =
    forall (m :: * -> *) a. M m => EditMode -> Text -> m a -> m a
Cmd.suppress_history EditMode
Cmd.MethodEdit Text
"note track method edit" forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *). M m => Fallthrough -> Msg -> m ()
EditUtil.fallthrough Fallthrough
EditUtil.WantBackspace Msg
msg
    case Msg
msg of
        (Msg -> Maybe Key
EditUtil.method_key -> Just Key
key) -> do
            (BlockId
block_id, TrackNum
tracknum, TrackId
_, TrackTime
pos) <- forall (m :: * -> *).
M m =>
m (BlockId, TrackNum, TrackId, TrackTime)
Selection.get_insert
            (ControlTrack
ctrack, Bool
create) <- forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> (Text -> Bool) -> m (ControlTrack, Bool)
this_control_track BlockId
block_id TrackNum
tracknum
                Text -> Bool
ParseTitle.is_pitch_track
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
create forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => BlockId -> ControlTrack -> m ()
create_pitch_track BlockId
block_id ControlTrack
ctrack
            forall (m :: * -> *). M m => Pos -> Key -> m ()
PitchTrack.method_edit_at
                (BlockId -> TrackNum -> TrackTime -> TrackTime -> Pos
EditUtil.Pos BlockId
block_id (ControlTrack -> TrackNum
track_control ControlTrack
ctrack) TrackTime
pos TrackTime
0) Key
key
            forall (m :: * -> *). M m => Pos -> m ()
ensure_note_event (BlockId -> TrackNum -> TrackTime -> TrackTime -> Pos
EditUtil.Pos BlockId
block_id (ControlTrack -> TrackNum
track_note ControlTrack
ctrack) TrackTime
pos TrackTime
0)
        Msg
_ -> forall (m :: * -> *) a. M m => m a
Cmd.abort
    forall (m :: * -> *) a. Monad m => a -> m a
return Status
Cmd.Done

-- * implementation

-- | Create a pitch track.
create_pitch_track :: Cmd.M m => BlockId -> ControlTrack -> m ()
create_pitch_track :: forall (m :: * -> *). M m => BlockId -> ControlTrack -> m ()
create_pitch_track BlockId
block_id (ControlTrack TrackNum
note TrackNum
pitch) = do
    forall (m :: * -> *). M m => BlockId -> TrackNum -> Text -> m ()
create_track BlockId
block_id TrackNum
pitch Text
"*"
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TrackNum
pitch forall a. Eq a => a -> a -> Bool
== TrackNum
note forall a. Num a => a -> a -> a
+ TrackNum
1) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackNum -> m ()
Ui.merge_track BlockId
block_id TrackNum
note TrackNum
pitch
    forall (m :: * -> *). M m => ViewId -> m ()
Create.widen forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m ViewId
Cmd.get_focused_view
    -- Link note track underneath newly created pitch track.
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall (m :: * -> *). M m => BlockId -> m Bool
Ui.has_explicit_skeleton BlockId
block_id) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackNum -> m ()
Ui.splice_skeleton_below BlockId
block_id TrackNum
pitch TrackNum
note

create_dyn_track :: Cmd.M m => BlockId -> ControlTrack -> m ()
create_dyn_track :: forall (m :: * -> *). M m => BlockId -> ControlTrack -> m ()
create_dyn_track BlockId
block_id (ControlTrack TrackNum
note TrackNum
dyn) = do
    forall (m :: * -> *). M m => BlockId -> TrackNum -> Text -> m ()
create_track BlockId
block_id TrackNum
dyn forall a b. (a -> b) -> a -> b
$
        Typed Control -> Text
ParseTitle.control_to_title (forall a. a -> Typed a
ScoreT.untyped Control
Controls.dynamic)
    forall (m :: * -> *). M m => ViewId -> m ()
Create.widen forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m ViewId
Cmd.get_focused_view
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall (m :: * -> *). M m => BlockId -> m Bool
Ui.has_explicit_skeleton BlockId
block_id) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackNum -> m ()
Ui.splice_skeleton_below BlockId
block_id TrackNum
dyn TrackNum
note

create_track :: Cmd.M m => BlockId -> TrackNum -> Text -> m ()
create_track :: forall (m :: * -> *). M m => BlockId -> TrackNum -> Text -> m ()
create_track BlockId
block_id TrackNum
tracknum Text
title =
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> Text -> Events -> m TrackId
Create.track BlockId
block_id TrackNum
tracknum Text
title Events
Events.empty

-- | Ensure that a note event exists at the given spot.  An existing event is
-- left alone, but if there is no existing event a new one will be created.
ensure_note_event :: Cmd.M m => EditUtil.Pos -> m ()
ensure_note_event :: forall (m :: * -> *). M m => Pos -> m ()
ensure_note_event Pos
pos = do
    Text
text <- forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets (EditState -> Text
Cmd.state_note_text forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EditState
Cmd.state_edit)
    forall (m :: * -> *). M m => Pos -> Bool -> Bool -> Modify -> m ()
EditUtil.modify_event_at_trigger Pos
pos Bool
False Bool
False forall a b. (a -> b) -> a -> b
$
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> Maybe a
Just Text
text, Bool
False) (\Text
old -> (forall a. a -> Maybe a
Just Text
old, Bool
False))

get_state :: Cmd.M m => (Cmd.EditState -> a) -> m a
get_state :: forall (m :: * -> *) a. M m => (EditState -> a) -> m a
get_state EditState -> a
f = forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets (EditState -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EditState
Cmd.state_edit)