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

{-# LANGUAGE StrictData #-}
module Synth.Sampler.Patch.Java (patches) where
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text

import           System.FilePath ((</>))

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

import qualified Cmd.Instrument.Bali as Bali
import qualified Cmd.Instrument.ImInst as ImInst
import qualified Derive.Attrs as Attrs
import qualified Derive.C.Prelude.Note as Prelude.Note
import qualified Derive.Call as Call
import qualified Derive.Instrument.DUtil as DUtil
import qualified Derive.Scale as Scale

import qualified Instrument.Common as Common
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.Code as Code
import qualified Synth.Sampler.Patch.Lib.Prepare as Prepare
import qualified Synth.Sampler.Patch.Lib.Util as Util
import           Synth.Sampler.Patch.Lib.Util (Dynamic(..))
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.Wav

patches :: [Patch.Patch]
patches :: [Patch]
patches = forall a b. (a -> b) -> [a] -> [b]
map Instrument -> Patch
makePatch [Instrument
slenthem, Instrument
peking]

data Instrument = Instrument {
    Instrument -> Text
name :: Text
    , Instrument -> Variations
variations :: Variations
    , Instrument -> Tuning
tuning :: Tuning
    }

type Tuning = Map Pitch Pitch.NoteNumber
type Variations = Articulation -> (Pitch, Util.Dynamic) -> Util.Variation

slenthem :: Instrument
slenthem :: Instrument
slenthem = Instrument
    { name :: Text
name = Text
"slenthem"
    , forall {a}. Num a => Articulation -> (Pitch, Dynamic) -> a
variations :: forall {a}. Num a => Articulation -> (Pitch, Dynamic) -> a
variations :: Variations
variations
    , tuning :: Tuning
tuning = 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 (forall a b. (a -> b) -> [a] -> [b]
map (Int -> PitchClass -> Pitch
Pitch Int
2) [PitchClass
P1 ..])
        [ NoteNumber
50.18 -- 21
        , NoteNumber
51.65 -- 22
        , NoteNumber
53    -- 23
        , NoteNumber
56    -- 24
        , NoteNumber
57.05 -- 25
        , NoteNumber
58.68 -- 26
        , NoteNumber
60.13 -- 27
        ]
        -- TODO copy pasted from Scale.Java
    }
    where
    variations :: Articulation -> (Pitch, Dynamic) -> a
variations Articulation
Open = \case
        (Pitch Int
2 PitchClass
P6, Dynamic
PP) -> a
3
        (Pitch Int
2 PitchClass
P6, Dynamic
MF) -> a
5
        (Pitch Int
2 PitchClass
P7, Dynamic
FF) -> a
3
        (Pitch, Dynamic)
_ -> a
4
    variations Articulation
Mute = \case
        (Pitch Int
2 PitchClass
P5, Dynamic
PP) -> a
5
        (Pitch, Dynamic)
_ -> a
6
    variations Articulation
Character = forall a b. a -> b -> a
const a
0

peking :: Instrument
peking :: Instrument
peking = Instrument
    { name :: Text
name = Text
"peking"
    , forall {a}. Num a => Articulation -> (Pitch, Dynamic) -> a
variations :: forall {a}. Num a => Articulation -> (Pitch, Dynamic) -> a
variations :: Variations
variations
    , tuning :: Tuning
tuning = 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 (forall a b. (a -> b) -> [a] -> [b]
map (Int -> PitchClass -> Pitch
Pitch Int
5) [PitchClass
P1 ..])
        [ NoteNumber
86.4  -- 51
        , NoteNumber
87.7  -- 52
        , NoteNumber
88.98 -- 53
        , NoteNumber
80 forall a. Num a => a -> a -> a
+ NoteNumber
12    -- 44
        , NoteNumber
81.03 forall a. Num a => a -> a -> a
+ NoteNumber
12 -- 45
        , NoteNumber
82.48 forall a. Num a => a -> a -> a
+ NoteNumber
12 -- 46
        , NoteNumber
84.14 forall a. Num a => a -> a -> a
+ NoteNumber
12 -- 47
        ]
    }
    where
    variations :: Articulation -> (Pitch, Dynamic) -> a
variations Articulation
Open = forall a b. a -> b -> a
const a
4
    variations Articulation
Mute = \case
        (Pitch Int
5 PitchClass
P3, Dynamic
MF) -> a
5
        (Pitch, Dynamic)
_ -> a
6
    variations Articulation
Character = \(Pitch Int
_ PitchClass
p, Dynamic
dyn) ->
        forall a. a -> Maybe a -> a
fromMaybe a
0 forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Dynamic
dyn forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PitchClass
p Map PitchClass (Map Dynamic a)
byPitch
        where
        -- Character works with +character, calls have to add it or not.
        byPitch :: Map PitchClass (Map Dynamic a)
byPitch = 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 [PitchClass
P1 ..] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ [(Dynamic
MP, a
2), (Dynamic
MF, a
2), (Dynamic
FF, a
2)]
            , [(Dynamic
MP, a
1), (Dynamic
MF, a
4)]
            , [(Dynamic
MF, a
4)]
            , [(Dynamic
MP, a
2), (Dynamic
MF, a
4)]
            , [(Dynamic
MP, a
2), (Dynamic
MF, a
2)]
            , [(Dynamic
MF, a
5)]
            , [(Dynamic
MP, a
4), (Dynamic
MF, a
4)]
            ]

