-- | Csound pitch constants for fast sketching. 
-- It's better to use functions from module "Temporal.Music".

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
import Temporal.Music(temp, Score)

type Pitch  = Irate
type Octave = Int

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

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

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

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


-- natural, sharps

c, cs, d, ds, e, es, f, fs, g, gs, a, as, b, bs,
    cb, db, eb, fb, gb, ab, bb :: Score Pitch

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

es = f
bs = high c

-- flats

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