-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Utilities for the instrument definitions in "Local.Instrument".
module Cmd.Instrument.MidiInst (
    Synth, synth
    , make_inst
    -- * code
    , make_code
    , Code(..), Call
    , generator, transformer, both, note_calls
    , note_generators, note_transformers, val_calls
    , null_call, null_calls
    , postproc, cmd, thru

    -- * Patch
    , Patch(..), patch, common
    , make_patch, patch_from_pair, named_patch, default_patch
    -- ** modify
    , dummy, code, doc, attribute_map, decay, synth_controls
    , add_flag, add_flags, pressure, add_common_flag, triggered
    , control_defaults
    -- ** environ
    , environ, range, nn_range
    -- ** per-allocation
    , inst_range
    -- * allocations
    , allocations, config, config1

    -- * types
    , Load, MakeDb
) where
import qualified Data.Map as Map
import qualified Data.Set as Set

import qualified Util.Doc as Doc
import qualified Util.Lens as Lens
import qualified Util.Pretty as Pretty

import qualified App.Path as Path
import qualified Cmd.Cmd as Cmd
import qualified Derive.Call.Module as Module
import qualified Derive.Derive as Derive
import qualified Derive.Env as Env
import qualified Derive.EnvKey as EnvKey
import qualified Derive.Expr as Expr
import qualified Derive.Library as Library
import qualified Derive.REnv as REnv
import qualified Derive.Scale as Scale
import qualified Derive.ScoreT as ScoreT
import qualified Derive.Symbols as Symbols

import qualified Instrument.Common as Common
import qualified Instrument.Inst as Inst
import qualified Instrument.InstT as InstT

import qualified Midi.Midi as Midi
import qualified Perform.Midi.Control as Control
import qualified Perform.Midi.Patch as Patch
import qualified Perform.Pitch as Pitch
import qualified Perform.Signal as Signal

import qualified Ui.UiConfig as UiConfig

import           Global
import           Types


type Synth = Inst.SynthDecl Cmd.InstrumentCode

synth :: InstT.SynthName -> Text -> [Patch] -> Synth
synth :: SynthName -> SynthName -> [Patch] -> Synth
synth SynthName
name SynthName
doc [Patch]
patches =
    forall code.
SynthName
-> SynthName -> [(SynthName, Inst code)] -> SynthDecl code
Inst.SynthDecl SynthName
name SynthName
doc (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map Patch -> SynthName
name_of [Patch]
patches) (forall a b. (a -> b) -> [a] -> [b]
map Patch -> Inst InstrumentCode
make_inst [Patch]
patches))
    where name_of :: Patch -> SynthName