makePatch :: Instrument -> Patch.Patch
makePatch :: Instrument -> Patch
makePatch inst :: Instrument
inst@(Instrument { Text
name :: Text
name :: Instrument -> Text
name, Tuning
tuning :: Tuning
tuning :: Instrument -> Tuning
tuning }) = (Text -> Patch
Patch.patch Text
name)
    { _dir :: String
Patch._dir = String
dir
    , _convert :: Note -> ConvertM Sample
Patch._convert = Instrument -> AttributeMap Articulation -> Note -> ConvertM Sample
convert Instrument
inst AttributeMap Articulation
attributeMap
    , _karyaPatch :: Patch
Patch._karyaPatch =
        Lens Patch Code
ImInst.code forall f a. Lens f a -> a -> f -> f
#= Code
code forall a b. (a -> b) -> a -> b
$
        Range -> Patch -> Patch
ImInst.range (forall a. Map Pitch a -> Range
makeRange 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
            }
    , _allFilenames :: Set String
Patch._allFilenames = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ Instrument -> [String]
allFilenames Instrument
inst
    }
    where
    dir :: String
dir = String
"java" String -> String -> String
</> Text -> String
untxt Text
name
    -- TODO copy paste with Rambat
    code :: Code
code = Code
note
        forall a. Semigroup a => a -> a -> a
<> String -> (Note -> ConvertM Sample) -> Code
Util.thru String
dir (Instrument -> AttributeMap Articulation -> Note -> ConvertM Sample
convert Instrument
inst AttributeMap Articulation
attributeMap)
        forall a. Semigroup a => a -> a -> a
<> InstrumentPostproc -> Code
ImInst.postproc InstrumentPostproc
DUtil.with_symbolic_pitch
    note :: Code
note = Doc
-> (NoteArgs -> NoteDeriver -> NoteDeriver)
-> (NoteArgs -> NoteDeriver)
-> Code
Bali.zero_dur_mute_with Doc
""
        (\NoteArgs
_args -> forall {a}. Deriver a -> Deriver a
transform forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Y -> Deriver a -> Deriver a
Call.multiply_dynamic Y
0.65)
        (\NoteArgs
args -> forall {a}. Deriver a -> Deriver a
transform forall a b. (a -> b) -> a -> b
$
            Config -> NoteArgs -> NoteDeriver
Prelude.Note.default_note Config
Prelude.Note.use_attributes NoteArgs
args)
        where transform :: Deriver a -> Deriver a
transform = forall {a}. Deriver a -> Deriver a
Code.withVariation

    -- TODO filter out the ones I don't have
    attributeMap :: AttributeMap Articulation
attributeMap = forall a. [(Attributes, a)] -> AttributeMap a
Common.attribute_map
        [ (Attributes
Attrs.mute, Articulation
Mute)
        , (Text -> Attributes
Attrs.attr Text
"character", Articulation
Character)
        , (forall a. Monoid a => a
mempty, Articulation
Open)
        ]

