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

-- | Definitions for the gender wayang instrument family.
module Synth.Sampler.Patch.Wayang (
    patches
    -- * interactive
    , checkStarts
    , showPitchTable
) where
import qualified Data.Char as Char
import qualified Data.Either as Either
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified Data.Text.Read as Text.Read

import           System.FilePath ((</>))

import qualified Util.Lists as Lists
import qualified Util.Log as Log
import qualified Util.Maps as Maps
import qualified Util.Num as Num
import qualified Util.Texts as Texts

import qualified Cmd.Instrument.Bali as Bali
import qualified Cmd.Instrument.ImInst as ImInst
import qualified Derive.Attrs as Attrs
import qualified Derive.DeriveT as DeriveT
import qualified Derive.EnvKey as EnvKey
import qualified Derive.Instrument.DUtil as DUtil
import qualified Derive.PSignal as PSignal
import qualified Derive.Scale.BaliScales as BaliScales
import           Derive.Scale.BaliScales (Tuning(..))
import qualified Derive.Scale.Wayang as Wayang
import qualified Derive.ShowVal as ShowVal

import qualified Instrument.Common as Common
import qualified Midi.Key as Key
import qualified Midi.Midi as Midi
import qualified Perform.Im.Patch as Im.Patch
import qualified Perform.Pitch as Pitch
import qualified Perform.RealTime as RealTime

import qualified Synth.Sampler.Patch as Patch
import qualified Synth.Sampler.Patch.Lib.Util as Util
import qualified Synth.Sampler.Patch.WayangCode as WayangCode
import qualified Synth.Sampler.Sample as Sample
import qualified Synth.Shared.Control as Control
import qualified Synth.Shared.Note as Note
import qualified Synth.Shared.Signal as Signal

import           Global
import           Synth.Types


sampleFormat :: Util.SampleFormat
sampleFormat :: SampleFormat
sampleFormat = SampleFormat
Util.Flac

patches :: [Patch.Patch]
patches :: [Patch]
patches = Instrument -> Patch
pasang Instrument
Pemade forall a. a -> [a] -> [a]
: Instrument -> Patch
pasang Instrument
Kantilan
    forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Instrument, Tuning) -> Patch
make
        [ (Instrument
Pemade, Tuning
Umbang), (Instrument
Pemade, Tuning
Isep)
        , (Instrument
Kantilan, Tuning
Umbang), (Instrument
Kantilan, Tuning
Isep)
        ]
    where
    pasang :: Instrument -> Patch
pasang Instrument
inst = Text -> (Patch -> Patch) -> Patch
Patch.patchKarya (Text
"wayang-" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
Util.showtLower Instrument
inst) forall a b. (a -> b) -> a -> b
$
        Text -> Patch -> Patch
ImInst.dummy Text
Bali.pasang_msg forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instrument -> Patch -> Patch
setRange Instrument
inst
    make :: (Instrument, Tuning) -> Patch
make (Instrument
inst, Tuning
tuning) =
        (Text -> Patch
Patch.patch forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
"-"
            [Text
"wayang", forall a. Show a => a -> Text
Util.showtLower Instrument
inst, forall a. Show a => a -> Text
Util.showtLower Tuning
tuning])
        { _dir :: FilePath
Patch._dir = FilePath
dir
        , _convert :: Note -> ConvertM Sample
Patch._convert = Instrument -> Tuning -> Note -> ConvertM Sample
convert Instrument
inst Tuning
tuning
        , _allFilenames :: Set FilePath
Patch._allFilenames = Instrument -> Tuning -> Set FilePath
allFilenames Instrument
inst Tuning
tuning
        , _karyaPatch :: Patch
Patch._karyaPatch = Lens Patch Code
ImInst.code forall f a. Lens f a -> a -> f -> f
#= Instrument -> Tuning -> Code
code Instrument
inst Tuning
tuning forall a b. (a -> b) -> a -> b
$
            Instrument -> Patch -> Patch
setRange Instrument
inst forall a b. (a -> b) -> a -> b
$ forall {a}. ShowVal a => a -> Patch -> Patch
setTuning Tuning
tuning forall a b. (a -> b) -> a -> b
$
            Patch -> Patch
ImInst.make_patch forall a b. (a -> b) -> a -> b
$ Patch
Im.Patch.patch
                { patch_controls :: Map Control Text
Im.Patch.patch_controls = forall a. Monoid a => [a] -> a
mconcat
                    [ Map Control Text
Control.supportPitch
                    , Map Control Text
Control.supportDyn
                    , Map Control Text
Control.supportVariation
                    , forall k a. k -> a -> Map k a
Map.singleton Control
Control.mute
                        Text
"Amount of mute. This becomes a shortened envelope."
                    ]
                , patch_attribute_map :: AttributeMap
Im.Patch.patch_attribute_map = forall a b. a -> b -> a
const () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttributeMap Articulation
attributeMap
                }
        }
        where
        code :: Instrument -> Tuning -> Code
code Instrument
inst Tuning
tuning = Code
WayangCode.code
            forall a. Semigroup a => a -> a -> a
<> FilePath -> (Note -> ConvertM Sample) -> Code
Util.thru FilePath
dir (Instrument -> Tuning -> Note -> ConvertM Sample
convert Instrument
inst Tuning
tuning)
            forall a. Semigroup a => a -> a -> a
