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

-- | Old scales, from McPhee's "Music In Bali".
--
-- "Distances in terms of Cents can be computed from the vibration numbers of
-- any two tones by means of a logarithm table---a simple but time-consuming
-- process." -- Music in Bali, introduction, page xv.
module Derive.Scale.McPhee where
import qualified Data.Text as Text

import qualified Util.Doc as Doc
import qualified Util.Texts as Texts
import qualified Derive.Scale.Bali as Bali
import qualified Perform.Pitch as Pitch
import Global


type Hz = Double

data Laras = Laras {
    Laras -> Text
name :: Text
    , Laras -> Text
genre :: Text
    , Laras -> Text
origin :: Text
    -- | 'hz' start on this note, relative to selisir.
    , Laras -> Pitch
base :: Bali.Pitch
    , Laras -> Octave
base_octave :: Pitch.Octave
    , Laras -> [Hz]
hz :: [Hz]
    } deriving (Laras -> Laras -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Laras -> Laras -> Bool
$c/= :: Laras -> Laras -> Bool
== :: Laras -> Laras -> Bool
$c== :: Laras -> Laras -> Bool
Eq, Octave -> Laras -> ShowS
[Laras] -> ShowS
Laras -> String
forall a.
(Octave -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Laras] -> ShowS
$cshowList :: [Laras] -> ShowS
show :: Laras -> String
$cshow :: Laras -> String
showsPrec :: Octave -> Laras -> ShowS
$cshowsPrec :: Octave -> Laras -> ShowS
Show)

extract :: Pitch.Pitch -> Pitch.Pitch -> Laras
    -> (Text, ([Pitch.NoteNumber], Doc.Doc))
extract :: Pitch -> Pitch -> Laras -> (Text, ([NoteNumber], Doc))
extract Pitch
low Pitch
high Laras
laras = (Text -> Text
dashes Text
sname, (Pitch -> Pitch -> Laras -> [NoteNumber]
hz_to_nn Pitch
low Pitch
high Laras
laras, Doc
doc))
    where
    doc :: Doc
doc
        | Laras -> Text
name Laras
laras forall a. Eq a => a -> a -> Bool
== Text
"6-edo" = Doc
"Theoretical 6-EDO tuning."
        | Bool
otherwise = Doc
"From McPhee's \"Music in Bali\", from "
            forall a. Semigroup a => a -> a -> a
<> Text -> Doc
Doc.Doc (Text -> Text
Text.toTitle (Laras -> Text
origin Laras
laras)) forall a. Semigroup a => a -> a -> a
<> Doc
"."
    sname :: Text
sname
        | Text -> Bool
Text.null (Laras -> Text
name Laras
laras) = forall a. Textlike a => a -> a -> a -> a
Texts.join2 Text
"-" (Laras -> Text
genre Laras
laras) (Laras -> Text
origin Laras
laras)
        | Bool
otherwise = Laras -> Text
name Laras
laras
    dashes :: Text -> Text
dashes = (Char -> Char) -> Text -> Text
Text.map (\Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' then Char
'-' else Char
c)

hz_to_nn :: Pitch.Pitch -> Pitch.Pitch -> Laras -> [Pitch.NoteNumber]
hz_to_nn :: Pitch -> Pitch -> Laras -> [NoteNumber]
hz_to_nn Pitch
low Pitch
high Laras
laras =
    Octave -> Pitch -> Pitch -> Pitch -> [NoteNumber] -> [NoteNumber]
Bali.extend_scale (forall (t :: * -> *) a. Foldable t => t a -> Octave
length (Laras -> [Hz]
hz Laras
laras)) Pitch
low Pitch
high
        (forall pc. Enum pc => Octave -> pc -> Pitch
Pitch.pitch (Laras -> Octave
base_octave Laras
laras) (Laras -> Pitch
base Laras
laras))
        (forall a b. (a -> b) -> [a] -> [b]
map Hz -> NoteNumber
Pitch.hz_to_nn (Laras -> [Hz]
hz Laras
laras))

