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

-- | Modartt's amazing Pianoteq softsynth.
module User.Elaforge.Instrument.Pianoteq (synth) where
import qualified Cmd.Instrument.Bali as Bali
import qualified Cmd.Instrument.MidiInst as MidiInst
import qualified Derive.Call.GraceUtil as GraceUtil
import qualified Derive.Call.Make as Make
import qualified Derive.Call.Module as Module
import qualified Derive.Call.Sub as Sub
import qualified Derive.Controls as Controls
import qualified Derive.Derive as Derive
import qualified Derive.ScoreT as ScoreT
import qualified Derive.ShowVal as ShowVal

import qualified Instrument.Common as Common
import qualified Instrument.InstT as InstT
import qualified Midi.Midi as Midi
import qualified Perform.Midi.Patch as Patch
import qualified Perform.NN as NN

import           Global


-- Supports MTS, aka real time tuning.
synth :: MidiInst.Synth
synth :: Synth
synth = Name -> Name -> [Patch] -> Synth
MidiInst.synth Name
"pianoteq" Name
"Modartt Pianoteq" [Patch]
patches

patches :: [MidiInst.Patch]
patches :: [Patch]
patches =
    [ PbRange -> [(Control, Control)] -> Patch
MidiInst.default_patch PbRange
pb_range
        [ (Control
67, Control
"soft-pedal")
        , (Control
69, Control
"harmonic-pedal")
        , (Control
66, Control
"sost-pedal")
        , (Control
64, Control
Controls.pedal)
        -- whole bunch more
        ]
    , Lens Patch Code
MidiInst.code forall f a. Lens f a -> a -> f -> f
#= Code
Bali.pasang_code forall a b. (a -> b) -> a -> b
$ Name -> [(Control, Control)] -> Patch
patch Name
"pasang" []
    , (NoteNumber, NoteNumber) -> Patch -> Patch
MidiInst.nn_range (NoteNumber
NN.g2, NoteNumber
NN.a6) forall a b. (a -> b) -> a -> b
$ Name -> [(Control, Control)] -> Patch
patch Name
"yangqin" []
    , Patch
harp
    ]

pb_range :: Patch.PbRange
pb_range :: PbRange
pb_range = (-Int
24, Int
24)

harp :: MidiInst.Patch
harp :: Patch
harp = Lens Patch Code
MidiInst.code forall f a. Lens f a -> a -> f -> f
#= Code
code forall a b. (a -> b) -> a -> b
$ Patch :-> Common Code
MidiInst.commonforall a b c. Lens a b -> Lens b c -> Lens a c
#forall {code}. Common code :-> Doc
Common.doc forall f a. Lens f a -> a -> f -> f
#= Doc
doc forall a b. (a -> b) -> a -> b
$
    -- Ensure a known state.
    -- TODO pianoteq supports multiple MIDI channels for pitch, but not
    -- for pedals.  For this to work, the inst has to have only a single
    -- channel allocated.  Otherwise it will just go on a different channel and
    -- the performer doesn't know that pianoteq's channels are actually not
    -- independent WRT controls.
    [(Control, Y)] -> Patch -> Patch
MidiInst.control_defaults [(Control
gliss, Y
0), (Control
harmonic, Y
0), (Control
lute, Y
0)] forall a b. (a -> b) -> a -> b
$
    Name -> [(Control, Control)] -> Patch
patch Name
"harp"
        [ (Control
67, Control
gliss)
        , (Control
69, Control
harmonic)
        , (Control
66, Control
lute)
        , (Control
64, Control
damp)
        ]
    where
    code :: MidiInst.Code
    code :: Code
code = [Call Note] -> Code
MidiInst.note_calls
        [ forall d. Symbol -> Calls d -> Call d
MidiInst.both Symbol
"o" forall a b. (a -> b) -> a -> b
$ Module -> CallName -> Control -> Y -> Calls Note
Make.control_note Module
Module.instrument CallName
"o" Control
harmonic Y
1
        , forall d. Symbol -> Calls d -> Call d
MidiInst.both Symbol
"m" forall a b. (a -> b) -> a -> b
$ Module -> CallName -> Control -> Y -> Calls Note
Make.control_note Module
Module.instrument CallName
"m" Control
lute Y
1
        , forall d. Symbol -> Generator d -> Call d
MidiInst.generator Symbol
"g" Generator Note
c_grace
        ]
    -- TODO add diatonic gliss call, like zheng
    harmonic :: Control
harmonic = Control
"harmonic"
    lute :: Control
lute = Control
"lute"
    damp :: Control
damp = Control
"damp"
    doc :: Doc
doc = Doc
"The harp has a backwards sustain pedal, in that it sustains by\
        \ default unless " forall a. Semigroup a => a -> a -> a
<> forall a. ShowVal a => a -> Doc
ShowVal.doc Control
damp forall a. Semigroup a => a -> a -> a
<> Doc
" is 1.  The `ped`\
        \ control call is useful to quickly damp ringing notes."

gliss :: ScoreT.Control
gliss :: Control
gliss = Control
"gliss"

c_grace :: Derive.Generator Derive.Note
c_grace :: Generator Note
c_grace = Module
-> Doc
-> (NoteDeriver -> NoteDeriver)
-> (PassedArgs Note -> [Event] -> NoteDeriver)
-> Generator Note
GraceUtil.make_grace Module
Module.instrument
    (Doc
"This is just like the standard `g` call, except it sets "
        forall a. Semigroup a => a -> a -> a
<> forall a. ShowVal a => a -> Doc
ShowVal.doc Control
gliss forall a. Semigroup a => a -> a -> a
<> Doc
" and doesn't use `(`.")
    (forall a. Control -> Y -> Deriver a -> Deriver a
Derive.with_constant_control Control
gliss Y
1) (\PassedArgs Note
_args [Event]
events -> [Event] -> NoteDeriver
Sub.derive [Event]
events)

patch :: InstT.Name -> [(Midi.Control, ScoreT.Control)] -> MidiInst.Patch
patch :: Name -> [(Control, Control)] -> Patch
patch = PbRange -> Name -> [(Control, Control)] -> Patch
MidiInst.named_patch PbRange
pb_range