<> InstrumentPostproc -> Code
ImInst.postproc InstrumentPostproc
with_symbolic_pitch
        dir :: FilePath
dir = FilePath
"wayang" FilePath -> FilePath -> FilePath
</> forall a. Show a => a -> FilePath
Util.showLower Instrument
inst FilePath -> FilePath -> FilePath
</> forall a. Show a => a -> FilePath
Util.showLower Tuning
tuning
    setRange :: Instrument -> Patch -> Patch
setRange Instrument
inst = Range -> Patch -> Patch
ImInst.range forall a b. (a -> b) -> a -> b
$ Instrument -> Range
BaliScales.instrument_range forall a b. (a -> b) -> a -> b
$ case Instrument
inst of
        Instrument
Pemade -> Instrument
Wayang.pemade
        Instrument
Kantilan -> Instrument
Wayang.kantilan
    setTuning :: a -> Patch -> Patch
setTuning a
tuning = forall a. ToVal a => Text -> a -> Patch -> Patch
ImInst.environ Text
EnvKey.tuning (forall a. ShowVal a => a -> Text
ShowVal.show_val a
tuning)
    with_symbolic_pitch :: InstrumentPostproc
with_symbolic_pitch = forall val.
(Eq val, Typecheck val) =>
Text -> Maybe val -> InstrumentPostproc -> InstrumentPostproc
DUtil.when_env Text
"symbolic-pitch" (forall a. a -> Maybe a
Just Bool
True) forall a b. (a -> b) -> a -> b
$
        (Transposed -> Either Text Note) -> InstrumentPostproc
DUtil.add_symbolic_pitch_convert Transposed -> Either Text Note
pitchConvert

pitchConvert :: PSignal.Transposed -> Either Text Pitch.Note
pitchConvert :: Transposed -> Either Text Note
pitchConvert Transposed
pitch = do
    Note
note <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Pretty a => a -> Text
pretty forall a b. (a -> b) -> a -> b
$ Transposed -> Either PitchError Note
PSignal.pitch_note Transposed
pitch
    if ScaleId
scale_id forall a. Eq a => a -> a -> Bool
== ScaleId
"wayang-srg"
        then Text -> Note
Pitch.Note forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text Text
pitchSrgpd (Note -> Text
Pitch.note_text Note
note)
        else forall (m :: * -> *) a. Monad m => a -> m a
return Note
note
    where
    scale_id :: ScaleId
scale_id = Scale -> ScaleId
DeriveT.pscale_scale_id forall a b. (a -> b) -> a -> b
$ forall a. RawPitch a -> Scale
DeriveT.pitch_scale Transposed
pitch

-- | This is a hack to convert wayang-srg to ioeua notation so symbolic pitch
-- recognizes it.  It would be better to go through Pitch.Pitch parsing to do
-- the conversion, but better than that is if I make up my mind about what kind
-- of notation I want.
pitchSrgpd :: Text -> Either Text Text
pitchSrgpd :: Text -> Either Text Text
pitchSrgpd Text
pitch = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
pc Map Text (Integer, Text)
to_ioe of
    Maybe (Integer, Text)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"not in srgpd: " forall a. Semigroup a => a -> a -> a
<> Text
pitch
    Just (Integer
offset, Text
pc) -> do
        let Right (Integer
octi, Text
_) = forall a. Num a => Reader a -> Reader a
Text.Read.signed forall a. Integral a => Reader a
Text.Read.decimal Text
oct
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
showt (Integer
octi forall a. Num a => a -> a -> a
+ Integer
offset) forall a. Semigroup a => a -> a -> a
<> Text
pc
    where
    (Text
oct, Text
pc) = (Char -> Bool) -> Text -> (Text, Text)
Text.span (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char -> Bool
Char.isDigit Char
c) Text
pitch
    to_ioe :: Map Text (Integer, Text)
to_ioe = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (Text
"s", (-Integer
1, Text
"e"))
        , (Text
"r", (-Integer
1, Text
"u"))
        , (Text
"g", (-Integer
1, Text
"a"))
        , (Text
"p", (Integer
0, Text
"i"))
        , (Text
"d", (Integer
0, Text
"o"))
        ]

attributeMap :: Common.AttributeMap Articulation
attributeMap :: AttributeMap Articulation
attributeMap = forall a. [(Attributes, a)] -> AttributeMap a
Common.attribute_map
    [ (Attributes
calung forall a. Semigroup a => a -> a -> a
<> Attributes
mute, Articulation
CalungMute)
    , (Attributes
calung, Articulation
Calung)
    , (Attributes
mute forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.loose, Articulation
LooseMute)
    , (Attributes
mute, Articulation
Mute)
    , (forall a. Monoid a => a
mempty, Articulation
Open)
    ]
    where
    mute :: Attributes
mute = Attributes
Attrs.mute
    calung :: Attributes
calung = Text -> Attributes
Attrs.attr Text
"calung"

-- * checks

