-- | Csound pitch constants

module CsoundExpr.Base.Pitch 
    (     
     Pitch, Octave,
     low, high, lower, higher,

     -- * Pitch constants
     --
     -- | 'c' is 8.00, 'cs' is 8.01 etc.
     c, cs, d, ds, e, es, f, fs, g, gs, a, as, b, bs,
     cb, db, eb, fb, gb, ab, bb
    )
where

import CsoundExpr.Base

type Pitch  = Irate
type Octave = Int

-- | 'high' shifts pitch one octave higher
high :: Pitch -> Pitch
high = higher 1

-- | 'low' shifts pitch one octave lower
low :: Pitch -> Pitch
low = lower 1

-- | 'higher' shifts pitch by @n@ octaves higher
higher :: Octave -> Pitch -> Pitch
higher n = ( + (double $ fromIntegral n))

-- | 'lower' shifts pitch by @n@ octaves lower
lower :: Octave -> Pitch -> Pitch
lower n = higher (-n)


-- natural, sharps

c, cs, d, ds, e, es, f, fs, g, gs, a, as, b, bs :: Pitch

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

es = f
bs = high c

-- flats

cb, db, eb, fb, gb, ab, bb :: Pitch

cb = low b 
db = cs
eb = ds
fb = e
gb = fs
ab = gs
bb = as