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

-- | Support types for Balinese scales.  Unlike BaliScales, this should be
-- independent of the scale framework and have light dependencies.
module Derive.Scale.Bali where
import qualified Util.Lists as Lists
import qualified Perform.Pitch as Pitch


-- | Pitch for saih pitu.  Pemero and penyorog are Es and As respectively.
data Pitch = I | O | E | Es | U | A | As
    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)

-- | Extend a scale downwards and upwards, assuming the extended octaves
-- are exactly 2:1.  The input should have at least an octave's worth of
-- pitches.
extend_scale :: Pitch.PitchClass -> Pitch.Pitch -- ^ extend down to here
    -> Pitch.Pitch -- ^ extend up to here
    -> Pitch.Pitch -- ^ from this original starting point
    -> [Pitch.NoteNumber] -> [Pitch.NoteNumber]
extend_scale :: Int -> Pitch -> Pitch -> Pitch -> [NoteNumber] -> [NoteNumber]
extend_scale Int
per_octave Pitch
low Pitch
high Pitch
start [NoteNumber]
nns =
    forall a. [a] -> [a]
reverse (forall a. Int -> [a] -> [a]
take Int
to_low [NoteNumber]
down) forall a. [a] -> [a] -> [a]
++ [NoteNumber]
nns forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
take Int
to_high [NoteNumber]
up
    where
    to_low :: Int
to_low = Int -> Pitch -> Pitch -> Int
Pitch.diff_pc Int
per_octave Pitch
start Pitch
low
    -- 'high' is inclusive, so +1.
    to_high :: Int
to_high = Int -> Pitch -> Pitch -> Int
Pitch.diff_pc Int
per_octave Pitch
high Pitch
start forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [NoteNumber]
nns forall a. Num a => a -> a -> a
+ Int
1
    down :: [NoteNumber]
down =
        [ NoteNumber
nn forall a. Num a => a -> a -> a
- NoteNumber
12 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
oct
        | Integer
oct <- [Integer
1..], NoteNumber
nn <- forall a. [a] -> [a]
reverse (forall a. Int -> [a] -> [a]
take Int
per_octave [NoteNumber]
nns)
        ]
    up :: [NoteNumber]
up =
        [ NoteNumber
nn forall a. Num a => a -> a -> a
+ NoteNumber
12 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
oct
        | Integer
oct <- [Integer
1..], NoteNumber
nn <- forall a. Int -> [a] -> [a]
Lists.takeEnd Int
per_octave [NoteNumber]
nns
        ]