laras :: Laras
laras :: Laras
laras = Text -> Text -> Text -> Pitch -> Octave -> [Hz] -> Laras
Laras Text
"" Text
"" Text
"" Pitch
Bali.I Octave
4 []

-- | Music in Bali, page 42.
--
-- These start at tembung ding.  According to McPhee, selisir starts at 3,
-- which means that tembung's ding is selisir's dung:
--
-- >         0   1   2   3   4   5   6
-- > tembung I   O   E   Es  U   A   Aa
-- > selisir U   A   As  I   O   E   Es
saih_pitu :: [Laras]
saih_pitu :: [Laras]
saih_pitu =
    [ Text -> Text -> [Hz] -> Laras
s Text
"luang" Text
"seseh"             [Hz
276, Hz
305, Hz
345, Hz
372, Hz
410, Hz
466, Hz
505]
    , Text -> Text -> [Hz] -> Laras
s Text
"gambang" Text
"krobokan"        [Hz
275, Hz
305, Hz
326, Hz
360, Hz
405, Hz
440, Hz
465]
    , Text -> Text -> [Hz] -> Laras
s Text
"pegulingan" Text
"klungkung"    [Hz
325, Hz
360, Hz
402, Hz
437, Hz
490, Hz
564, Hz
614]
    , Text -> Text -> [Hz] -> Laras
s Text
"pegulingan" Text
"tampak gangsal" [Hz
310, Hz
337, Hz
365, Hz
425, Hz
457, Hz
485, Hz
560]
    , Text -> Text -> [Hz] -> Laras
s Text
"gambuh" Text
"tabanan"          [Hz
211, Hz
232, Hz
250, Hz
280, Hz
303, Hz
325, Hz
345]
    , Text -> Text -> [Hz] -> Laras
s Text
"gambuh" Text
"batuan"           [Hz
202, Hz
220, Hz
237.5, Hz
266, Hz
290, Hz
315, Hz
330]
    ]
    where s :: Text -> Text -> [Hz] -> Laras
s Text
genre Text
origin = Text -> Text -> Text -> Pitch -> Octave -> [Hz] -> Laras
Laras Text
"" Text
genre Text
origin Pitch
Bali.U Octave
3

-- | These start at selisir ding.
selisir :: [Laras]
selisir :: [Laras]
selisir =
    -- "typical" selisir
    [ Text -> Text -> [Hz] -> Laras
s Text
"gong" Text
"peliatan"   [Hz
280, Hz
305, Hz
327, Hz
405, Hz
435]
    , Text -> Text -> [Hz] -> Laras
s Text
"gong" Text
"klungkung"  [Hz
264, Hz
291, Hz
322, Hz
397, Hz
434]
    , Text -> Text -> [Hz] -> Laras
s Text
"gong" Text
"apuan"      [Hz
285, Hz
302, Hz
322, Hz
410, Hz
435]
    , Text -> Text -> [Hz] -> Laras
s Text
"gong" Text
"sayan"      [Hz
275, Hz
290, Hz
325, Hz
403, Hz
427]
    , Text -> Text -> [Hz] -> Laras
s Text
"gong" Text
"gianyar"    [Hz
274, Hz
296, Hz
327, Hz
415, Hz
435]
    -- unusual selisir
    -- From Gusti Putuh.
    , Laras
laras { name :: Text
name = Text
"tembung cenik", hz :: [Hz]
hz = [Hz
273, Hz
295, Hz
328, Hz
390, Hz
433] }
    -- Used for McPhee's Semar Pegulingan.  Also called selisir or sunaren.
    , Text -> Text -> [Hz] -> Laras
s Text
"pelegongan" Text
"sanur"   [Hz
310, Hz
345, Hz
372, Hz
450, Hz
490]
    , Text -> Text -> [Hz] -> Laras
s Text
"pelegongan" Text
"selisir" [Hz
305, Hz
325, Hz
360, Hz
435, Hz
470]
    -- From "gamelan barong".
    , Laras
laras
        { genre :: Text
genre = Text
"barong", name :: Text
name = Text
"demung", hz :: [Hz]
hz = [Hz
362, Hz
408, Hz
434, Hz
562, Hz
593]
        }
    ]
    where s :: Text -> Text -> [Hz] -> Laras
