{-# LANGUAGE 
        FlexibleInstances, 
        TypeSynonymInstances, 
        Rank2Types #-}

-- | Representing pitch
module Temporal.Music.Notation.Pitch (
	-- * Types
    --
    -- | There are four main datatypes 'Frequency', 'Pitch', 'Scale' and 'Tone'.
    -- 'Pitch' consists of 'Scale' and 'Tone'.
    -- Every 'Pitch' can be converted to 'Frequency' (see a 'absPitch'). 
    -- 'Scale' defines logarithmic mapping from 2d integer coordinates of
    -- 'Tone' to 1d double values. 'Scale' is 2d logarithmic grid in 
    -- frequency domain and 'Tone' is point on that grid. 
	Frequency, c1, a1,
    Pch(pitch), 
    Pitch(..), 
    Interval, Scale(..), scaleSize, fromIntervals,
    Bend, Octave, Step, 
    Tone(..), tone, toneNum,
	-- * Transformers
    -- ** Pitch 
    PitchFunctor(..),
    -- ** Scale 
    setScale, mapBase, setBase, transposeScale,
    -- ** Tone
    ToneFunctor(..), 
	setBend, bend, step, transp,
    low, l', ll', high, h', hh', lower, higher, invert,
    -- * Rendering
    frequency, absPitch
 )
where

import Data.Function(on)
import qualified Data.Vector as V

import Temporal.Music.Notation.Score(Score)
import Control.Arrow(first, second)
import Temporal.Music.Notation.Seg

type Frequency = Double

-- | middle C (261.626 Hz)
c1 :: Frequency
c1 = 261.626 

-- | middle A (440 Hz)
a1 :: Frequency
a1 = 440


class Seg a => Pch a where    
    pitch :: Tone a -> Pitch a
{-
instance Nat n => Pch (IntSeg n) where
    pitch x = Pitch (defaultScale x) x
            where defaultScale x = Scale (0, c1) 2 $ V.fromList $ 
                        let n = toneNum x
                            n'  = fromIntegral n
                            eqt = (2 ** ) . (/n') . fromIntegral
                        in  map eqt [0 .. n-1]
-}

-- | 'Pitch' consists of 'Scale' and 'Tone'
data Seg n => Pitch n = Pitch 
        { pitchScale :: Scale
        , pitchTone  :: Tone n
        } deriving (Show, Eq)


--------------------------------------------------------------
-- Scale

-- | Musical interval. Ratio between two frequency values.
type Interval = Frequency

-- | 'Scale' defines 2d grid in frequency domain. First value of 2d vector 
-- is octave and second is step. 'Scale' consists of base tone, 
-- octave interval and individual tone intervals inside octave. 
-- Base tone links scale coordinates to frequency coordinates. 
-- Base tone is pair (n, f) of integer value and frequency value,
-- Base tone defines that @'tone' n@ corresponds to frequency @f@.
--
-- For example scales @s1@ and @s2@ are equal
--
-- >import Temporal.Music.Notation.Local.Scales(eqt)
-- >
-- >s1 = eqt 0 c1
-- >s2 = eqt 9 a1
--
-- This doesn't make much sense for equal temperament. But can be useful
-- for just scales. For example this gives just pythagorean scale in G major
--
-- >import Temporal.Music.Notation.Local.Scales(pyth)
-- > 
-- >pythG = pyth 7 (3/2 * c1)
-- 
-- if you write just @pyth 0 (3/2 * c1)@ note (0 :: Tone N12) corresponds
-- to G.

data Scale = Scale 
    { scaleBase   :: (Int, Frequency)   
            -- ^ start point of the grid,
            --   @(n, cps)@ corresponds to @(0, n)@
            --   where n is step id of 'scaleBase' and
            --   @cps@ is 'scaleBase' in frequency units.

    , scaleOctave :: Interval           
            -- ^ octave interval

    , scaleSteps  :: V.Vector Interval  
            -- ^ multipliers for each step in octave
    } deriving (Show, Eq)

-- | gives number of steps in one octave.
scaleSize :: Scale -> Int
scaleSize = V.length . scaleSteps

-- | 'fromIntervals' makes scale constructor from 'octave' interval and
-- scale step intervals.
fromIntervals ::  
        Interval -> [Interval]
    -> (Int -> Frequency -> Scale)
fromIntervals octave steps = \c0 f0 -> Scale (c0, f0) octave $ V.fromList steps


-------------------------------------------------------------
-- Tone

-- | represents tone's diversion from scale grid.
type Bend   = Double
type Octave = Int
type Step   = Int

-- | 'Tone' is 2d integer value (octave, step) that can be converted to 
-- frequency
-- with some scale. 'Bend' is a level of diversion from scale-tones
-- 1-level bend is equal to 1 step. For tones with fractional bends frequency
-- is calculated with linear interpolation by nearest values in scale.
data Seg n => Tone n = Tone
        { toneBend   :: Bend     
        , toneOctave :: Octave  
        , toneStep   :: n
        } deriving (Eq, Show) 

-- | 'tone' constructs Tone from step value. Bend is set to zero.
tone :: Seg n => n -> Tone n
tone = Tone 0 0

-- | 'toneNum' queries number of steps in scale for given tone. 
-- It decodes type value to 'Int'.
toneNum :: Seg n => Tone n -> Int
toneNum x = segSize $ num x
    where num :: Seg n => Tone n -> n
          num = const undefined

-- instances

instance (Eq n, Seg n) => Ord (Tone n) where
    compare = compare `on` (\(Tone b o s) -> (o, fromEnum s, b))

instance Seg n => Enum (Tone n) where
    toEnum x   = res  
        where res    = Tone 0 o $ toEnum s
              (o, s) = divMod x (toneNum res)
    fromEnum x = toneOctave x * toneNum x + (fromEnum $ toneStep x)
 
instance (Eq n, Show n, Seg n) => Num (Tone n) where
    (+) = liftBi (+) (+) (+)
    (-) = liftBi (-) (-) (+)
    (*) = liftBi (*) (*) (*)

    abs = liftUn abs abs abs
    signum t@(Tone b o s)
        | abs b < 1e-6 && o == 0 && s == minBound = 0
        | t > 0 = fromInteger 1
        | otherwise = fromInteger $ -1

    fromInteger x = step (fromInteger x) $ tone minBound 

-------------------------------------------------------------------
-------------------------------------------------------------------
-- Transformers

-- Pitch

class PitchFunctor a where
	mapPitch :: (forall n . Seg n => Pitch n -> Pitch n) -> (a -> a)
    
instance Seg n => PitchFunctor (Pitch n) where
	mapPitch f = f

instance (PitchFunctor a) => PitchFunctor (Score a) where
	mapPitch f = fmap (mapPitch f)


-- Scale

mapScale :: PitchFunctor a => (Scale -> Scale) -> a -> a
mapScale f = mapPitch $ \p -> p{ pitchScale = f $ pitchScale p }

-- | setting specific scale
setScale :: PitchFunctor a => Scale -> a -> a
setScale x = mapScale $ const x

-- | mapping of scale base tone 
mapBase :: PitchFunctor a => (Frequency -> Frequency) -> a -> a
mapBase f = mapScale $ \s -> s{ scaleBase = second f $ scaleBase s }

-- | setting scale base tone
setBase :: PitchFunctor a => Frequency -> a -> a 
setBase b = mapBase $ const b

-- | 'transposeScale' shifts scaleSteps by given number.
-- For example if your just scale is defined with middle C as base
-- and you want to transpose it to middle D you can write
--
-- >res = someScale 2 (wholeTone * c1)
-- >    where wholeTone = 9/8
--
-- or
-- 
-- >transposeScale 2 $ someScale 0 c1
--
-- And now 0 corresponds to middle C and step multipliers are rearranged 
-- so that someScale starts from middle D.
transposeScale :: PitchFunctor a => Step -> a -> a
transposeScale n = mapScale $ \(Scale b o s) -> Scale b o $ rotateSteps n s
    where rotateSteps x s = V.map ( (/d) . (s V.! ) . flip mod n) ids
              where n   = V.length s  
                    d   = s V.! (mod x n)
                    ids = V.fromList [x .. x + n]
                    
-- Tone
-- | transformer for types that contain tone
class ToneFunctor a where
    mapTone :: (forall n . Seg n => Tone n -> Tone n) -> (a -> a)

instance Seg n => ToneFunctor (Tone n) where
    mapTone f = f

instance ToneFunctor a => ToneFunctor (Score a) where
	mapTone f = fmap (mapTone f)

instance Seg n => ToneFunctor (Pitch n) where
    mapTone f (Pitch s t) = Pitch s $ f t 

-- | set bend value 
setBend :: ToneFunctor a => Bend -> a -> a
setBend d = mapTone $ \x -> x{ toneBend = d }

-- | shift in bends
bend :: ToneFunctor a => Bend -> a -> a
bend d = mapTone $ \x -> x{ toneBend = toneBend x + d }

-- | transposition, shift in steps
step :: ToneFunctor a => Step -> a -> a
step n = mapTone $ liftUn id id ( + n)


-- | transposition, shift in steps
transp :: ToneFunctor a => Step -> a -> a
transp = step

-- | one octave lower
low :: ToneFunctor a => a -> a
low = lower 1

-- | shorcut for 'low'
l' :: ToneFunctor a => a -> a
l' = low

-- | shorcut for @'lower' 2@
ll' :: ToneFunctor a => a -> a
ll' = lower 2

-- | one octave higher
high :: ToneFunctor a => a -> a
high = higher 1

-- | shorcut for 'high'
h' :: ToneFunctor a => a -> a
h' = high

-- | shorcut for @'higher' 2@
hh' :: ToneFunctor a => a -> a
hh' = higher 2


-- | shifts downwards in octaves
lower :: ToneFunctor a => Int -> a -> a
lower n = higher (-n)

-- | shifts upwards in octaves
higher :: ToneFunctor a => Int -> a -> a
higher n = mapTone $ \(Tone b o s) -> Tone b (o + n) s

-- | inverts note around some tone center. Tone center defines
-- two tones octave apart around current note in wich inversion takes place.
--
-- For example with center at 5 note @c@ in twelve tone scale 
-- @[5, 6, 7, 8, 9, bb, 11, c, 1, 2, 3, 4, 5]@ goes into note  bb.
-- Inversion counts number of steps from lower center tone to given tone
-- and then result is higher center tone shifted lower by this number.
invert :: ToneFunctor a => Step -> a -> a
invert center = mapTone $  
    \t@(Tone b o s) -> 
        let n = toneNum t
            c = mod center n
            w = fromEnum s
            q = if c <= w
                then (2 * c + n - w)
                else (2 * c - n - w)
            (o', s') = divMod q n
        in  Tone b (o + o') $ toEnum s'


-----------------------------------------------------------
-- rendering

-- | pitch to frequency conversion
absPitch :: Seg n => Pitch n -> Frequency
absPitch (Pitch s t) = frequency s t

-- | calculates frequency value for given tone on scale grid
frequency :: Seg n => Scale -> Tone n -> Frequency
frequency s t@(Tone b o n) = (bendCoeff r' d s * ) $
    scaleFreq s d
    where (b', r') = properFraction b
          d = fromEnum t + fromIntegral b'

bendCoeff :: Bend -> Step -> Scale -> Double
bendCoeff r n s
    | abs r < 1e-6 = 1
    | r > 0        = flip loginterpCoeff r       $ getTones s n $ n + 1
    | otherwise    = flip loginterpCoeff (abs r) $ getTones s n $ n - 1
    where getTones s n1 n2 = (scaleFreq s n1, scaleFreq s n2)  
   

scaleFreq :: Scale -> Int -> Frequency
scaleFreq s x = f0 * (scaleOctave s ^^ o) * (scaleSteps s V.! n)
    where (o, n)   = divMod (x - c0) $ scaleSize s
          (c0, f0) = scaleBase s 

loginterpCoeff :: (Double, Double) -> Double -> Double
loginterpCoeff (l, r) x = (r / l) ** x


-- tone manipulation

liftUn :: Seg n     
    => (Double -> Double) 
    -> (Int -> Int) 
    -> (Int -> Int)
    -> Tone n -> Tone n
liftUn f g h t@(Tone b o s) = 
    (uncurry $ Tone (f b)) $ 
    fit (toneNum t) (g o, h $ fromEnum s)
    


liftBi :: Seg n 
    => (Double -> Double -> Double) 
    -> (Int -> Int -> Int) 
    -> (Int -> Int -> Int) 
    -> Tone n -> Tone n -> Tone n
liftBi f g h t@(Tone b o s) (Tone b' o' s') = 
    (uncurry $ Tone (b `f` b')) $ 
    fit (toneNum t) (o `g` o', fromEnum s `h` fromEnum s')

fit :: Seg s => Int -> (Int, Int) -> (Int, s)
fit n (o, s) = (o + o', toEnum s')
    where (o', s') = divMod s n