allFilenames :: Instrument -> Tuning -> Set FilePath
allFilenames :: Instrument -> Tuning -> Set FilePath
allFilenames Instrument
inst Tuning
tuning = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {c}. (a, b, c) -> a
fst3 forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> [b]
Either.rights
    [ Instrument
-> Tuning
-> Articulation
-> Either Note NoteNumber
-> Dynamic
-> Int
-> Either Text (FilePath, NoteNumber, NoteNumber)
toFilename Instrument
inst Tuning
tuning Articulation
articulation (forall a b. b -> Either a b
Right NoteNumber
nn) Dynamic
dyn Int
variation
    | Articulation
articulation <- forall a. (Enum a, Bounded a) => [a]
Util.enumAll
    , NoteNumber
nn <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Instrument -> Tuning -> Articulation -> [(NoteNumber, (Key, Note))]
instrumentKeys Instrument
inst Tuning
tuning Articulation
articulation
    , Dynamic
dyn <- forall a. (Enum a, Bounded a) => [a]
Util.enumAll
    , Int
variation <- [Int
0 .. Articulation -> Int
variationsOf Articulation
articulation forall a. Num a => a -> a -> a
- Int
1]
    ]
    where
    fst3 :: (a, b, c) -> a
fst3 (a
a, b
_, c
_) = a
a

checkStarts :: (Sample.Sample, [[Sample.Sample]])
checkStarts :: (Sample, [[Sample]])
checkStarts = (FilePath -> Sample
makeSample FilePath
reference,)
    [ forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Sample
makeSample forall a b. (a -> b) -> a -> b
$ Instrument
-> Tuning -> Articulation -> Note -> Dynamic -> [FilePath]
makeFilenames Instrument
instrument Tuning
tuning Articulation
articulation Note
pitch Dynamic
dyn
    | Instrument
instrument <- [Instrument
Pemade, Instrument
Kantilan]
    , Tuning
tuning <- [Tuning
Umbang, Tuning
Isep]
    , Articulation
articulation <- forall a. (Enum a, Bounded a) => [a]
Util.enumAll
    , Note
pitch <- forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ Instrument -> Tuning -> Articulation -> [(NoteNumber, (Key, Note))]
instrumentKeys Instrument
instrument Tuning
tuning Articulation
articulation
    , Dynamic
dyn <- forall a. (Enum a, Bounded a) => [a]
Util.enumAll
    ]
    where
    Right (FilePath
reference, NoteNumber
_, NoteNumber
_) =
        Instrument
-> Tuning
-> Articulation
-> Either Note NoteNumber
-> Dynamic
-> Int
-> Either Text (FilePath, NoteNumber, NoteNumber)
toFilename Instrument
Pemade Tuning
Umbang Articulation
Mute (forall a b. a -> Either a b
Left Note
"4i") Dynamic
Util.FF Int
0
    makeFilenames :: Instrument
-> Tuning -> Articulation -> Note -> Dynamic -> [FilePath]
makeFilenames Instrument
instrument Tuning
tuning Articulation
articulation Note
pitch Dynamic
dyn =
        forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {c}. (a, b, c) -> a
fst3 forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> [b]
Either.rights forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map (Instrument
-> Tuning
-> Articulation
-> Either Note NoteNumber
-> Dynamic
-> Int
-> Either Text (FilePath, NoteNumber, NoteNumber)
toFilename Instrument
instrument Tuning
tuning Articulation
articulation (forall a b. a -> Either a b
Left Note
pitch) Dynamic
dyn)
            [Int
0 .. Articulation -> Int
variationsOf Articulation
articulation forall a. Num a => a -> a -> a
- Int
1]
    fst3 :: (a, b, c) -> a
fst3 (a
a, b
_, c
_) = a
a
    makeSample :: FilePath -> Sample
makeSample FilePath
fname = (FilePath -> Sample
Sample.make FilePath
fname)
        { envelope :: Signal
Sample.envelope = forall {k} (kind :: k). [(RealTime, Y)] -> Signal kind
Signal.from_pairs
            [(RealTime
0, Y
1), (RealTime
0 forall a. Num a => a -> a -> a
+ RealTime
dur, Y
1), (RealTime
0 forall a. Num a => a -> a -> a
+ RealTime
dur forall a. Num a => a -> a -> a
+ RealTime
muteTime, Y
0)]
        , ratios :: Signal
Sample.ratios = forall {k} (kind :: k). Y -> Signal kind
Signal.constant Y
1
        }
    dur :: RealTime
dur = RealTime
1

-- * convert

{- | Convert Note.Note into Sample.Sample.

    * map Note.instrument to (Instrument, Tuning)
    * map attrs to Articulation
    * map dynamic
    This is select the next higher Dynamic, then scale down by the difference
    * pitch

    I can use duration, or can extend duration until the next mute, and add
    a silent mute.  If the latter, I have to do it as a preprocess step, since
    it affects overlap calculation.
-}
convert :: Instrument -> Tuning -> Note.Note -> Patch.ConvertM Sample.Sample
convert :: Instrument -> Tuning -> Note -> ConvertM Sample
convert Instrument
instrument Tuning
tuning Note
note = do
    let articulation :: Articulation
articulation = forall a. a -> AttributeMap a -> Attributes -> a
Util.articulationDefault Articulation
Open AttributeMap Articulation
attributeMap forall a b. (a -> b) -> a -> b
$
            Note -> Attributes
