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

-- | Instruments for the offline NESS synthesizer.
module User.Elaforge.Instrument.Ness where
import qualified Data.Map as Map
import qualified Data.Set as Set

import qualified Util.Log as Log
import qualified Cmd.Cmd as Cmd
import qualified Cmd.Instrument.ImInst as ImInst
import qualified Derive.Attrs as Attrs
import qualified Derive.Call.Make as Make
import qualified Derive.Call.Module as Module
import qualified Derive.Derive as Derive
import qualified Derive.EnvKey as EnvKey
import qualified Derive.Expr as Expr
import qualified Derive.Instrument.DUtil as DUtil
import qualified Derive.Library as Library
import qualified Derive.PSignal as PSignal
import qualified Derive.REnv as REnv
import qualified Derive.Scale.Twelve as Twelve
import qualified Derive.ScoreT as ScoreT

import qualified Perform.Im.Patch as Patch
import qualified Perform.Pitch as Pitch
import qualified Instrument.Inst as Inst
import qualified Synth.Shared.Config as Config
import qualified Synth.Shared.Control as Control
import Global
import qualified Ness.Guitar as Guitar
import qualified Ness.Guitar.Patch as Guitar.Patch
import qualified Ness.Multiplate as Multiplate
import qualified Ness.Multiplate.Patch as Multiplate.Patch
import qualified Ness.Patches as Patches


synth :: Inst.SynthDecl Cmd.InstrumentCode
synth :: SynthDecl InstrumentCode
synth = Text -> Text -> [(Text, Patch)] -> SynthDecl InstrumentCode
ImInst.synth Text
Config.nessName
    Text
"Write notes to a file, to submit to NESS by hand." forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Patch -> Patch
make) (forall k a. Map k a -> [(k, a)]
Map.toList Map Text Patch
Patches.patches)

make :: Patches.Patch -> ImInst.Patch
make :: Patch -> Patch
make Patch
patch = case Patch
patch of
    Patches.PGuitar Instrument
inst -> Instrument -> Patch
guitar Instrument
inst
    Patches.PMultiplate Instrument
inst -> Instrument -> Patch
multiplate Instrument
inst

guitar :: Guitar.Instrument -> ImInst.Patch
guitar :: Instrument -> Patch
guitar Instrument
inst = Lens Patch Code
ImInst.code forall f a. Lens f a -> a -> f -> f
#= Code
code forall a b. (a -> b) -> a -> b
$ forall a. ToVal a => Text -> a -> Patch -> Patch
ImInst.environ Text
EnvKey.open_strings [ConstantPitch]
strings forall a b. (a -> b) -> a -> b
$
    Patch -> Patch
ImInst.make_patch forall a b. (a -> b) -> a -> b
$ Patch
Patch.patch
        { patch_controls :: Map Control Text
Patch.patch_controls = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (Control
Control.pitch, Text
"")
            , (Control
Control.dynamic, Text
"")
            , (Control
Guitar.Patch.c_location, Text
"Pluck location.")
            -- TODO use Derive.Controls.finger
            , (Control
Guitar.Patch.c_finger, Text
"Stopping finger weight.")
            ]
        , patch_attribute_map :: AttributeMap
Patch.patch_attribute_map = [Attributes] -> AttributeMap
Patch.make_attribute_map [Attributes
Attrs.mute]
        }
    where
    strings :: [ConstantPitch]
strings = forall a b. (a -> b) -> [a] -> [b]
map String -> ConstantPitch
make_string forall a b. (a -> b) -> a -> b
$ Instrument -> [String]
Guitar.iStrings Instrument
inst
    code :: Code
code = Code
note forall a. Semigroup a => a -> a -> a
<> Code
postproc
    postproc :: Code
postproc = InstrumentPostproc -> Code
ImInst.postproc forall a b. (a -> b) -> a -> b
$
        forall old new.
(Typecheck old, ToVal new) =>
Text -> Text -> (old -> Either Msg new) -> InstrumentPostproc
DUtil.move_val Text
EnvKey.string Text
EnvKey.element Pitch -> Either Msg Text
show_string
    note :: Code
note = Generator Note -> Code
ImInst.null_call forall a b. (a -> b) -> a -> b
$ Bool -> Set Control -> Generator Note
DUtil.constant_controls Bool
False forall a b. (a -> b) -> a -> b
$
        forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Control -> Control
control [Control
Guitar.Patch.c_location, Control
Control.dynamic]

show_string :: PSignal.Pitch -> Either Log.Msg Text
show_string :: Pitch -> Either Msg Text
show_string = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Stack => Priority -> Maybe Stack -> Text -> Msg
Log.msg Priority
Log.Warn forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Text
pretty) Note -> Text
Pitch.note_text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transposed -> Either PitchError Note
PSignal.pitch_note forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. RawPitch a -> RawPitch b
PSignal.coerce

make_string :: Guitar.String -> REnv.ConstantPitch
make_string :: String -> ConstantPitch
make_string String
str = ScaleId -> Note -> NoteNumber -> ConstantPitch
REnv.ConstantPitch ScaleId
Twelve.scale_id
    (Text -> Note
Pitch.Note (String -> Text
Guitar.sName String
str)) (String -> NoteNumber
Guitar.sNn String
str)
    -- TODO Twelve.scale_id may well be wrong, which can cause parsing errors.
    -- The string should also give the scale.

control :: Control.Control -> ScoreT.Control
control :: Control -> Control
control (Control.Control Text
c) = Text -> Control
ScoreT.Control Text
c

multiplate :: Multiplate.Instrument -> ImInst.Patch
multiplate :: Instrument -> Patch
multiplate Instrument
inst = Lens Patch Code
ImInst.code forall f a. Lens f a -> a -> f -> f
#= Code
code forall a b. (a -> b) -> a -> b
$ Patch -> Patch
ImInst.make_patch Patch
patch
    where
    code :: Code
code = [Call Note] -> Code
ImInst.note_calls
        [ forall d. Symbol -> Generator d -> Call d
ImInst.generator (Text -> Symbol
Expr.Symbol Text
object) forall a b. (a -> b) -> a -> b
$ Text -> Generator Note
generator Text
object
        | Text
object <- Instrument -> [Text]
Multiplate.iObjects Instrument
inst
        ]
    generator :: Text -> Generator Note
generator Text
object = forall d. Calls d -> Generator d
Library.generator forall a b. (a -> b) -> a -> b
$ forall a.
ToVal a =>
Module -> CallName -> Tags -> Doc -> Text -> a -> Calls Note
Make.environ_note Module
Module.instrument
        (Text -> CallName
Derive.CallName Text
object) forall a. Monoid a => a
mempty Doc
"Strike the named object."
        Text
EnvKey.element Text
object
    patch :: Patch
patch = Patch
Patch.patch
        { patch_controls :: Map Control Text
Patch.patch_controls = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (Control
Control.dynamic, Text
"")
            , (Control
Multiplate.Patch.c_x, Text
"")
            , (Control
Multiplate.Patch.c_y, Text
"")
            , (Control
Multiplate.Patch.c_duration, Text
"")
            ]
        }