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

-- | Various samples from Sonic Couture's Balinese gamelan.
module Synth.Sampler.Patch.ScGamelan (patches) where
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Typeable as Typeable

import qualified System.Directory as Directory
import           System.FilePath ((</>))
import qualified Text.Read as Read

import qualified Util.Lists as Lists
import qualified Cmd.Instrument.CUtil as CUtil
import qualified Derive.Attrs as Attrs
import qualified Perform.NN as NN
import qualified Perform.Pitch as Pitch
import qualified Synth.Sampler.Patch as Patch
import qualified Synth.Sampler.Patch.Lib.Code as Code
import qualified Synth.Sampler.Patch.Lib.Drum as Drum
import qualified Synth.Sampler.Patch.Lib.Util as Util
import qualified Synth.Shared.Config as Config
import qualified Synth.Shared.Signal as Signal

import           Global


patches :: [Patch.Patch]
patches :: [Patch]
patches = [Patch
gongPatch]
    -- CUtil.simple_drum CUtil.MidiThru Nothing gong_strokes (sc_patch "gong")
    -- : CUtil.simple_drum CUtil.MidiThru Nothing kempli_kajar_notes
    --     (sc_patch "kempli")
    -- : reyong_ks (ranged_patch Legong.reyong_range "reyong")
    -- : ranged_patch Legong.trompong_range "trompong"
    -- : concat
    -- [ pasang True (range_of Legong.jegog) "jegog"
    -- , pasang True (range_of Legong.calung) "calung"
    -- , pasang True (range_of Legong.penyacah) "penyacah"
    -- , tunggal False Legong.ugal_range "ugal"
    -- , pasang False (range_of Legong.pemade) "pemade"
    -- , pasang False (range_of Legong.kantilan) "kantilan"
    -- ]

gongPatch :: Patch.Patch
gongPatch :: Patch
gongPatch = forall art.
Ord art =>
FilePath
-> PatchName
-> StrokeMap art
-> ConvertMap art
-> (Maybe art -> CallConfig)
-> Patch
Drum.patch FilePath
dir PatchName
"sc-gong" StrokeMap Gong
gongStrokeMap ConvertMap Gong
gongConvertMap Maybe Gong -> CallConfig
configOf
    where
    configOf :: Maybe Gong -> CallConfig
configOf (Just Gong
gong) = CallConfig
CUtil.call_config
        { _natural_nn :: Maybe NoteNumber
CUtil._natural_nn = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Gong -> NoteNumber
gongNn Gong
gong
        , _transform :: NoteDeriver -> NoteDeriver
CUtil._transform = forall a. Deriver a -> Deriver a
Code.withVariation
        }
    -- Drum.strokeMapTable shouldn't put Nothings in there.
    configOf Maybe Gong
Nothing = forall a. HasCallStack => FilePath -> a
error FilePath
"no gong for attrs!?"
    dir :: FilePath
dir = FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
gongsDir

gongStrokeMap :: Drum.StrokeMap Gong
gongStrokeMap :: StrokeMap Gong
gongStrokeMap = forall art.
Ord art =>
Stops
-> [(Char, Symbol, Attributes, art, PatchName)] -> StrokeMap art
Drum.strokeMapSimple []
    [ (Char
'z', Symbol
"O", Attributes
gong forall a. Semigroup a => a -> a -> a
<> Attributes
wadon, Gong
GongWadon, PatchName
open)
    , (Char
'x', Symbol
"o", Attributes
gong forall a. Semigroup a => a -> a -> a
<> Attributes
lanang, Gong
GongLanang, PatchName
open)
    , (Char
'q', Symbol
"p", Attributes
kempur, Gong
Kempur, PatchName
open)
    , (Char
'w', Symbol
"m", Attributes
kemong, Gong
Kemong, PatchName
open)
    ]
    where open :: PatchName
open = PatchName
""