Note.attributes Note
note
    let (Dynamic
dyn, Y
dynVal) = forall dyn.
(Bounded dyn, Enum dyn) =>
(dyn -> (Int, Int)) -> Y -> Note -> (dyn, Y)
Util.dynamic Dynamic -> (Int, Int)
dynamicRange Y
minDyn Note
note
    Either Note NoteNumber
symPitch <- forall (m :: * -> *).
MonadError Text m =>
Note -> m (Either Note NoteNumber)
Util.symbolicPitch Note
note
    Dynamic
dyn <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Instrument -> Tuning -> Articulation -> Dynamic -> Dynamic
workaround Instrument
instrument Tuning
tuning Articulation
articulation Dynamic
dyn
    let var :: Int
var = Int -> Note -> Int
Util.variation (Articulation -> Int
variationsOf Articulation
articulation) Note
note
    (FilePath
filename, NoteNumber
noteNn, NoteNumber
sampleNn) <- forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
tryRight forall a b. (a -> b) -> a -> b
$
        Instrument
-> Tuning
-> Articulation
-> Either Note NoteNumber
-> Dynamic
-> Int
-> Either Text (FilePath, NoteNumber, NoteNumber)
toFilename Instrument
instrument Tuning
tuning Articulation
articulation
            Either Note NoteNumber
symPitch Dynamic
dyn Int
var
    forall (m :: * -> *). (HasCallStack, LogMonad m) => Text -> m ()
Log.debug forall a b. (a -> b) -> a -> b
$ Text
"note at " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty (Note -> RealTime
Note.start Note
note) forall a. Semigroup a => a -> a -> a
<> Text
": "
        forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty ((Dynamic
dyn, Y
dynVal), (Either Note NoteNumber
symPitch, NoteNumber
sampleNn), Int
var)
        forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
txt FilePath
filename
    let variableMute :: RealTime
variableMute = Y -> RealTime
RealTime.seconds forall a b. (a -> b) -> a -> b
$ Control -> Note -> Y
Note.initial0 Control
Control.mute Note
note
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (FilePath -> Sample
Sample.make FilePath
filename)
        { envelope :: Signal
Sample.envelope = if
            | Articulation -> Bool
isMute Articulation
articulation -> forall {k} (kind :: k). Y -> Signal kind
Signal.constant Y
dynVal
            | RealTime
variableMute forall a. Ord a => a -> a -> Bool
> RealTime
0 -> forall {k} (kind :: k). [(RealTime, Y)] -> Signal kind
Signal.from_pairs
                [ (Note -> RealTime
Note.start Note
note, Y
dynVal)
                , (Note -> RealTime
Note.start Note
note
                    forall a. Num a => a -> a -> a
+ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. (Eq a, Num a) => a -> a -> a -> a
Num.scale (RealTime, RealTime)
variableMuteRange (RealTime
1forall a. Num a => a -> a -> a
-RealTime
variableMute), Y
0)
                ]
            | Bool
otherwise -> forall {k} (kind :: k). [(RealTime, Y)] -> Signal kind
Signal.from_pairs
                [ (Note -> RealTime
Note.start Note
note, Y
dynVal), (Note -> RealTime
Note.end Note
note, Y
dynVal)
                , (Note -> RealTime
Note.end Note
note forall a. Num a => a -> a -> a
+ RealTime
muteTime, Y
0)
                ]
        , ratios :: Signal
Sample.ratios = forall {k} (kind :: k). Y -> Signal kind
Signal.constant forall a b. (a -> b) -> a -> b
$ NoteNumber -> NoteNumber -> Y
Sample.pitchToRatio NoteNumber
sampleNn NoteNumber
noteNn
        }

isMute :: Articulation -> Bool
isMute :: Articulation -> Bool
isMute = \case
    Articulation
Mute -> Bool
True
    Articulation
LooseMute -> Bool
True
    Articulation
CalungMute -> Bool
True
    Articulation
_ -> Bool
False

-- | I'm missing these samples, so substitute some others.
workaround :: Instrument -> Tuning -> Articulation -> Util.Dynamic
    -> Util.Dynamic
workaround :: Instrument -> Tuning -> Articulation -> Dynamic -> Dynamic
workaround Instrument
Kantilan Tuning
Umbang Articulation
CalungMute Dynamic
Util.FF = Dynamic
Util.MF
workaround Instrument
_ Tuning
_ Articulation
_ Dynamic
dyn = Dynamic
dyn

variableMuteRange :: (RealTime, RealTime)
variableMuteRange :: (RealTime, RealTime)
variableMuteRange = (RealTime
0.85, RealTime
4)

-- | Time to mute at the end of a note.
muteTime :: RealTime
muteTime :: RealTime
muteTime = RealTime
0.35

-- | Wayang samples are normalized, so it just scales by Control.dynamic, where
-- 0 gets this value.
minDyn :: Signal.Y
minDyn :: Y
minDyn = Y
0.5

-- * toFilename

