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

{- | The default keyboard layout.

    I group cmds by their function.  Overlapping keys will be detected and show
    up in the log as a warning on startup.

    Some global cmds also have a command-key version, so you can invoke them
    even when kbd entry is on.

    Track-specific cmds are bound in 'Cmd.Track'.

    Global generic cmds:

    0. State level operations, like load, save, undo.  Set timestep mode, set
    edit mode.  Play, stop.  Move the selection.

    1. Modify text independent attributes, like start position and duration.
    This includes copy and paste, remove, modify duration, nudge, ...

    Track-specific cmds are looked up in "Cmd.Track".

    2. Track specific event operations, possibly affecting all events in the
    selection: transposition, etc.  These are active regardless of EditMode,
    and are found in Cmd.*TrackKeymap.

    3. Track specific event editing, which modifies a single event.
    E.g., input notes and note text, pitches in a certain scale, control
    values, etc.  This is enabled by edit mode, and will shadow printable keys,
    depending on the track type and edit mode.  Found in Cmd.*Track.

    4. Kbd entry, if on, will hijack the letter keys and turn them into
    NoteOns.

    Then there's midi recording:  (TODO which is theoretical since it's not
    implemented)

    In record mode, the block is played while recording midi msgs and their
    timestamps, which are later passed to the integrator to convert into
    events.
-}
module Cmd.GlobalKeymap (
    pure_keymap, io_keymap, all_keymap, all_keymap_errors
) where
import qualified Control.Monad.Identity as Identity

import qualified App.Config as Config
import qualified App.Path as Path
import qualified Cmd.BlockConfig as BlockConfig
import qualified Cmd.Clip as Clip
import qualified Cmd.Cmd as Cmd
import qualified Cmd.Create as Create
import qualified Cmd.Edit as Edit
import qualified Cmd.Factor as Factor
import qualified Cmd.Keymap as Keymap
import           Cmd.Keymap
    (SimpleMod(..), bind_click, bind_drag, bind_key, bind_key_status,
     bind_repeatable, command_char, secondary_char, plain_char, plain_key,
     shift_char)
import qualified Cmd.PhysicalKey as PhysicalKey
import qualified Cmd.PitchTrack as PitchTrack
import qualified Cmd.Play as Play
import qualified Cmd.RulerCmd as RulerCmd
import qualified Cmd.Save as Save
import qualified Cmd.Selection as Selection
import qualified Cmd.StepPlay as StepPlay
import qualified Cmd.TimeStep as TimeStep
import qualified Cmd.Track as Track
import qualified Cmd.Undo as Undo
import qualified Cmd.ViewConfig as ViewConfig
import qualified Cmd.Views as Views

import qualified Derive.Scale as Scale
import qualified Ui.Block as Block
import qualified Ui.Key as Key
import qualified Ui.Meter.Meter as Meter
import qualified Ui.Ui as Ui

import           Global


pure_keymap :: Cmd.Handler Cmd.CmdId
pure_keymap :: Handler (CmdT Identity)
pure_keymap = forall (m :: * -> *). Keymap m -> Handler m
Cmd.Keymap forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). [Binding m] -> (Keymap m, [Text])
Keymap.make_keymap [Binding (CmdT Identity)]
pure_bindings

io_keymap :: Cmd.Handler (Cmd.CmdT IO)
io_keymap :: Handler (CmdT IO)
io_keymap = forall (m :: * -> *). Keymap m -> Handler m
Cmd.Keymap forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). [Binding m] -> (Keymap m, [Text])
Keymap.make_keymap [Binding (CmdT IO)]
io_bindings

-- | This is not useful for execution since the cmds themselves have been
-- stripped of their code, but it's still useful to find keymap collisions and
-- print a global keymap.  They're stripped to make them all the same type, so
-- they can all go into the same Keymap, so collision detection and
-- documentation doesn't have to care about 'pure_keymap' vs 'io_keymap'.
all_keymap :: Cmd.Keymap Cmd.CmdId
all_keymap_errors :: [Text]
(Keymap (CmdT Identity)
all_keymap, [Text]
all_keymap_errors) =
    forall (m :: * -> *). [Binding m] -> (Keymap m, [Text])
Keymap.make_keymap ([Binding (CmdT Identity)]
pure_bindings forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {m :: * -> *}.
(a, NamedCmd m) -> (a, NamedCmd (CmdT Identity))
strip [Binding (CmdT IO)]
io_bindings)
    where
    strip :: (a, NamedCmd m) -> (a, NamedCmd (CmdT Identity))
strip = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a b. (a -> b) -> a -> b
$ \(Cmd.NamedCmd Text
name Msg -> m Status
_) ->
        forall (m :: * -> *). Text -> (Msg -> m Status) -> NamedCmd m
Cmd.NamedCmd Text
name (forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return Status
Cmd.Done))

-- * io cmds

-- | Cmds that use IO.  This should be a limited to the small set of cmds that
-- need it.
io_bindings :: [Keymap.Binding (Cmd.CmdT IO)]
io_bindings :: [Binding (CmdT IO)]
io_bindings = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Binding (CmdT IO)]
file_bindings, [Binding (CmdT IO)]
undo_bindings, [Binding (CmdT IO)]
quit_bindings
    -- This actually belongs in 'play_bindings', but needs to be in IO, because
    -- stopping involves possibly killing threads and stopping audio.
    , forall (m :: * -> *).
[SimpleMod] -> Key -> Text -> m Status -> [Binding m]
bind_key_status [] (Char -> Key
Key.Char Char
' ') Text
"stop or play" CmdT IO Status
stop_or_play
    ]

-- Previously a second space would contract the selection, but it didn't seem
-- that useful.
-- context_stop :: Cmd.CmdT IO ()
-- context_stop = unlessM Play.cmd_context_stop (Selection.to_point True)

stop_or_play :: Cmd.CmdT IO Cmd.Status
stop_or_play :: CmdT IO Status
stop_or_play = CmdT IO Bool
Play.cmd_context_stop forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return Status
Cmd.Done
    Bool