s Text
genre Text
origin = Text -> Text -> Text -> Pitch -> Octave -> [Hz] -> Laras
Laras Text
"" Text
genre Text
origin Pitch
Bali.I Octave
4

-- | Bebonangan seems to be an old name for beleganjur.  Dong to dang.
bebonangan :: [Laras]
bebonangan :: [Laras]
bebonangan =
    [ Text -> [Hz] -> Laras
s Text
"sayan" [Hz
290, Hz
325, Hz
403, Hz
427]
    ]
    where s :: Text -> [Hz] -> Laras
s Text
origin = Text -> Text -> Text -> Pitch -> Octave -> [Hz] -> Laras
Laras Text
"" Text
"beleganjur" Text
origin Pitch
Bali.O Octave
4


-- slendro

-- | o e u a i
slendro :: [Laras]
slendro :: [Laras]
slendro =
    [ (Text -> [Hz] -> Laras
s Text
""         [Hz
183, Hz
210, Hz
241.5, Hz
277, Hz
318.5]) { name :: Text
name = Text
"6-edo" }
    , Text -> [Hz] -> Laras
s Text
"kuta"      [Hz
183, Hz
206, Hz
241, Hz
280, Hz
327]
    , Text -> [Hz] -> Laras
s Text
"klandis"   [Hz
180, Hz
203, Hz
235, Hz
274, Hz
317.5]
    , Text -> [Hz] -> Laras
s Text
"tabanan"   [Hz
179, Hz
212, Hz
240, Hz
278, Hz
320]
    -- from Buleleng
    , Text -> [Hz] -> Laras
s Text
"patantaran" [Hz
175, Hz
200, Hz
225, Hz
260, Hz
300]
    , Text -> [Hz] -> Laras
s Text
"lod peken" [Hz
172, Hz
200, Hz
225, Hz
257.5, Hz
305]
    , Text -> [Hz] -> Laras
s Text
"sawan"     [Hz
167.5, Hz
191.5, Hz
220, Hz
248, Hz
290]
    ]
    where s :: Text -> [Hz] -> Laras
s Text
origin = Text -> Text -> Text -> Pitch -> Octave -> [Hz] -> Laras
Laras Text
"" Text
"gender" Text
origin Pitch
Bali.O Octave
3

-- | e u a i
angklung :: [Laras]
angklung :: [Laras]
angklung =
    [ Text -> [Hz] -> Laras
s Text
"mas"       [Hz
410, Hz
469, Hz
519, Hz
620]
    , Text -> [Hz] -> Laras
s Text
"kamasan"   [Hz
400, Hz
450, Hz
495, Hz
610]
    , Text -> [Hz] -> Laras
s Text
"sayan"     [Hz
365, Hz
420, Hz
485, Hz
564]
    , Text -> [Hz] -> Laras
s Text
"tabanan"   [Hz
326, Hz
375, Hz
428, Hz
485]
    -- unusual tunings
    , Text -> [Hz] -> Laras
s Text
"mega tiga" [Hz
345, Hz
390, Hz
440, Hz
495]
    , Text -> [Hz] -> Laras
s Text
"nyutebel"  [Hz
359, Hz
430, Hz
480, Hz
550]
    , Text -> [Hz] -> Laras
s Text
"culik"     [Hz
335, Hz
375, Hz
445, Hz
505]
    , Text -> [Hz] -> Laras
s Text
"negara"    [Hz
270, Hz
305, Hz
375, Hz
445]
    ]
    where s :: Text -> [Hz] -> Laras
s Text
origin = Text -> Text -> Text -> Pitch -> Octave -> [Hz] -> Laras
Laras Text
"" Text
"angklung" Text
origin Pitch
Bali.O Octave
4