{- | Find the sample.

    File structure:
    > {pemade,kantilan}/{isep,umbang}/{normal,calung}/
    >     $key-$lowVel-$highVel-$group.flac
    > normal groups = mute{1..8} loose{1..8} open{1..4}
    > calung groups = calung{1..3} calung+mute{1..6}
    > mute and loose start at Key.f0 (17)
    > open starts at Key.f4 65

    TODO The complicated encoding is leftover kontakt nonsense.  I could rename
    to $symPitch-$dyn-$articulation-$var.flac.  On the other hand, it means I
    can easily map back to the kontakt instrument, though it would be easier
    without the ncw nonsense.
-}
toFilename :: Instrument -> Tuning -> Articulation
    -> Either Pitch.Note Pitch.NoteNumber -> Util.Dynamic -> Util.Variation
    -> Either Text (FilePath, Pitch.NoteNumber, Pitch.NoteNumber)
toFilename :: Instrument
-> Tuning
-> Articulation
-> Either Note NoteNumber
-> Dynamic
-> Int
-> Either Text (FilePath, NoteNumber, NoteNumber)
toFilename Instrument
instrument Tuning
tuning Articulation
articulation Either Note NoteNumber
symPitch Dynamic
dyn Int
variation = do
    (NoteNumber
sampleNn, NoteNumber
noteNn, Midi.Key Int
sampleKey) <-
        Instrument
-> Tuning
-> Articulation
-> Either Note NoteNumber
-> Either Text (NoteNumber, NoteNumber, Key)
findPitch Instrument
instrument Tuning
tuning Articulation
articulation Either Note NoteNumber
symPitch
    let (Int
lowVel, Int
highVel) = Dynamic -> (Int, Int)
dynamicRange forall a b. (a -> b) -> a -> b
$
            case (Instrument
instrument, Tuning
tuning, Articulation
articulation, Dynamic
dyn, Int
sampleKey) of
                -- Just forgot to sample this one.
                (Instrument
Kantilan, Tuning
Umbang, Articulation
CalungMute, Dynamic
Util.FF, Int
52) -> Dynamic
Util.MF
                (Instrument, Tuning, Articulation, Dynamic, Int)
_ -> Dynamic
dyn
    forall (m :: * -> *) a. Monad m => a -> m a
return
        ( FilePath
panggul
            FilePath -> FilePath -> FilePath
</> forall a. Monoid a => a -> [a] -> a
Lists.join FilePath
"-"
                [forall a. Show a => a -> FilePath
show Int
sampleKey, forall a. Show a => a -> FilePath
show Int
lowVel, forall a. Show a => a -> FilePath
show Int
highVel, FilePath
group]
            forall a. Semigroup a => a -> a -> a
<> SampleFormat -> FilePath
Util.extension SampleFormat
sampleFormat
        , NoteNumber
noteNn
        , NoteNumber
sampleNn
        )
    where
    panggul :: FilePath
panggul = case Articulation
articulation of
        Articulation
CalungMute -> FilePath
"calung"
        Articulation
Calung -> FilePath
"calung"
        Articulation
_ -> FilePath
"normal"
    group :: FilePath
group = Articulation -> FilePath
articulationFile Articulation
articulation forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (Int
variation forall a. Num a => a -> a -> a
+ Int
1)

dynamicRange :: Util.Dynamic -> (Int, Int)
dynamicRange :: Dynamic -> (Int, Int)
dynamicRange = \case
    Dynamic
Util.PP -> (Int
1, Int
31)
    Dynamic
Util.MP -> (Int
32, Int
64)
    Dynamic
Util.MF -> (Int
65, Int
108)
    Dynamic
Util.FF -> (Int
109, Int
127)

articulationFile :: Articulation -> String
articulationFile :: Articulation -> FilePath
articulationFile = \case
    Articulation
Mute -> FilePath
"mute"
    Articulation
LooseMute -> FilePath
"loose"
    Articulation
Open -> FilePath
"open"
    Articulation
Calung -> FilePath
"calung"
    Articulation
CalungMute -> FilePath
"calung+mute"

variationsOf :: Articulation -> Util.Variation
variationsOf :: Articulation -> Int
variationsOf = \case
    Articulation
Mute -> Int
8
    Articulation
LooseMute -> Int
8
    Articulation
Open -> Int
4
    Articulation
Calung -> Int
3
    Articulation
CalungMute -> Int
6

-- * implementation