False -> forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets (PlayState -> Maybe PlayCmd
Cmd.state_previous_play forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> PlayState
Cmd.state_play) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe PlayCmd
Nothing -> PlayArgs -> Status
Cmd.Play forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => m PlayArgs
Play.root_top
        Just (Cmd.PlayCmd Text
_ CmdId PlayArgs
cmd) -> PlayArgs -> Status
Cmd.Play forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. M m => CmdId a -> m a
Cmd.lift_id CmdId PlayArgs
cmd

file_bindings :: [Keymap.Binding (Cmd.CmdT IO)]
file_bindings :: [Binding (CmdT IO)]
file_bindings = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'S' Text
"save" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets State -> Maybe (Writable, SaveFile)
Cmd.state_save_file forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just (Writable
_, Cmd.SaveRepo Canonical
repo) -> do
            -- Even when using git, write a standalone state as a safeguard.
            FilePath -> CmdT IO FilePath
Save.write_current_state forall a b. (a -> b) -> a -> b
$
                FilePath -> FilePath
Save.state_path_for_repo (Canonical -> FilePath
Path.to_path Canonical
repo)
            FilePath -> CmdT IO ()
Save.save_git_as (Canonical -> FilePath
Path.to_path Canonical
repo)
        Maybe (Writable, SaveFile)
_ -> CmdT IO ()
Save.save_state
    ]

undo_bindings :: [Keymap.Binding (Cmd.CmdT IO)]
undo_bindings :: [Binding (CmdT IO)]
undo_bindings = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'u' Text
"undo" CmdT IO ()
Undo.undo
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'r' Text
"redo" CmdT IO ()
Undo.redo
    ]

-- | Quit is special because it's the only Cmd that returns Cmd.Quit.
-- See how annoying it is to make a keymap by hand?
quit_bindings :: [Keymap.Binding (Cmd.CmdT IO)]
quit_bindings :: [Binding (CmdT IO)]
quit_bindings = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall (m :: * -> *).
[SimpleMod] -> Key -> Text -> m Status -> [Binding m]
bind_key_status [SimpleMod
PrimaryCommand] Key
q Text
"soft quit" CmdT IO Status
Save.soft_quit
    , forall (m :: * -> *).
[SimpleMod] -> Key -> Text -> m Status -> [Binding m]
bind_key_status [SimpleMod
Shift, SimpleMod
PrimaryCommand] Key
q Text
"hard quit" CmdT IO Status
Save.hard_quit
    ]
    where q :: Key
q = Char -> Key
Key.Char (Stack => Char -> Char
PhysicalKey.physical_key Char
'q')

-- * pure cmds

-- | Cmds that don't use IO.  Exported from the module for the responder.
pure_bindings :: [Keymap.Binding (Cmd.CmdT Identity.Identity)]
pure_bindings :: [Binding (CmdT Identity)]
pure_bindings = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Binding (CmdT Identity)]
play_bindings, forall (m :: * -> *). M m => [Binding m]
mouse_bindings, forall (m :: * -> *). M m => [Binding m]
selection_bindings, forall (m :: * -> *). M m => [Binding m]
step_play_bindings
    , forall (m :: * -> *). M m => [Binding m]
view_config_bindings, forall (m :: * -> *). M m => [Binding m]
block_config_bindings, forall (m :: * -> *). M m => [Binding m]
edit_state_bindings
    , forall (m :: * -> *). M m => [Binding m]
event_bindings, forall (m :: * -> *). M m => [Binding m]
pitch_bindings, forall (m :: * -> *). M m => [Binding m]
create_bindings, forall (m :: * -> *). M m => [Binding m]
clip_bindings
    -- TODO use this to catch the focus bug
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [SimpleMod
SecondaryCommand] (Char -> Key
Key.Char Char
'a') Text
"debug" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => (State -> State) -> m ()
Cmd.modify forall a b. (a -> b) -> a -> b
$ \State
st -> State
st { state_debug :: Bool
Cmd.state_debug = Bool -> Bool
not (State -> Bool
Cmd.state_debug State
st) }
    ]

play_bindings :: [Keymap.Binding (Cmd.CmdT Identity.Identity)]
play_bindings :: [Binding (CmdT Identity)]
play_bindings = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    -- The pattern is that the modifiers select where to start playing, and
    -- the key says whether it's the local block or from the root block.
    [ [SimpleMod]
-> Key -> Text -> CmdId PlayArgs -> [Binding (CmdT Identity)]
bind [SimpleMod]
block Key
local Text
"play local block" forall (m :: * -> *). M m => m PlayArgs
Play.local_block
    , [SimpleMod]
-> Key -> Text -> CmdId PlayArgs -> [Binding (CmdT Identity)]
bind [SimpleMod]
sel Key
local Text
"play or loop local selection" forall (m :: * -> *). M m => m PlayArgs
Play.local_selection
    -- See if playing from the top is more useful than the previous step.
    , [SimpleMod]
-> Key -> Text -> CmdId PlayArgs -> [Binding (CmdT Identity)]
bind forall a. [a]
prev Key
local Text
"play local from top of window" forall (m :: * -> *). M m => m PlayArgs
Play.local_top
    , [SimpleMod]
-> Key -> Text -> CmdId PlayArgs -> [Binding (CmdT Identity)]
bind [SimpleMod]
block Key
root Text
"play root from start" forall (m :: * -> *). M m => m PlayArgs
Play.root_block
    , [SimpleMod]
-> Key -> Text -> CmdId PlayArgs -> [Binding (CmdT Identity)]
bind [SimpleMod]
sel Key
root Text
"play or loop root from local selection" forall (m :: * -> *). M m => m PlayArgs
Play.root_selection
    -- It plays from the selection on the root, instead of the local one.
    -- This breaks the modifier+key pattern, but it's useful to manually set
    -- a play starting point on the root.
    , [SimpleMod]
-> Key -> Text -> CmdId PlayArgs -> [Binding (CmdT Identity)]
bind ([SimpleMod]
block forall a. [a] -> [a] -> [a]
++ [SimpleMod]
sel) Key
root Text
"play root from root selection"
        forall (m :: * -> *). M m => m PlayArgs
Play.root_from_root_selection
    , [SimpleMod]
-> Key -> Text -> CmdId PlayArgs -> [Binding (CmdT Identity)]
bind forall a. [a]
prev Key
root Text
"play root from top of window" forall (m :: * -> *). M m => m PlayArgs
Play.root_top
    ]
    where
    bind :: [SimpleMod]