gongConvertMap :: Drum.ConvertMap Gong
gongConvertMap :: ConvertMap Gong
gongConvertMap = Drum.ConvertMap
    { _dynRange :: (Y, Y)
_dynRange = (Y
0.9, Y
1.1)
    , _naturalNn :: Maybe (Gong -> NoteNumber)
_naturalNn = forall a. a -> Maybe a
Just Gong -> NoteNumber
gongNn
    , _muteTime :: Maybe RealTime
_muteTime = forall a. Maybe a
Nothing
    , _getFilename :: Gong -> Y -> Y -> (FilePath, Maybe (Y, Y))
_getFilename = Gong -> Y -> Y -> (FilePath, Maybe (Y, Y))
gongFilename
    , _allFilenames :: Set FilePath
_allFilenames = Set FilePath
gongAllFilenames
    }

{-
t0 = mapM_ Text.IO.putStrLn $ Texts.columns 2 $ map head $
    showDyns Kempur 0.05 0.5 1.5
t1 = mapM_ Text.IO.putStrLn $ Texts.columns 2 $ map head $
    showDyns2 Kempur 0.05 0.5 1.5

showDyns gong step minDyn maxDyn =
    map (\dyn -> map (normal dyn) $ gongVariations dyn gong) $
        Lists.rangeEnd 0 1 step
    where
    normal dyn (fname, (low, high)) =
        [ pp dyn, pp $ dynToVel dyn, txt fname
        , pp $ Num.scale minDyn maxDyn $ Num.normalize low high dyn
        ]

showDyns2 gong step minDyn maxDyn =
    map (\dyn -> map (normal dyn) $ gongVariations dyn gong) $
        Lists.rangeEnd 0 1 step
    where
    normal dyn (fname, (low, high)) =
        [ pp dyn, pp $ dynToVel dyn, txt fname
        , pp $ Util.dynamicAutoScale (minDyn, maxDyn) (low, high) dyn
        ]

pp :: Pretty a => a -> Text
pp = pretty
-}

gongFilename :: Gong -> Signal.Y -> Signal.Y
    -> (FilePath, Maybe (Signal.Y, Signal.Y))
gongFilename :: Gong -> Y -> Y -> (FilePath, Maybe (Y, Y))
gongFilename Gong
gong Y
dyn Y
var =
    forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Y -> a
Util.pickVariation (Y -> Gong -> [(FilePath, (Y, Y))]
gongVariations Y
dyn Gong
gong) Y
var

baseDir :: FilePath
baseDir :: FilePath
baseDir = FilePath
"sc-gamelan"

gongsDir :: FilePath
gongsDir :: FilePath
gongsDir = FilePath
"gongs"

gong :: Attributes
gong = PatchName -> Attributes
Attrs.attr PatchName
"gong"
kemong :: Attributes
kemong = PatchName -> Attributes
Attrs.attr PatchName
"kemong"
kempur :: Attributes
kempur = PatchName -> Attributes
Attrs.attr PatchName
"kempur"
wadon :: Attributes
wadon = PatchName -> Attributes
Attrs.attr PatchName
"wadon"
lanang :: Attributes
lanang = PatchName -> Attributes
Attrs.attr PatchName
"lanang"

gongVariations :: Signal.Y -> Gong -> [(FilePath, (Signal.Y, Signal.Y))]
gongVariations :: Y -> Gong -> [(FilePath, (Y, Y))]
gongVariations Y
dyn = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. ((Int, Int), a) -> (a, (Y, Y))
toDyn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. [((Int, Int), b)] -> [((Int, Int), b)]
select forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gong -> [((Int, Int), FilePath)]
gongSamples
    where
    toDyn :: ((Int, Int), a) -> (a, (Y, Y))
toDyn ((Int
low, Int
high), a
fname) =
        (a
fname, (Int -> Y
Util.velToDyn Int
low, Int -> Y
Util.velToDyn Int
high))
    select :: [((Int, Int), b)] -> [((Int, Int), b)]
select = forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((forall a. Ord a => a -> a -> Bool
<=Int
vel) 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
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((forall a. Ord a => a -> a -> Bool
<Int
vel)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) -> a
fst)
    vel :: Int
vel = Y -> Int
Util.dynToVel Y
dyn

