module TScore.Midi(module TScore.Midi,module Reactive.Event) where
import Tile.Tilable
import Reactive.Event
import Reactive.Updatable
data Interval = Unison | Second | Third | Fourth
| Fifth | Sixth | Seventh | Octave
| Ninth | Tenth | Eleventh | Twelth
| Thirteenth | Fourteenth | Fifteenth
| Sixteenth | Seventeenth
deriving (Show, Enum, Eq,Ord,Bounded,Read)
data PitchClass = Fbb | Cbb | Gbb | Dbb | Abb | Ebb | Bbb
| Fb | Cb | Gb | Db | Ab | Eb | Bb
| F | C | G | D | A | E | B
| Fs | Cs | Gs | Ds |As |Es | Bs
| Fss | Css | Gss | Dss | Ass | Ess | Bss
| Fsss | Csss | Gsss
deriving (Enum,Show,Bounded,Eq,Ord,Read)
instance Updatable PitchClass d iv where
update _ = id
pitchClassToPitch :: PitchClass -> MidiPitch
pitchClassToPitch pc = mod ((fromEnum pc)*7+fromEnum(C)) 12
pitchClassAndScaleToPitch :: PitchClass -> Int -> MidiPitch
pitchClassAndScaleToPitch pc s
= let s' = mod (s+1) 10
in pitchClassToPitch pc + s'*12
pitchToPitchClass :: MidiPitch -> PitchClass
pitchToPitchClass p = toEnum(fromEnum(Ab) +mod (4+p*7) 12)
data NumMode = I | II | III | IV | V | VI | VII | VIII | IX | X | XI | XII | XIII | XIV deriving (Enum,Show,Bounded,Eq,Ord)
type MidiPitch = Int
type Channel = Int
type Velocity = Int
data Midi = Midi { channelMidi :: Channel
, pitchMidi :: MidiPitch
, velocityMidi :: Velocity}
deriving Show
instance Updatable Midi d iv where
update _ = id
type EventMidi = Event Midi
instance (Eq d, Num d, Lattice d) => Tilable d Midi
instance Eq (Midi) where
(Midi a b _) == (Midi a' b' _) = a == a' && b == b'
instance Ord (Midi) where
compare (Midi c p _) (Midi c' p' _)
= case compare c c' of
EQ -> compare p p'
LT -> LT
GT -> GT
instance POrd (Midi) where
partialCompare m m' = Just $ compare m m'
type Tone = MidiPitch
type ScalePattern = [Int]
majorP :: ScalePattern
majorP = [2,2,1,2,2,2,1]
betweenP :: ScalePattern
betweenP = [2,2,1,2,2,3]
minorP :: ScalePattern
minorP = [2,1,2,2,1,3,1]
toneP :: ScalePattern
toneP = [2,2,2,2,2,2]
chromaticP :: ScalePattern
chromaticP = [1,1,1,1,1,1,1,1,1,1,1,1]
dimP :: ScalePattern
dimP = [2,1,2,1,2,1,2,1]
pentatonicP :: ScalePattern
pentatonicP = [2,2,3,2,3]
alteredP :: ScalePattern
alteredP = [1,3,1,2,1,3,1]
rotateP :: ScalePattern -> NumMode -> ScalePattern
rotateP pa nm = (drop (fromEnum nm) pa) ++ (take (fromEnum nm) pa)
sizeP :: ScalePattern -> Int
sizeP p = foldl (+) 0 p
data Scale = Scale
{scalePitchClass:: PitchClass,
scalePattern:: ScalePattern}
note :: Scale -> Int -> MidiPitch
note (Scale pc pa) n =
let s = sizeP pa
l = length pa
in (pitchClassToPitch pc) + (div n l)*s + foldl (+) 0 (take (mod n l) pa)
major :: PitchClass -> Scale
major pc = (Scale pc majorP)
between :: PitchClass -> Scale
between pc = (Scale pc betweenP)
majorMode :: PitchClass -> NumMode -> Scale
majorMode pc md = (Scale pc (rotateP majorP md))
minor :: PitchClass -> Scale
minor pc = (Scale pc minorP)
minorMode :: PitchClass -> NumMode -> Scale
minorMode pc md = (Scale pc (rotateP minorP md))
tone :: PitchClass -> Scale
tone pc = (Scale pc toneP)
pentatonic :: PitchClass -> Scale
pentatonic pc = (Scale pc pentatonicP)
altered :: PitchClass -> Scale
altered pc = (Scale pc alteredP)
chromatic :: PitchClass -> Scale
chromatic pc = (Scale pc chromaticP)
dim :: PitchClass -> Scale
dim pc = (Scale pc dimP)
data ScaleType = Pentatonic | Tone | Between | Diminished
| Major
| Minor | Altered | Chromatic deriving (Show, Enum, Eq, Bounded,Read, Ord)
instance Updatable ScaleType d iv where
update _ = id
scale :: PitchClass -> ScaleType -> Scale
scale pc st
= case st of
Major -> major pc
Between -> between pc
Minor -> minor pc
Tone -> tone pc
Diminished -> dim pc
Chromatic -> chromatic pc
Pentatonic -> pentatonic pc
Altered -> altered pc
rankInScale :: Midi -> Scale -> Int
rankInScale (Midi c p v) (Scale pc pa)
= let s = max 1 (sizeP pa)
scale = scanl (+) 0 pa
in length (takeWhile (< mod (p pitchClassToPitch pc) s) scale)
noteInScale :: Scale -> Midi -> Midi
noteInScale s@(Scale pc pa) m@(Midi c p v) =
let k = pitchClassToPitch pc
r = rankInScale (Midi 0 p 0) s
scale = scanl (+) 0 pa
np = k+12*(div (p k) 12) + scale !!r
in Midi c np v
transpose :: Scale -> Int -> Midi -> Midi
transpose s@(Scale pc st) i m@(Midi c p v) =
let
r = rankInScale m s
delta = note (Scale pc st) (r+i) note (Scale pc st) r
nv = case delta == 0 of
True -> v
False -> floor $ (toRational v)*9/10
in Midi c (mod (p + delta) 127) v
where
newi st r i
= case st of
Pentatonic ->
let ri = (div i 7)*5
di = mod i 7
in ri + case (r+di <= 2) of
True -> di
False -> case (r+di) of
3 -> 2
4 -> 4
5 -> 5
_ -> 5
_ -> i
toScale m n (Midi c p v) = Midi c (n*12 + m+(mod (pm) 12)) v
pitchShift :: MidiPitch -> Midi -> Midi
pitchShift i (Midi c p v) = Midi c (p+i) v