-> Key -> Text -> CmdId PlayArgs -> [Binding (CmdT Identity)]
bind [SimpleMod]
smods Key
key Text
desc CmdId PlayArgs
cmd = forall (m :: * -> *).
[SimpleMod] -> Key -> Text -> m Status -> [Binding m]
bind_key_status [SimpleMod]
smods Key
key Text
desc forall a b. (a -> b) -> a -> b
$
        PlayArgs -> Status
Cmd.Play forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CmdId PlayArgs
cmd forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). M m => Text -> CmdId PlayArgs -> m ()
Play.set_previous_play Text
desc CmdId PlayArgs
cmd)
    block :: [SimpleMod]
block = [SimpleMod
PrimaryCommand]
    sel :: [SimpleMod]
sel = [SimpleMod
Shift]
    prev :: [a]
prev = []
    local :: Key
local = Key
Key.Enter
    root :: Key
root = Char -> Key
Key.Char (Stack => Char -> Char
PhysicalKey.physical_key Char
'\'')

-- | I bind the mouse by device rather than function, since I can't detect
-- overlaps as easily for mouse bindings.
mouse_bindings :: Cmd.M m => [Keymap.Binding m]
mouse_bindings :: forall (m :: * -> *). M m => [Binding m]
mouse_bindings = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall (m :: * -> *).
M m =>
[SimpleMod]
-> MouseButton -> MouseOn -> Text -> (Msg -> m ()) -> [Binding m]
bind_drag [] MouseButton
btn MouseOn
Cmd.OnTrack Text
"snap drag selection"
        (forall (m :: * -> *). M m => MouseButton -> Bool -> Msg -> m ()
Selection.cmd_snap_selection MouseButton
btn Bool
False)
    , forall (m :: * -> *).
M m =>
[SimpleMod]
-> MouseButton -> MouseOn -> Text -> (Msg -> m ()) -> [Binding m]
bind_drag [SimpleMod
Shift] MouseButton
btn MouseOn
Cmd.OnTrack Text
"snap drag selection"
        (forall (m :: * -> *). M m => MouseButton -> Bool -> Msg -> m ()
Selection.cmd_snap_selection MouseButton
btn Bool
True)
    , forall (m :: * -> *).
M m =>
[SimpleMod]
-> MouseButton -> MouseOn -> Text -> (Msg -> m ()) -> [Binding m]
bind_drag [SimpleMod
PrimaryCommand] MouseButton
btn MouseOn
Cmd.OnTrack Text
"drag selection"
        (forall (m :: * -> *). M m => MouseButton -> Bool -> Msg -> m ()
Selection.cmd_mouse_selection MouseButton
btn Bool
False)
    , forall (m :: * -> *).
M m =>
[SimpleMod]
-> MouseButton -> MouseOn -> Text -> (Msg -> m ()) -> [Binding m]
bind_drag [SimpleMod
Shift, SimpleMod
PrimaryCommand] MouseButton
btn MouseOn
Cmd.OnTrack Text
"extend selection"
        (forall (m :: * -> *). M m => MouseButton -> Bool -> Msg -> m ()
Selection.cmd_mouse_selection MouseButton
btn Bool
True)
    , forall (m :: * -> *).
M m =>
[SimpleMod]
-> MouseButton -> MouseOn -> Text -> (Msg -> m ()) -> [Binding m]
Keymap.bind_release [] MouseButton
btn MouseOn
Cmd.OnTrack Text
"mouse release"
        (forall a b. a -> b -> a
const forall (m :: * -> *). M m => m ()
Selection.record_history)

    , forall (m :: * -> *).
M m =>
[SimpleMod]
-> MouseButton
-> MouseOn
-> MouseButton
-> Text
-> (Msg -> m ())
-> [Binding m]
bind_click [] MouseButton
btn MouseOn
Cmd.OnTrack MouseButton
2 Text
"open block"
        (forall a b. a -> b -> a
const (forall (m :: * -> *). M m => Bool -> m ()
BlockConfig.cmd_open_block Bool
False))
    , forall (m :: * -> *).
M m =>
[SimpleMod]
-> MouseButton
-> MouseOn
-> MouseButton
-> Text
-> (Msg -> m ())
-> [Binding m]
bind_click [SimpleMod
PrimaryCommand] MouseButton
btn MouseOn
Cmd.OnTrack MouseButton
2 Text
"open block"
        (forall a b. a -> b -> a
const (forall (m :: * -> *). M m => Bool -> m ()
BlockConfig.cmd_open_block Bool
True))

    -- TODO without a track_drag equivalent for skeleton clicks, this
    -- will interfere with the OnTrack bind_drag when you drag into the
    -- track.
    , forall (m :: * -> *).
M m =>
[SimpleMod]
-> MouseButton -> MouseOn -> Text -> (Msg -> m ()) -> [Binding m]
bind_drag [] MouseButton
btn MouseOn
Cmd.OnSkeleton Text
"select track"
        (forall (m :: * -> *). M m => MouseButton -> Msg -> m ()
Selection.cmd_select_track MouseButton
btn)
    , forall (m :: * -> *).
M m =>
[SimpleMod]
-> MouseButton
-> MouseOn
-> MouseButton
-> Text
-> (Msg -> m ())
-> [Binding m]
bind_click [] MouseButton
btn MouseOn
Cmd.OnSkeleton MouseButton
2 Text
"add block title"
        forall (m :: * -> *). M m => Msg -> m ()
BlockConfig.cmd_add_block_title
    , forall (m :: * -> *).
M m =>
[SimpleMod]
-> MouseButton
-> MouseOn
-> MouseButton
-> Text
-> (Msg -> m ())
-> [Binding m]
bind_click [SimpleMod
PrimaryCommand] MouseButton
btn MouseOn
Cmd.OnSkeleton MouseButton
1
        Text