allFilenames :: Instrument -> [Sample.SamplePath]
allFilenames :: Instrument -> [String]
allFilenames (Instrument { Tuning
tuning :: Tuning
tuning :: Instrument -> Tuning
tuning, Variations
variations :: Variations
variations :: Instrument -> Variations
variations }) =
    [ String
fname
    | Articulation
art <- forall a. (Enum a, Bounded a) => [a]
Util.enumAll
    , Pitch
pitch <- forall k a. Map k a -> [k]
Map.keys Tuning
tuning
    , Dynamic
dyn <- forall a. (Enum a, Bounded a) => [a]
Util.enumAll
    , String
fname <- Variations -> Articulation -> Pitch -> Dynamic -> [String]
toFilenames Variations
variations Articulation
art Pitch
pitch Dynamic
dyn
    ]

makeRange :: Map Pitch a -> Scale.Range
makeRange :: forall a. Map Pitch a -> Range
makeRange Map Pitch a
tuning = Pitch -> Pitch -> Range
Scale.Range (Pitch -> Pitch
toPitch Pitch
bottom) (Pitch -> Pitch
toPitch Pitch
top)
    where
    Just Pitch
bottom = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey Map Pitch a
tuning
    Just Pitch
top = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.maxViewWithKey Map Pitch a
tuning

data Articulation = Open | Mute | Character -- ^ peking have character
    deriving (Int -> Articulation -> String -> String
[Articulation] -> String -> String
Articulation -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Articulation] -> String -> String
$cshowList :: [Articulation] -> String -> String
show :: Articulation -> String
$cshow :: Articulation -> String
showsPrec :: Int -> Articulation -> String -> String
$cshowsPrec :: Int -> Articulation -> String -> String
Show, 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)

convert :: Instrument -> Common.AttributeMap Articulation -> Note.Note
    -> Patch.ConvertM Sample.Sample
convert :: Instrument -> AttributeMap Articulation -> Note -> ConvertM Sample
convert (Instrument { Tuning
tuning :: Tuning
tuning :: Instrument -> Tuning
tuning, Variations
variations :: Variations
variations :: Instrument -> Variations
variations }) AttributeMap Articulation
attrMap Note
note = do
    let art :: Articulation
art = forall a. a -> AttributeMap a -> Attributes -> a
Util.articulationDefault Articulation
Open AttributeMap Articulation
attrMap 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
0 Note
note
    Either Note NoteNumber
symPitch <- forall (m :: * -> *).
MonadError Text m =>
Note -> m (Either Note NoteNumber)
Util.symbolicPitch Note
note
    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
    (Pitch
pitch, (NoteNumber
noteNn, NoteNumber
sampleNn)) <- forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
tryRight forall a b. (a -> b) -> a -> b
$ Tuning
-> Either Note NoteNumber
-> Either Text (Pitch, (NoteNumber, NoteNumber))
findPitch Tuning
tuning Either Note NoteNumber
symPitch
    let filenames :: [String]
filenames = Variations -> Articulation -> Pitch -> Dynamic -> [String]
findFilenames Variations
variations Articulation
art Pitch
pitch Dynamic
dyn
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (String -> Sample
Sample.make (forall a. [a] -> Note -> a
Util.chooseVariation [String]
filenames Note
note))
        -- TODO duplicate from Rambat
        { envelope :: Signal
Sample.envelope = if
            | Articulation
art forall a. Eq a => a -> a -> Bool
== Articulation
Mute -> 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
        }

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

-- TODO similar to Rambat.findPitch, except no umbang/isep
findPitch :: Tuning -> Either Pitch.Note Pitch.NoteNumber
    -> Either Text (Pitch, (Pitch.NoteNumber, Pitch.NoteNumber))
