{-# LANGUAGE TypeOperators, TypeSynonymInstances, TemplateHaskell, DeriveDataTypeable #-}

module MusicPad.Type.Music where

import Rika.Env
import Prelude ()
import Text.JSON.Generic
import Data.Data
import Rika.Data.Record.Label

infixr 5 :+:, :=:

type Octave = Int

type Pitch = (PitchClass, Octave)

a4 :: Pitch
a4 = (A,4)                               -- concert A

data PitchClass = Cff | Cf | C | Dff | Cs | Df | Css | D | Eff | Ds 
                | Ef | Fff | Dss | E | Es | Ff | F | Gff | Ess | Fs
                | Gf | Fss | G | Aff | Gs | Af | Gss | A | Bff | As 
                | Bf | Ass | B | Bs | Bss
     deriving (Eq,Ord,Show,Read,Enum, Typeable, Data)
     

instance Default PitchClass where
  def = A

type Dur   = Rational


data Primitive a = Note Dur a        
                 | Rest Dur              
     deriving (Show, Eq, Ord, Typeable, Data)


data Music a = Prim (Primitive a)               -- primitive value 
             | Music a :+: Music a              -- sequential composition
             | Music a :=: Music a              -- parallel composition (long)
             | Music a :=/ Music a              -- parallel composition
     deriving (Show, Eq, Ord, Typeable, Data)



note d p       = Prim (Note d p)
rest d         = Prim (Rest d)


cff,cf,c,cs,css,dff,df,d,ds,dss,eff,ef,e,es,ess,fff,ff,f,
  fs,fss,gff,gf,g,gs,gss,aff,af,a,as,ass,bff,bf,b,bs,bss 
  :: Octave -> Dur -> Music Pitch

cff o d = note d (Cff,o)
cf  o d = note d (Cf, o)
c   o d = note d (C,  o)
cs  o d = note d (Cs, o)
css o d = note d (Css,o)
dff o d = note d (Dff,o)
df  o d = note d (Df, o)
d   o d = note d (D,  o)
ds  o d = note d (Ds, o)
dss o d = note d (Dss,o)
eff o d = note d (Eff,o)
ef  o d = note d (Ef, o)
e   o d = note d (E,  o)
es  o d = note d (Es, o)
ess o d = note d (Ess,o)
fff o d = note d (Fff,o)
ff  o d = note d (Ff, o)
f   o d = note d (F,  o)
fs  o d = note d (Fs, o)
fss o d = note d (Fss,o)
gff o d = note d (Gff,o)
gf  o d = note d (Gf, o)
g   o d = note d (G,  o)
gs  o d = note d (Gs, o)
gss o d = note d (Gss,o)
aff o d = note d (Aff,o)
af  o d = note d (Af, o)
a   o d = note d (A,  o)
as  o d = note d (As, o)
ass o d = note d (Ass,o)
bff o d = note d (Bff,o)
bf  o d = note d (Bf, o)
b   o d = note d (B,  o)
bs  o d = note d (Bs, o)
bss o d = note d (Bss,o)



type AbsPitch = Int

absPitch :: Pitch -> AbsPitch
absPitch (pc,oct) = 12 * oct + pcToInt pc

pcToInt :: PitchClass -> Int
pcToInt Cff = -2
pcToInt Cf  = -1
pcToInt C   =  0
pcToInt Cs  =  1
pcToInt Css =  2

pcToInt Dff =  0
pcToInt Df  =  1
pcToInt D   =  2
pcToInt Ds  =  3
pcToInt Dss =  4

pcToInt Eff =  2
pcToInt Ef  =  3
pcToInt E   =  4
pcToInt Es  =  5
pcToInt Ess =  6

pcToInt Fff =  3
pcToInt Ff  =  4
pcToInt F   =  5
pcToInt Fs  =  6
pcToInt Fss =  7

pcToInt Gff =  5
pcToInt Gf  =  6
pcToInt G   =  7
pcToInt Gs  =  8
pcToInt Gss =  9

pcToInt Aff =  7
pcToInt Af  =  8
pcToInt A   =  9
pcToInt As  = 10
pcToInt Ass = 11

pcToInt Bff =  9
pcToInt Bf  = 10
pcToInt B   = 11
pcToInt Bs  = 12
pcToInt Bss = 13


pitch     :: AbsPitch -> Pitch
pitch     ap       = 
    let (oct,  n) = divMod ap 12
    in  ([C,Cs,D,Ds,E,F,Fs,G,Gs,A,As,B] !! n, oct)
    
    
trans    :: Int -> Pitch -> Pitch
trans i p = pitch (absPitch p + i)


