Safe Haskell | Safe-Inferred |
---|
Core CmdT monad that cmds run in.
A Cmd is what user actions turn into. The main thing they do is edit
Ui.State
, or Cmd.State
, but a special subset can also do IO
actions like saving and loading files.
The Cmd monad has two kinds of exception: abort or throw. Abort means that the Cmd decided that it's not the proper Cmd for this Msg (keystroke, mouse movement, whatever) and another Cmd should get a crack at it. Throw means that the Cmd failed and there is nothing to be done but log an error. When an exception is thrown, the ui and cmd states are rolled back and midi output is discarded.
Cmds should be in the monad Cmd.M m => m ...
.
They have to be polymorphic because they run in both IO and Identity. IO because some cmds such saving and loading files require IO, and Identity because the majority of cmds don't. REPL cmds run in IO so they can load and save, and the result is that any cmd that wants to be used from both Identity cmds (bound to keystrokes) and the REPL must be polymorphic in the monad.
Previously I used M
instead of Monad m => CmdT m ...
to establish
Functor, but post-AMP I don't need that any more. But to maintain
consistency I'll keep using M
.
Synopsis
- data Backend
- = Midi !Patch.Patch !Patch.Config
- | Im !Im.Patch.Patch
- | Sc !Sc.Patch.Patch
- | Dummy !Text
- data ResolvedInstrument = ResolvedInstrument {}
- data Modifier
- data SelectionHistory = SelectionHistory {
- sel_past :: [(ViewId, Sel.Selection)]
- sel_future :: [(ViewId, Sel.Selection)]
- data HistoryEntry = HistoryEntry {
- hist_state :: !Ui.State
- hist_damage :: !Update.UiDamage
- hist_names :: ![Text]
- hist_commit :: !(Maybe.Maybe GitT.Commit)
- data HistoryCollect = HistoryCollect {}
- data HistoryConfig = HistoryConfig {
- hist_keep :: !Int
- hist_last_commit :: !(Maybe.Maybe GitT.Commit)
- data LastCmd
- = UndoRedo
- | Load (Maybe.Maybe GitT.Commit) [Text]
- data History = History {
- hist_past :: ![HistoryEntry]
- hist_present :: !HistoryEntry
- hist_future :: ![HistoryEntry]
- hist_last_cmd :: !(Maybe.Maybe LastCmd)
- type Inst = Inst.Inst InstrumentCode
- type InstrumentDb = Inst.Db InstrumentCode
- type InstrumentPostproc = Score.Event -> (Score.Event, [Log.Msg])
- type ThruFunction = Scale -> Attrs.Attributes -> InputNote.Input -> CmdId [Thru]
- data InstrumentCode = InstrumentCode {}
- type Serial = Int
- data WriteDeviceState = WriteDeviceState {
- wdev_note_addr :: !(Map InputNote.NoteId Patch.Addr)
- wdev_note_key :: !(Map InputNote.NoteId Midi.Key)
- wdev_addr_serial :: !(Map Patch.Addr Serial)
- wdev_serial :: !Serial
- wdev_last_note_id :: !(Maybe.Maybe InputNote.NoteId)
- wdev_pitch_track :: !(Map InputNote.NoteId (BlockId, Types.TrackNum))
- wdev_addr_inst :: !(Map Patch.Addr Midi.Types.Patch)
- data Action
- = InsertEvent !(Maybe.Maybe TrackTime) !Text
- | ReplaceText !Text
- | PrependText !Text
- | AppendText !Text
- type RecordedActions = Map Char Action
- data EditMode
- = NoEdit
- | ValEdit
- | MethodEdit
- data EditState = EditState {
- state_edit_mode :: !EditMode
- state_floating_input :: !Bool
- state_advance :: Bool
- state_chord :: Bool
- state_record_velocity :: Bool
- state_kbd_entry :: !Bool
- state_time_step :: !TimeStep.TimeStep
- state_note_duration :: !TimeStep.TimeStep
- state_note_orientation :: !Types.Orientation
- state_note_text :: !Text
- state_kbd_entry_octave :: !Pitch.Octave
- state_recorded_actions :: !RecordedActions
- state_instrument_attributes :: !(Map ScoreT.Instrument Attrs.Attributes)
- state_edit_box :: !(Block.Box, Block.Box)
- type TrackSelection = (Sel.Selection, BlockId, Maybe.Maybe TrackId)
- newtype Hooks = Hooks {
- hooks_selection :: [[(ViewId, Maybe.Maybe TrackSelection)] -> CmdId ()]
- data SyncConfig = SyncConfig {}
- data StepState = StepState {
- step_view_id :: !ViewId
- step_tracknums :: [Types.TrackNum]
- step_before :: ![(ScoreTime, State)]
- step_after :: ![(ScoreTime, State)]
- newtype Thread = Thread (Async.Async ())
- data PlayCmd = PlayCmd !Text !(CmdId PlayArgs)
- data PlayState = PlayState {
- state_play_control :: ![Transport.PlayControl]
- state_performance :: !(Map BlockId Performance)
- state_current_performance :: !(Map BlockId Performance)
- state_performance_threads :: !(Map BlockId Thread)
- state_play_step :: !TimeStep.TimeStep
- state_step :: !(Maybe.Maybe StepState)
- state_play_multiplier :: RealTime.RealTime
- state_sync :: !(Maybe.Maybe SyncConfig)
- state_im_progress :: !(Map BlockId (Map TrackId (Map ScoreT.Instrument (RealTime.RealTime, RealTime.RealTime))))
- state_previous_play :: !(Maybe.Maybe PlayCmd)
- data Config = Config {
- config_app_dir :: !Path.AppDir
- config_save_dir :: !Path.Canonical
- config_midi_interface :: !Interface.Interface
- config_ky_paths :: ![FilePath]
- config_rdev_map :: !(Map Midi.ReadDevice Midi.ReadDevice)
- config_wdev_map :: !(Map Midi.WriteDevice Midi.WriteDevice)
- config_instrument_db :: !InstrumentDb
- config_builtins :: !Builtins
- config_highlight_colors :: !(Map Color.Highlight Color.Color)
- config_im :: !Shared.Config.Config
- config_im_play_direct :: Bool
- config_git_user :: !SaveGitT.User
- data Fingerprint = Fingerprint ![FilePath] !Int
- data KyCache
- data KeycapsState = KeycapsState {}
- data KeycapsUpdate
- data SavedState
- data Saved = Saved {
- _saved_state :: !SavedState
- _editor_open :: !Bool
- data Writable
- data SaveFile
- data State = State {
- state_config :: !Config
- state_save_file :: !(Maybe.Maybe (Writable, SaveFile))
- state_saved :: !Saved
- state_ky_cache :: !(Maybe.Maybe KyCache)
- state_derive_immediately :: !(Set BlockId)
- state_history :: !History
- state_history_config :: !HistoryConfig
- state_history_collect :: !HistoryCollect
- state_selection_history :: !SelectionHistory
- state_keys_down :: !(Map Modifier Modifier)
- state_focused_view :: !(Maybe.Maybe ViewId)
- state_screens :: ![Rect.Rect]
- state_keycaps :: !(Maybe.Maybe KeycapsState)
- state_keycaps_update :: !(Maybe.Maybe KeycapsUpdate)
- state_global_status :: !(Map Text Text)
- state_play :: !PlayState
- state_hooks :: !Hooks
- state_wdev_state :: !WriteDeviceState
- state_rdev_state :: !InputNote.ReadDeviceState
- state_edit :: !EditState
- state_repl_status :: !Status
- state_debug :: !Bool
- data Thru
- class (Log.LogMonad m, Ui.M m) => M m where
- get :: m State
- put :: State -> m ()
- write_thru :: Thru -> m ()
- abort :: m a
- catch_abort :: m a -> m (Maybe.Maybe a)
- newtype CmdT m a = CmdT (CmdStack m a)
- type CmdStack m = Ui.StateT (MonadState.StateT State (Logger.LoggerT Thru (Log.LogT m)))
- type Result a = (State, [Thru], [Log.Msg], Either Ui.Error (a, Ui.State, Update.UiDamage))
- type RunCmd cmd_m val_m a = Ui.State -> State -> CmdT cmd_m a -> val_m (Result a)
- data FloatingInput
- = FloatingOpen !ViewId !Types.TrackNum !ScoreTime !Text !(Int, Int)
- | FloatingInsert !Text
- data PlayDirectArgs = PlayDirectArgs {}
- data PlayArgs = PlayArgs {
- play_sync :: !(Maybe.Maybe SyncConfig)
- play_name :: !Text
- play_midi :: !Midi.Perform.MidiEvents
- play_sc :: !Sc.Note.PlayNotes
- play_inv_tempo :: !(Maybe.Maybe Transport.InverseTempoFunction)
- play_repeat_at :: !(Maybe.Maybe RealTime.RealTime)
- play_im_end :: !(Maybe.Maybe RealTime.RealTime)
- play_im_direct :: !(Maybe.Maybe PlayDirectArgs)
- data Status
- = Continue
- | Done
- | Play !PlayArgs
- | FloatingInput !FloatingInput
- | Quit
- type CmdL a = CmdT IO a
- type CmdId = CmdT Identity
- data MouseOn
- data Bindable
- data KeySpec = KeySpec !(Set Modifier) !Bindable
- type Keymap m = Map KeySpec (NamedCmd m)
- data NoteEntryMap a
- = WithOctave (Map Pitch.Octave (Map Char a))
- | WithoutOctave (Map Char a)
- data NamedCmd m = NamedCmd {}
- type HandlerId = Handler CmdId
- data Handler m
- = Keymap !(Keymap m)
- | Handler !(Maybe.Maybe (NoteEntryMap KeycapsT.KeyDoc)) !(NamedCmd m)
- handler :: Text -> (Msg.Msg -> m Status) -> Handler m
- call :: M m => Handler m -> Msg.Msg -> m Status
- mods_down :: M m => m (Set Modifier)
- note_entry_lookup :: Pitch.Octave -> Char -> NoteEntryMap a -> Maybe.Maybe a
- msg_to_bindable :: Msg.Msg -> Maybe.Maybe Bindable
- mouse_on :: UiMsg.Context -> MouseOn
- show_mod :: Modifier -> Text
- show_bindable :: Bool -> Bindable -> Text
- merge_status :: Status -> Status -> Status
- run :: Monad m => a -> RunCmd m m a
- run_ :: Monad m => Ui.State -> State -> CmdT m a -> m (Either String (a, State, Ui.State), [Log.Msg])
- eval :: Monad m => Ui.State -> State -> CmdT m a -> m (Either String a, [Log.Msg])
- run_id :: Ui.State -> State -> CmdT Identity a -> Result (Maybe.Maybe a)
- run_id_io :: RunCmd Identity IO Status
- run_io :: RunCmd IO IO Status
- lift_id :: M m => CmdId a -> m a
- sequence_cmds :: M m => [a -> m Status] -> a -> m Status
- midi_thru :: Midi.WriteDevice -> Midi.Message -> Thru
- midi :: M m => Midi.WriteDevice -> Midi.Message -> m ()
- osc :: M m => [OSC.OSC] -> m ()
- throw :: (CallStack.Stack, M m) => Text -> m a
- ignore_abort :: M m => m a -> m ()
- rethrow_io :: IO a -> CmdT IO a
- abort_unless :: M m => Maybe.Maybe a -> m a
- require :: (CallStack.Stack, M m) => Text -> Maybe.Maybe a -> m a
- require_right :: (CallStack.Stack, M m) => (err -> Text) -> Either err a -> m a
- state_save_dir :: State -> Maybe.Maybe FilePath
- score_path :: State -> FilePath
- fingerprint :: [Ky.Loaded] -> Fingerprint
- initial_state :: Config -> State
- reinit_state :: HistoryEntry -> State -> State
- state_midi_writer :: State -> Interface.Message -> IO ()
- to_absolute :: State -> Path.Relative -> FilePath
- lookup_scale :: LookupScale
- kill_thread :: Thread -> IO ()
- kill_performance_threads :: State -> IO ()
- running_threads :: CmdT IO [BlockId]
- initial_play_state :: PlayState
- initial_edit_state :: EditState
- empty_wdev_state :: WriteDeviceState
- perf_tempo :: Performance -> Transport.TempoFunction
- perf_inv_tempo :: Performance -> Transport.InverseTempoFunction
- perf_closest_warp :: Performance -> Transport.ClosestWarpFunction
- make_derive_instrument :: ResolvedInstrument -> Instrument
- empty_code :: InstrumentCode
- initial_history :: HistoryEntry -> History
- empty_history_config :: HistoryConfig
- empty_history_collect :: HistoryCollect
- empty_history_entry :: Ui.State -> HistoryEntry
- empty_selection_history :: SelectionHistory
- mouse_mod_btn :: Modifier -> Maybe.Maybe Types.MouseButton
- strip_modifier :: Modifier -> Modifier
- gets :: M m => (State -> a) -> m a
- modify :: M m => (State -> State) -> m ()
- modify_play_state :: M m => (PlayState -> PlayState) -> m ()
- get_screen :: M m => Maybe.Maybe (Int, Int) -> m Rect.Rect
- lookup_performance :: M m => BlockId -> m (Maybe.Maybe Performance)
- get_performance :: M m => BlockId -> m Performance
- invalidate_performances :: M m => m ()
- clear_im_cache :: BlockId -> CmdT IO ()
- keys_down :: M m => m (Map Modifier Modifier)
- get_focused_view :: M m => m ViewId
- get_focused_block :: M m => m BlockId
- lookup_focused_view :: M m => m (Maybe.Maybe ViewId)
- lookup_focused_block :: M m => m (Maybe.Maybe BlockId)
- focus :: Ui.M m => ViewId -> m ()
- get_current_step :: M m => m TimeStep.TimeStep
- get_insert_tracknum :: M m => m (Maybe.Maybe Types.TrackNum)
- set_view_status :: M m => ViewId -> (Int, Text) -> Maybe.Maybe Text -> m ()
- set_global_status :: M m => Text -> Text -> m ()
- set_status :: M m => (Int, Text) -> Maybe.Maybe Text -> m ()
- inst_synth :: ResolvedInstrument -> InstT.SynthName
- inst_common :: ResolvedInstrument -> Common.Common InstrumentCode
- midi_patch :: ResolvedInstrument -> Maybe.Maybe (Patch.Patch, Patch.Config)
- sc_patch :: ResolvedInstrument -> Maybe.Maybe Sc.Patch.Patch
- get_midi_instrument :: (CallStack.Stack, M m) => ScoreT.Instrument -> m (Patch.Patch, Patch.Config)
- lookup_midi_config :: M m => ScoreT.Instrument -> m (Maybe.Maybe Patch.Config)
- lookup_backend :: M m => ScoreT.Instrument -> m (Maybe.Maybe Backend)
- lookup_instrument :: M m => ScoreT.Instrument -> m (Maybe.Maybe ResolvedInstrument)
- get_instrument :: (CallStack.Stack, M m) => ScoreT.Instrument -> m ResolvedInstrument
- get_lookup_instrument :: M m => m (ScoreT.Instrument -> Maybe.Maybe ResolvedInstrument)
- state_lookup_instrument :: Ui.State -> State -> ScoreT.Instrument -> Either Text ResolvedInstrument
- memoized_instrument :: UiConfig.Allocations -> InstrumentDb -> ScoreT.Instrument -> Either Text ResolvedInstrument
- resolve_instrument :: InstrumentDb -> UiConfig.Allocation -> Either Text ResolvedInstrument
- get_qualified :: M m => InstT.Qualified -> m Inst
- get_alloc_qualified :: M m => UiConfig.Allocation -> m Inst
- lookup_qualified :: M m => InstT.Qualified -> m (Maybe.Maybe Inst)
- get_lookup_backend :: State -> InstT.Qualified -> Maybe.Maybe Inst.Backend
- inst_lookup :: InstT.Qualified -> InstrumentDb -> Maybe.Maybe Inst
- get_wdev_state :: M m => m WriteDeviceState
- modify_wdev_state :: M m => (WriteDeviceState -> WriteDeviceState) -> m ()
- derive_immediately :: M m => [BlockId] -> m ()
- inflict_damage :: M m => ScoreDamage -> m ()
- inflict_block_damage :: M m => BlockId -> m ()
- inflict_track_damage :: M m => BlockId -> TrackId -> m ()
- modify_edit_state :: M m => (EditState -> EditState) -> m ()
- set_edit_box :: M m => Block.Box -> Block.Box -> m ()
- is_val_edit :: M m => m Bool
- is_kbd_entry :: M m => m Bool
- set_note_text :: M m => Text -> m ()
- get_instrument_attributes :: M m => ScoreT.Instrument -> m Attrs.Attributes
- set_instrument_attributes :: M m => ScoreT.Instrument -> Attrs.Attributes -> m ()
- name :: M m => Text -> m a -> m a
- suppress_history :: M m => EditMode -> Text -> m a -> m a
- log_event :: BlockId -> TrackId -> Event.Event -> Text
- all_notes_off :: M m => m ()
- data Performance = Performance {
- perf_derive_cache :: Cache
- perf_events :: Vector Score.Event
- perf_logs :: [Log.Msg]
- perf_logs_written :: Bool
- perf_track_dynamic :: TrackDynamic
- perf_integrated :: [Integrated]
- perf_damage :: ScoreDamage
- perf_warps :: [TrackWarp.TrackWarp]
- perf_track_signals :: TrackSignals
- perf_block_deps :: BlockDeps
- perf_track_instruments :: Map TrackId (Set ScoreT.Instrument)
- perf_ui_state :: Ui.State
Documentation
This merges the compiled-id Inst.Backend
and the per-score
UiConfig.Backend
.
Instances
data ResolvedInstrument Source #
This is an instrument as looked up by lookup_instrument
or
get_lookup_instrument
. This merges compiled-in and runtime instrument
data.
Instances
Show ResolvedInstrument Source # | |
Defined in Cmd.Cmd showsPrec :: Int -> ResolvedInstrument -> ShowS # show :: ResolvedInstrument -> String # showList :: [ResolvedInstrument] -> ShowS # | |
Pretty.Pretty ResolvedInstrument Source # | |
Defined in Cmd.Cmd pretty :: ResolvedInstrument -> Text Source # format :: ResolvedInstrument -> Doc Source # formatList :: [ResolvedInstrument] -> Doc Source # |
KeyMod Key.Modifier | |
MouseMod Types.MouseButton (Maybe.Maybe (Types.TrackNum, UiMsg.Track)) | Mouse button, and track it went down at, if any. The block is not recorded. You can't drag across blocks so you know any click must apply to the focused block. |
MidiMod Midi.Channel Midi.Key | Only chan and key are stored. While it may be useful to map according to the device, this code doesn't know which devices are available. Block or track level handlers can query the device themselves. |
data SelectionHistory Source #
Remember previous selections. This should be updated only by significant movements, so clicks and cmd-a, but not hjkl stuff.
SelectionHistory | |
|
Instances
Show SelectionHistory Source # | |
Defined in Cmd.Cmd showsPrec :: Int -> SelectionHistory -> ShowS # show :: SelectionHistory -> String # showList :: [SelectionHistory] -> ShowS # | |
Eq SelectionHistory Source # | |
Defined in Cmd.Cmd (==) :: SelectionHistory -> SelectionHistory -> Bool # (/=) :: SelectionHistory -> SelectionHistory -> Bool # | |
Pretty.Pretty SelectionHistory Source # | |
Defined in Cmd.Cmd pretty :: SelectionHistory -> Text Source # format :: SelectionHistory -> Doc Source # formatList :: [SelectionHistory] -> Doc Source # |
data HistoryEntry Source #
HistoryEntry | |
|
Instances
Show HistoryEntry Source # | |
Defined in Cmd.Cmd showsPrec :: Int -> HistoryEntry -> ShowS # show :: HistoryEntry -> String # showList :: [HistoryEntry] -> ShowS # | |
Pretty.Pretty HistoryEntry Source # | |
Defined in Cmd.Cmd pretty :: HistoryEntry -> Text Source # format :: HistoryEntry -> Doc Source # formatList :: [HistoryEntry] -> Doc Source # |
data HistoryCollect Source #
HistoryCollect | |
|
Instances
Show HistoryCollect Source # | |
Defined in Cmd.Cmd showsPrec :: Int -> HistoryCollect -> ShowS # show :: HistoryCollect -> String # showList :: [HistoryCollect] -> ShowS # | |
Pretty.Pretty HistoryCollect Source # | |
Defined in Cmd.Cmd pretty :: HistoryCollect -> Text Source # format :: HistoryCollect -> Doc Source # formatList :: [HistoryCollect] -> Doc Source # |
data HistoryConfig Source #
HistoryConfig | |
|
Instances
Show HistoryConfig Source # | |
Defined in Cmd.Cmd showsPrec :: Int -> HistoryConfig -> ShowS # show :: HistoryConfig -> String # showList :: [HistoryConfig] -> ShowS # | |
Pretty.Pretty HistoryConfig Source # | |
Defined in Cmd.Cmd pretty :: HistoryConfig -> Text Source # format :: HistoryConfig -> Doc Source # formatList :: [HistoryConfig] -> Doc Source # |
Record some information about the last cmd for the benefit of
maintain_history
.
UndoRedo | This cmd set the state because it was an undo or redo. Otherwise undo and redo themselves would be recorded and multiple undo would be impossible! |
Load (Maybe.Maybe GitT.Commit) [Text] | This cmd set the state because of a load. This should reset all the history so I can start loading from the new state's history. |
Ghosts of state past, present, and future.
History | |
|
Instances
type Inst = Inst.Inst InstrumentCode Source #
Like InstrumentDb
.
type InstrumentDb = Inst.Db InstrumentCode Source #
Instantiate Inst.Db
with the code type. The only reason the Db has the
type parameter is so I can define it in its own module without a circular
import.
type InstrumentPostproc = Score.Event -> (Score.Event, [Log.Msg]) Source #
Process each event before conversion. This is like a postproc call, but it can only map events 1:1 and you don't have to explicitly call it.
This can change the duration, but should not change Score.event_start
,
because the events are not resorted afterwards. Also, it's applied during
conversion, so it only makes sense to modify Score.event_duration
,
Score.event_controls
, Score.event_pitch
, and Score.event_environ
.
TODO so I could have it return just those? But then it has to return Maybe
to not modify and needs a record type.
type ThruFunction = Scale -> Attrs.Attributes -> InputNote.Input -> CmdId [Thru] Source #
data InstrumentCode Source #
The code part of an instrument, i.e. the calls and cmds it brings into scope.
This has to be in Cmd.Cmd for circular import reasons.
InstrumentCode | |
|
Instances
Show InstrumentCode Source # | |
Defined in Cmd.Cmd showsPrec :: Int -> InstrumentCode -> ShowS # show :: InstrumentCode -> String # showList :: [InstrumentCode] -> ShowS # | |
Pretty.Pretty InstrumentCode Source # | |
Defined in Cmd.Cmd pretty :: InstrumentCode -> Text Source # format :: InstrumentCode -> Doc Source # formatList :: [InstrumentCode] -> Doc Source # |
data WriteDeviceState Source #
WriteDeviceState | |
|
Instances
Show WriteDeviceState Source # | |
Defined in Cmd.Cmd showsPrec :: Int -> WriteDeviceState -> ShowS # show :: WriteDeviceState -> String # showList :: [WriteDeviceState] -> ShowS # | |
Eq WriteDeviceState Source # | |
Defined in Cmd.Cmd (==) :: WriteDeviceState -> WriteDeviceState -> Bool # (/=) :: WriteDeviceState -> WriteDeviceState -> Bool # |
Repeat a recorded action.
Select event and duration and hit shift-1 to record InsertEvent.
Text edits record ReplaceText, PrependText, or AppendText in the last
action field (bound to .
), which you can then save.
InsertEvent !(Maybe.Maybe TrackTime) !Text | If a duration is given, the event has that duration, otherwise it gets the current time step. |
ReplaceText !Text | |
PrependText !Text | |
AppendText !Text |
These enable various commands to edit event text. What exactly val and method mean are dependent on the track.
Editing state, modified in the course of editing.
EditState | |
|
type TrackSelection = (Sel.Selection, BlockId, Maybe.Maybe TrackId) Source #
Just a Sel.Selection
annotated with its BlockId and TrackId. There's
no deep reason for it, it just saves a bit of work for selection hooks.
Hooks are Cmds that run after some event.
Hooks | |
|
data SyncConfig Source #
Configure synchronization. MMC is used to set the play position and MTC is used to start and stop playing.
MMC has start and stop msgs, but they seem useless, since they're sysexes, which are not delivered precisely.
SyncConfig | |
|
Instances
Show SyncConfig Source # | |
Defined in Cmd.Cmd showsPrec :: Int -> SyncConfig -> ShowS # show :: SyncConfig -> String # showList :: [SyncConfig] -> ShowS # | |
Pretty.Pretty SyncConfig Source # | |
Defined in Cmd.Cmd pretty :: SyncConfig -> Text Source # format :: SyncConfig -> Doc Source # formatList :: [SyncConfig] -> Doc Source # |
Step play is a way of playing back the performance in non-realtime.
StepState | |
|
Wrap Async to make it showable. I use Async instead of ThreadId because
I want to make sure they can run their finalizers when the app quits, and
I can wait on an Async, but not on a ThreadId. At the moment, the
finalizers are killing im subprocesses. kill_thread
uses Async.cancel,
which synchronously waits for the thread to complete.
Thread (Async.Async ()) |
Wrapper around CmdId PlayArgs to make it Showable.
State concerning derivation, performance, and playing the performance.
PlayState | |
|
Config type variables that change never or rarely. These mostly come from the App.StaticConfig.
Config | |
|
data Fingerprint Source #
Keep track of loaded files and a fingerprint for their contents. This is used to detect when they should be reloaded.
Fingerprint ![FilePath] !Int |
Instances
Monoid Fingerprint Source # | |
Defined in Cmd.Cmd mempty :: Fingerprint # mappend :: Fingerprint -> Fingerprint -> Fingerprint # mconcat :: [Fingerprint] -> Fingerprint # | |
Semigroup Fingerprint Source # | |
Defined in Cmd.Cmd (<>) :: Fingerprint -> Fingerprint -> Fingerprint # sconcat :: NonEmpty Fingerprint -> Fingerprint # stimes :: Integral b => b -> Fingerprint -> Fingerprint # | |
Show Fingerprint Source # | |
Defined in Cmd.Cmd showsPrec :: Int -> Fingerprint -> ShowS # show :: Fingerprint -> String # showList :: [Fingerprint] -> ShowS # | |
Eq Fingerprint Source # | |
Defined in Cmd.Cmd (==) :: Fingerprint -> Fingerprint -> Bool # (/=) :: Fingerprint -> Fingerprint -> Bool # | |
Pretty.Pretty Fingerprint Source # | |
Defined in Cmd.Cmd pretty :: Fingerprint -> Text Source # format :: Fingerprint -> Doc Source # formatList :: [Fingerprint] -> Doc Source # |
A loaded and parsed ky file, or an error string. This also has the files loaded and their timestamps, to detect when one has changed.
KyCache !(Either Text (Builtins, InstrumentAliases)) !Fingerprint | |
PermanentKy !(Builtins, InstrumentAliases) | This disables the cache mechanism. Tests use this to avoid having to set SaveFile. |
data KeycapsState Source #
The set of things that can affect a keycaps window. So when this changes, the window has to be updated. I assume the KeycapsT.Layout is constant, so it's not in here, which allows me to cache global keymaps in CAFs.
Instances
Show KeycapsState Source # | |
Defined in Cmd.Cmd showsPrec :: Int -> KeycapsState -> ShowS # show :: KeycapsState -> String # showList :: [KeycapsState] -> ShowS # | |
Eq KeycapsState Source # | |
Defined in Cmd.Cmd (==) :: KeycapsState -> KeycapsState -> Bool # (/=) :: KeycapsState -> KeycapsState -> Bool # |
data KeycapsUpdate Source #
KeycapsUpdate KeycapsState (Maybe.Maybe ((Int, Int), KeycapsT.Layout)) KeycapsT.RawBindings | |
KeycapsClose |
Instances
Show KeycapsUpdate Source # | |
Defined in Cmd.Cmd showsPrec :: Int -> KeycapsUpdate -> ShowS # show :: KeycapsUpdate -> String # showList :: [KeycapsUpdate] -> ShowS # |
data SavedState Source #
JustLoaded | Just loaded from a file. This is almost like SavedChanges, except
that it's required so |
UnsavedChanges | |
SavedChanges |
Instances
Show SavedState Source # | |
Defined in Cmd.Cmd showsPrec :: Int -> SavedState -> ShowS # show :: SavedState -> String # showList :: [SavedState] -> ShowS # | |
Eq SavedState Source # | |
Defined in Cmd.Cmd (==) :: SavedState -> SavedState -> Bool # (/=) :: SavedState -> SavedState -> Bool # |
This tracks how much the score has been saved to disk.
Saved | |
|
App global state. Unlike Ui.State
, this is not saved to disk.
This is normally modified inside a CmdT
, which is also a StateT
,
so it can also use the UI state functions. If an exception is thrown, both
this state and the UI state will be rolled back.
This is kind of an unorganized wodge. The problem is that since state is all centralized in one place, every special snowflake Cmd that needs its own bit of state winds up getting its own little knob in here. On one hand, it's non-modular. On the other hand, it lets me keep an eye on it.
So far, most Cmds are pretty fundamental, so they more or less deserve
their spots here. If it gets out of control, though, I'll have to either
come up with a clever way of storing typed data where they can't collide,
say by having a Cmd return a new Cmd and keeping the state trapped inside,
or a less clever but simpler and easier way like Map Name Dynamic
.
State | |
|
MidiThru !Interface.Message | Send MIDI thru. You can give it a timestamp, but it should be 0 for
thru, which will cause it to go straight to the front of the queue. Use
|
ImThru !Thru.Message | |
OscThru ![OSC.OSC] |
class (Log.LogMonad m, Ui.M m) => M m where Source #
write_thru :: Thru -> m () Source #
Log a note to send out. This is the midi or im thru mechanism.
An abort is an exception to get out of CmdT, but it's considered the
same as returning Continue. It's so a command can back out if e.g. it's
selected by the Handler
but has an additional prerequisite such as
having an active block.
catch_abort :: m a -> m (Maybe.Maybe a) Source #
Instances
MonadTrans CmdT Source # | For some reason, newtype deriving doesn't work on MonadTrans. |
Monad m => MonadError Ui.Error (CmdT m) Source # | |
MonadIO m => MonadIO (CmdT m) Source # | |
Monad m => Applicative (CmdT m) Source # | |
Functor m => Functor (CmdT m) Source # | |
Monad m => Monad (CmdT m) Source # | |
Monad m => M (CmdT m) Source # | |
Monad m => Ui.M (CmdT m) Source # | And to the UI state operations. |
Monad m => Log.LogMonad (CmdT m) Source # | Give CmdT unlifted access to all the logging functions. |
type CmdStack m = Ui.StateT (MonadState.StateT State (Logger.LoggerT Thru (Log.LogT m))) Source #
type Result a = (State, [Thru], [Log.Msg], Either Ui.Error (a, Ui.State, Update.UiDamage)) Source #
The result of running a Cmd.
type RunCmd cmd_m val_m a = Ui.State -> State -> CmdT cmd_m a -> val_m (Result a) Source #
Cmds can run in either Identity or IO, but are generally returned in IO, just to make things uniform.
data FloatingInput Source #
FloatingOpen !ViewId !Types.TrackNum !ScoreTime !Text !(Int, Int) | Open a new floating text input. View, track, pos, (select start, select end). |
FloatingInsert !Text | Insert the given text into an already open edit box. |
Instances
Show FloatingInput Source # | |
Defined in Cmd.Cmd showsPrec :: Int -> FloatingInput -> ShowS # show :: FloatingInput -> String # showList :: [FloatingInput] -> ShowS # |
data PlayDirectArgs Source #
Arguments for play_im_direct_thread
.
Instances
Show PlayDirectArgs Source # | |
Defined in Cmd.Cmd showsPrec :: Int -> PlayDirectArgs -> ShowS # show :: PlayDirectArgs -> String # showList :: [PlayDirectArgs] -> ShowS # | |
Eq PlayDirectArgs Source # | |
Defined in Cmd.Cmd (==) :: PlayDirectArgs -> PlayDirectArgs -> Bool # (/=) :: PlayDirectArgs -> PlayDirectArgs -> Bool # |
PlayArgs | |
|
Continue | Continue processing, so another Cmd will have an opportunity to see the Msg. |
Done | Stop further cmd processing, "consuming" the Msg. |
Play !PlayArgs | Hack to control import dependencies, see Cmd.PlayC. |
FloatingInput !FloatingInput | Open a FloatingInput box. |
Quit | Pack it up and go home. |
Where a click or drag occurred.
Key Bool Key.Key | Key IsRepeat Key |
Click Types.MouseButton MouseOn Int | Click MouseButton Clicks |
Drag Types.MouseButton MouseOn | |
Release Types.MouseButton MouseOn | Mouse button release. |
Note Midi.Channel Midi.Key | Channel can be used to restrict bindings to a certain keyboard. This should probably be something more abstract though, such as a device which can be set by the static config. |
data NoteEntryMap a Source #
NoteEntry might depend on base octave, and might have different mappings for unshifted or shifted.
WithOctave (Map Pitch.Octave (Map Char a)) | |
WithoutOctave (Map Char a) |
Instances
Functor NoteEntryMap Source # | |
Defined in Cmd.Cmd fmap :: (a -> b) -> NoteEntryMap a -> NoteEntryMap b # (<$) :: a -> NoteEntryMap b -> NoteEntryMap a # | |
Show a => Show (NoteEntryMap a) Source # | |
Defined in Cmd.Cmd showsPrec :: Int -> NoteEntryMap a -> ShowS # show :: NoteEntryMap a -> String # showList :: [NoteEntryMap a] -> ShowS # |
Pair a Cmd with a Doc that can be used for logging, undo, etc.
This is the toplevel object representing a cmd. Fundamentally it's just Msg -> Status, but it's also wrapped up in some documentation, so cmds can be introspected.
Keymap !(Keymap m) | |
Handler !(Maybe.Maybe (NoteEntryMap KeycapsT.KeyDoc)) !(NamedCmd m) |
mods_down :: M m => m (Set Modifier) Source #
Return the mods currently down, stripping out non-modifier keys and notes, so that overlapping keys will still match. Mouse mods are not filtered, so each mouse chord can be bound individually.
note_entry_lookup :: Pitch.Octave -> Char -> NoteEntryMap a -> Maybe.Maybe a Source #
mouse_on :: UiMsg.Context -> MouseOn Source #
merge_status :: Status -> Status -> Status Source #
Combine two Statuses by keeping the one with higher priority. Yes, Status could be a Monoid but merge should be a rare operation.
run_ :: Monad m => Ui.State -> State -> CmdT m a -> m (Either String (a, State, Ui.State), [Log.Msg]) Source #
Like run
, but discard MIDI thru and updates.
eval :: Monad m => Ui.State -> State -> CmdT m a -> m (Either String a, [Log.Msg]) Source #
Like run_
, but discard all the final states.
run_id :: Ui.State -> State -> CmdT Identity a -> Result (Maybe.Maybe a) Source #
Run the Cmd in Identity, returning Nothing if it aborted.
run_id_io :: RunCmd Identity IO Status Source #
Run the given command in Identity, but return it in IO, just as
a convenient way to have a uniform return type with run
(provided it is
run in IO).
lift_id :: M m => CmdId a -> m a Source #
Promote a CmdId to a generic cmd, which can also run as a CmdT IO. TODO: shouldn't it be possible to do this for free?
sequence_cmds :: M m => [a -> m Status] -> a -> m Status Source #
Run a set of Cmds as a single Cmd. The first one to return non-Continue will return. Cmds can use this to dispatch to other Cmds.
midi_thru :: Midi.WriteDevice -> Midi.Message -> Thru Source #
midi :: M m => Midi.WriteDevice -> Midi.Message -> m () Source #
throw :: (CallStack.Stack, M m) => Text -> m a Source #
This is the same as Ui.throw, but it feels like things in Cmd may not always want to reuse State's exceptions, so they should call this one.
ignore_abort :: M m => m a -> m () Source #
Run a subcomputation that is allowed to abort.
rethrow_io :: IO a -> CmdT IO a Source #
Run an IO action, rethrowing any IO exception as a Cmd exception.
abort_unless :: M m => Maybe.Maybe a -> m a Source #
Extract a Just value, or abort
. Generally used to check for Cmd
conditions that don't fit into a Keymap.
require :: (CallStack.Stack, M m) => Text -> Maybe.Maybe a -> m a Source #
Throw an exception with the given msg on Nothing.
require_right :: (CallStack.Stack, M m) => (err -> Text) -> Either err a -> m a Source #
state_save_dir :: State -> Maybe.Maybe FilePath Source #
Absolute directory of the save file.
score_path :: State -> FilePath Source #
Unique name for this score, for the global im cache.
fingerprint :: [Ky.Loaded] -> Fingerprint Source #
initial_state :: Config -> State Source #
reinit_state :: HistoryEntry -> State -> State Source #
Reset the parts of the State which are specific to a "session". This should be called whenever an entirely new state is loaded.
state_midi_writer :: State -> Interface.Message -> IO () Source #
Get a midi writer that takes the config_wdev_map
into account.
to_absolute :: State -> Path.Relative -> FilePath Source #
Convert a relative path to place it in the app dir.
lookup_scale :: LookupScale Source #
This was previously in Config
, and configured via StaticConfig. But it
turns out I don't really use StaticConfig. It has a name here just so
I don't get references to Scale.All.lookup_scale
everywhere.
kill_thread :: Thread -> IO () Source #
kill_performance_threads :: State -> IO () Source #
strip_modifier :: Modifier -> Modifier Source #
Take a modifier to its key in the modifier map which has extra info like mouse down position stripped.
get_screen :: M m => Maybe.Maybe (Int, Int) -> m Rect.Rect Source #
Return the rect of the screen closest to the given point, or the default.
lookup_performance :: M m => BlockId -> m (Maybe.Maybe Performance) Source #
get_performance :: M m => BlockId -> m Performance Source #
invalidate_performances :: M m => m () Source #
Clear all performances, which will cause them to be rederived.
This is stronger than Ui.update_all
, because Ui.update_all will simply
cause diff to look at the blocks for diffs, while this will force a
re-derivation even if there are no apparent diffs.
keys_down :: M m => m (Map Modifier Modifier) Source #
Keys currently held down, as in state_keys_down
.
get_focused_view :: M m => m ViewId Source #
get_focused_block :: M m => m BlockId Source #
lookup_focused_view :: M m => m (Maybe.Maybe ViewId) Source #
lookup_focused_block :: M m => m (Maybe.Maybe BlockId) Source #
In some circumstances I don't want to abort if there's no focused block.
focus :: Ui.M m => ViewId -> m () Source #
Request focus. state_focused_view
will be updated once fltk reports the
focus change.
get_current_step :: M m => m TimeStep.TimeStep Source #
get_insert_tracknum :: M m => m (Maybe.Maybe Types.TrackNum) Source #
Get the leftmost track covered by the insert selection, which is considered the "focused" track by convention.
set_view_status :: M m => ViewId -> (Int, Text) -> Maybe.Maybe Text -> m () Source #
This just calls Ui.set_view_status
, but all status setting should
go through here so they can be uniformly filtered or logged or something.
set_global_status :: M m => Text -> Text -> m () Source #
Emit a special log msg that will cause log view to put this key and value in its status bar. A value of "" will cause logview to delete that key.
set_status :: M m => (Int, Text) -> Maybe.Maybe Text -> m () Source #
Set a status variable on all views.
get_midi_instrument :: (CallStack.Stack, M m) => ScoreT.Instrument -> m (Patch.Patch, Patch.Config) Source #
lookup_midi_config :: M m => ScoreT.Instrument -> m (Maybe.Maybe Patch.Config) Source #
lookup_backend :: M m => ScoreT.Instrument -> m (Maybe.Maybe Backend) Source #
lookup_instrument :: M m => ScoreT.Instrument -> m (Maybe.Maybe ResolvedInstrument) Source #
get_instrument :: (CallStack.Stack, M m) => ScoreT.Instrument -> m ResolvedInstrument Source #
get_lookup_instrument :: M m => m (ScoreT.Instrument -> Maybe.Maybe ResolvedInstrument) Source #
state_lookup_instrument :: Ui.State -> State -> ScoreT.Instrument -> Either Text ResolvedInstrument Source #
memoized_instrument :: UiConfig.Allocations -> InstrumentDb -> ScoreT.Instrument -> Either Text ResolvedInstrument Source #
This memoizes instrument resolution in case you're going to do it a lot.
resolve_instrument
has to merge some things so it's not exactly free.
The spine-strict Map makes this less efficient for one-off lookups, but so
far all uses are mapping the lookup across many events.
Of course, the memoization only works as long as the memo table persists,
which should happen if you use get_lookup_instrument
and reuse the
function it returns.
resolve_instrument :: InstrumentDb -> UiConfig.Allocation -> Either Text ResolvedInstrument Source #
See ResolvedInstrument
.
get_qualified :: M m => InstT.Qualified -> m Inst Source #
get_alloc_qualified :: M m => UiConfig.Allocation -> m Inst Source #
lookup_qualified :: M m => InstT.Qualified -> m (Maybe.Maybe Inst) Source #
Look up an instrument that might not be allocated.
inst_lookup :: InstT.Qualified -> InstrumentDb -> Maybe.Maybe Inst Source #
get_wdev_state :: M m => m WriteDeviceState Source #
modify_wdev_state :: M m => (WriteDeviceState -> WriteDeviceState) -> m () Source #
derive_immediately :: M m => [BlockId] -> m () Source #
inflict_damage :: M m => ScoreDamage -> m () Source #
inflict_block_damage :: M m => BlockId -> m () Source #
Cause a block to rederive even if there haven't been any edits on it.
inflict_track_damage :: M m => BlockId -> TrackId -> m () Source #
Cause a track to rederive even if there haven't been any edits on it.
set_edit_box :: M m => Block.Box -> Block.Box -> m () Source #
At the Ui level, the edit box is per-block, but I use it to indicate edit mode, which is global. So it gets stored in Cmd.State and must be synced with new blocks.
is_val_edit :: M m => m Bool Source #
is_kbd_entry :: M m => m Bool Source #
set_note_text :: M m => Text -> m () Source #
get_instrument_attributes :: M m => ScoreT.Instrument -> m Attrs.Attributes Source #
set_instrument_attributes :: M m => ScoreT.Instrument -> Attrs.Attributes -> m () Source #
name :: M m => Text -> m a -> m a Source #
Give a name to a Cmd. The name is applied when the cmd returns so the names come out in call order, and it doesn't incur overhead for cmds that abort.
suppress_history :: M m => EditMode -> Text -> m a -> m a Source #
Like name
, but also set the state_suppress_edit
. This will suppress
history recording until the edit mode changes from the given one.
log_event :: BlockId -> TrackId -> Event.Event -> Text Source #
Log an event so that it can be clicked on in logview.
all_notes_off :: M m => m () Source #
Turn off all sounding notes, reset controls. TODO clear out WriteDeviceState?
data Performance Source #
This holds the final performance for a given block. It is used to actually play music, and poked and prodded in a separate thread to control its evaluation.
This is basically the same as Result
. I could make them be the
same, but Performance wasn't always the same and may not be the same in the
future.
Unlike other records, the fields here are all lazy. This is because I need
to put an unevaluated Performance into Cmd.state_current_performances, and
then force the fields in a separate thread. Also I need to modify
perf_damage
without forcing any of the others.
Performance | |
|
Instances
Show Performance Source # | |
Defined in Cmd.Msg showsPrec :: Int -> Performance -> ShowS # show :: Performance -> String # showList :: [Performance] -> ShowS # | |
Pretty.Pretty Performance Source # | |
Defined in Cmd.Msg pretty :: Performance -> Text Source # format :: Performance -> Doc Source # formatList :: [Performance] -> Doc Source # |