data Gong = GongWadon | GongLanang | Kempur | Kemong
    deriving (Gong -> Gong -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Gong -> Gong -> Bool
$c/= :: Gong -> Gong -> Bool
== :: Gong -> Gong -> Bool
$c== :: Gong -> Gong -> Bool
Eq, Eq Gong
Gong -> Gong -> Bool
Gong -> Gong -> Ordering
Gong -> Gong -> Gong
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 :: Gong -> Gong -> Gong
$cmin :: Gong -> Gong -> Gong
max :: Gong -> Gong -> Gong
$cmax :: Gong -> Gong -> Gong
>= :: Gong -> Gong -> Bool
$c>= :: Gong -> Gong -> Bool
> :: Gong -> Gong -> Bool
$c> :: Gong -> Gong -> Bool
<= :: Gong -> Gong -> Bool
$c<= :: Gong -> Gong -> Bool
< :: Gong -> Gong -> Bool
$c< :: Gong -> Gong -> Bool
compare :: Gong -> Gong -> Ordering
$ccompare :: Gong -> Gong -> Ordering
Ord, Int -> Gong -> FilePath -> FilePath
[Gong] -> FilePath -> FilePath
Gong -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Gong] -> FilePath -> FilePath
$cshowList :: [Gong] -> FilePath -> FilePath
show :: Gong -> FilePath
$cshow :: Gong -> FilePath
showsPrec :: Int -> Gong -> FilePath -> FilePath
$cshowsPrec :: Int -> Gong -> FilePath -> FilePath
Show, Typeable.Typeable, Int -> Gong
Gong -> Int
Gong -> [Gong]
Gong -> Gong
Gong -> Gong -> [Gong]
Gong -> Gong -> Gong -> [Gong]
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 :: Gong -> Gong -> Gong -> [Gong]
$cenumFromThenTo :: Gong -> Gong -> Gong -> [Gong]
enumFromTo :: Gong -> Gong -> [Gong]
$cenumFromTo :: Gong -> Gong -> [Gong]
enumFromThen :: Gong -> Gong -> [Gong]
$cenumFromThen :: Gong -> Gong -> [Gong]
enumFrom :: Gong -> [Gong]
$cenumFrom :: Gong -> [Gong]
fromEnum :: Gong -> Int
$cfromEnum :: Gong -> Int
toEnum :: Int -> Gong
$ctoEnum :: Int -> Gong
pred :: Gong -> Gong
$cpred :: Gong -> Gong
succ :: Gong -> Gong
$csucc :: Gong -> Gong
Enum, Gong
forall a. a -> a -> Bounded a
maxBound :: Gong
$cmaxBound :: Gong
minBound :: Gong
$cminBound :: Gong
Bounded)

gongNn :: Gong -> Pitch.NoteNumber
gongNn :: Gong -> NoteNumber
gongNn = \case
    Gong
GongWadon -> NoteNumber
NN.as1 forall a. Num a => a -> a -> a
+ NoteNumber
0.25
    Gong
GongLanang -> NoteNumber
NN.b1 forall a. Num a => a -> a -> a
+ NoteNumber
0.75
    Gong
Kempur -> NoteNumber
NN.gs2 forall a. Num a => a -> a -> a
+ NoteNumber
0.24
    Gong
Kemong -> NoteNumber
NN.as3 forall a. Num a => a -> a -> a
- NoteNumber
0.09

-- * make gongSamples

groupSamples :: [((String, Char, Int), FilePath)]
    -> [(Gong, [((Int, Int), FilePath)])]
groupSamples :: [((FilePath, Char, Int), FilePath)]
-> [(Gong, [((Int, Int), FilePath)])]
groupSamples =
    forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Char, [(Int, FilePath)])] -> [((Int, Int), FilePath)]
group) forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap FilePath -> Gong
parseGong forall a b. Ord a => [(a, b)] -> [(a, NonNull b)]
Lists.groupFst)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ord a => [(a, b)] -> [(a, NonNull b)]
Lists.groupFst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {a} {b}. ((a, a, a), b) -> (a, (a, (a, b)))
shuffle
    where
    shuffle :: ((a, a, a), b) -> (a, (a, (a, b)))
shuffle ((a
inst, a
var, a
maxVel), b
fname) = (a
inst, (a
var, (a
maxVel, b
fname)))
    group :: [(Char, [(Int, FilePath)])] -> [((Int, Int), FilePath)]
    group :: [(Char, [(Int, FilePath)])] -> [((Int, Int), FilePath)]