"toggle skeleton edge" forall (m :: * -> *). M m => Msg -> m ()
BlockConfig.cmd_toggle_edge
    , forall (m :: * -> *).
M m =>
[SimpleMod]
-> MouseButton
-> MouseOn
-> MouseButton
-> Text
-> (Msg -> m ())
-> [Binding m]
bind_click [SimpleMod
Shift] MouseButton
btn MouseOn
Cmd.OnSkeleton MouseButton
1 Text
"move tracks"
        forall (m :: * -> *). M m => Msg -> m ()
BlockConfig.cmd_move_tracks
    , forall (m :: * -> *).
M m =>
[SimpleMod]
-> MouseButton
-> MouseOn
-> MouseButton
-> Text
-> (Msg -> m ())
-> [Binding m]
bind_click [SimpleMod
SecondaryCommand] MouseButton
btn MouseOn
Cmd.OnSkeleton MouseButton
1 Text
"toggle mute"
        forall (m :: * -> *). M m => Msg -> m ()
BlockConfig.cmd_mute_or_unsolo
    , forall (m :: * -> *).
M m =>
[SimpleMod]
-> MouseButton
-> MouseOn
-> MouseButton
-> Text
-> (Msg -> m ())
-> [Binding m]
bind_click [SimpleMod
SecondaryCommand] MouseButton
btn MouseOn
Cmd.OnSkeleton MouseButton
2 Text
"toggle solo"
        forall (m :: * -> *). M m => Msg -> m ()
BlockConfig.cmd_set_solo

    , forall (m :: * -> *).
M m =>
[SimpleMod]
-> MouseButton
-> MouseOn
-> MouseButton
-> Text
-> (Msg -> m ())
-> [Binding m]
bind_click [SimpleMod
Shift] MouseButton
btn MouseOn
Cmd.OnDivider MouseButton
1 Text
"expand collapsed"
        forall (m :: * -> *). M m => Msg -> m ()
BlockConfig.cmd_expand_track
    ]
    where
    btn :: MouseButton
btn = MouseButton
Config.mouse_select

selection_bindings :: Cmd.M m => [Keymap.Binding m]
selection_bindings :: forall (m :: * -> *). M m => [Binding m]
selection_bindings = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_repeatable [] Key
Key.Down Text
"advance selection" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Direction -> Move -> m ()
Selection.step Direction
TimeStep.Advance Move
move
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_repeatable [SimpleMod
Shift] Key
Key.Down Text
"extend advance selection" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Direction -> Move -> m ()
Selection.step Direction
TimeStep.Advance Move
Selection.Extend

    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_repeatable [] Key
Key.Up Text
"rewind selection" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Direction -> Move -> m ()
Selection.step Direction
TimeStep.Rewind Move
move
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_repeatable [SimpleMod
Shift] Key
Key.Up Text
"extend rewind selection" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Direction -> Move -> m ()
Selection.step Direction
TimeStep.Rewind Move
Selection.Extend

    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_repeatable [] Key
Key.Right Text
"shift selection right" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Bool -> Move -> MouseButton -> m ()
Selection.shift Bool
True Move
move MouseButton
1
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_repeatable [SimpleMod
Shift] Key
Key.Right Text
"extend selection right" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Bool -> Move -> MouseButton -> m ()
Selection.shift Bool
True Move
Selection.Extend MouseButton
1

    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_repeatable [] Key
Key.Left Text
"shift selection left" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Bool -> Move -> MouseButton -> m ()
Selection.shift Bool
True Move
move (-MouseButton
1)
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_repeatable [SimpleMod
Shift] Key
Key.Left Text
"extend selection left" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Bool -> Move -> MouseButton -> m ()
Selection.shift Bool
True Move
Selection.Extend (-MouseButton
1)

    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
repeatable_char Char
'h' Text
"move selection left" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Bool -> Move -> MouseButton -> m ()
Selection.shift Bool
True Move
move (-MouseButton
1)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
repeatable_char Char
'H' Text
"move selection left" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Bool -> Move -> MouseButton -> m ()
Selection.shift Bool
True Move
Selection.Extend (-MouseButton
1)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
repeatable_char Char
'l' Text
"move selection right" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Bool -> Move -> MouseButton -> m ()
Selection.shift Bool
True Move
move MouseButton
1
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
repeatable_char Char
'L' Text
"move selection right" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Bool -> Move -> MouseButton -> m ()
Selection.shift Bool
True Move
Selection.Extend MouseButton
1
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
repeatable_char Char
'j' Text
"move selection advance" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Direction -> Move -> m ()
Selection.step Direction
TimeStep.Advance Move
move
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
repeatable_char Char
'J' Text
"move selection advance" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Direction -> Move -> m ()
Selection.step Direction
TimeStep.Advance Move
Selection.Extend
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
repeatable_char Char
'k' Text
"move selection rewind" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Direction -> Move -> m ()
Selection.step Direction
TimeStep.Rewind Move
move
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
repeatable_char Char
'K' Text
"move selection rewind" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Direction -> Move -> m ()
Selection.step Direction
TimeStep.Rewind Move
Selection.Extend
    -- Mnemonic: next, previous.
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
repeatable_char Char
'n' Text
"move to next note track" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Move -> MouseButton -> m ()
Selection.jump_to_track Move
move forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 :: * -> *).
M m =>
Direction -> Bool -> m (Maybe MouseButton)
Selection.find_note_track Direction
Selection.R Bool
False
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
repeatable_char Char
'p' Text
"move to previous note track" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Move -> MouseButton -> m ()
Selection.jump_to_track Move
move forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 :: * -> *).
M m =>
Direction -> Bool -> m (Maybe MouseButton)
Selection.find_note_track Direction
Selection.L Bool
False
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
plain_char Char
'N' Text
"expand to next note track" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Move -> MouseButton -> m ()
Selection.jump_to_track Move
Selection.Extend forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 :: * -> *).
M m =>
Direction -> Bool -> m (Maybe MouseButton)
Selection.find_note_track Direction
Selection.R Bool
True
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
plain_char Char
'P' Text
"expand to previous note track" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Move -> MouseButton -> m ()
Selection.jump_to_track Move
Selection.Extend forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 :: * -> *).
M m =>
Direction -> Bool -> m (Maybe MouseButton)
Selection.find_note_track Direction
Selection.L Bool
True

    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
