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

{- | Saih gender wayang.

    I use ding deng dong dung dang.  I don't know if this is ever actually used
    for gender, but the notation is compact and I don't think there are any
    other conventions.

    @
    3o  3e  3u  3a  4i  4o  4e  4u  4a  5i  5o  5e  5u  5a  6i
    pemade -------------------------------
                        kantilan -----------------------------
    3a  4i  4o  4e  4u  4a  5i  5o  5e  5u  5a  6i  6o  6e  6u
    36  41  42  43  45  46  51
    3d  4s  4r  4g  4p  4d  5s
    @
-}
module Derive.Scale.Wayang where
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Vector as Vector

import qualified Util.Lists as Lists
import qualified Derive.Scale as Scale
import qualified Derive.Scale.Bali as Bali
import qualified Derive.Scale.BaliScales as BaliScales
import qualified Derive.Scale.McPhee as McPhee
import qualified Derive.Scale.Scales as Scales
import qualified Derive.Scale.Theory as Theory
import qualified Derive.Scale.TheoryFormat as TheoryFormat
import qualified Derive.ShowVal as ShowVal

import qualified Midi.Key2 as Key2
import qualified Midi.Midi as Midi
import qualified Perform.Midi.Patch as Patch
import qualified Perform.Pitch as Pitch

import           Global


scales :: [Scale.Definition]
scales :: [Definition]
scales = forall a b. (a -> b) -> [a] -> [b]
map (Scale -> Definition
Scale.Simple forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Scale -> Scale
Scales.add_doc Doc
"Saih gender wayang.")
    [ ScaleId -> ScaleMap -> Scale
BaliScales.make_scale ScaleId
scale_id forall a b. (a -> b) -> a -> b
$
        Config -> Format -> Maybe (Int, Int) -> ScaleMap
BaliScales.scale_map (Laras -> Config
config Laras
laras_sawan)
            Format
BaliScales.ioeua_absolute forall a. Maybe a
Nothing
    , ScaleId -> ScaleMap -> Scale
BaliScales.make_scale ScaleId
"wayang-a" forall a b. (a -> b) -> a -> b
$
        Config -> Format -> Maybe (Int, Int) -> ScaleMap
BaliScales.scale_map (Pitch -> Config -> Config
rebase (forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
1 Pitch
U) (Laras -> Config
config Laras
laras_sawan))
            Format
BaliScales.ioeua_absolute forall a. Maybe a
Nothing
    , ScaleId -> ScaleMap -> Scale
BaliScales.make_scale ScaleId
"wayang-srg" forall a b. (a -> b) -> a -> b
$
        Config -> Format -> Maybe (Int, Int) -> ScaleMap
BaliScales.scale_map (Pitch -> Config -> Config
rebase (forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
1 Pitch
U) (Laras -> Config
config Laras
laras_sawan))
            Format
sargam_absolute forall a. Maybe a
Nothing
    , Doc -> Scale -> Scale
Scales.add_doc
        Doc
"Pemade scale. This can be used to give the the same score to both\
            \ pemade and kantilan." forall a b. (a -> b) -> a -> b
$
        ScaleId -> ScaleMap -> Scale
BaliScales.make_scale ScaleId
"wayang-pemade"
            (Laras -> Instrument -> ScaleMap
inst_scale_map Laras
laras_sawan_pemade Instrument
pemade)
    , Doc -> Scale -> Scale
Scales.add_doc
        Doc
"Kantilan scale. This can be used to give the the same score to both\
            \ pemade and kantilan." forall a b. (a -> b) -> a -> b
$
        ScaleId -> ScaleMap -> Scale
BaliScales.make_scale ScaleId
"wayang-kantilan"
            (Laras -> Instrument -> ScaleMap
inst_scale_map Laras
laras_sawan_kantilan Instrument
kantilan)
    ]
    where
    inst_scale_map :: Laras -> Instrument -> ScaleMap