group = forall k a. Ord k => (a -> k) -> [a] -> [a]
Lists.sortOn (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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. [(Int, a)] -> [((Int, Int), a)]
groupRanges forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

groupRanges :: [(Int, a)] -> [((Int, Int), a)]
groupRanges :: forall a. [(Int, a)] -> [((Int, Int), a)]
groupRanges = forall {t} {b}. Num t => t -> [(t, b)] -> [((t, t), b)]
go Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> k) -> [a] -> [a]
Lists.sortOn forall a b. (a, b) -> a
fst
    where
    go :: t -> [(t, b)] -> [((t, t), b)]
go t
low ((t
high, b
a) : [(t, b)]
xs) = ((t
low, t
high), b
a) forall a. a -> [a] -> [a]
: t -> [(t, b)] -> [((t, t), b)]
go (t
highforall a. Num a => a -> a -> a
+t
1) [(t, b)]
xs
    go t
_ [] = []

parseGong :: String -> Gong
parseGong :: FilePath -> Gong
parseGong FilePath
n = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"no gong: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
n) FilePath
n Map FilePath Gong
toGong
    where
    toGong :: Map String Gong
    toGong :: Map FilePath Gong
toGong = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (FilePath
"Gong Wadon", Gong
GongWadon)
        , (FilePath
"Gong Lanang", Gong
GongLanang)
        , (FilePath
"Kempur", Gong
Kempur)
        , (FilePath
"Klentong", Gong
Kemong)
        ]

makeFileList :: FilePath -> IO [(Gong, [((Int, Int), FilePath)])]
makeFileList :: FilePath -> IO [(Gong, [((Int, Int), FilePath)])]
makeFileList FilePath
inst = do
    [FilePath]
fnames <- FilePath -> IO [FilePath]
Directory.listDirectory forall a b. (a -> b) -> a -> b
$
        FilePath
Config.unsafeSamplerRoot FilePath -> FilePath -> FilePath
</> FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
inst
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [((FilePath, Char, Int), FilePath)]
-> [(Gong, [((Int, Int), FilePath)])]
groupSamples forall a b. (a -> b) -> a -> b
$ forall a k. (a -> k) -> [a] -> [(k, a)]
Lists.keyOn FilePath -> (FilePath, Char, Int)
parseFilename [FilePath]
fnames

-- Gongs: $instName-{A,B,C}$maxVel.flac
parseFilename :: FilePath -> (String, Char, Int)
parseFilename :: FilePath -> (FilePath, Char, Int)
parseFilename FilePath
fname = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"no parse: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
fname) forall a b. (a -> b) -> a -> b
$
    case forall a. Eq a => NonNull a -> NonNull a -> NonNull (NonNull a)