name_of = (Patch :-> Patch
patchforall a b c. Lens a b -> Lens b c -> Lens a c
#Patch :-> SynthName
Patch.name #$)

make_inst :: Patch -> Inst.Inst Cmd.InstrumentCode
make_inst :: Patch -> Inst InstrumentCode
make_inst (Patch Patch
patch Maybe SynthName
dummy Common Code
common) = Inst.Inst
    { inst_backend :: Backend
inst_backend = case Maybe SynthName
dummy of
        Maybe SynthName
Nothing -> Patch -> Backend
Inst.Midi Patch
patch
        Just SynthName
msg -> SynthName -> Backend
Inst.Dummy SynthName
msg
    , inst_common :: Common InstrumentCode
inst_common = Common Code
common
        { common_code :: InstrumentCode
Common.common_code = Code -> InstrumentCode
make_code (forall code. Common code -> code
Common.common_code Common Code
common) }
    }

make_code :: Code -> Cmd.InstrumentCode
make_code :: Code -> InstrumentCode
make_code (Code Library
library InstrumentPostproc
postproc [HandlerId]
cmds Maybe ThruFunction
thru) = Cmd.InstrumentCode
    { inst_calls :: InstrumentCalls
inst_calls = Library -> InstrumentCalls
compile_library Library
library
    , inst_postproc :: InstrumentPostproc
inst_postproc = InstrumentPostproc
postproc
    , inst_cmds :: [HandlerId]
inst_cmds = [HandlerId]
cmds
    , inst_thru :: Maybe ThruFunction
inst_thru = Maybe ThruFunction
thru
    }

-- | InstrumentCalls doesn't have modules, so just pull everything out of every
-- module.
compile_library :: Library.Library -> Derive.InstrumentCalls
compile_library :: Library -> InstrumentCalls
compile_library = forall {a} {control} {pitch} {a} {control} {pitch} {a} {control}
       {pitch} {a}.
ScopesT
  (Scope (Map Module (CallMap a)) control pitch)
  (Scope (Map Module (CallMap a)) control pitch)
  (Scope (Map Module (CallMap a)) control pitch)
  (Map Module (CallMap a))
-> ScopesT (CallMap a) (CallMap a) (CallMap a) (CallMap a)
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library
-> (ScopesT
      (Scope
         (Map Module (CallMap (Generator Note)))
         (ModuleMap (Generator Control))
         (ModuleMap (Generator Pitch)))
      (Scope
         (Map Module (CallMap (Transformer Note)))
         (ModuleMap (Transformer Control))
         (ModuleMap (Transformer Pitch)))
      (Scope
         (Map Module (CallMap (TrackCall Note)))
         (ModuleMap (TrackCall Control))
         (ModuleMap (TrackCall Pitch)))
      (Map Module (CallMap ValCall)),
    [Shadowed])
Library.compile
    where
    convert :: ScopesT
  (Scope (Map Module (CallMap a)) control pitch)
  (Scope (Map Module (CallMap a)) control pitch)
  (Scope (Map Module (CallMap a)) control pitch)
  (Map Module (CallMap a))
-> ScopesT (CallMap a) (CallMap a) (CallMap a) (CallMap a)
convert (Derive.Scopes Scope (Map Module (CallMap a)) control pitch
gen Scope (Map Module (CallMap a)) control pitch
trans Scope (Map Module (CallMap a)) control pitch
track Map Module (CallMap a)
val) = Derive.Scopes
        { scopes_generator :: CallMap a
scopes_generator = forall a. Map Module (CallMap a) -> CallMap a
extract forall a b. (a -> b) -> a -> b
$ forall note control pitch. Scope note control pitch -> note
Derive.scope_note Scope (Map Module (CallMap a)) control pitch
gen
        , scopes_transformer :: CallMap a
scopes_transformer = forall a. Map Module (CallMap a) -> CallMap a
extract forall a b. (a -> b) -> a -> b
$ forall note control pitch. Scope note control pitch -> note
Derive.scope_note Scope (Map Module (CallMap a)) control pitch
trans
        , scopes_track :: CallMap a
scopes_track = forall a. Map Module (CallMap a) -> CallMap a
extract forall a b. (a -> b) -> a -> b
$ forall note control pitch. Scope note control pitch -> note
Derive.scope_note Scope (Map Module (CallMap a)) control pitch
track
        , scopes_val :: CallMap a
scopes_val = forall a. Map Module (CallMap a) -> CallMap a
extract Map Module (CallMap a)
val
        }
    -- TODO this doesn't warn about shadowed entries, but I'd have to extend
    -- 'synth' to be in LogMonad.
    extract :: Map Module.Module (Derive.CallMap a) -> Derive.CallMap a
    extract :: forall a. Map Module (CallMap a) -> CallMap a
extract = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems

-- * code

-- | A version of 'Cmd.InstrumentCode' that's more convenient for record update
-- syntax.
data Code = Code {
    Code -> Library
code_library :: !Library.Library
    , Code -> InstrumentPostproc
code_postproc :: !Cmd.InstrumentPostproc
    , Code -> [HandlerId]
code_cmds :: ![Cmd.HandlerId]
    , Code -> Maybe ThruFunction
code_thru :: !(Maybe Cmd.ThruFunction)
    }

instance Pretty Code where
    format :: Code -> Doc
format (Code Library
library InstrumentPostproc
_postproc [HandlerId]
cmds Maybe ThruFunction
thru) =
        Doc -> [(SynthName, Doc)] -> Doc
Pretty.record Doc
"Code"
            [ (SynthName
"library", forall a. Pretty a => a -> Doc
Pretty.format Library
library)
            , (SynthName
"cmds", forall a. Pretty a => a -> Doc
Pretty.format forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [HandlerId]
cmds)
            , (SynthName
"thru", forall a. Pretty a => a -> Doc
Pretty.format Maybe ThruFunction
thru)
            ]

instance Semigroup Code where
    <> :: Code -> Code -> Code
(<>)    (Code Library
lib1 InstrumentPostproc
post1 [HandlerId]
cmds1 Maybe ThruFunction
thru1)
            (Code Library
lib2 InstrumentPostproc
post2 [HandlerId]
cmds2 Maybe ThruFunction
thru2) =
        Library
-> InstrumentPostproc -> [HandlerId] -> Maybe ThruFunction -> Code
Code (Library
lib1forall a. Semigroup a => a -> a -> a
<>Library
lib2) (forall b c log a.
(b -> (c, [log])) -> (a -> (b, [log])) -> a -> (c, [log])
merge InstrumentPostproc
post1 InstrumentPostproc
post2) ([HandlerId]
cmds1forall a. Semigroup a => a -> a -> a
<>[HandlerId]
cmds2) (Maybe ThruFunction
thru1forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>Maybe ThruFunction
thru2)
instance Monoid Code where
    mempty :: Code
mempty = Library
-> InstrumentPostproc -> [HandlerId] -> Maybe ThruFunction -> Code
Code forall a. Monoid a => a
mempty (,[]) [] forall a. Maybe a
Nothing
    mappend :: Code -> Code -> Code
mappend = forall a. Semigroup a => a -> a -> a
(<>)

merge :: (b -> (c, [log])) -> (a -> (b, [log])) -> (a -> (c, [log]))
merge :: forall b c log a.
(b -> (c, [log])) -> (a -> (b, [log])) -> a -> (c, [log])
merge b -> (c, [log])
f1 a -> (b, [log])
f2 = (\(b
b, [log]
logs) -> ([log]
logs++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> (c, [log])
f1 b
b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, [log])
f2

-- ** code constructors

-- | Bundle together generators and transformers.  The rationale is described
-- in 'Derive.CallMaps'.
data Call d =
    Generator Expr.Symbol (Derive.Generator d)
    | Transformer Expr.Symbol (Derive.Transformer d)
    | Both Expr.Symbol (Derive.Generator d) (Derive.Transformer d)

generator :: Expr.Symbol -> Derive.Generator d -> Call d
generator :: forall d. Symbol -> Generator d -> Call d
generator = forall d. Symbol -> Generator d -> Call d
Generator

transformer :: Expr.Symbol -> Derive.Transformer d -> Call d
transformer :: forall d. Symbol -> Transformer d -> Call d
transformer = forall d. Symbol -> Transformer d -> Call d
Transformer

both :: Expr.Symbol -> Library.Calls d -> Call d
both :: forall d. Symbol -> Calls d -> Call d
both Symbol
name Calls d
calls =
    forall d. Symbol -> Generator d -> Transformer d -> Call d
Both Symbol
name (forall d. Calls d -> Generator d
Library.generator Calls d
calls) (forall d. Calls d -> Transformer d
Library.transformer Calls d
calls)

-- | Add the given call as the null note call to the note track.  This also
-- binds 'Symbols.default_note', since that's supposed to be the \"named\" way
-- to call \"\".
null_call :: Derive.Generator Derive.Note -> Code
null_call :: Generator Note -> Code
null_call = [Call Note] -> Code
note_calls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Generator Note -> [Call Note]
null_calls

null_calls :: Derive.Generator Derive.Note -> [Call Derive.Note]
null_calls :: Generator Note -> [Call Note]
null_calls Generator Note
call =
    [ forall d. Symbol -> Generator d -> Call d
generator Symbol
Symbols.null_note Generator Note
call
    , forall d. Symbol -> Generator d -> Call d
generator Symbol
Symbols.default_note Generator Note
call
    ]

note_calls :: [Call Derive.Note] -> Code
note_calls :: [Call Note] -> Code
note_calls [Call Note]
calls =
    [(Symbol, Generator Note)] -> Code
note_generators ([(Symbol
name, Generator Note
c) | Generator Symbol
name Generator Note
c <- [Call Note]
calls]
        forall a. [a] -> [a] -> [a]
++ [(Symbol
name, Generator Note
c) | Both Symbol
name Generator Note
c Transformer Note
_ <- [Call Note]
calls])
    forall a. Semigroup a => a -> a -> a
<> [(Symbol, Transformer Note)] -> Code
note_transformers ([(Symbol
name, Transformer Note
c) | Transformer Symbol
name Transformer Note
c <- [Call Note]
calls]
        forall a. [a] -> [a] -> [a]
++ [(Symbol
name, Transformer Note
c) | Both Symbol
name Generator Note
_ Transformer Note
c <- [Call Note]
calls])

-- | Add the given calls to the note track scope.
note_generators :: [(Expr.Symbol, Derive.Generator Derive.Note)] -> Code
note_generators :: [(Symbol, Generator Note)] -> Code
note_generators [(Symbol, Generator Note)]
calls = forall a. Monoid a => a
mempty { code_library :: Library
code_library = forall call.
ToLibrary (Generator call) =>
[(Symbol, Generator call)] -> Library
Library.generators [(Symbol, Generator Note)]
calls }

-- | Add the given calls to the note track scope.
note_transformers :: [(Expr.Symbol, Derive.Transformer Derive.Note)] -> Code
note_transformers :: [(Symbol, Transformer Note)] -> Code
note_transformers [(Symbol, Transformer Note)]
calls = forall a. Monoid a => a
mempty { code_library :: Library
code_library = forall call.
ToLibrary (Transformer call) =>
[(Symbol, Transformer call)] -> Library
Library.transformers [(Symbol, Transformer Note)]
calls }

val_calls :: [(Expr.Symbol, Derive.ValCall)] -> Code
val_calls :: [(Symbol, ValCall)] -> Code
val_calls [(Symbol, ValCall)]
calls = forall a. Monoid a => a
mempty { code_library :: Library
code_library = [(Symbol, ValCall)] -> Library
Library.vals [(Symbol, ValCall)]
calls }

postproc :: Cmd.InstrumentPostproc -> Code
postproc :: InstrumentPostproc -> Code
postproc InstrumentPostproc
post = forall a. Monoid a => a
mempty { code_postproc :: InstrumentPostproc
code_postproc = InstrumentPostproc
post }

cmd :: Cmd.HandlerId -> Code
cmd :: HandlerId -> Code
cmd HandlerId
c = forall a. Monoid a => a
mempty { code_cmds :: [HandlerId]
code_cmds = [HandlerId
c] }

thru :: Cmd.ThruFunction -> Code
thru :: ThruFunction -> Code
thru ThruFunction
f = forall a. Monoid a => a
mempty { code_thru :: Maybe ThruFunction
code_thru = forall a. a -> Maybe a
Just ThruFunction
f }

-- * Patch

data Patch = Patch {
    Patch -> Patch
patch_patch :: Patch.Patch
    , Patch -> Maybe SynthName
patch_dummy :: Maybe Text
    , Patch -> Common Code
patch_common :: Common.Common Code
    }

patch :: Patch :-> Patch
patch = forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Patch -> Patch
patch_patch (\Patch -> Patch
f Patch
r -> Patch
r { patch_patch :: Patch
patch_patch = Patch -> Patch
f (Patch -> Patch
patch_patch Patch
r) })
common :: Patch :-> Common Code
common = forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Patch -> Common Code
patch_common
    (\Common Code -> Common Code
f Patch
r -> Patch
r { patch_common :: Common Code
patch_common = Common Code -> Common Code
f (Patch -> Common Code
patch_common Patch
r) })

instance Pretty Patch where
    format :: Patch -> Doc
format (Patch Patch
patch Maybe SynthName
dummy Common Code
common) = Doc -> [(SynthName, Doc)] -> Doc
Pretty.record Doc
"Patch"
        [ (SynthName
"patch", forall a. Pretty a => a -> Doc
Pretty.format Patch
patch)
        , (SynthName
"dummy", forall a. Pretty a => a -> Doc
Pretty.format Maybe SynthName
dummy)
        , (SynthName
"common", forall a. Pretty a => a -> Doc
Pretty.format Common Code
common)
        ]

make_patch :: Patch.Patch -> Patch
make_patch :: Patch -> Patch
make_patch Patch
p = Patch
    { patch_patch :: Patch
patch_patch = Patch
p
    , patch_dummy :: Maybe SynthName
patch_dummy = forall a. Maybe a
Nothing
    , patch_common :: Common Code
patch_common = forall code. code -> Common code
Common.common forall a. Monoid a => a
mempty
    }

-- | Convert patches as emitted by 'Patch.Sysex.Patch'.
patch_from_pair :: (Patch.Patch, Common.Common ()) -> Patch
patch_from_pair :: (Patch, Common ()) -> Patch
patch_from_pair (Patch
patch, Common ()
common) = (Patch -> Patch
make_patch Patch
patch)
    { patch_common :: Common Code
patch_common = Common ()
common { common_code :: Code
Common.common_code = forall a. Monoid a => a
mempty } }

-- | Make a patch, with a few parameters that tend to be unique per patch.
-- Controls come last because they are often a long list.
--
-- TODO I don't love the name, but 'patch' is already taken by the lens.
named_patch :: Control.PbRange -> InstT.Name
    -> [(Midi.Control, ScoreT.Control)] -> Patch
named_patch :: PbRange -> SynthName -> [(Control, Control)] -> Patch
named_patch PbRange
pb_range SynthName
name [(Control, Control)]
controls =
    Patch -> Patch
make_patch forall a b. (a -> b) -> a -> b
$ (PbRange -> SynthName -> Patch
Patch.patch PbRange
pb_range SynthName
name)
        { patch_control_map :: ControlMap
Patch.patch_control_map = [(Control, Control)] -> ControlMap
Control.control_map [(Control, Control)]
controls }

-- | Make a default patch for the synth.
default_patch :: Control.PbRange -> [(Midi.Control, ScoreT.Control)] -> Patch
default_patch :: PbRange -> [(Control, Control)] -> Patch
default_patch PbRange
pb_range [(Control, Control)]
controls =
    Patch -> Patch
make_patch forall a b. (a -> b) -> a -> b
$ (PbRange -> SynthName -> Patch
Patch.patch PbRange
pb_range SynthName
Patch.default_name)
        { patch_control_map :: ControlMap
Patch.patch_control_map = [(Control, Control)] -> ControlMap
Control.control_map [(Control, Control)]
controls }

-- ** modify

dummy :: Text -> Patch -> Patch
dummy :: SynthName -> Patch -> Patch
dummy SynthName
msg Patch
patch = Patch
patch { patch_dummy :: Maybe SynthName
patch_dummy = forall a. a -> Maybe a
Just SynthName
msg }

code :: Lens Patch Code
code :: Lens Patch Code
code = Patch :-> Common Code
common forall a b c. Lens a b -> Lens b c -> Lens a c
# forall {code}. Common code :-> code
Common.code

doc :: Lens Patch Doc.Doc
doc :: Lens Patch Doc
doc = Patch :-> Common Code
common forall a b c. Lens a b -> Lens b c -> Lens a c
# forall {code}. Common code :-> Doc
Common.doc

attribute_map :: Lens Patch Patch.AttributeMap
attribute_map :: Lens Patch AttributeMap
attribute_map = Patch :-> Patch
patch forall a b c. Lens a b -> Lens b c -> Lens a c
# Patch :-> AttributeMap
Patch.attribute_map

decay :: Lens Patch (Maybe RealTime)
decay :: Lens Patch (Maybe RealTime)
decay = Patch :-> Patch
patch forall a b c. Lens a b -> Lens b c -> Lens a c
# Patch :-> Settings
Patch.defaults forall a b c. Lens a b -> Lens b c -> Lens a c
# Settings :-> Maybe RealTime
Patch.decay

-- | Annotate all the patches with some global controls.
synth_controls :: [(Midi.Control, ScoreT.Control)] -> [Patch] -> [Patch]
synth_controls :: [(Control, Control)] -> [Patch] -> [Patch]
synth_controls [(Control, Control)]
controls = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$
    Patch :-> Patch
patch forall a b c. Lens a b -> Lens b c -> Lens a c
# Patch :-> ControlMap
Patch.control_map forall f a. Lens f a -> (a -> a) -> f -> f
%= ([(Control, Control)] -> ControlMap
Control.control_map [(Control, Control)]
controls <>)

add_flag :: Patch.Flag -> Patch.Patch -> Patch.Patch
add_flag :: Flag -> Patch -> Patch
add_flag Flag
flag =
    Patch :-> Settings
Patch.defaultsforall a b c. Lens a b -> Lens b c -> Lens a c
#Settings :-> Maybe (Set Flag)
Patch.flags forall f a. Lens f a -> (a -> a) -> f -> f
%= forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag -> Set Flag -> Set Flag
Patch.add_flag Flag
flag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty

add_flags :: [Patch.Flag] -> Patch.Patch -> Patch.Patch
add_flags :: [Flag] -> Patch -> Patch
add_flags [Flag]
flags = Patch :-> Settings
Patch.defaultsforall a b c. Lens a b -> Lens b c -> Lens a c
#Settings :-> Maybe (Set Flag)
Patch.flags
    forall f a. Lens f a -> (a -> a) -> f -> f
%= forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => Set a -> Set a -> Set a
Set.union (forall a. Ord a => [a] -> Set a
Set.fromList [Flag]
flags) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty

-- | Set a patch to pressure control.
pressure :: Patch -> Patch
pressure :: Patch -> Patch
pressure = Patch :-> Patch
patch forall f a. Lens f a -> (a -> a) -> f -> f
%= (Patch :-> Settings
Patch.defaultsforall a b c. Lens a b -> Lens b c -> Lens a c
#Settings :-> Maybe RealTime
Patch.decay forall f a. Lens f a -> a -> f -> f
#= forall a. a -> Maybe a
Just RealTime
0)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag -> Patch -> Patch
add_flag Flag
Patch.Pressure

add_common_flag :: Common.Flag -> Patch -> Patch
add_common_flag :: Flag -> Patch -> Patch
add_common_flag Flag
flag = Patch :-> Common Code
commonforall a b c. Lens a b -> Lens b c -> Lens a c
#forall {code}. Common code :-> Set Flag
Common.flags forall f a. Lens f a -> (a -> a) -> f -> f
%= forall a. Ord a => a -> Set a -> Set a
Set.insert Flag
flag

triggered :: Patch -> Patch
triggered :: Patch -> Patch
triggered = Flag -> Patch -> Patch
add_common_flag Flag
Common.Triggered

control_defaults :: [(ScoreT.Control, Signal.Y)] -> Patch -> Patch
control_defaults :: [(Control, Y)] -> Patch -> Patch
control_defaults [(Control, Y)]
controls =
    Patch :-> Patch
patchforall a b c. Lens a b -> Lens b c -> Lens a c
#Patch :-> Settings
Patch.defaultsforall a b c. Lens a b -> Lens b c -> Lens a c
#Settings :-> Maybe ControlValMap
Patch.control_defaults forall f a. Lens f a -> a -> f -> f
#= forall a. a -> Maybe a
Just (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Control, Y)]
controls)