repeatable_char Char
'w' Text
"move to next event" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
M m =>
MouseButton -> Move -> TimeStep -> m ()
Selection.step_with MouseButton
1 Move
move forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m TimeStep
Track.event_and_note_step
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
repeatable_char Char
'W' Text
"extend to next event" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
M m =>
MouseButton -> Move -> TimeStep -> m ()
Selection.step_with MouseButton
1 Move
Selection.Extend forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m TimeStep
Track.event_and_note_step
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
repeatable_char Char
'b' Text
"move to previous event" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
M m =>
MouseButton -> Move -> TimeStep -> m ()
Selection.step_with (-MouseButton
1) Move
move forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m TimeStep
Track.event_and_note_step
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
repeatable_char Char
'B' Text
"extend to previous event" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
M m =>
MouseButton -> Move -> TimeStep -> m ()
Selection.step_with (-MouseButton
1) Move
Selection.Extend forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m TimeStep
Track.event_and_note_step

    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [SimpleMod
PrimaryCommand] (Char -> Key
Key.Char Char
'a') Text
"select track / all"
        forall (m :: * -> *). M m => m ()
Selection.cmd_track_all
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [SimpleMod
PrimaryCommand] (Char -> Key
Key.Char Char
'A') Text
"toggle extend tracks"
        forall (m :: * -> *). M m => m ()
Selection.cmd_toggle_extend_tracks

    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [SimpleMod
Shift] (Char -> Key
Key.Char Char
' ') Text
"selection start to point"
        (forall (m :: * -> *). M m => Bool -> m ()
Selection.to_point Bool
False)
    ]
    where
    move :: Move
move = Move
Selection.default_move
    repeatable_char :: Char -> Text -> m () -> [Binding m]
repeatable_char Char
c = forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_repeatable [] (Char -> Key
Key.Char Char
c)

step_play_bindings :: Cmd.M m => [Keymap.Binding m]
step_play_bindings :: forall (m :: * -> *). M m => [Binding m]
step_play_bindings = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_repeatable [SimpleMod
PrimaryCommand] Key
Key.Down
        Text
"step play advance" (forall (m :: * -> *). M m => Bool -> m ()
StepPlay.cmd_set_or_advance Bool
False)
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_repeatable [SimpleMod
Shift, SimpleMod
PrimaryCommand] Key
Key.Down
        Text
"step play tracks advance" (forall (m :: * -> *). M m => Bool -> m ()
StepPlay.cmd_set_or_advance Bool
True)
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_repeatable [SimpleMod
PrimaryCommand] Key
Key.Up
        Text
"step play rewind" forall (m :: * -> *). M m => m ()
StepPlay.cmd_rewind
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_repeatable [SimpleMod
Shift, SimpleMod
PrimaryCommand] Key
Key.Up
        Text
"step play rewind" forall (m :: * -> *). M m => m ()
StepPlay.cmd_rewind
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [SimpleMod
PrimaryCommand] Key
Key.Right
        Text
"step play here" (forall (m :: * -> *). M m => Bool -> m ()
StepPlay.cmd_here Bool
False)
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [SimpleMod
Shift, SimpleMod
PrimaryCommand] Key
Key.Right
        Text
"step play tracks here" (forall (m :: * -> *). M m => Bool -> m ()
StepPlay.cmd_here Bool
True)
    ]

view_config_bindings :: Cmd.M m => [Keymap.Binding m]
view_config_bindings :: forall (m :: * -> *). M m => [Binding m]
view_config_bindings = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
plain_char Char
'[' Text
"zoom out step" (forall (m :: * -> *). M m => Direction -> m ()
ViewConfig.zoom_by_rank Direction
TimeStep.Rewind)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
plain_char Char
']' Text
"zoom in step" (forall (m :: * -> *). M m => Direction -> m ()
ViewConfig.zoom_by_rank Direction
TimeStep.Advance)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
plain_char Char
'{' Text
"zoom out *0.8" (forall (m :: * -> *). M m => (Double -> Double) -> m ()
ViewConfig.cmd_zoom_around_insert (forall a. Num a => a -> a -> a
*Double
0.8))
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
plain_char Char
'}' Text
"zoom in *1.25" (forall (m :: * -> *). M m => (Double -> Double) -> m ()
ViewConfig.cmd_zoom_around_insert (forall a. Num a => a -> a -> a
*Double
1.25))
    -- undo and redo for selection, but I never use it
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
secondary_char Char
'[' Text
"previous selection"
        (forall (m :: * -> *). M m => Bool -> m ()
Selection.previous_selection Bool
True)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
secondary_char Char
']' Text
"next selection" (forall (m :: * -> *). M m => Bool -> m ()
Selection.next_selection Bool
True)

    -- TODO experimental
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'q' Text
"set suggested track widths"
        (forall (m :: * -> *). M m => ViewId -> m ()
ViewConfig.set_suggested_track_widths 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 :: * -> *). M m => Char -> Text -> m () -> [Binding m]
plain_char Char
'\\' Text
"zoom to ruler or selection"
        forall (m :: * -> *). M m => m ()