findPitch :: Tuning
-> Either Note NoteNumber
-> Either Text (Pitch, (NoteNumber, NoteNumber))
findPitch Tuning
tuning = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {m :: * -> *}.
MonadError Text m =>
Note -> m (Pitch, (NoteNumber, NoteNumber))
findSymPitch forall {m :: * -> *} {e}.
(MonadError e m, IsString e) =>
NoteNumber -> m (Pitch, (NoteNumber, NoteNumber))
findNnPitch
    where
    findSymPitch :: Note -> m (Pitch, (NoteNumber, NoteNumber))
findSymPitch (Pitch.Note Text
pitch) = do
        Pitch
pitch <- forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
tryJust (Text
"can't parse symbolic pitch: " forall a. Semigroup a => a -> a -> a
<> Text
pitch) forall a b. (a -> b) -> a -> b
$
            Text -> Maybe Pitch
parsePitch Text
pitch
        -- Symbolic pitch doesn't actually need the nn, but can at least check
        -- range.
        NoteNumber
nn <- forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
tryJust (Text
"pitch out of range: " forall a. Semigroup a => a -> a -> a
<> String -> Text
txt (Pitch -> String
showPitch Pitch
pitch)) forall a b. (a -> b) -> a -> b
$
            forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Pitch
pitch Tuning
tuning
        forall (m :: * -> *) a. Monad m => a -> m a
return (Pitch
pitch, (NoteNumber
nn, NoteNumber
nn))
    findNnPitch :: NoteNumber -> m (Pitch, (NoteNumber, NoteNumber))
findNnPitch NoteNumber
nn = do
        (NoteNumber
sampleNn, Pitch
pitch) <- forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
tryJust e
"no pitches" forall a b. (a -> b) -> a -> b
$
            forall k v. (Ord k, Num k) => k -> Map k v -> Maybe (k, v)
Maps.lookupClosest NoteNumber
nn Map NoteNumber Pitch
nnToPitch
        forall (m :: * -> *) a. Monad m => a -> m a
return (Pitch
pitch, (NoteNumber
nn, NoteNumber
sampleNn))
    nnToPitch :: Map NoteNumber Pitch
nnToPitch = forall a k. Ord a => Map k a -> Map a k
Maps.invert Tuning
tuning

-- If 0 variations, choose from next dyn up
findFilenames :: Variations -> Articulation -> Pitch -> Util.Dynamic
    -> [Sample.SamplePath]
findFilenames :: Variations -> Articulation -> Pitch -> Dynamic -> [String]
findFilenames Variations
variation Articulation
art Pitch
pitch Dynamic
dyn = forall {a}. [[a]] -> [a]
nonNull
    [ Variations -> Articulation -> Pitch -> Dynamic -> [String]
toFilenames Variations
variation Articulation
art Pitch
pitch Dynamic
dyn
    , if Dynamic
dyn forall a. Ord a => a -> a -> Bool
< Dynamic
FF then Variations -> Articulation -> Pitch -> Dynamic -> [String]
findFilenames Variations
variation Articulation
art Pitch
pitch (forall a. Enum a => a -> a
succ Dynamic
dyn) else []
    , if Articulation
art forall a. Eq a => a -> a -> Bool
== Articulation
Character then Variations -> Articulation -> Pitch -> Dynamic -> [String]
findFilenames Variations
variation Articulation
Open Pitch
pitch Dynamic
dyn else []
    ]
    where
    nonNull :: [[a]] -> [a]
nonNull ([] : [[a]]
xs) = [[a]] -> [a]
nonNull [[a]]
xs
    nonNull ([a]
x : [[a]]
_) = [a]
x
    nonNull [] = []

-- | Find variation samples: {open,mute}/2{1..7}-{pp,mp,mf,ff}-v{1..n}
toFilenames :: Variations -> Articulation -> Pitch -> Util.Dynamic
    -> [Sample.SamplePath]
toFilenames :: Variations -> Articulation -> Pitch -> Dynamic -> [String]
toFilenames Variations
variations Articulation
art Pitch
pitch Dynamic
dyn =
    forall a b. (a -> b) -> [a] -> [b]
map (Pitch -> Articulation -> Dynamic -> Int -> String
unparseFilename Pitch
pitch Articulation
art Dynamic
dyn) [Int
1 .. Variations
variations Articulation
art (Pitch
pitch, Dynamic
dyn)]