-- ** environ

-- | The instrument will also set the given environ when it comes into scope.
environ :: REnv.ToVal a => Env.Key -> a -> Patch -> Patch
environ :: forall a. ToVal a => SynthName -> a -> Patch -> Patch
environ SynthName
name a
val = Patch :-> Common Code
common forall f a. Lens f a -> (a -> a) -> f -> f
%= forall a code.
ToVal a =>
SynthName -> a -> Common code -> Common code
Common.add_environ SynthName
name a
val

-- | Set instrument range.
range :: Scale.Range -> Patch -> Patch
range :: Range -> Patch -> Patch
range Range
range = forall a. ToVal a => SynthName -> a -> Patch -> Patch
environ SynthName
EnvKey.instrument_bottom (Range -> Pitch
Scale.range_bottom Range
range)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToVal a => SynthName -> a -> Patch -> Patch
environ SynthName
EnvKey.instrument_top (Range -> Pitch
Scale.range_top Range
range)

nn_range :: (Pitch.NoteNumber, Pitch.NoteNumber) -> Patch -> Patch
nn_range :: (NoteNumber, NoteNumber) -> Patch -> Patch
nn_range (NoteNumber
bottom, NoteNumber
top) = forall a. ToVal a => SynthName -> a -> Patch -> Patch
environ SynthName
EnvKey.instrument_bottom NoteNumber
bottom
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToVal a => SynthName -> a -> Patch -> Patch
environ SynthName
EnvKey.instrument_top NoteNumber
top