ViewConfig.zoom_to_ruler_or_selection
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'R' Text
"resize to fit"
        (forall (m :: * -> *). M m => Bool -> ViewId -> m ()
Views.resize_to_fit Bool
False 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 :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'L' Text
"horizontal tile" forall (m :: * -> *). M m => m ()
ViewConfig.horizontal_tile
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'\\' Text
"maximize and zoom"
        (forall (m :: * -> *). M m => ViewId -> m ()
Views.maximize_and_zoom forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m ViewId
Cmd.get_focused_view)

    -- Unfortunately cmd-` is taken by an edit state bind, and they all live
    -- there so it would create an inconsistency to move just one.
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
secondary_char Char
'`' Text
"cycle focus forward" (forall (m :: * -> *). M m => Bool -> m ()
ViewConfig.cycle_focus Bool
True)
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [SimpleMod
SecondaryCommand, SimpleMod
Shift] (Char -> Key
Key.Char Char
'`') Text
"cycle focus backward"
        (forall (m :: * -> *). M m => Bool -> m ()
ViewConfig.cycle_focus Bool
False)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
secondary_char Char
'H' Text
"block focus left" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Direction -> m ()
ViewConfig.move_focus Direction
ViewConfig.West
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
secondary_char Char
'J' Text
"block focus down" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Direction -> m ()
ViewConfig.move_focus Direction
ViewConfig.South
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
secondary_char Char
'K' Text
"block focus up" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Direction -> m ()
ViewConfig.move_focus Direction
ViewConfig.North
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
secondary_char Char
'L' Text
"block focus right" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Direction -> m ()
ViewConfig.move_focus Direction
ViewConfig.East
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
secondary_char Char
'W' Text
"close view" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => ViewId -> m ()
Ui.destroy_view 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 :: * -> *). M m => Char -> Text -> m () -> [Binding m]
secondary_char Char
'f' Text
"scroll advance" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => TrackTime -> m ()
ViewConfig.scroll_pages TrackTime
0.75
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
secondary_char Char
'b' Text
"scroll rewind" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => TrackTime -> m ()
ViewConfig.scroll_pages (-TrackTime
0.75)
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [] Key
Key.Home Text
"scroll home" forall (m :: * -> *). M m => m ()
ViewConfig.scroll_to_home
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [] Key
Key.End Text
"scroll end" forall (m :: * -> *). M m => m ()
ViewConfig.scroll_to_end
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [] Key
Key.PageDown Text
"scroll advance" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => TrackTime -> m ()
ViewConfig.scroll_pages TrackTime
0.75
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [] Key
Key.PageUp Text
"scroll rewind" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => TrackTime -> m ()
ViewConfig.scroll_pages (-TrackTime
0.75)
    ]

block_config_bindings :: Cmd.M m => [Keymap.Binding m]
block_config_bindings :: forall (m :: * -> *). M m => [Binding m]
block_config_bindings = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
plain_char Char
'M' Text
"toggle mute" (forall (m :: * -> *). M m => TrackFlag -> m ()
BlockConfig.cmd_toggle_flag TrackFlag
Block.Mute)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
plain_char Char
'S' Text
"toggle solo" (forall (m :: * -> *). M m => TrackFlag -> m ()
BlockConfig.cmd_toggle_flag TrackFlag
Block.Solo)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
plain_char Char
'D' Text
"toggle disable"
        (forall (m :: * -> *). M m => TrackFlag -> m ()
BlockConfig.cmd_toggle_flag TrackFlag
Block.Disable)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
plain_char Char
'C' Text
"toggle collapse"
        (forall (m :: * -> *). M m => TrackFlag -> m ()
BlockConfig.cmd_toggle_flag TrackFlag
Block.Collapse)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'C' Text
"collapse empty"
        (forall (m :: * -> *). M m => BlockId -> m ()
BlockConfig.toggle_collapse_empty forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'M' Text
"toggle merge all"
        (forall (m :: * -> *). M m => BlockId -> m ()
BlockConfig.toggle_merge_all forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'm' Text
"toggle merged" forall (m :: * -> *). M m => m ()
BlockConfig.toggle_merge_selected

    -- The idea is cmd-; works in kbd mode.
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
';' Text
"add ruler section" forall (m :: * -> *). M m => m ()
RulerCmd.local_add_section
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
plain_char Char
':' Text
"clip block" forall (m :: * -> *). M m => m ()
BlockConfig.clip
    ]

-- | Modify global edit state.
edit_state_bindings :: Cmd.M m => [Keymap.Binding m]
edit_state_bindings :: forall (m :: * -> *). M m => [Binding m]
edit_state_bindings = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall (m :: * -> *). M m => Key -> Text -> m () -> [Binding m]
plain_key Key
Key.Escape Text
"toggle val edit" forall (m :: * -> *). M m => m ()
Edit.cmd_toggle_val_edit
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'[' Text
"toggle val edit" forall (m :: * -> *). M m => m ()
Edit.cmd_toggle_val_edit
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [] Key
Key.Tab Text
"toggle method edit" forall (m :: * -> *). M m => m ()
Edit.cmd_toggle_method_edit
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
']' Text
"toggle kbd entry mode" forall (m :: * -> *). M m => m ()
Edit.cmd_toggle_kbd_entry
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'{' Text
"toogle val edit and kbd entry"
        forall (m :: * -> *). M m => m ()
Edit.cmd_toggle_val_edit_kbd_entry

    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'0' Text
"set event step" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => TimeStep -> m ()
Edit.set_step TimeStep
TimeStep.event_step
    , forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'1') (forall {m :: * -> *}. M m => Rank -> (Text, m ())
step_rank Rank
Meter.Section)
    , forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'2') (forall {m :: * -> *}. M m => Rank -> (Text, m ())
step_rank Rank
Meter.W)
    , forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'3') (forall {m :: * -> *}. M m => Rank -> (Text, m ())
step_rank Rank
Meter.H)
    , forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'4') (forall {m :: * -> *}. M m => Rank -> (Text, m ())
step_rank Rank
Meter.Q)
    , forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'5') (forall {m :: * -> *}. M m => Rank -> (Text, m ())
step_rank Rank
Meter.E)
    , forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'6') (forall {m :: * -> *}. M m => Rank -> (Text, m ())
step_rank Rank
Meter.S)
    , forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'7') (forall {m :: * -> *}. M m => Rank -> (Text, m ())
step_rank Rank
Meter.T32)
    , forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'8') (forall {m :: * -> *}. M m => Rank -> (Text, m ())
step_rank Rank
Meter.T64)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
shift_char Char
'=' Text
"toggle duration" forall (m :: * -> *). M m => m ()
Edit.toggle_note_duration

    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [SimpleMod
PrimaryCommand] (Char -> Key
Key.Char Char
'`') Text
"toggle absolute/relative step"
        forall (m :: * -> *). M m => m ()
