{- | Vim-inspired modal input handling: translates key events into calls
against the pure navigation functions in "Termtab.UI.Types" and the
document edits in "Termtab.UI.Editing", plus the stateful bits neither
of those modules owns — playback transport, file save, and note preview.

Dispatch is keyed on 'asInputMode' ('NormalMode', 'GoToMode',
'VisualMode', a nested 'MenuMode', or 'CommandMode'); each mode has its
own @handle*@ function below that only recognizes the keys valid in that
mode, falling through to a \"you're on your own\" case in 'NormalMode'
or an explicit \"unknown\" status message in the others.
-}
module Termtab.UI.Keybindings (handleEvent) where

import Brick
import Brick.BChan (BChan, writeBChan)
import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.STM (readTVarIO)
import Control.Exception (SomeException, catch)
import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import Data.Char (digitToInt, isDigit)
import Graphics.Vty qualified as V
import System.Environment (lookupEnv)
import System.FilePath (replaceExtension)

import Termtab.Audio (engineNoteOff, engineNoteOn)
import Termtab.Audio.PlaybackThread
import Termtab.Audio.Types (AudioConfig (..), PlaybackStatus (..))
import Termtab.Export.MIDI (exportMidi)
import Termtab.Types (Beat (..), BeatIndex (..), Measure (..), MeasureIndex (..), Note (..), Song (..), TimeSignature (..), Track (..))
import Termtab.UI.Editing
import Termtab.UI.Types

{- | Top-level Brick event handler: routes a key event to the @handle*@
function for the current 'asInputMode', or updates playhead state on a
'PlaybackTick'. Anything else (mouse events, unrecognized 'AppEvent's)
is ignored.
-}
handleEvent :: BrickEvent ResourceName AppEvent -> EventM ResourceName AppState ()
handleEvent :: BrickEvent ResourceName AppEvent -> EventM ResourceName AppState ()
handleEvent (VtyEvent (V.EvKey Key
key [Modifier]
mods)) = do
    mode <- (AppState -> InputMode) -> EventM ResourceName AppState InputMode
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AppState -> InputMode
asInputMode
    case mode of
        InputMode
NormalMode -> Key -> [Modifier] -> EventM ResourceName AppState ()
handleNormal Key
key [Modifier]
mods
        InputMode
GoToMode -> Key -> EventM ResourceName AppState ()
handleGoTo Key
key
        InputMode
VisualMode -> Key -> EventM ResourceName AppState ()
handleVisual Key
key
        MenuMode [[Char]]
path -> [[Char]] -> Key -> EventM ResourceName AppState ()
handleMenu [[Char]]
path Key
key
        CommandMode [Char]
buf -> Key -> [Char] -> EventM ResourceName AppState ()
handleCommand Key
key [Char]
buf
handleEvent (AppEvent AppEvent
PlaybackTick) = EventM ResourceName AppState ()
handlePlaybackTick
handleEvent BrickEvent ResourceName AppEvent
_ = () -> EventM ResourceName AppState ()
forall a. a -> EventM ResourceName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{- | React to a 'PlaybackTick': read the current position\/status out of
the shared 'PlaybackEnv' STM state and mirror it into 'AppState' so the
UI can draw the playhead. Sets both playhead fields back to 'Nothing'
once status is 'Stopped'.
-}
handlePlaybackTick :: EventM ResourceName AppState ()
handlePlaybackTick :: EventM ResourceName AppState ()
handlePlaybackTick = do
    mEnv <- (AppState -> Maybe PlaybackEnv)
-> EventM ResourceName AppState (Maybe PlaybackEnv)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AppState -> Maybe PlaybackEnv
asPlaybackEnv
    case mEnv of
        Maybe PlaybackEnv
Nothing -> () -> EventM ResourceName AppState ()
forall a. a -> EventM ResourceName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just PlaybackEnv
env -> do
            (mi, bi) <- IO (MeasureIndex, BeatIndex)
-> EventM ResourceName AppState (MeasureIndex, BeatIndex)
forall a. IO a -> EventM ResourceName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MeasureIndex, BeatIndex)
 -> EventM ResourceName AppState (MeasureIndex, BeatIndex))
-> IO (MeasureIndex, BeatIndex)
-> EventM ResourceName AppState (MeasureIndex, BeatIndex)
forall a b. (a -> b) -> a -> b
$ TVar (MeasureIndex, BeatIndex) -> IO (MeasureIndex, BeatIndex)
forall a. TVar a -> IO a
readTVarIO (PlaybackEnv -> TVar (MeasureIndex, BeatIndex)
pePositionVar PlaybackEnv
env)
            status <- liftIO $ readTVarIO (peStatusVar env)
            modify $ \AppState