-- ** per-allocation

-- | Like 'range', but set it in the allocation, not the patch.
inst_range :: Scale.Range -> Common.Config -> Common.Config
inst_range :: Range -> Config -> Config
inst_range Range
range =
    forall a. ToVal a => SynthName -> a -> Config -> Config
Common.add_cenviron SynthName
EnvKey.instrument_bottom (Range -> Pitch
Scale.range_bottom Range
range)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToVal a => SynthName -> a -> Config -> Config
Common.add_cenviron SynthName
EnvKey.instrument_top (Range -> Pitch
Scale.range_top Range
range)

-- * Allocations

allocations ::
    [(ScoreT.Instrument, InstT.Qualified,
        Common.Config -> Common.Config, UiConfig.Backend)]
    -- ^ (inst, qualified, set_config, backend)
    -> UiConfig.Allocations
allocations :: [(Instrument, Qualified, Config -> Config, Backend)] -> Allocations
allocations = [(Instrument, Allocation)] -> Allocations
UiConfig.make_allocations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}.
(a, Qualified, Config -> Config, Backend) -> (a, Allocation)
make
    where
    make :: (a, Qualified, Config -> Config, Backend) -> (a, Allocation)
make (a
name, Qualified
qualified, Config -> Config
set_config, Backend
backend) =
        ( a
name
        , UiConfig.Allocation
            { alloc_qualified :: Qualified
alloc_qualified = Qualified
qualified
            , alloc_config :: Config
alloc_config = Config -> Config
set_config Config
Common.empty_config
            , alloc_backend :: Backend
alloc_backend = Backend
backend
            }
        )

