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

-- | This is like "Derive.Scale.Legong", except specialized to the selisir
-- mode.
module Derive.Scale.Selisir where
import qualified Data.Map as Map
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.Legong as Legong
import qualified Derive.Scale.McPhee as McPhee
import qualified Derive.Scale.Theory as Theory

import qualified Midi.Key as Key
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 = Config -> ScaleId -> Doc -> [Definition]
Legong.make_scale_set Config
config ScaleId
scale_id Doc
"The usual saih lima."

scale_id :: Pitch.ScaleId
scale_id :: ScaleId
scale_id = ScaleId
"selisir"

config :: BaliScales.Config
config :: Config
config = 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
laras_rambat
    }
    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

laras :: Map Text BaliScales.Laras
laras :: LarasMap
laras = [Laras] -> LarasMap
BaliScales.laras_map forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall a b. (a -> b) -> [a] -> [b]
map Laras -> Laras
pitu_to_lima (forall k a. Map k a -> [a]
Map.elems LarasMap
Legong.laras)
    , [Laras
pegulingan_teges]
    , [Laras]
mcphee
    ]

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
Legong.low_pitch Pitch
Legong.high_pitch)
        [Laras]
McPhee.selisir
    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 Pitch
low_pitch forall a. a -> a
id Doc
doc (forall a b. (a -> b) -> [a] -> [b]
map (\NoteNumber
nn -> (NoteNumber
nn, NoteNumber
nn)) [NoteNumber]
nns)

-- | Exported for instruments to use.
laras_rambat :: BaliScales.Laras
laras_rambat :: Laras
laras_rambat = Laras -> Laras
pitu_to_lima Laras
Legong.laras_rambat

-- | Strip extra notes to get back to saih lima.
pitu_to_lima :: BaliScales.Laras -> BaliScales.Laras
pitu_to_lima :: Laras -> Laras
pitu_to_lima Laras
laras = Laras
laras
    { laras_umbang :: Vector NoteNumber
BaliScales.laras_umbang = forall {a}. Vector a -> Vector a
strip forall a b. (a -> b) -> a -> b
$ Laras -> Vector NoteNumber
BaliScales.laras_umbang Laras
laras
    , laras_isep :: Vector NoteNumber
BaliScales.laras_isep = forall {a}. Vector a -> Vector a
strip forall a b. (a -> b) -> a -> b
$ Laras -> Vector NoteNumber
BaliScales.laras_isep Laras
laras
    }
    where
    strip :: Vector a -> Vector a
strip = forall a. [a] -> Vector a
Vector.fromList
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\[a]
nns -> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a. [a] -> Int -> Maybe a
Lists.at [a]
nns) [Int
0, Int
1, Int
2, Int
4, Int
5])
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [[a]]
Lists.chunked Int
7 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
Vector.toList

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, 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, 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, Pitch
forall a. a -> a -> Bounded a
maxBound :: Pitch
$cmaxBound :: Pitch
minBound :: Pitch
$cminBound :: Pitch
Bounded)

low_pitch :: Pitch.Pitch
low_pitch :: Pitch
low_pitch = Pitch
Legong.low_pitch

-- TODO what is the ombak?
pegulingan_teges :: BaliScales.Laras
pegulingan_teges :: Laras
pegulingan_teges = Text
-> Pitch
-> ([NoteNumber] -> [NoteNumber])
-> Doc
-> [(NoteNumber, NoteNumber)]
-> Laras
BaliScales.laras Text
"pegulingan-teges" Pitch
low_pitch (Int -> Pitch -> [NoteNumber] -> [NoteNumber]
extend Int
4 Pitch
U)
    Doc
"From Teges Semar Pegulingan, via Bob Brown's 1972 recording."
    forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\NoteNumber
nn -> (NoteNumber
nn, NoteNumber
nn))
    [ NoteNumber
69.55 -- 4u
    , NoteNumber
70.88 -- 4a
    , NoteNumber
75.25 -- 5i
    , NoteNumber
76.90 -- 5o, kantilan begin
    , NoteNumber
77.94 -- 5e
    , NoteNumber
81.80 -- 5u... should I agree with the lower octave?
    ]

-- | Extend down to the "Legong" range.
extend :: Pitch.Octave -> Pitch -> [Pitch.NoteNumber] -> [Pitch.NoteNumber]
extend :: Int -> Pitch -> [NoteNumber] -> [NoteNumber]
extend Int
oct Pitch
pc =
    Int -> Pitch -> Pitch -> Pitch -> [NoteNumber] -> [NoteNumber]
Bali.extend_scale Int
7 Pitch
Legong.low_pitch Pitch
Legong.high_pitch (forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
oct Pitch
pc)

instrument_scale ::
    ([(Midi.Key, Pitch.NoteNumber)] -> [(Midi.Key, Pitch.NoteNumber)])
    -- ^ drop and take keys for the instrument's range
    -> BaliScales.Laras -> BaliScales.Tuning -> Patch.Scale
instrument_scale :: ([(Key, NoteNumber)] -> [(Key, NoteNumber)])
-> Laras -> Tuning -> Scale
instrument_scale = Text
-> [Key]
-> ([(Key, NoteNumber)] -> [(Key, NoteNumber)])
-> Laras
-> Tuning
-> Scale
Legong.make_instrument_scale Text
"selisir"
    [Key
Key.c_1, Key
Key.d_1, Key
Key.e_1, Key
Key.g_1, Key
Key.a_1] -- i o e u a