inst_scale_map Laras
laras = Config -> Instrument -> ScaleMap
BaliScales.instrument_scale_map (Laras -> Config
config Laras
laras)

sargam_absolute :: TheoryFormat.Format
sargam_absolute :: Format
sargam_absolute = Text -> Degrees -> Format
TheoryFormat.make_absolute_format Text
"[1-9][srgpd]" forall a b. (a -> b) -> a -> b
$
    [Text] -> Degrees
TheoryFormat.make_degrees forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
Text.singleton [Char]
"srgpd"

pemade :: BaliScales.Instrument
pemade :: Instrument
pemade = Int -> Pitch -> Pitch -> Instrument
instrument Int
4 (forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
3 Pitch
O) (forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
5 Pitch
I)

kantilan :: BaliScales.Instrument
kantilan :: Instrument
kantilan = Int -> Pitch -> Pitch -> Instrument
instrument Int
5 (forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
4 Pitch
O) (forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
6 Pitch
I)

instrument :: Pitch.Octave -> Pitch.Pitch -> Pitch.Pitch
    -> BaliScales.Instrument
instrument :: Int -> Pitch -> Pitch -> Instrument
instrument = Degrees -> RelativeOctaves -> Int -> Pitch -> Pitch -> Instrument
BaliScales.Instrument Degrees
BaliScales.ioeua RelativeOctaves
BaliScales.arrow_octaves

config :: BaliScales.Laras -> BaliScales.Config
config :: Laras -> Config
config Laras
default_laras = BaliScales.Config
    { config_layout :: Layout
config_layout = Layout
layout
    , config_keys :: Keys
config_keys = forall a. Monoid a => a
mempty
    , config_default_key :: Key
config_default_key = Key
default_key
    , config_laras :: LarasMap
config_laras = LarasMap
laras
    , config_default_laras :: Laras
config_default_laras = Laras
default_laras
    }
    where
    layout :: Layout
layout = Int -> Layout
Theory.diatonic_layout Int
5
    default_key :: Key
default_key = Degree -> Text -> [Int] -> Layout -> Key
Theory.key (Int -> Int -> Degree
Pitch.Degree Int
0 Int
0) Text
"default" (forall a. Int -> a -> [a]
replicate Int
5 Int
1) Layout
layout

rebase :: Pitch.Pitch -> BaliScales.Config -> BaliScales.Config
rebase :: Pitch -> Config -> Config
rebase Pitch
base Config
config = Config
config
    { config_laras :: LarasMap
BaliScales.config_laras = Laras -> Laras
set forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> LarasMap
BaliScales.config_laras Config
config
    , config_default_laras :: Laras
BaliScales.config_default_laras =
        Laras -> Laras
set forall a b. (a -> b) -> a -> b
$ Config -> Laras
BaliScales.config_default_laras Config
config
    }
    where
    set :: Laras -> Laras
set Laras
laras = Laras
laras { laras_base :: Pitch
BaliScales.laras_base = Pitch
base }

-- | Start octave for the extended scale.
base_oct :: Pitch.Octave
base_oct :: Int
base_oct = Int
1

scale_id :: Pitch.ScaleId
scale_id :: ScaleId
scale_id = ScaleId
"wayang"

-- * laras

data Pitch = I | O | E | U | A deriving (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, Int -> Pitch
Pitch -> Int
Pitch -> [Pitch]
Pitch -> Pitch
Pitch -> Pitch -> [Pitch]
Pitch -> Pitch -> Pitch -> [Pitch]
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 :: Pitch -> Pitch -> Pitch -> [Pitch]
$cenumFromThenTo :: Pitch -> Pitch -> Pitch -> [Pitch]
enumFromTo :: Pitch -> Pitch -> [Pitch]
$cenumFromTo :: Pitch -> Pitch -> [Pitch]
enumFromThen :: Pitch -> Pitch -> [Pitch]
$cenumFromThen :: Pitch -> Pitch -> [Pitch]
enumFrom :: Pitch -> [Pitch]
$cenumFrom :: Pitch -> [Pitch]
fromEnum :: Pitch -> Int
$cfromEnum :: Pitch -> Int
toEnum :: Int -> Pitch
$ctoEnum :: Int -> Pitch
pred :: Pitch -> Pitch
$cpred :: Pitch -> Pitch
succ :: Pitch -> Pitch
$csucc :: Pitch -> Pitch
Enum, Int -> Pitch -> ShowS
[Pitch] -> ShowS
Pitch -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Pitch] -> ShowS
$cshowList :: [Pitch] -> ShowS
show :: Pitch -> [Char]
$cshow :: Pitch -> [Char]
showsPrec :: Int -> Pitch -> ShowS
$cshowsPrec :: Int -> Pitch -> ShowS
Show)