st ->
                AppState
st
                    { asPlayheadMeasure = case status of
                        PlaybackStatus
Stopped -> Maybe MeasureIndex
forall a. Maybe a
Nothing
                        PlaybackStatus
_ -> MeasureIndex -> Maybe MeasureIndex
forall a. a -> Maybe a
Just MeasureIndex
mi
                    , asPlayheadBeat = case status of
                        PlaybackStatus
Stopped -> Maybe BeatIndex
forall a. Maybe a
Nothing
                        PlaybackStatus
_ -> BeatIndex -> Maybe BeatIndex
forall a. a -> Maybe a
Just BeatIndex
bi
                    , asPlaybackStatus = status
                    }

{- | The default (\"normal mode\") keymap: hjkl-style navigation
(@h@\/@l@ move by beat with the special end-of-song\/trailing-empty-measure
handling in 'handleMoveRight'\/'handleMoveLeft'\/'handleMoveForward'\/
'handleMoveBack'; @j@\/@k@ move by string), digit keys for fret entry
(with a live 'previewNote' preview), @d@\/backspace to delete,
@r@ for rest, shift-tab to cycle duration, @u@\/@U@ for undo\/redo,
@:@ into 'CommandMode', @g@ into 'GoToMode', @v@ into 'VisualMode',
space into the root 'MenuMode', and Ctrl-s to save. Most bindings clear
any in-progress fret entry and status message first since they represent
moving on from whatever the previous action was.
-}
handleNormal :: V.Key -> [V.Modifier] -> EventM ResourceName AppState ()
handleNormal :: Key -> [Modifier] -> EventM ResourceName AppState ()
handleNormal Key
key [Modifier]
mods = case Key
key of
    -- Quit / mode switching
    Key
V.KEsc -> EventM ResourceName AppState ()
handleEsc
    V.KChar Char
':' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearFretEntry (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \AppState
st -> AppState
st{asInputMode = CommandMode "", asMessage = Nothing}
    -- Navigation (clears fret entry)
    V.KChar Char
'h' -> EventM ResourceName AppState ()
handleMoveLeft
    V.KChar Char
'l' | Modifier
V.MCtrl Modifier -> [Modifier] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Modifier]
mods -> EventM ResourceName AppState ()
handleMoveRight
    V.KChar Char
'k' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearFretEntry (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
moveStringDown
    V.KChar Char
'j' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearFretEntry (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
moveStringUp
    V.KChar Char
'W' -> EventM ResourceName AppState ()
handleMoveForward
    V.KChar Char
'B' -> EventM ResourceName AppState ()
handleMoveBack
    V.KChar Char
'g' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearFretEntry (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \AppState
st -> AppState
st{asInputMode = GoToMode, asMessage = Just "g-"}
    -- Visual mode
    V.KChar Char
'v' ->
        (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$
            AppState -> AppState
clearFretEntry (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \AppState
st ->
                AppState
st{asInputMode = VisualMode, asSelectionStart = Just (asCurrentMeasure st, asCurrentBeat st), asMessage = Just "-- VISUAL --"}
    -- Space menu
    V.KChar Char
' ' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearFretEntry (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \AppState
st -> AppState
st{asInputMode = MenuMode [], asMessage = Just "s:subdivide  c:combine  n:note  m:measure"}
    -- Display
    V.KChar Char
't' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearFretEntry (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
cycleDisplayMode
    V.KChar Char
'+' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearFretEntry (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
zoomIn
    V.KChar Char
'-' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearFretEntry (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
zoomOut
    -- Editing: fret entry
    V.KChar Char
c | Char -> Bool
isDigit Char
c -> do
        (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AppState -> AppState
enterFretDigit (Char -> Int
digitToInt Char
c)
        EventM ResourceName AppState ()
previewNote
    -- Editing: delete
    V.KChar Char
'd' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearFretEntry (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
deleteNoteAtCursor
    Key
V.KBS -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearFretEntry (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
deleteNoteAtCursor
    -- Editing: rest
    V.KChar Char
'r' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearFretEntry (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
insertRest
    -- Editing: duration cycle
    Key
V.KBackTab -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearFretEntry (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
cycleDuration
    -- Undo/Redo
    V.KChar Char
'u' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearFretEntry (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
undo
    V.KChar Char
'U' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearFretEntry (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
redo
    -- Save (Ctrl+s)
    V.KChar Char
's' | Modifier
V.MCtrl Modifier -> [Modifier] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Modifier]
mods -> EventM ResourceName AppState ()
doSave
    Key
_ -> () -> EventM ResourceName AppState ()
forall a. a -> EventM ResourceName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{- | Escape in 'NormalMode' controls playback transport rather than
changing input mode (there's no mode to leave): pauses if currently
playing, or fully stops if already paused. No effect if nothing is
playing.
-}
handleEsc :: EventM ResourceName AppState ()
handleEsc :: EventM ResourceName AppState ()
handleEsc = do
    status <- (AppState -> PlaybackStatus)
-> EventM ResourceName AppState PlaybackStatus
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AppState -> PlaybackStatus
asPlaybackStatus
    mEnv <- gets asPlaybackEnv
    case (status, mEnv) of
        (PlaybackStatus
Playing, Just PlaybackEnv
env) -> do
            IO () -> EventM ResourceName AppState ()
forall a. IO a -> EventM ResourceName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ResourceName AppState ())
-> IO () -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ PlaybackEnv -> IO ()
pausePlayback PlaybackEnv
env
            (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ \AppState
st -> AppState
st{asPlaybackStatus = Paused, asMessage = Just "Paused"}
        (PlaybackStatus
Paused, Just PlaybackEnv
env) -> do
            IO () -> EventM ResourceName AppState ()
forall a. IO a -> EventM ResourceName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ResourceName AppState ())
-> IO () -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ PlaybackEnv -> IO ()
stopPlayback PlaybackEnv
env
            (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ \AppState
st ->
                AppState
st
                    { asPlaybackStatus = Stopped
                    , asPlayheadMeasure = Nothing
                    , asPlayheadBeat = Nothing
                    , asMessage = Just "Stopped"
                    }
        (PlaybackStatus, Maybe PlaybackEnv)
_ -> () -> EventM ResourceName AppState ()
forall a. a -> EventM ResourceName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{- | Move right by one beat, auto-creating and moving into a new measure
when already at the last beat of the last measure — this is how new
measures get added just by navigating past the end, without a separate
\"add measure\" keypress.
-}
handleMoveRight :: EventM ResourceName AppState ()
handleMoveRight :: EventM ResourceName AppState ()
handleMoveRight = do
    st <- EventM ResourceName AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
    if atLastBeat st && atLastMeasure st
        then modify $ clearFretEntry . clearMessage . moveMeasureForward . addMeasure
        else modify $ clearFretEntry . clearMessage . moveBeatRight

{- | Move left by one beat. If that would leave a measure that is empty and
so is everything after it ('isTrailingEmpty'), delete that trailing
empty measure on the way out instead of leaving a dangling blank
measure behind (the mirror image of 'handleMoveRight' auto-creating one).
-}
handleMoveLeft :: EventM ResourceName AppState ()
handleMoveLeft :: EventM ResourceName AppState ()
handleMoveLeft = do
    st <- EventM ResourceName AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
    let curMi = AppState -> MeasureIndex
asCurrentMeasure AppState
st
    if atFirstBeat st && not (atFirstMeasure st) && isTrailingEmpty curMi st && measureCount st > 1
        then -- Leaving a trailing empty measure: delete it and go to last beat of previous measure
            modify $ clearFretEntry . clearMessage . deleteAndGoToPrevLastBeat
        else modify $ clearFretEntry . clearMessage . moveBeatLeft

{- | Move back one whole measure, with the same trailing-empty-measure
cleanup as 'handleMoveLeft'.
-}
handleMoveBack :: EventM ResourceName AppState ()
handleMoveBack :: EventM ResourceName AppState ()
handleMoveBack = do
    st <- EventM ResourceName AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
    let curMi = AppState -> MeasureIndex
asCurrentMeasure AppState
st
    if not (atFirstMeasure st) && isTrailingEmpty curMi st && measureCount st > 1
        then -- Delete trailing empty measure and go to last beat of previous measure
            modify $ clearFretEntry . clearMessage . deleteAndGoToPrevLastBeat
        else modify $ clearFretEntry . clearMessage . moveMeasureBack

-- | Delete the current empty measure and move cursor to the last beat of the previous measure.
deleteAndGoToPrevLastBeat :: AppState -> AppState
deleteAndGoToPrevLastBeat :: AppState -> AppState
deleteAndGoToPrevLastBeat AppState
st =
    let MeasureIndex Int
curM = AppState -> MeasureIndex
asCurrentMeasure AppState
st
        prevM :: Int
prevM = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
curM Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        -- Compute last beat of previous measure BEFORE deletion
        prevSt :: AppState
prevSt = AppState
st{asCurrentMeasure = MeasureIndex prevM}
        prevBeatCount :: Int
prevBeatCount = AppState -> Int
currentMeasureBeatCount AppState
prevSt
        deleted :: AppState
deleted = AppState -> AppState
deleteMeasure AppState
st
     in AppState
deleted{asCurrentMeasure = MeasureIndex prevM, asCurrentBeat = BeatIndex (prevBeatCount - 1)}

{- | Move forward one whole measure, auto-creating a new one at the end
just like 'handleMoveRight' does at the beat level.
-}
handleMoveForward :: EventM ResourceName AppState ()
handleMoveForward :: EventM ResourceName AppState ()
handleMoveForward = do
    st <- EventM ResourceName AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
    if atLastMeasure st
        then modify $ clearFretEntry . clearMessage . moveMeasureForward . addMeasure
        else modify $ clearFretEntry . clearMessage . moveMeasureForward

{- | 'VisualMode' keymap: @h@\/@l@ extend the selection by moving the
cursor (the selection's other end, 'asSelectionStart', stays fixed from
when @v@ was pressed); space opens the menu (from which @c@ ombines the
selection via 'combineBeats'); Escape cancels the selection and returns
to 'NormalMode'.
-}
handleVisual :: V.Key -> EventM ResourceName AppState ()
handleVisual :: Key -> EventM ResourceName AppState ()
handleVisual Key
key = case Key
key of
    Key
V.KEsc -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \AppState
st -> AppState
st{asSelectionStart = Nothing}
    V.KChar Char
'h' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
moveBeatLeft
    V.KChar Char
'l' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
moveBeatRight
    V.KChar Char
' ' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ \AppState
st -> AppState
st{asInputMode = MenuMode [], asMessage = Just "s:subdivide  c:combine  n:note  m:measure"}
    Key
_ -> () -> EventM ResourceName AppState ()
forall a. a -> EventM ResourceName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{- | Space-menu keymap, dispatched on the menu path accumulated in
'MenuMode'. @[]@ is the root menu (@s@ubdivide, @c@ombine, @n@ote
effects, @m@easure — each of the first and last two opening a nested
submenu rather than acting immediately); @[\"s\"]@, @[\"n\"]@, @[\"m\"]@
are those submenus. Every submenu's Escape returns to the root menu
rather than 'NormalMode' (only the root menu's Escape does that), and an
unrecognized key at any depth reports a status message and exits to
'NormalMode' via 'backToNormal'. The @[\"n\"]@ (note effects) submenu is
entirely unimplemented stubs.
-}
handleMenu :: [String] -> V.Key -> EventM ResourceName AppState ()
handleMenu :: [[Char]] -> Key -> EventM ResourceName AppState ()
handleMenu [] Key
key = case Key
key of
    -- Root menu
    V.KChar Char
's' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ \AppState
st -> AppState
st{asInputMode = MenuMode ["s"], asMessage = Just "2:halves  3:triplets  4:quadruplets"}
    V.KChar Char
'c' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
combineBeats (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal
    V.KChar Char
'n' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ \AppState
st -> AppState
st{asInputMode = MenuMode ["n"], asMessage = Just "b:bend  s:slide  h:hammer-on  p:pull-off  v:vibrato  m:palm mute (stubs)"}
    V.KChar Char
'm' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ \AppState
st -> AppState
st{asInputMode = MenuMode ["m"], asMessage = Just "a:add measure  d:delete measure"}
    Key
V.KEsc -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal
    Key
_ -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> AppState -> AppState
setMessage [Char]
"Unknown menu option"
handleMenu [[Char]
"s"] Key
key = case Key
key of
    -- Subdivide submenu
    V.KChar Char
'2' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AppState -> AppState
subdivideBeat Int
2
    V.KChar Char
'3' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AppState -> AppState
subdivideBeat Int
3
    V.KChar Char
'4' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AppState -> AppState
subdivideBeat Int
4
    Key
V.KEsc -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ \AppState
st -> AppState
st{asInputMode = MenuMode [], asMessage = Just "s:subdivide  c:combine  n:note  m:measure"}
    Key
_ -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> AppState -> AppState
setMessage [Char]
"Unknown subdivision"
handleMenu [[Char]
"n"] Key
key = case Key
key of
    -- Note effects submenu (stubs)
    Key
V.KEsc -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ \AppState
st -> AppState
st{asInputMode = MenuMode [], asMessage = Just "s:subdivide  c:combine  n:note  m:measure"}
    Key
_ -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> AppState -> AppState
setMessage [Char]
"Not yet implemented"
handleMenu [[Char]
"m"] Key
key = case Key
key of
    -- Measure submenu
    V.KChar Char
'a' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
addMeasure
    V.KChar Char
'd' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
deleteMeasure
    Key
V.KEsc -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ \AppState
st -> AppState
st{asInputMode = MenuMode [], asMessage = Just "s:subdivide  c:combine  n:note  m:measure"}
    Key
_ -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> AppState -> AppState
setMessage [Char]
"Unknown measure operation"
handleMenu [[Char]]
_ Key
key = case Key
key of
    Key
V.KEsc -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal
    Key
_ -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> AppState -> AppState
setMessage [Char]
"Unknown menu option"

{- | \"@g@-prefix\" jump keymap entered from 'NormalMode''s @g@ key:
@gg@\/@ge@ to song start\/end, @gh@\/@gl@ to measure start\/end,
@gk@\/@gj@ to first\/last string. Always returns to 'NormalMode'
afterward, including on an unrecognized key.
-}
handleGoTo :: V.Key -> EventM ResourceName AppState ()
handleGoTo :: Key -> EventM ResourceName AppState ()
handleGoTo Key
key = case Key
key of
    V.KChar Char
'g' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
goToStart (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal
    V.KChar Char
'e' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
goToEnd (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal
    V.KChar Char
'h' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
goToMeasureStart (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal
    V.KChar Char
'l' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
goToMeasureEnd (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal
    V.KChar Char
'k' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
goToFirstString (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal
    V.KChar Char
'j' -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
goToLastString (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal
    Key
V.KEsc -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal
    Key
_ -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> AppState -> AppState
setMessage [Char]
"Unknown go-to target"

{- | Ex-style command-line editing in 'CommandMode': accumulate typed
characters into the mode's buffer, backspace to delete (leaving the
mode entirely on backspace at an empty buffer), Enter to run
'dispatchCommand' on what's been typed.
-}
handleCommand :: V.Key -> String -> EventM ResourceName AppState ()
handleCommand :: Key -> [Char] -> EventM ResourceName AppState ()
handleCommand Key
key [Char]
buf = case Key
key of
    Key
V.KEnter -> [Char] -> EventM ResourceName AppState ()
dispatchCommand [Char]
buf
    Key
V.KEsc -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal
    Key
V.KBS
        | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
buf -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
clearMessage (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> AppState
backToNormal
        | Bool
otherwise -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ \AppState
st -> AppState
st{asInputMode = CommandMode (init buf)}
    V.KChar Char
c -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ \AppState
st -> AppState
st{asInputMode = CommandMode (buf ++ [c])}
    Key
_ -> () -> EventM ResourceName AppState ()
forall a. a -> EventM ResourceName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{- | Run a completed command-line entry: @q@\/@quit@\/@exit@ halt Brick,
@p@\/@play@ start playback, @w@\/@write@\/@save@ save to disk. Anything
else reports \"Unknown command\" and returns to 'NormalMode'.
-}
dispatchCommand :: String -> EventM ResourceName AppState ()
dispatchCommand :: [Char] -> EventM ResourceName AppState ()
dispatchCommand [Char]
cmd = case [Char]
cmd of
    [Char]
"q" -> EventM ResourceName AppState ()
forall n s. EventM n s ()
halt
    [Char]
"quit" -> EventM ResourceName AppState ()
forall n s. EventM n s ()
halt
    [Char]
"exit" -> EventM ResourceName AppState ()
forall n s. EventM n s ()
halt
    [Char]
"p" -> EventM ResourceName AppState ()
startPlay
    [Char]
"play" -> EventM ResourceName AppState ()
startPlay
    [Char]
"w" -> EventM ResourceName AppState ()
doSave
    [Char]
"write" -> EventM ResourceName AppState ()
doSave
    [Char]
"save" -> EventM ResourceName AppState ()
doSave
    [Char]
_ -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> AppState -> AppState
setMessage ([Char]
"Unknown command: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cmd)

{- | Save the current song as MIDI (the only export format wired up here).
Reuses 'asFilePath' if it already has a @.mid@\/@.midi@ extension,
otherwise swaps whatever extension it has for @.mid@; falls back to
@untitled.mid@ for a song that was never loaded from\/saved to a path.
-}
doSave :: EventM ResourceName AppState ()
doSave :: EventM ResourceName AppState ()
doSave = do
    st <- EventM ResourceName AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
    let song = AppState -> Song
asSong AppState
st
        savePath = case AppState -> Maybe [Char]
asFilePath AppState
st of
            Just [Char]
fp
                | ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([Char] -> [Char] -> Bool
`isSuffixOf'` [Char]
fp) [[Char]
".mid", [Char]
".midi"] -> [Char]
fp
                | Bool
otherwise -> [Char] -> [Char] -> [Char]
replaceExtension [Char]
fp [Char]
".mid"
            Maybe [Char]
Nothing -> [Char]
"untitled.mid"
    result <- liftIO $ saveToFile savePath song
    case result of
        Right () -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> AppState -> AppState
setMessage ([Char]
"Saved: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
savePath)
        Left [Char]
err -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> AppState -> AppState
setMessage ([Char]
"Save failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
err)

{- | Export @song@ to @path@ via 'exportMidi', catching any exception
(missing directory, permissions, etc) into a 'Left' error string instead
of crashing the UI thread.
-}
saveToFile :: FilePath -> Song -> IO (Either String ())
saveToFile :: [Char] -> Song -> IO (Either [Char] ())
saveToFile [Char]
path Song
song =
    (() -> Either [Char] ()
forall a b. b -> Either a b
Right (() -> Either [Char] ()) -> IO () -> IO (Either [Char] ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Song -> IO ()
exportMidi [Char]
path Song
song)
        IO (Either [Char] ())
-> (SomeException -> IO (Either [Char] ()))
-> IO (Either [Char] ())
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(SomeException
e :: SomeException) -> Either [Char] () -> IO (Either [Char] ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Either [Char] ()
forall a b. a -> Either a b
Left (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e))

{- | @isSuffixOf' suffix s@ is 'True' when @s@ ends with @suffix@; used by
'doSave' to check a file extension.
-}
isSuffixOf' :: String -> String -> Bool
isSuffixOf' :: [Char] -> [Char] -> Bool
isSuffixOf' [Char]
suffix [Char]
s = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
suffix) [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
suffix

{- | Handle @:play@\/@:p@: a no-op if already 'Playing'; resumes via
'resumePlayback' if 'Paused' (reusing the existing 'PlaybackEnv'); if
'Stopped', lazily initializes a 'PlaybackEnv' on first use
('tryInitPlayback', stashing it in 'asPlaybackEnv' for reuse) and starts
playback from the cursor's current measure. Reports \"Set
TERMTAB_SOUNDFONT to play\" if no engine could be created.
-}
startPlay :: EventM ResourceName AppState ()
startPlay :: EventM ResourceName AppState ()
startPlay = do
    st <- EventM ResourceName AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
    case asPlaybackStatus st of
        PlaybackStatus
Playing -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> AppState -> AppState
setMessage [Char]
"Already playing"
        PlaybackStatus
Paused -> do
            case AppState -> Maybe PlaybackEnv
asPlaybackEnv AppState
st of
                Just PlaybackEnv
env -> do
                    IO () -> EventM ResourceName AppState ()
forall a. IO a -> EventM ResourceName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ResourceName AppState ())
-> IO () -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ PlaybackEnv -> MeasureIndex -> IO ()
resumePlayback PlaybackEnv
env (AppState -> MeasureIndex
asCurrentMeasure AppState
st)
                    (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> AppState -> AppState
setMessage [Char]
"Playing..." (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \AppState
s -> AppState
s{asPlaybackStatus = Playing}
                Maybe PlaybackEnv
Nothing -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> AppState -> AppState
setMessage [Char]
"No audio engine"
        PlaybackStatus
Stopped -> do
            env <- case AppState -> Maybe PlaybackEnv
asPlaybackEnv AppState
st of
                Just PlaybackEnv
env -> Maybe PlaybackEnv
-> EventM ResourceName AppState (Maybe PlaybackEnv)
forall a. a -> EventM ResourceName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return (PlaybackEnv -> Maybe PlaybackEnv
forall a. a -> Maybe a
Just PlaybackEnv
env)
                Maybe PlaybackEnv
Nothing -> do
                    let bChan :: BChan AppEvent
bChan = AppState -> BChan AppEvent
asBChan AppState
st
                    IO (Maybe PlaybackEnv)
-> EventM ResourceName AppState (Maybe PlaybackEnv)
forall a. IO a -> EventM ResourceName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe PlaybackEnv)
 -> EventM ResourceName AppState (Maybe PlaybackEnv))
-> IO (Maybe PlaybackEnv)
-> EventM ResourceName AppState (Maybe PlaybackEnv)
forall a b. (a -> b) -> a -> b
$ BChan AppEvent -> IO (Maybe PlaybackEnv)
tryInitPlayback BChan AppEvent
bChan
            case env of
                Maybe PlaybackEnv
Nothing -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> AppState -> AppState
setMessage [Char]
"Set TERMTAB_SOUNDFONT to play"
                Just PlaybackEnv
pEnv -> do
                    (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ \AppState
s -> AppState
s{asPlaybackEnv = Just pEnv}
                    IO () -> EventM ResourceName AppState ()
forall a. IO a -> EventM ResourceName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ResourceName AppState ())
-> IO () -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ PlaybackEnv -> Song -> MeasureIndex -> IO ()
startPlayback PlaybackEnv
pEnv (AppState -> Song
asSong AppState
st) (AppState -> MeasureIndex
asCurrentMeasure AppState
st)
                    (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM ResourceName AppState ())
-> (AppState -> AppState) -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState -> AppState
backToNormal (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> AppState -> AppState
setMessage [Char]
"Playing..." (AppState -> AppState)
-> (AppState -> AppState) -> AppState -> AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \AppState
s -> AppState
s{asPlaybackStatus = Playing}

{- | Attempt to build a 'PlaybackEnv' from the @TERMTAB_SOUNDFONT@
environment variable, wiring its notify callback to post 'PlaybackTick'
on @bChan@. Returns 'Nothing' (rather than throwing) if the variable is
unset or engine initialization fails for any reason — audio is treated
as optional, not a hard requirement to run the editor.
-}
tryInitPlayback :: BChan AppEvent -> IO (Maybe PlaybackEnv)
tryInitPlayback :: BChan AppEvent -> IO (Maybe PlaybackEnv)
tryInitPlayback BChan AppEvent
bChan = do
    mPath <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"TERMTAB_SOUNDFONT"
    case mPath of
        Maybe [Char]
Nothing -> Maybe PlaybackEnv -> IO (Maybe PlaybackEnv)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PlaybackEnv
forall a. Maybe a
Nothing
        Just [Char]
path -> do
            let cfg :: AudioConfig
cfg = AudioConfig{acSoundFontPath :: [Char]
acSoundFontPath = [Char]
path}
                notify :: IO ()
notify = BChan AppEvent -> AppEvent -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan AppEvent
bChan AppEvent
PlaybackTick
            (PlaybackEnv -> Maybe PlaybackEnv
forall a. a -> Maybe a
Just (PlaybackEnv -> Maybe PlaybackEnv)
-> IO PlaybackEnv -> IO (Maybe PlaybackEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AudioConfig -> IO () -> IO PlaybackEnv
initPlaybackEnv AudioConfig
cfg IO ()
notify)
                IO (Maybe PlaybackEnv)
-> (SomeException -> IO (Maybe PlaybackEnv))
-> IO (Maybe PlaybackEnv)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(SomeException
_ :: SomeException) -> Maybe PlaybackEnv -> IO (Maybe PlaybackEnv)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PlaybackEnv
forall a. Maybe a
Nothing

{- | Play the note at the current cursor position briefly (fire-and-forget).
Lazily initializes 'asPlaybackEnv' the same way 'startPlay' does if
there isn't one yet, so the very first fret digit typed can already
produce sound. Runs in a forked thread so the 200ms preview delay
doesn't block the UI event loop.
-}
previewNote :: EventM ResourceName AppState ()
previewNote :: EventM ResourceName AppState ()
previewNote = do
    st <- EventM ResourceName AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
    mEnv <- case asPlaybackEnv st of
        Just PlaybackEnv
env -> Maybe PlaybackEnv
-> EventM ResourceName AppState (Maybe PlaybackEnv)
forall a. a -> EventM ResourceName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return (PlaybackEnv -> Maybe PlaybackEnv
forall a. a -> Maybe a
Just PlaybackEnv
env)
        Maybe PlaybackEnv
Nothing -> do
            let bChan :: BChan AppEvent
bChan = AppState -> BChan AppEvent
asBChan AppState
st
            env <- IO (Maybe PlaybackEnv)
-> EventM ResourceName AppState (Maybe PlaybackEnv)
forall a. IO a -> EventM ResourceName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe PlaybackEnv)
 -> EventM ResourceName AppState (Maybe PlaybackEnv))
-> IO (Maybe PlaybackEnv)
-> EventM ResourceName AppState (Maybe PlaybackEnv)
forall a b. (a -> b) -> a -> b
$ BChan AppEvent -> IO (Maybe PlaybackEnv)
tryInitPlayback BChan AppEvent
bChan
            case env of
                Just PlaybackEnv
e -> (AppState -> AppState) -> EventM ResourceName AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\AppState
s -> AppState
s{asPlaybackEnv = Just e}) EventM ResourceName AppState ()
-> EventM ResourceName AppState (Maybe PlaybackEnv)
-> EventM ResourceName AppState (Maybe PlaybackEnv)
forall a b.
EventM ResourceName AppState a
-> EventM ResourceName AppState b -> EventM ResourceName AppState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe PlaybackEnv
-> EventM ResourceName AppState (Maybe PlaybackEnv)
forall a. a -> EventM ResourceName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return (PlaybackEnv -> Maybe PlaybackEnv
forall a. a -> Maybe a
Just PlaybackEnv
e)
                Maybe PlaybackEnv
Nothing -> Maybe PlaybackEnv
-> EventM ResourceName AppState (Maybe PlaybackEnv)
forall a. a -> EventM ResourceName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PlaybackEnv
forall a. Maybe a
Nothing
    case mEnv of
        Maybe PlaybackEnv
Nothing -> () -> EventM ResourceName AppState ()
forall a. a -> EventM ResourceName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just PlaybackEnv
env -> case AppState -> Maybe Track
currentTrack AppState
st of
            Maybe Track
Nothing -> () -> EventM ResourceName AppState ()
forall a. a -> EventM ResourceName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just Track
track ->
                let beats :: [Beat]
beats = Track -> MeasureIndex -> [Beat]
beatsForTrackMeasure Track
track (AppState -> MeasureIndex
asCurrentMeasure AppState
st)
                    BeatIndex Int
bIdx = AppState -> BeatIndex
asCurrentBeat AppState
st
                 in case Int -> [Beat] -> [Beat]
forall a. Int -> [a] -> [a]
drop Int
bIdx [Beat]
beats of
                        (Beat
beat : [Beat]
_) ->
                            case (Note -> Bool) -> [Note] -> [Note]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Note
n -> Note -> Maybe StringIndex
noteString Note
n Maybe StringIndex -> Maybe StringIndex -> Bool
forall a. Eq a => a -> a -> Bool
== StringIndex -> Maybe StringIndex
forall a. a -> Maybe a
Just (AppState -> StringIndex
asCurrentString AppState
st)) (Beat -> [Note]
beatNotes Beat
beat) of
                                (Note
note : [Note]
_) -> IO () -> EventM ResourceName AppState ()
forall a. IO a -> EventM ResourceName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ResourceName AppState ())
-> IO () -> EventM ResourceName AppState ()
forall a b. (a -> b) -> a -> b
$ IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
                                    let ch :: MidiChannel
ch = Track -> MidiChannel
trackChannel Track
track
                                    AudioEngine -> MidiChannel -> Pitch -> Velocity -> IO ()
engineNoteOn (PlaybackEnv -> AudioEngine
peAudioEngine PlaybackEnv
env) MidiChannel
ch (Note -> Pitch
notePitch Note
note) (Note -> Velocity
noteVelocity Note
note)
                                    Int -> IO ()
threadDelay Int
200000 -- 200ms preview
                                    AudioEngine -> MidiChannel -> Pitch -> IO ()
engineNoteOff (PlaybackEnv -> AudioEngine
peAudioEngine PlaybackEnv
env) MidiChannel
ch (Note -> Pitch
notePitch Note
note)
                                [Note]
_ -> () -> EventM ResourceName AppState ()
forall a. a -> EventM ResourceName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        [Beat]
_ -> () -> EventM ResourceName AppState ()
forall a. a -> EventM ResourceName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Return to 'NormalMode' from any other input mode.
backToNormal :: AppState -> AppState
backToNormal :: AppState -> AppState
backToNormal AppState
st = AppState
st{asInputMode = NormalMode}

-- | Clear the status-bar message.
clearMessage :: AppState -> AppState
clearMessage :: AppState -> AppState
clearMessage AppState
st = AppState
st{asMessage = Nothing}

-- | Set the status-bar message.
setMessage :: String -> AppState -> AppState
setMessage :: [Char] -> AppState -> AppState
setMessage [Char]
msg AppState
st = AppState
st{asMessage = Just msg}