Edit.toggle_absolute_relative_step
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [SimpleMod
PrimaryCommand, SimpleMod
Shift] (Char -> Key
Key.Char Char
'`')
        Text
"toggle input note orientation"
        (forall (m :: * -> *). M m => m ()
Edit.cmd_toggle_note_orientation forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). M m => m ()
Selection.update_orientation)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
plain_char Char
'`' Text
"toggle advance" forall (m :: * -> *). M m => m ()
Edit.toggle_advance
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
shift_char Char
'`' Text
"toggle chord" forall (m :: * -> *). M m => m ()
Edit.toggle_chord

    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
plain_char Char
'-' Text
"octave -1" (forall (m :: * -> *). M m => (MouseButton -> MouseButton) -> m ()
Edit.cmd_modify_octave (forall a. Num a => a -> a -> a
subtract MouseButton
1))
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
plain_char Char
'=' Text
"octave +1" (forall (m :: * -> *). M m => (MouseButton -> MouseButton) -> m ()
Edit.cmd_modify_octave (forall a. Num a => a -> a -> a
+MouseButton
1))
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'-' Text
"play speed / 9/8"
        (forall (m :: * -> *). M m => (RealTime -> RealTime) -> m ()
Play.modify_play_multiplier (forall a. Fractional a => a -> a -> a
/ (RealTime
9forall a. Fractional a => a -> a -> a
/RealTime
8)))
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'=' Text
"play speed * 9/8"
        (forall (m :: * -> *). M m => (RealTime -> RealTime) -> m ()
Play.modify_play_multiplier (forall a. Num a => a -> a -> a
* (RealTime
9forall a. Fractional a => a -> a -> a
/RealTime
8)))
    ]
    where
    step_rank :: Rank -> (Text, m ())
step_rank Rank
rank =
        ( Text
"set step: " forall a. Semigroup a => a -> a -> a
<> TimeStep -> Text
TimeStep.show_time_step TimeStep
step
        , forall (m :: * -> *). M m => TimeStep -> Rank -> m ()
Edit.set_step_rank TimeStep
step Rank
rank
        )
        where step :: TimeStep
step = Rank -> TimeStep
TimeStep.rank Rank
rank

-- delete = remove events and move following events back
-- clear = just remove events

-- | Modify events.
event_bindings :: Cmd.M m => [Keymap.Binding m]
event_bindings :: forall (m :: * -> *). M m => [Binding m]
event_bindings = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    -- J = move previous event to cursor, K = move next event to cursor.
    [ forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'J' Text
"move event forward" forall (m :: * -> *). M m => m ()
Edit.cmd_move_event_forward
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'K' Text
"move event backward" forall (m :: * -> *). M m => m ()
Edit.cmd_move_event_backward
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'j' Text
"insert time" forall (m :: * -> *). M m => m ()
Edit.cmd_insert_time
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'k' Text
"delete time" forall (m :: * -> *). M m => m ()
Edit.cmd_delete_time
    -- Unlike other event editing commands, you don't have to be in insert
    -- mode to remove events.  Maybe I'll change that later.
    , forall (m :: * -> *). M m => Key -> Text -> m () -> [Binding m]
plain_key Key
Key.Backspace Text
"clear selected" forall (m :: * -> *). M m => m ()
Edit.cmd_clear_and_advance
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'o' Text
"join events" forall (m :: * -> *). M m => m ()
Edit.cmd_join_events
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'O' Text
"split events" forall (m :: * -> *). M m => m ()
Edit.cmd_split_events

    -- This used to be cmd-s but 'a' is unmapped in kbd entry and I often want
    -- to adjust note durations.
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
plain_char Char
'a' Text
"set dur" forall (m :: * -> *). M m => m ()
Edit.cmd_set_duration
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'z' Text
"set call duration" forall (m :: * -> *). M m => m ()
Edit.cmd_set_call_duration
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'Z' Text
"toggle zero-dur" forall (m :: * -> *). M m => m ()
Edit.cmd_toggle_zero_timestep
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'g' Text
"set start" forall (m :: * -> *). M m => m ()
Edit.cmd_set_start
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'G' Text
"invert orientation" forall (m :: * -> *). M m => m ()
Edit.cmd_invert_orientation

    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_repeatable [] (Char -> Key
Key.Char Char
'.') Text
"run last action"
        (forall (m :: * -> *). M m => Char -> m ()
Edit.run_action_at Char
'.')
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
shift_char Char
'1' Text
"run action 1" (forall (m :: * -> *). M m => Char -> m ()
Edit.run_action_at Char
'1')
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
shift_char Char
'2' Text
"run action 2" (forall (m :: * -> *). M m => Char -> m ()
Edit.run_action_at Char
'2')
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
shift_char Char
'3' Text
"run action 3" (forall (m :: * -> *). M m => Char -> m ()
Edit.run_action_at Char
'3')
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
shift_char Char
'4' Text
"run action 4" (forall (m :: * -> *). M m => Char -> m ()
Edit.run_action_at Char
'4')
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
shift_char Char
'5' Text
"cycle enharmonic"
        (forall (m :: * -> *). M m => ModifyPitch -> m ()
PitchTrack.pitches ModifyPitch
PitchTrack.cycle_enharmonics)
    , Char -> Text -> m () -> [Binding m]
shift_command Char
'1' Text
"record in slot 1" (forall (m :: * -> *). M m => Char -> m ()
Edit.save_last_action_to Char
'1')
    , Char -> Text -> m () -> [Binding m]
shift_command Char
'2' Text
"record in slot 2" (forall (m :: * -> *). M m => Char -> m ()
Edit.save_last_action_to Char
'2')
    , Char -> Text -> m () -> [Binding m]
shift_command Char
'3' Text
"record in slot 3" (forall (m :: * -> *). M m => Char -> m ()
Edit.save_last_action_to Char
'3')
    , Char -> Text -> m () -> [Binding m]
shift_command Char
'4' Text
"record in slot 4" (forall (m :: * -> *). M m => Char -> m ()
Edit.save_last_action_to Char
'4')

    -- modify event text

    -- There are placed to avoid conflict with 'Cmd.state_kbd_entry' for either
    -- pitched instruments or specialized keymaps like drums.
    , forall (m :: * -> *).
[SimpleMod] -> Key -> Text -> m Status -> [Binding m]
bind_key_status [] (Char -> Key
Key.Char (Stack => Char -> Char
PhysicalKey.physical_key Char
'/'))
        Text
"append text" forall (m :: * -> *). M m => m Status
Edit.append_text
    , forall (m :: * -> *).
[SimpleMod] -> Key -> Text -> m Status -> [Binding m]
bind_key_status [] (Char -> Key
Key.Char (Stack => Char -> Char
PhysicalKey.physical_key Char
'?'))
        Text
"replace last call" forall (m :: * -> *). M m => m Status
Edit.replace_last_call
    , forall (m :: * -> *).
[SimpleMod] -> Key -> Text -> m Status -> [Binding m]
bind_key_status [] (Char -> Key
Key.Char Char
'i') Text
"prepend text" forall (m :: * -> *). M m => m Status
Edit.prepend_text
    , forall (m :: * -> *).
[SimpleMod] -> Key -> Text -> m Status -> [Binding m]
bind_key_status [] (Char -> Key
Key.Char Char
'I') Text
"replace first call"
        forall (m :: * -> *). M m => m Status
Edit.replace_first_call

    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [SimpleMod
SecondaryCommand] (Char -> Key
Key.Char Char
'c')
        Text
"toggle commented" forall (m :: * -> *). M m => m ()
Edit.cmd_toggle_commented
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
',' Text
"strip transformer" forall (m :: * -> *). M m => m ()
Edit.strip_transformer
    ]
    where
    shift_command :: Char -> Text -> m () -> [Binding m]