unparseFilename :: Pitch -> Articulation -> Util.Dynamic -> Util.Variation
    -> FilePath
unparseFilename :: Pitch -> Articulation -> Dynamic -> Int -> String
unparseFilename Pitch
pitch Articulation
art Dynamic
dyn Int
var =
    Articulation -> String
articulationDir Articulation
art
        String -> String -> String
</> forall a. Monoid a => a -> [a] -> a
Lists.join String
"-" [Pitch -> String
showPitch Pitch
pitch, forall a. Show a => a -> String
Util.showLower Dynamic
dyn, Char
'v' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Int
var]
        forall a. [a] -> [a] -> [a]
++ SampleFormat -> String
Util.extension SampleFormat
sampleFormat

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)

articulationDir :: Articulation -> String
articulationDir :: Articulation -> String
articulationDir = \case
    Articulation
Mute -> String
"mute"
    Articulation
Open -> String
"open"
    Articulation
Character -> String
"character"

-- * prepare

_relink :: String -> [FilePath] -> IO ()
_relink :: String -> [String] -> IO ()
_relink String
inst [String]
filenames =
    String -> String -> String -> [(String, String)] -> IO ()
Prepare.relink (String
Prepare.baseDir String -> String -> String
</> String
"java" String -> String -> String
</> String
inst) String
"raw" String
"samples"
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> [String] -> IO [(String, String)]
Prepare.renames (String
Prepare.baseDir String -> String -> String
</> String
"java" String -> String -> String
</> String
inst String -> String -> String
</> String
"raw")
            [String]
filenames

_pekingRelink :: IO ()
_pekingRelink :: IO ()
_pekingRelink = String -> [String] -> IO ()
_relink String
"peking" (Instrument -> [String]
allFilenames Instrument
peking)


-- * pitch

data Pitch = Pitch Pitch.Octave PitchClass
    deriving (Int -> Pitch -> String -> String
[Pitch] -> String -> String
Pitch -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Pitch] -> String -> String
$cshowList :: [Pitch] -> String -> String
show :: Pitch -> String
$cshow :: Pitch -> String
showsPrec :: Int -> Pitch -> String -> String
$cshowsPrec :: Int -> Pitch -> String -> String
Show, Pitch -> Pitch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pitch -> Pitch -> Bool
$c/= :: Pitch -> Pitch -> Bool
== :: Pitch -> Pitch -> Bool
$c== :: Pitch -> Pitch -> Bool
Eq, Eq Pitch
Pitch -> Pitch -> Bool
Pitch -> Pitch -> Ordering
Pitch -> Pitch -> Pitch
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 :: Pitch -> Pitch -> Pitch
$cmin :: Pitch -> Pitch -> Pitch
max :: Pitch -> Pitch -> Pitch
$cmax :: Pitch -> Pitch -> Pitch
>= :: Pitch -> Pitch -> Bool
$c>= :: Pitch -> Pitch -> Bool
> :: Pitch -> Pitch -> Bool
$c> :: Pitch -> Pitch -> Bool
<= :: Pitch -> Pitch -> Bool
$c<= :: Pitch -> Pitch -> Bool
< :: Pitch -> Pitch -> Bool
$c< :: Pitch -> Pitch -> Bool
compare :: Pitch -> Pitch -> Ordering
$ccompare :: Pitch -> Pitch -> Ordering
Ord)