laras :: Map Text BaliScales.Laras
laras :: LarasMap
laras = 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 forall a b. (a -> b) -> a -> b
$
    Laras
laras_sawan
    forall a. a -> [a] -> [a]
: Laras
laras_sawan_pemade
    forall a. a -> [a] -> [a]
: Laras
laras_sawan_kantilan
    forall a. a -> [a] -> [a]
: [Laras]
mcphee

laras_sawan :: BaliScales.Laras
laras_sawan :: Laras
laras_sawan = Text
-> Pitch
-> ([NoteNumber] -> [NoteNumber])
-> Doc
-> [(NoteNumber, NoteNumber)]
-> Laras
BaliScales.laras Text
"sawan" (forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
1 Pitch
I)
    (Pitch -> [NoteNumber] -> [NoteNumber]
extend (Instrument -> Pitch
BaliScales.inst_low Instrument
pemade))
    Doc
"Tuning from my gender wayang, made in Sawan, Singaraja." forall a b. (a -> b) -> a -> b
$
    -- Of course the overlapping parts of the scales are a bit different, and
    -- I have to pick one.  So I choose the pemade version.
    Laras -> [(NoteNumber, NoteNumber)]
BaliScales.laras_nns Laras
laras_sawan_pemade
    forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
drop Int
5 (Laras -> [(NoteNumber, NoteNumber)]
BaliScales.laras_nns Laras
laras_sawan_kantilan)

laras_sawan_pemade :: BaliScales.Laras
laras_sawan_pemade :: Laras
laras_sawan_pemade = Text
-> Pitch
-> ([NoteNumber] -> [NoteNumber])
-> Doc
-> [(NoteNumber, NoteNumber)]
-> Laras
BaliScales.laras Text
"sawan-pemade" (forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
3 Integer
1) forall a. a -> a
id
    Doc
"Sawan tuning for pemade."
    [ (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) -- 4i
    , (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) -- 5i
    ]

laras_sawan_kantilan :: BaliScales.Laras
laras_sawan_kantilan :: Laras
laras_sawan_kantilan = Text
-> Pitch
-> ([NoteNumber] -> [NoteNumber])
-> Doc
-> [(NoteNumber, NoteNumber)]
-> Laras
BaliScales.laras Text
"sawan-kantilan" (forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
4 Integer
1) forall a. a -> a
id
    Doc
"Sawan tuning for kantilan"
    [ (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) -- 5i
    , (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) -- 6i
    ]

mcphee :: [BaliScales.Laras]
mcphee :: [Laras]
mcphee = forall a b. (a -> b) -> [a] -> [b]
map ((Text, ([NoteNumber], Doc)) -> Laras
make forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pitch -> Pitch -> Laras -> (Text, ([NoteNumber], Doc))
McPhee.extract Pitch
low_pitch Pitch
high_pitch) [Laras]
McPhee.slendro
    where
    make :: (Text, ([NoteNumber], Doc)) -> Laras
make (Text
name, ([NoteNumber]
nns, Doc
doc)) =
        Text