shift_command = forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [SimpleMod
Shift, SimpleMod
PrimaryCommand] forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Key
Key.Char

-- | Bindings which work on pitch tracks.  The reason this is global rather
-- than in pitch track keymaps is that it's handy to select multiple tracks
-- and have the cmd automatically skip non pitch tracks.  This only really
-- applies to pitch tracks though, because they are often collapsed and edited
-- from their note track.
pitch_bindings :: Cmd.M m => [Keymap.Binding m]
pitch_bindings :: forall (m :: * -> *). M m => [Binding m]
pitch_bindings = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    -- These are named after the vi commands for up and down, but they don't
    -- feel right.
    [ forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'y' Text
"transpose up chromatic degree" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
M m =>
Transposition -> MouseButton -> MouseButton -> m ()
PitchTrack.transpose_selection Transposition
Scale.Chromatic MouseButton
0 MouseButton
1
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'e' Text
"transpose down chromatic degree" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
M m =>
Transposition -> MouseButton -> MouseButton -> m ()
PitchTrack.transpose_selection Transposition
Scale.Chromatic MouseButton
0 (-MouseButton
1)
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [SimpleMod
SecondaryCommand] (Char -> Key
Key.Char Char
'y')
        Text
"transpose up diatonic degree" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
M m =>
Transposition -> MouseButton -> MouseButton -> m ()
PitchTrack.transpose_selection Transposition
Scale.Diatonic MouseButton
0 MouseButton
1
    , forall (m :: * -> *).
M m =>
[SimpleMod] -> Key -> Text -> m () -> [Binding m]
bind_key [SimpleMod
SecondaryCommand] (Char -> Key
Key.Char Char
'e')
        Text
"transpose down diatonic degree" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
M m =>
Transposition -> MouseButton -> MouseButton -> m ()
PitchTrack.transpose_selection Transposition
Scale.Diatonic MouseButton
0 (-MouseButton
1)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'Y' Text
"transpose up octave" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
M m =>
Transposition -> MouseButton -> MouseButton -> m ()
PitchTrack.transpose_selection Transposition
Scale.Chromatic MouseButton
1 MouseButton
0
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'E' Text
"transpose down octave" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
M m =>
Transposition -> MouseButton -> MouseButton -> m ()
PitchTrack.transpose_selection Transposition
Scale.Chromatic (-MouseButton
1) MouseButton
0
    ]

create_bindings :: Cmd.M m => [Keymap.Binding m]
create_bindings :: forall (m :: * -> *). M m => [Binding m]
create_bindings = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'n' Text
"insert track right" (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *). M m => m TrackId
Create.insert_track_right)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
't' Text
"splice track below" (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *). M m => m TrackId
Create.splice_below)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'T' Text
"insert branch" forall (m :: * -> *). M m => m ()
Create.insert_branch
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'h' Text
"splice track above" (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *). M m => m TrackId
Create.splice_above)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'H' Text
"splice track above ancestors"
        (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *). M m => m TrackId
Create.splice_above_ancestors)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'd' Text
"delete tracks" forall (m :: * -> *). M m => m ()
Create.destroy_selected_tracks

    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'N' Text
"create view"
        (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'b' Text
"create block"
        (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => RulerId -> m BlockId
Create.block forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => BlockId -> m RulerId
Ui.block_ruler
            forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block)
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'B' Text
"create block from template or selection"
        forall (m :: * -> *). M m => m ()
Factor.block_from_template
    ]

clip_bindings :: Cmd.M m => [Keymap.Binding m]
clip_bindings :: forall (m :: * -> *). M m => [Binding m]
clip_bindings = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'c' Text
"copy selection" forall (m :: * -> *). M m => m ()
Clip.cmd_copy_selection
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'x' Text
"cut selection" forall (m :: * -> *). M m => m ()
Clip.cmd_cut_selection
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'v' Text
"paste selection" forall (m :: * -> *). M m => m ()
Clip.cmd_paste_overwrite
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'V' Text
"insert selection" forall (m :: * -> *). M m => m ()
Clip.cmd_paste_insert
    , forall (m :: * -> *). M m => Char -> Text -> m () -> [Binding m]
command_char Char
'i' Text
"merge selection" forall (m :: * -> *). M m => m ()
Clip.cmd_paste_merge
    ]