data PitchClass = P1 | P2 | P3 | P4 | P5 | P6 | P7
    deriving (Int -> PitchClass -> String -> String
[PitchClass] -> String -> String
PitchClass -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PitchClass] -> String -> String
$cshowList :: [PitchClass] -> String -> String
show :: PitchClass -> String
$cshow :: PitchClass -> String
showsPrec :: Int -> PitchClass -> String -> String
$cshowsPrec :: Int -> PitchClass -> String -> String
Show, PitchClass -> PitchClass -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PitchClass -> PitchClass -> Bool
$c/= :: PitchClass -> PitchClass -> Bool
== :: PitchClass -> PitchClass -> Bool
$c== :: PitchClass -> PitchClass -> Bool
Eq, Eq PitchClass
PitchClass -> PitchClass -> Bool
PitchClass -> PitchClass -> Ordering
PitchClass -> PitchClass -> PitchClass
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 :: PitchClass -> PitchClass -> PitchClass
$cmin :: PitchClass -> PitchClass -> PitchClass
max :: PitchClass -> PitchClass -> PitchClass
$cmax :: PitchClass -> PitchClass -> PitchClass
>= :: PitchClass -> PitchClass -> Bool
$c>= :: PitchClass -> PitchClass -> Bool
> :: PitchClass -> PitchClass -> Bool
$c> :: PitchClass -> PitchClass -> Bool
<= :: PitchClass -> PitchClass -> Bool
$c<= :: PitchClass -> PitchClass -> Bool
< :: PitchClass -> PitchClass -> Bool
$c< :: PitchClass -> PitchClass -> Bool
compare :: PitchClass -> PitchClass -> Ordering
$ccompare :: PitchClass -> PitchClass -> Ordering
Ord, Int -> PitchClass
PitchClass -> Int
PitchClass -> [PitchClass]
PitchClass -> PitchClass
PitchClass -> PitchClass -> [PitchClass]
PitchClass -> PitchClass -> PitchClass -> [PitchClass]
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 :: PitchClass -> PitchClass -> PitchClass -> [PitchClass]
$cenumFromThenTo :: PitchClass -> PitchClass -> PitchClass -> [PitchClass]
enumFromTo :: PitchClass -> PitchClass -> [PitchClass]
$cenumFromTo :: PitchClass -> PitchClass -> [PitchClass]
enumFromThen :: PitchClass -> PitchClass -> [PitchClass]
$cenumFromThen :: PitchClass -> PitchClass -> [PitchClass]
enumFrom :: PitchClass -> [PitchClass]
$cenumFrom :: PitchClass -> [PitchClass]
fromEnum :: PitchClass -> Int
$cfromEnum :: PitchClass -> Int
toEnum :: Int -> PitchClass
$ctoEnum :: Int -> PitchClass
pred :: PitchClass -> PitchClass
$cpred :: PitchClass -> PitchClass
succ :: PitchClass -> PitchClass
$csucc :: PitchClass -> PitchClass
Enum)

toPitch :: Pitch -> Pitch.Pitch
toPitch :: Pitch -> Pitch
toPitch (Pitch Int
oct PitchClass
pc) = forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
oct (forall a. Enum a => a -> Int
fromEnum PitchClass
pc)

showPitch :: Pitch -> String
showPitch :: Pitch -> String
showPitch (Pitch Int
oct PitchClass
pc) = forall a. Show a => a -> String
show Int
oct forall a. Semigroup a => a -> a -> a
<> forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Show a => a -> String
show PitchClass
pc)

parsePitch :: Text -> Maybe Pitch
parsePitch :: Text -> Maybe Pitch
parsePitch Text
t = do
    [Char
o, Char
p] <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
t
    Int
oct <- Char -> Maybe Int
Num.readDigit Char
o
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a -> Bool
Num.inRange Int
0 Int
8 Int
oct
    PitchClass
pc <- Int -> Maybe PitchClass
parsePitchClass forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Char -> Maybe Int
Num.readDigit Char
p
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> PitchClass -> Pitch
Pitch Int
oct PitchClass
pc

parsePitchClass :: Int -> Maybe PitchClass
parsePitchClass :: Int -> Maybe PitchClass
parsePitchClass = \case
    Int
1 -> forall a. a -> Maybe a
Just PitchClass
P1
    Int
2 -> forall a. a -> Maybe a
Just PitchClass
P2
    Int
3 -> forall a. a -> Maybe a
Just PitchClass
P3
    Int
4 -> forall a. a -> Maybe a
Just PitchClass
P4
    Int
5 -> forall a. a -> Maybe a
Just PitchClass
P5
    Int
6 -> forall a. a -> Maybe a
Just PitchClass
P6
    Int
7 -> forall a. a -> Maybe a
Just PitchClass
P7
    Int
_ -> forall a. Maybe a
Nothing