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

{- | Javanese scales.

    @
    01 02 03 05 06 11 12 13 15 16 21 22 23 25 26 31 32 33 35 36 41 42 43 45 46
    gong---------->   kempul----------->            kenong----------->
                suwukan->
    11 12 13 15 16 21 22 23 25 26 31 32 33 35 36 41 42 43 45 46 51 52 53 55 56
                               kethuk                        pyang
                   slenthem------>saron demung-->saron barung-->peking-------->
                gender barung---------------------------->
                6..1. 2. 3. 5. 6. 1  2  3  5  6  1^ 2^ 3^
                               gender panerus--------------------------->
                               6..1. 2. 3. 5. 6. 1  2  3  5  6  1^ 2^ 3^
                gambang------------------------------------------------->
           (?)  6..1. 2. 3. 5. 6  1  2  3  5  6  1^ 2^ 3^ 5^ 6^ 1^^2^^3^^
    11 12 13 15 16 21 22 23 25 26 31 32 33 35 36 41 42 43 45 46 51 52 53 55 56
                      siter------------------------------>
                                  bonang barung---------------->
                                                 bonang panerus--------------->
    @
-}
module Derive.Scale.Java (scales, old_scales) where
import qualified Data.Map as Map
import qualified Data.Vector as Vector

import qualified Util.Lists as Lists
import qualified Derive.Derive as Derive
import qualified Derive.Scale as Scale
import qualified Derive.Scale.BaliScales as BaliScales
import qualified Derive.Scale.JavaScales as JavaScales
import qualified Derive.Sig as Sig

import qualified Perform.Pitch as Pitch

import           Global


type Pathet = Text

scales :: Map Derive.CallName Derive.ScaleCall
scales :: Map CallName ScaleCall
scales = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (CallName
"pelog", ScaleCall
s_pelog)
    ]

s_pelog :: Derive.ScaleCall
s_pelog :: ScaleCall
s_pelog = CallName -> Doc -> (ScaleF, [ArgDoc]) -> ScaleCall
Derive.scale_call CallName
"pelog" Doc
"doc" forall a b. (a -> b) -> a -> b
$
    forall a. Parser a -> (a -> Deriver Scale) -> (ScaleF, [ArgDoc])
Scale.call ((,)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a deflt.
(Typecheck a, ToVal deflt) =>
ArgName -> deflt -> Doc -> Parser a
Sig.defaulted ArgName
"pathet" (Text
"lima" :: Text) Doc
"doc"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a deflt.
(Typecheck a, ToVal deflt) =>
ArgName -> deflt -> Doc -> Parser a
Sig.defaulted ArgName
"scale-inst" (forall a. Maybe a
Nothing :: Maybe Text) Doc
"doc"
    ) forall a b. (a -> b) -> a -> b
$ \(Text
pathet, Maybe Text
mb_scale_inst) -> do
        Layout
layout <- forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require (Text
"unknown pathet: " forall a. Semigroup a => a -> a -> a
<> Text
pathet) forall a b. (a -> b) -> a -> b
$
            forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
pathet Map Text Layout
keys
        Maybe Instrument
mb_inst <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
            (\Text
inst -> forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require (Text
"unknown scale-inst: " forall a. Semigroup a => a -> a -> a
<> Text
inst) forall a b. (a -> b) -> a -> b
$
                forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
inst Map Text Instrument
instruments)
            Maybe Text
mb_scale_inst
        let name :: Text
name = Text
"pelog" forall a. Semigroup a => a -> a -> a
<> Text
"-" forall a. Semigroup a => a -> a -> a
<> Text
pathet forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text
"-"<>) Maybe Text
mb_scale_inst
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Layout -> Maybe Instrument -> Scale
make_scale Text
name Layout
layout Maybe Instrument
mb_inst

-- TODO name and "doc" are now redundant, they now come from ScaleCall
make_scale :: Text -> JavaScales.Layout -> Maybe JavaScales.Instrument
    -> Scale.Scale
make_scale :: Text -> Layout -> Maybe Instrument -> Scale
make_scale Text
name Layout
layout Maybe Instrument
mb_inst = Text -> ScaleMap -> Doc -> Scale
JavaScales.make_scale Text
name ScaleMap
smap Doc
"doc"
    where
    smap :: ScaleMap
smap = JavaScales.ScaleMap
        { Layout
$sel:layout:ScaleMap :: Layout
layout :: Layout
layout
        , Laras
default_laras :: Laras
$sel:default_laras:ScaleMap :: Laras
default_laras
        , Map Text Laras
laras_map :: Map Text Laras
$sel:laras_map:ScaleMap :: Map Text Laras
laras_map
        , $sel:format:ScaleMap :: Format
format = case Maybe Instrument
mb_inst of
            Maybe Instrument
Nothing -> Layout -> Format
JavaScales.cipher_absolute Layout
layout
            Just Instrument
inst -> Layout -> Instrument -> Format
JavaScales.cipher_octave_relative Layout
layout Instrument
inst
        }