data Instrument = Pemade | Kantilan deriving (Instrument -> Instrument -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Instrument -> Instrument -> Bool
$c/= :: Instrument -> Instrument -> Bool
== :: Instrument -> Instrument -> Bool
$c== :: Instrument -> Instrument -> Bool
Eq, Eq Instrument
Instrument -> Instrument -> Bool
Instrument -> Instrument -> Ordering
Instrument -> Instrument -> Instrument
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Instrument -> Instrument -> Instrument
$cmin :: Instrument -> Instrument -> Instrument
max :: Instrument -> Instrument -> Instrument
$cmax :: Instrument -> Instrument -> Instrument
>= :: Instrument -> Instrument -> Bool
$c>= :: Instrument -> Instrument -> Bool
> :: Instrument -> Instrument -> Bool
$c> :: Instrument -> Instrument -> Bool
<= :: Instrument -> Instrument -> Bool
$c<= :: Instrument -> Instrument -> Bool
< :: Instrument -> Instrument -> Bool
$c< :: Instrument -> Instrument -> Bool
compare :: Instrument -> Instrument -> Ordering
$ccompare :: Instrument -> Instrument -> Ordering
Ord, Int -> Instrument -> FilePath -> FilePath
[Instrument] -> FilePath -> FilePath
Instrument -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Instrument] -> FilePath -> FilePath
$cshowList :: [Instrument] -> FilePath -> FilePath
show :: Instrument -> FilePath
$cshow :: Instrument -> FilePath
showsPrec :: Int -> Instrument -> FilePath -> FilePath
$cshowsPrec :: Int -> Instrument -> FilePath -> FilePath
Show, Int -> Instrument
Instrument -> Int
Instrument -> [Instrument]
Instrument -> Instrument
Instrument -> Instrument -> [Instrument]
Instrument -> Instrument -> Instrument -> [Instrument]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Instrument -> Instrument -> Instrument -> [Instrument]
$cenumFromThenTo :: Instrument -> Instrument -> Instrument -> [Instrument]
enumFromTo :: Instrument -> Instrument -> [Instrument]
$cenumFromTo :: Instrument -> Instrument -> [Instrument]
enumFromThen :: Instrument -> Instrument -> [Instrument]
$cenumFromThen :: Instrument -> Instrument -> [Instrument]
enumFrom :: Instrument -> [Instrument]
$cenumFrom :: Instrument -> [Instrument]
fromEnum :: Instrument -> Int
$cfromEnum :: Instrument -> Int
toEnum :: Int -> Instrument
$ctoEnum :: Int -> Instrument
pred :: Instrument -> Instrument
$cpred :: Instrument -> Instrument
succ :: Instrument -> Instrument
$csucc :: Instrument -> Instrument
Enum, Instrument
forall a. a -> a -> Bounded a
maxBound :: Instrument
$cmaxBound :: Instrument
minBound :: Instrument
$cminBound :: Instrument
Bounded)

data Articulation = Mute | LooseMute | Open | CalungMute | Calung
    deriving (Articulation -> Articulation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Articulation -> Articulation -> Bool
$c/= :: Articulation -> Articulation -> Bool
== :: Articulation -> Articulation -> Bool
$c== :: Articulation -> Articulation -> Bool
Eq, Eq Articulation
Articulation -> Articulation -> Bool
Articulation -> Articulation -> Ordering
Articulation -> Articulation -> Articulation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Articulation -> Articulation -> Articulation
$cmin :: Articulation -> Articulation -> Articulation
max :: Articulation -> Articulation -> Articulation
$cmax :: Articulation -> Articulation -> Articulation
>= :: Articulation -> Articulation -> Bool
$c>= :: Articulation -> Articulation -> Bool
> :: Articulation -> Articulation -> Bool
$c> :: Articulation -> Articulation -> Bool
<= :: Articulation -> Articulation -> Bool
$c<= :: Articulation -> Articulation -> Bool
< :: Articulation -> Articulation -> Bool
$c< :: Articulation -> Articulation -> Bool
compare :: Articulation -> Articulation -> Ordering
$ccompare :: Articulation -> Articulation -> Ordering
Ord, Int -> Articulation
Articulation -> Int
Articulation -> [Articulation]
Articulation -> Articulation
Articulation -> Articulation -> [Articulation]
Articulation -> Articulation -> Articulation -> [Articulation]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Articulation -> Articulation -> Articulation -> [Articulation]
$cenumFromThenTo :: Articulation -> Articulation -> Articulation -> [Articulation]
enumFromTo :: Articulation -> Articulation -> [Articulation]
$cenumFromTo :: Articulation -> Articulation -> [Articulation]
enumFromThen :: Articulation -> Articulation -> [Articulation]
$cenumFromThen :: Articulation -> Articulation -> [Articulation]
enumFrom :: Articulation -> [Articulation]
$cenumFrom :: Articulation -> [Articulation]
fromEnum :: Articulation -> Int
$cfromEnum :: Articulation -> Int
toEnum :: Int -> Articulation
$ctoEnum :: Int -> Articulation
pred :: Articulation -> Articulation
$cpred :: Articulation -> Articulation
succ :: Articulation -> Articulation
$csucc :: Articulation -> Articulation
Enum, Articulation
forall a. a -> a -> Bounded a
maxBound :: Articulation
$cmaxBound :: Articulation
minBound :: Articulation
$cminBound :: Articulation
Bounded, Int -> Articulation -> FilePath -> FilePath
[Articulation] -> FilePath -> FilePath
Articulation -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Articulation] -> FilePath -> FilePath
$cshowList :: [Articulation] -> FilePath -> FilePath
show :: Articulation -> FilePath
$cshow :: Articulation -> FilePath
showsPrec :: Int -> Articulation -> FilePath -> FilePath
$cshowsPrec :: Int -> Articulation -> FilePath -> FilePath
Show)

findPitch :: Instrument -> Tuning -> Articulation
    -> Either Pitch.Note Pitch.NoteNumber
    -> Either Text (Pitch.NoteNumber, Pitch.NoteNumber, Midi.Key)
findPitch :: Instrument
-> Tuning
-> Articulation
-> Either Note NoteNumber
-> Either Text (NoteNumber, NoteNumber, Key)
findPitch Instrument
instrument Tuning
tuning Articulation
articulation = \case
    Left Note