-- | Create an incomplete Config.  It's incomplete because it doesn't have
-- the Settings from 'Patch.patch_defaults', so it'll need to have those
-- applied when it gets applied to 'UiConfig.state_allocations'.
config :: [Patch.Addr] -> Patch.Config
config :: [Addr] -> Config
config = [(Addr, Maybe Int)] -> Config
Patch.config forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (, forall a. Maybe a
Nothing)

-- | Specialize 'config' for a single Addr.
config1 :: Midi.WriteDevice -> Midi.Channel -> Patch.Config
config1 :: WriteDevice -> Control -> Config
config1 WriteDevice
dev Control
chan = [Addr] -> Config
config [(WriteDevice
dev, Control
chan)]


-- * types

-- | Instrument definition modules that need to load from disk export a
-- function called @load@, with this signature.  Use the AppDir to find
-- 'Config.instrument_dir'.
type Load = Path.AppDir -> IO (Maybe Synth)


{- | Some synths may require a more expensive load, e.g. they could parse
    a directory full of sysex dumps.  These expose a @make_db@ function with
    this type.  As with 'Load', the FilePath is 'Config.instrument_dir'.  The
    function is expected to do its work and save the results in the instrument
    dir

    You should use 'Cmd.Instrument.MidiInst.save_synth', which will put the
    file into 'Config.instrument_cache_dir' with the same name as the synth.
-}
type MakeDb = Path.AppDir -> IO ()