-> Pitch
-> ([NoteNumber] -> [NoteNumber])
-> Doc
-> [(NoteNumber, NoteNumber)]
-> Laras
BaliScales.laras Text
name (forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
1 Integer
0) forall a. a -> a
id Doc
doc
            (forall a b. (a -> b) -> [a] -> [b]
map (\NoteNumber
nn -> (NoteNumber
nn, NoteNumber
nn)) [NoteNumber]
nns)

-- | Extend down two octaves so that I start at 1i, and up two octaves to 8i.
--
-- pemade starts at 3o - 4i - 5i, kanti is 4o - 5i - 6i
extend :: Pitch.Pitch -> [Pitch.NoteNumber] -> [Pitch.NoteNumber]
extend :: Pitch -> [NoteNumber] -> [NoteNumber]
extend Pitch
from = Int -> Pitch -> Pitch -> Pitch -> [NoteNumber] -> [NoteNumber]
Bali.extend_scale Int
5 Pitch
low_pitch Pitch
high_pitch Pitch
from

low_pitch, high_pitch :: Pitch.Pitch
low_pitch :: Pitch
low_pitch = forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
1 Pitch
I
high_pitch :: Pitch
high_pitch = forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
8 Pitch
I

undo_extend :: [a] -> [a]
undo_extend :: forall a. [a] -> [a]
undo_extend = forall a. Int -> [a] -> [a]
take Int
15 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop (Int
1 forall a. Num a => a -> a -> a
+ Int
5 forall a. Num a => a -> a -> a
+ Int
5)
    -- take (kantilan_high - kantilan_low) . drop (pemade_low - 1 I)

-- * instrument integration

instrument_scale :: Bool -> BaliScales.Laras -> BaliScales.Tuning -> Patch.Scale
instrument_scale :: Bool -> Laras -> Tuning -> Scale
instrument_scale Bool
extended Laras
laras Tuning
tuning =
    Text -> [(Key, NoteNumber)] -> Scale
Patch.make_scale (Text
"wayang " forall a. Semigroup a => a -> a -> a
<> forall a. ShowVal a => a -> Text
ShowVal.show_val Tuning
tuning) forall a b. (a -> b) -> a -> b
$
        forall a b. [a] -> [b] -> [(a, b)]
zip (Bool -> [Key]
midi_keys Bool
extended)
            ((if Bool
extended then forall a. a -> a
id else forall a. [a] -> [a]
undo_extend) (forall a. Vector a -> [a]
Vector.toList Vector NoteNumber
nns))
    where
    nns :: Vector NoteNumber
nns = case Tuning
tuning of
        Tuning
BaliScales.Umbang -> Laras -> Vector NoteNumber
BaliScales.laras_umbang Laras
laras
        Tuning
BaliScales.Isep -> Laras -> Vector NoteNumber
BaliScales.laras_isep Laras
laras

-- | If extended is True, emit from i1 on up.  Otherwise, give pemade to
-- kantilan range.
midi_keys :: Bool -> [Midi.Key]
midi_keys :: Bool -> [Key]
midi_keys Bool
extended = forall a. [a] -> [a]
trim forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. Integral a => a -> [Key]
keys [Int
base_oct forall a. Num a => a -> a -> a
+ Int
1 ..]
    -- base_oct + 1 because MIDI starts at octave -1
    where
    trim :: [a] -> [a]
trim
        | Bool
extended = forall a. Int -> [a] -> [a]
take (Int
7forall a. Num a => a -> a -> a
*Int
5 forall a. Num a => a -> a -> a
+ Int
1)
        | Bool
otherwise = forall a. Int -> [a] -> [a]
take (Int
3forall a. Num a => a -> a -> a
*Int
5) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop (Int
1 forall a. Num a => a -> a -> a
+ Int
3forall a. Num a => a -> a -> a
*Int
5)
    keys :: a -> [Key]
keys a
oct = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Integral a => a -> Key
Midi.to_key (a
oct forall a. Num a => a -> a -> a
* a
12) +) -- i o e u a
        [Key
Key2.e_2, Key
Key2.f_2, Key
Key2.a_2, Key
Key2.b_2, Key
Key2.c_1]