Lists.split FilePath
"-" FilePath
fname of
        [FilePath
inst, FilePath
rest] -> case forall a. Eq a => NonNull a -> NonNull a -> NonNull (NonNull a)
Lists.split FilePath
"." FilePath
rest of
            [Char
var : FilePath
maxVel, FilePath
"flac"] -> (FilePath
inst, Char
var,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => FilePath -> Maybe a
Read.readMaybe FilePath
maxVel
            [FilePath]
_ -> forall a. Maybe a
Nothing
        [FilePath]
_ -> forall a. Maybe a
Nothing

-- | Generate 'gongSamples'.
_makeGongSamples :: IO ()
_makeGongSamples :: IO ()
_makeGongSamples =
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(Typeable a, Show a, Typeable b, Pretty b) =>
FilePath -> [(a, [b])] -> [FilePath]
Drum.enumFunction FilePath
"gongSamples" forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [(Gong, [((Int, Int), FilePath)])]
makeFileList FilePath
gongsDir

gongAllFilenames :: Set FilePath
gongAllFilenames :: Set FilePath
gongAllFilenames = forall (t :: * -> *) a.
(HasCallStack, Foldable t) =>
Int -> t a -> t a
Util.assertLength Int
97 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList
    [FilePath
fname | Gong
art <- forall a. (Enum a, Bounded a) => [a]
Util.enumAll , ((Int, Int)
_, FilePath
fname) <- Gong -> [((Int, Int), FilePath)]
gongSamples Gong
art]

-- * generated

gongSamples :: Gong -> [((Int, Int), FilePath)]
gongSamples :: Gong -> [((Int, Int), FilePath)]
gongSamples = \case
    Gong
GongLanang ->
        [ ((Int
0, Int
20), FilePath
"Gong Lanang-A020.flac")
        , ((Int
0, Int
20), FilePath
"Gong Lanang-B020.flac")
        , ((Int
0, Int
34), FilePath
"Gong Lanang-C034.flac")
        , ((Int
21, Int
34), FilePath
"Gong Lanang-A034.flac")
        , ((Int
21, Int
36), FilePath
"Gong Lanang-B036.flac")
        , ((Int
35, Int
50), FilePath
"Gong Lanang-A050.flac")
        , ((Int
35, Int
50), FilePath
"Gong Lanang-C050.flac")
        , ((Int
37, Int
52), FilePath
"Gong Lanang-B052.flac")
        , ((Int
51, Int
70), FilePath
"Gong Lanang-A070.flac")
        , ((Int
51, Int
71), FilePath
"Gong Lanang-C071.flac")
        , ((Int
53, Int
68), FilePath
"Gong Lanang-B068.flac")
        , ((Int
69, Int
89), FilePath
"Gong Lanang-B089.flac")
        , ((Int
71, Int
87), FilePath
"Gong Lanang-A087.flac")
        , ((Int
72, Int
88), FilePath
"Gong Lanang-C088.flac")
        , ((Int
88, Int
103), FilePath
"Gong Lanang-A103.flac")
        , ((Int
89, Int
102), FilePath
"Gong Lanang-C102.flac")
        , ((Int
90, Int
106), FilePath
"Gong Lanang-B106.flac")
        , ((Int
103, Int
117), FilePath
"Gong Lanang-C117.flac")
        , ((Int
104, Int
117), FilePath
"Gong Lanang-A117.flac")
        , ((Int
107, Int
118), FilePath
"Gong Lanang-B118.flac")
        , ((Int
118, Int
127), FilePath
"Gong Lanang-A127.flac")
        , ((Int
118, Int
127), FilePath
"Gong Lanang-C127.flac")
        , ((Int
119, Int
127), FilePath
"Gong Lanang-B127.flac")
        ]
    Gong
GongWadon ->
        [ ((Int
0, Int
26), FilePath
"Gong Wadon-A026.flac")
        , ((Int
0, Int
27), FilePath
"Gong Wadon-B027.flac")
        , ((Int
0, Int
26), FilePath
"Gong Wadon-C026.flac")
        , ((Int
27, Int
38), FilePath
"Gong Wadon-A038.flac")
        , ((Int
27, Int
38), FilePath
"Gong Wadon-C038.flac")
        , ((Int
28, Int
42), FilePath
"Gong Wadon-B042.flac")
        , ((Int
39, Int
47), FilePath
"Gong Wadon-A047.flac")
        , ((Int
39, Int
48), FilePath
"Gong Wadon-C048.flac")
        , ((Int
43, Int
55), FilePath
"Gong Wadon-B055.flac")
        , ((Int
48, Int
58), FilePath
"Gong Wadon-A058.flac")
        , ((Int
49, Int
56), FilePath
"Gong Wadon-C056.flac")
        , ((Int
56, Int
65), FilePath
"Gong Wadon-B065.flac")
        , ((Int
57, Int
67), FilePath
"Gong Wadon-C067.flac")
        , ((Int
59, Int
67), FilePath
"Gong Wadon-A067.flac")
        , ((Int
66, Int
77), FilePath
"Gong Wadon-B077.flac")
        , ((Int
68, Int
77), FilePath
"Gong Wadon-A077.flac")
        , ((Int
68, Int
77), FilePath
"Gong Wadon-C077.flac")
        , ((Int
78, Int
87), FilePath
"Gong Wadon-A087.flac")
        , ((Int
78, Int
86), FilePath
"Gong Wadon-B086.flac")
        , ((Int
78, Int
87), FilePath
"Gong Wadon-C087.flac")
        , ((Int
87, Int
96), FilePath
"Gong Wadon-B096.flac")
        , ((Int
88, Int
98), FilePath
"Gong Wadon-A098.flac")
        , ((Int
88, Int
97), FilePath
"Gong Wadon-C097.flac")
        , ((Int
97, Int
107), FilePath
"Gong Wadon-B107.flac")
        , ((Int
98, Int
107), FilePath
"Gong Wadon-C107.flac")
        , ((Int
99, Int
108), FilePath
"Gong Wadon-A108.flac")
        , ((Int
108, Int
115), FilePath
"Gong Wadon-B115.flac")
        , ((Int
108, Int
116), FilePath
"Gong Wadon-C116.flac")
        , ((Int
109, Int
117), FilePath
"Gong Wadon-A117.flac")
        , ((Int
116, Int
122), FilePath
"Gong Wadon-B122.flac")
        , ((Int
117, Int
122), FilePath
"Gong Wadon-C122.flac")
        , ((Int
118, Int
123), FilePath
"Gong Wadon-A123.flac")
        , ((Int
123, Int
127), FilePath
"Gong Wadon-B127.flac")
        , ((Int
123, Int
127), FilePath
"Gong Wadon-C127.flac")
        , ((Int
124, Int
127), FilePath
"Gong Wadon-A127.flac")
        ]
    Gong
Kempur ->
        [ ((Int
0, Int
36), FilePath
"Kempur-A036.flac")
        , ((Int
0, Int
36), FilePath
"Kempur-B036.flac")
        , ((Int
0, Int
36), FilePath
"Kempur-C036.flac")
        , ((Int
37, Int
55), FilePath
"Kempur-A055.flac")
        , ((Int
37, Int
54), FilePath
"Kempur-B054.flac")
        , ((Int
37, Int
58), FilePath
"Kempur-C058.flac")
        , ((Int
55, Int
68), FilePath
"Kempur-B068.flac")
        , ((Int
56, Int
72), FilePath
"Kempur-A072.flac")
        , ((Int
59, Int
72), FilePath
"Kempur-C072.flac")
        , ((Int
69, Int
81), FilePath
"Kempur-B081.flac")
        , ((Int
73, Int
89), FilePath
"Kempur-A089.flac")
        , ((Int
73, Int
82), FilePath
"Kempur-C082.flac")
        , ((Int
82, Int
94), FilePath
"Kempur-B094.flac")
        , ((Int
83, Int
94), FilePath
"Kempur-C094.flac")
        , ((Int
90, Int
106), FilePath
"Kempur-A106.flac")
        , ((Int
95, Int
106), FilePath
"Kempur-B106.flac")
        , ((Int
95, Int
108), FilePath
"Kempur-C108.flac")
        , ((Int
107, Int
119), FilePath
"Kempur-A119.flac")
        , ((Int
107, Int
118), FilePath
"Kempur-B118.flac")
        , ((Int
109, Int
119), FilePath
"Kempur-C119.flac")
        , ((Int
119, Int
127), FilePath
"Kempur-B127.flac")
        , ((Int
120, Int
127), FilePath
"Kempur-A127.flac")
        , ((Int
120, Int
127), FilePath
"Kempur-C127.flac")
        ]
    Gong
Kemong ->
        [ ((Int
0, Int
15), FilePath
"Klentong-A015.flac")
        , ((Int
0, Int
27), FilePath
"Klentong-B027.flac")
        , ((Int
0, Int
18), FilePath
"Klentong-C018.flac")
        , ((Int
16, Int
39), FilePath
"Klentong-A039.flac")
        , ((Int
19, Int
46), FilePath
"Klentong-C046.flac")
        , ((Int
28, Int
54), FilePath
"Klentong-B054.flac")
        , ((Int
40, Int
63), FilePath
"Klentong-A063.flac")
        , ((Int
47, Int
70), FilePath
"Klentong-C070.flac")
        , ((Int
55, Int
77), FilePath
"Klentong-B077.flac")
        , ((Int
64, Int
87), FilePath
"Klentong-A087.flac")
        , ((Int
71, Int
94), FilePath
"Klentong-C094.flac")
        , ((Int
78, Int
102), FilePath
"Klentong-B102.flac")
        , ((Int
88, Int
111), FilePath
"Klentong-A111.flac")
        , ((Int
95, Int
127), FilePath
"Klentong-C127.flac")
        , ((Int
103, Int
127), FilePath
"Klentong-B127.flac")
        , ((Int
112, Int
127), FilePath
"Klentong-A127.flac")
        ]