keys :: Map Pathet JavaScales.Layout
keys :: Map Text Layout
keys = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (Text
"lima", Int -> [Int] -> Layout
JavaScales.make_layout Int
0 [Int
1, Int
1, Int
2, Int
1, Int
2]) -- 12356
    , (Text
"nem", Int -> [Int] -> Layout
JavaScales.make_layout Int
0 [Int
1, Int
1, Int
2, Int
1, Int
2]) -- 12356
    , (Text
"barang", Int -> [Int] -> Layout
JavaScales.make_layout Int
1 [Int
1, Int
2, Int
1, Int
1, Int
2]) -- 23567
    ]

instruments :: Map Text JavaScales.Instrument
instruments :: Map Text Instrument
instruments = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ ( Text
"gender-barung"
      , JavaScales.Instrument
        { $sel:center:Instrument :: Int
center = Int
3
        , $sel:bottom:Instrument :: Absolute
bottom = Int -> Int -> Absolute
JavaScales.Absolute Int
1 Int
6
        , $sel:top:Instrument :: Absolute
top = Int -> Int -> Absolute
JavaScales.Absolute Int
4 Int
3
        }
      )
    , (Text
"gender-panerus"
      , JavaScales.Instrument
        { $sel:center:Instrument :: Int
center = Int
4
        , $sel:bottom:Instrument :: Absolute
bottom = Int -> Int -> Absolute
JavaScales.Absolute Int
2 Int
6
        , $sel:top:Instrument :: Absolute
top = Int -> Int -> Absolute
JavaScales.Absolute Int
5 Int
3
        }
      )
    ]

laras_map :: Map Text BaliScales.Laras
laras_map :: Map Text Laras
laras_map = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a k. (a -> k) -> [a] -> [(k, a)]
Lists.keyOn Laras -> Text
BaliScales.laras_name
    [ Laras
laras_sequoia_pelog
    ]

default_laras :: BaliScales.Laras
default_laras :: Laras
default_laras = Laras
laras_sequoia_pelog

sequoia_pelog :: JavaScales.Laras
sequoia_pelog :: Laras
sequoia_pelog = JavaScales.Laras
    { $sel:name:Laras :: Text
name = Text
"sequoia-pelog"
    , $sel:doc:Laras :: Doc
doc = Doc
"Tuning of Sekar Sequoia."
    , $sel:base:Laras :: Pitch
base = forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
1 Integer
5
    , $sel:umbang:Laras :: Vector NoteNumber
umbang = forall a. [a] -> Vector a
Vector.fromList
        [ NoteNumber
46.68 -- 16
        , NoteNumber
48.13 -- 17
        , NoteNumber
50.18 -- 21
        , NoteNumber
51.65 -- 22
        , NoteNumber
53    -- 23
        , NoteNumber
56    -- 24
        , NoteNumber
57.05 -- 25
        -- ^^ guess

        , NoteNumber
58.68 -- 26 6.. (as3 + 0.5)
        , NoteNumber
60.13 -- 27 7.. (c4)
        , NoteNumber
62.18 -- 31 1. approx, no resonator
        , NoteNumber
63.65 -- 32 2.
        , NoteNumber
65    -- 33 3.
        , NoteNumber
68    -- 34 4. guess, no key
        , NoteNumber
69.05 -- 35 5.
        , NoteNumber
70.5  -- 36 6.
        , NoteNumber
72.14 -- 37 7.
        , NoteNumber
74.25 -- 41 1 approx
        , NoteNumber
75.68 -- 42 2
        , NoteNumber
77    -- 43 3
        , NoteNumber
80    -- 44 4 guess
        , NoteNumber
81.03 -- 45 5
        , NoteNumber
82.48 -- 46 6
        , NoteNumber
84.14 -- 47 7
        , NoteNumber
86.4  -- 51 51 1^ approx
        , NoteNumber
87.7  -- 52 2^
        , NoteNumber
88.98 -- 53 3^
        ]
    , $sel:isep:Laras :: Vector NoteNumber
isep = forall a. Monoid a => a
mempty
    }

laras_sequoia_pelog :: BaliScales.Laras
laras_sequoia_pelog :: Laras
laras_sequoia_pelog = Text
-> Pitch
-> ([NoteNumber] -> [NoteNumber])
-> Doc
-> [(NoteNumber, NoteNumber)]
-> Laras
BaliScales.laras Text
"sequoia-pelog" (forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
1 Integer
5) forall a. a -> a
id
    Doc
