-- | Csound pitch constants

module CsoundExpr.Base.Pitch 
    (Pch, Oct,
     c, cs, d, ds, e, es, f, fs, g, gs, a, as, b, bs,
     cb, db, eb, fb, gb, ab, bb, 
     css, dss, ess, fss, gss, ass, bss,
     cbb, dbb, ebb, fbb, gbb, abb, bbb)
where

import CsoundExpr.Base

type Pch  = Irate
type Oct  = Int

-- natural, sharps

c, cs, d, ds, e, es, f, fs, g, gs, a, as, b, bs :: Oct -> Pch

c  = inDouble (8.00 + ) 
cs = inDouble (8.01 + )
d  = inDouble (8.02 + )
ds = inDouble (8.03 + )
e  = inDouble (8.04 + )
f  = inDouble (8.05 + )
fs = inDouble (8.06 + )
g  = inDouble (8.07 + )
gs = inDouble (8.08 + )
a  = inDouble (8.09 + )
as = inDouble (8.10 + )
b  = inDouble (8.11 + )


inDouble :: (Double -> Double) -> Oct -> Pch
inDouble f = fromDouble . f . toDouble 
    where toDouble   = fromInteger  . toInteger
          fromDouble = fromRational . toRational



es = f
bs = c . (+1)

-- flats

cb, db, eb, fb, gb, ab, bb :: Oct -> Pch

cb = b . (\x -> x - 1)
db = cs
eb = ds
fb = e
gb = fs
ab = gs
bb = as

-- double sharps

css, dss, ess, fss, gss, ass, bss :: Oct -> Pch

css = d
dss = e
ess = fs
fss = g
gss = a
ass = b
bss = cs . (+1)

-- double flats

cbb, dbb, ebb, fbb, gbb, abb, bbb :: Oct -> Pch

cbb = bb . (\x -> x - 1)
dbb = c
ebb = d
fbb = eb
gbb = f
abb = g
bbb = a