sym -> do
        (NoteNumber
sampleNn, (Key
key, Note
_)) <- forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
tryJust (Text
"invalid pitch: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Note
sym) forall a b. (a -> b) -> a -> b
$
            forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((forall a. Eq a => a -> a -> Bool
==Note
sym) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map NoteNumber (Key, Note)
keys
        forall (m :: * -> *) a. Monad m => a -> m a
return (NoteNumber
sampleNn, NoteNumber
sampleNn, Key
key)
    Right NoteNumber
noteNn -> forall (m :: * -> *) a. Monad m => a -> m a
return (NoteNumber
sampleNn, NoteNumber
noteNn, Key
key)
        where
        -- Only Nothing if keys was empty.
        Just (NoteNumber
sampleNn, (Key
key, Note
_)) = forall k v. (Ord k, Num k) => k -> Map k v -> Maybe (k, v)
Maps.lookupClosest NoteNumber
noteNn Map NoteNumber (Key, Note)
keys
    where
    keys :: Map NoteNumber (Key, Note)
keys = Instrument -> Tuning -> Articulation -> Map NoteNumber (Key, Note)
keyMap Instrument
instrument Tuning
tuning Articulation
articulation

keyMap :: Instrument -> Tuning -> Articulation
    -> Map Pitch.NoteNumber (Midi.Key, Pitch.Note)
keyMap :: Instrument -> Tuning -> Articulation -> Map NoteNumber (Key, Note)
keyMap Instrument
instrument Tuning
tuning Articulation
articulation =
    forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error FilePath
"keyMap should have been complete") forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Instrument
instrument, Tuning
tuning, Articulation -> Key
octaveOf Articulation
articulation) Map (Instrument, Tuning, Key) (Map NoteNumber (Key, Note))
maps
    where
    -- Memoize the key maps.  This should be floated to a CAF.
    maps :: Map (Instrument, Tuning, Key) (Map NoteNumber (Key, Note))
maps = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ ((Instrument
instrument, Tuning
tuning, Key
octave), Instrument -> Tuning -> Key -> Map NoteNumber (Key, Note)
makeKeyMap Instrument
instrument Tuning
tuning Key
octave)
        | Instrument
instrument <- forall a. (Enum a, Bounded a) => [a]
Util.enumAll
        , Tuning
tuning <- forall a. (Enum a, Bounded a) => [a]
Util.enumAll
        , Key
octave <- forall a. Ord a => [a] -> [a]
Lists.unique forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Articulation -> Key
octaveOf forall a. (Enum a, Bounded a) => [a]
Util.enumAll
        ]
    octaveOf :: Articulation -> Key
octaveOf = \case
        Articulation
Mute -> -Key
2
        Articulation
LooseMute -> -Key
2
        Articulation
CalungMute -> -Key
2
        Articulation
Open -> Key
2
        Articulation
Calung -> Key
2

makeKeyMap :: Instrument -> Tuning -> Midi.Key
    -> Map Pitch.NoteNumber (Midi.Key, Pitch.Note)
makeKeyMap :: Instrument -> Tuning -> Key -> Map NoteNumber (Key, Note)
makeKeyMap Instrument
instrument Tuning
tuning Key
octave =
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [NoteNumber]
nns (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (Key
octaveforall a. Num a => a -> a -> a
*Key
12+) [Key]
keys) [Note]
notes)
    where
    ([Key]
keys, [Note]
notes) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ Int -> [(Key, Note)]
wayangKeys forall a b. (a -> b) -> a -> b
$ case Instrument
instrument of
        Instrument
Pemade -> Int
3
        Instrument
Kantilan -> Int
4
    nns :: [NoteNumber]
nns = case (Instrument
instrument, Tuning
tuning) of
        (Instrument
Pemade, Tuning
Umbang) -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(NoteNumber, NoteNumber)]
pemadeTuning
        (Instrument
Pemade, Tuning
Isep) -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(NoteNumber, NoteNumber)]
pemadeTuning
        (Instrument
Kantilan, Tuning
Umbang) -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(NoteNumber, NoteNumber)]
kantilanTuning
        (Instrument
Kantilan, Tuning
Isep) -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(NoteNumber, NoteNumber)]
kantilanTuning

instrumentKeys :: Instrument -> Tuning -> Articulation
    -> [(Pitch.NoteNumber, (Midi.Key, Pitch.Note))]
instrumentKeys :: Instrument -> Tuning -> Articulation -> [(NoteNumber, (Key, Note))]
instrumentKeys Instrument
instrument Tuning
tuning Articulation
articulation =
    forall a b. [a] -> [b] -> [(a, b)]
zip [NoteNumber]
nns (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (Key
offsetforall a. Num a => a -> a -> a
*Key
12+) [Key]
keys) [Note]
notes)
    where
    ([Key]
keys, [Note]
notes) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ Int -> [(Key, Note)]
wayangKeys forall a b. (a -> b) -> a -> b
$ case Instrument
instrument of
        Instrument
Pemade -> Int
3
        Instrument
Kantilan -> Int
4
    offset :: Key
offset = case Articulation
articulation of
        Articulation
Mute -> -Key
2
        Articulation
LooseMute -> -Key
2
        Articulation