"Tuning of Sekar Sequoia." forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\NoteNumber
nn -> (NoteNumber
nn, NoteNumber
nn)) forall a b. (a -> b) -> a -> b
$
    [ NoteNumber
46.68 -- 16
    , NoteNumber
48.13 -- 17
    , NoteNumber
50.18 -- 21
    , NoteNumber
51.65 -- 22
    , NoteNumber
53    -- 23
    , NoteNumber
56    -- 24
    , NoteNumber
57.05 -- 25
    -- ^^ TODO guess

    , NoteNumber
58.68 -- 26 6.. (as3 + 0.5)
    , NoteNumber
60.13 -- 27 7.. (c4)
    , NoteNumber
62.18 -- 31 1. approx, no resonator
    , NoteNumber
63.65 -- 32 2.
    , NoteNumber
65    -- 33 3.
    , NoteNumber
68    -- 34 4. guess, no key
    , NoteNumber
69.05 -- 35 5.
    , NoteNumber
70.5  -- 36 6.
    , NoteNumber
72.14 -- 37 7.
    , NoteNumber
74.25 -- 41 1 approx
    , NoteNumber
75.68 -- 42 2
    , NoteNumber
77    -- 43 3
    , NoteNumber
80    -- 44 4 guess
    , NoteNumber
81.03 -- 45 5
    , NoteNumber
82.48 -- 46 6
    , NoteNumber
84.14 -- 47 7
    , NoteNumber
86.4  -- 51 51 1^ approx
    , NoteNumber
87.7  -- 52 2^
    , NoteNumber
88.98 -- 53 3^
    ]
    -- vv TODO guess
    forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
+NoteNumber
12)
    [ NoteNumber
80
    , NoteNumber
81.03
    , NoteNumber
82.48
    , NoteNumber
84.14
    , NoteNumber
86.4
    , NoteNumber
87.7
    , NoteNumber
88.98
    ]


-- * old


old_scales :: [Scale.Definition]
old_scales :: [Definition]
old_scales = forall a b. (a -> b) -> [a] -> [b]
map Scale -> Definition
Scale.Simple forall a b. (a -> b) -> a -> b
$
    -- TODO This permutation game is no good, let's go back to key=pathet
    -- and maybe even scale-range=gender-panerus
    [ Text -> Layout -> Maybe Instrument -> Scale
make_scale Text
"pelog-lima" Layout
lima forall a. Maybe a
Nothing
    , Text -> Layout -> Maybe Instrument -> Scale
make_scale Text
"pelog-nem" Layout
lima forall a. Maybe a
Nothing
    , Text -> Layout -> Maybe Instrument -> Scale
make_scale Text
"pelog-barang" Layout
barang forall a. Maybe a
Nothing
    ] forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Instrument -> [Scale]
inst_scale) (forall k a. Map k a -> [(k, a)]
Map.toList Map Text Instrument
instruments)
    where
    lima :: Layout
lima = Int -> [Int] -> Layout
JavaScales.make_layout Int
0 [Int
1, Int
1, Int
2, Int
1, Int
2] -- 12356
    barang :: Layout
barang = Int -> [Int] -> Layout
JavaScales.make_layout Int
1 [Int
1, Int
2, Int
1, Int
1, Int
2] -- 23567
    inst_scale :: Text -> Instrument -> [Scale]
inst_scale Text
name Instrument
inst =
        [ Text -> Layout -> Maybe Instrument -> Scale
make_scale (Text
"pelog-lima-" forall a. Semigroup a => a -> a -> a
<> Text
name) Layout
lima (forall a. a -> Maybe a
Just Instrument
inst)
        , Text -> Layout -> Maybe Instrument -> Scale
make_scale (Text
"pelog-barang-" forall a. Semigroup a => a -> a -> a
<> Text
name) Layout
barang (forall a. a -> Maybe a
Just Instrument
inst)
        ]
    make_scale :: Text -> Layout -> Maybe Instrument -> Scale
make_scale Text
name Layout
layout Maybe Instrument
mb_inst = Text -> ScaleMap -> Doc -> Scale
JavaScales.make_scale Text
name ScaleMap
smap Doc
"doc"
        where
        smap :: ScaleMap
smap = JavaScales.ScaleMap
            { Layout
layout :: Layout
$sel:layout:ScaleMap :: Layout
layout
            , Laras
default_laras :: Laras
$sel:default_laras:ScaleMap :: Laras
default_laras
            , Map Text Laras
laras_map :: Map Text Laras
$sel:laras_map:ScaleMap :: Map Text Laras
laras_map
            , $sel:format:ScaleMap :: Format
format = case Maybe Instrument
mb_inst of
                Maybe Instrument
Nothing -> Layout -> Format
JavaScales.cipher_absolute Layout
layout
                Just Instrument
inst -> Layout -> Instrument -> Format
JavaScales.cipher_octave_relative Layout
layout Instrument
inst
            }