CalungMute -> -Key
2
        Articulation
Open -> Key
2
        Articulation
Calung -> Key
2
    nns :: [NoteNumber]
nns = case (Instrument
instrument, Tuning
tuning) of
        (Instrument
Pemade, Tuning
Umbang) -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(NoteNumber, NoteNumber)]
pemadeTuning
        (Instrument
Pemade, Tuning
Isep) -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(NoteNumber, NoteNumber)]
pemadeTuning
        (Instrument
Kantilan, Tuning
Umbang) -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(NoteNumber, NoteNumber)]
kantilanTuning
        (Instrument
Kantilan, Tuning
Isep) -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(NoteNumber, NoteNumber)]
kantilanTuning

wayangKeys :: Int -> [(Midi.Key, Pitch.Note)]
wayangKeys :: Int -> [(Key, Note)]
wayangKeys Int
baseOct = forall a. Int -> [a] -> [a]
take Int
10 forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1
    [ Key -> Key -> Text -> (Key, Note)
convert (Key
o forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Key
Midi.to_key Int
baseOct) Key
key Text
sym
    | Key
o <- [Key
0..], (Key
key, Text
sym) <- [(Key, Text)]
baseKeys
    ]
    where
    convert :: Key -> Key -> Text -> (Key, Note)
convert Key
oct Key
key Text
sym =
        (Key
key forall a. Num a => a -> a -> a
+ Key
octforall a. Num a => a -> a -> a
*Key
12, Text -> Note
Pitch.Note (forall a. Show a => a -> Text
showt (forall a. Num a => Key -> a
Midi.from_key Key
oct) forall a. Semigroup a => a -> a -> a
<> Text
sym))
    baseKeys :: [(Key, Text)]
baseKeys =
        [ (Key
Key.e_1, Text
"i")
        , (Key
Key.f_1, Text
"o")
        , (Key
Key.a_1, Text
"e")
        , (Key
Key.b_1, Text
"u")
        , (Key
Key.c0, Text
"a")
        ]

showPitchTable :: IO ()
showPitchTable :: IO ()
showPitchTable = Text -> IO ()
Text.IO.putStr forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$ Int -> [[Text]] -> [Text]
Texts.columns Int
3 forall a b. (a -> b) -> a -> b
$
    forall a. [[a]] -> [[a]]
Lists.rotate
    [ [Text]
pemadeUmbang forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Text
""
    , forall a. Int -> a -> [a]
replicate Int
5 Text
"" forall a. [a] -> [a] -> [a]
++ [Text]
kantilanUmbang
    , [Text]
pemadeIsep forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Text
""
    , forall a. Int -> a -> [a]
replicate Int
5 Text
"" forall a. [a] -> [a] -> [a]
++ [Text]
kantilanIsep
    ]
    where
    [[Text]
pemadeUmbang, [Text]
pemadeIsep, [Text]
kantilanUmbang, [Text]
kantilanIsep] =
        forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (NoteNumber -> Text
pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst))
            [ Instrument -> Tuning -> Articulation -> [(NoteNumber, (Key, Note))]
instrumentKeys Instrument
inst Tuning
tuning Articulation
Open
            | Instrument
inst <- [Instrument
Pemade, Instrument
Kantilan], Tuning
tuning <- [Tuning
Umbang, Tuning
Isep]
            ]
    pp :: Pitch.NoteNumber -> Text
    pp :: NoteNumber -> Text
pp = HasCallStack => Text -> Text -> Text -> Text
Text.replace Text
"nn" Text
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Text
pretty

pemadeTuning :: [(Pitch.NoteNumber, Pitch.NoteNumber)]
pemadeTuning :: [(NoteNumber, NoteNumber)]
pemadeTuning =
    [ (NoteNumber
52.27, NoteNumber
52.94)
    , (NoteNumber
54.55, NoteNumber
55.15)
    , (NoteNumber
57.35, NoteNumber
57.90)
    , (NoteNumber
59.85, NoteNumber
60.32)

    , (NoteNumber
62.50, NoteNumber
63.00)
    , (NoteNumber
64.45, NoteNumber
64.72)
    , (NoteNumber
67.29, NoteNumber
67.60)
    , (NoteNumber
69.25, NoteNumber
69.48)
    , (NoteNumber
71.83, NoteNumber
72.11)
    , (NoteNumber
74.66, NoteNumber
74.85)
    ]

kantilanTuning :: [(Pitch.NoteNumber, Pitch.NoteNumber)]
kantilanTuning :: [(NoteNumber, NoteNumber)]
kantilanTuning =
    [ (NoteNumber
64.31, NoteNumber
64.70)
    , (NoteNumber
67.13, NoteNumber
67.45)
    , (NoteNumber
69.22, NoteNumber
69.46)
    , (NoteNumber
71.81, NoteNumber
72.00)

    , (NoteNumber
74.57, NoteNumber
74.80)
    , (NoteNumber
76.75, NoteNumber
76.88)
    , (NoteNumber
79.37, NoteNumber
79.50)
    , (NoteNumber
81.53, NoteNumber
81.65)
    , (NoteNumber
84.02, NoteNumber
84.13)
    , (NoteNumber
86.79, NoteNumber
86.90)
    ]