{- |
Module      :  $Header$
Description :  Module that contains basic music definitions
Copyright   :  (c) David Janin, 2017
License     :  see the LICENSE file in the distribution

Maintainer  :  janin@labri.fr
Stability   :  experimental

This module provides basic definitions for midi music
-}

{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}

{-# LANGUAGE FlexibleInstances,
             MultiParamTypeClasses  #-}

module TScore.Midi(module TScore.Midi,module Reactive.Event) where

import Tile.Tilable
import Reactive.Event
import Reactive.Updatable
-- import Data.Word
-- import Data.Word.Odd


-- | Type enumerating some diatonic intervals (to be used in conjunction with scale patterns)
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)

-- | Type enumerating some pitch classes (ordered in perfect fiths)
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)

-- | No update needed
instance Updatable PitchClass d iv where
  update _ = id


-- | Converts pitchclass into midi pitch from 0 (C) to 11 (B)
pitchClassToPitch :: PitchClass -> MidiPitch                     
pitchClassToPitch pc = mod ((fromEnum pc)*7+fromEnum(C)) 12

-- | Converts pitchclass and scale number into midi pitch (A0 = 22, C1 = 24)
pitchClassAndScaleToPitch :: PitchClass -> Int -> MidiPitch                     
pitchClassAndScaleToPitch pc s
    = let s' = mod (s+1)  10 
      in pitchClassToPitch pc + s'*12
         
-- | Converts midi pitch into pitchClass (from C to A sharp)
pitchToPitchClass :: MidiPitch -> PitchClass
pitchToPitchClass p = toEnum(fromEnum(Ab) +mod (4+p*7) 12)

-- | Enumerating (sub) mode number
data NumMode = I | II | III | IV | V | VI | VII | VIII | IX | X | XI | XII | XIII | XIV deriving (Enum,Show,Bounded,Eq,Ord)

-- | Type defining the pitch in MIDI
type MidiPitch = Int

-- | Type defining the MIDI channel
type Channel = Int

-- | Type defining the velocity of the MIDI note
type Velocity = Int

-- | Type defining a Midi value
data Midi = Midi { channelMidi  :: Channel
                 , pitchMidi    :: MidiPitch
                 , velocityMidi :: Velocity}
            deriving Show

-- | No update needed
instance Updatable Midi d iv where
  update _ = id


-- | Alias for an event carrying a Midi message
type EventMidi = Event Midi

-- | Midi values are tilable
instance (Eq d, Num d, Lattice d) => Tilable d Midi
    

-- | Definition of equality in midi
instance Eq (Midi) where
  (Midi a b _) == (Midi a' b' _) = a == a' && b == b'

-- | Definition of order in midi (compares pitches)
instance Ord (Midi) where
  compare (Midi c p _) (Midi c' p' _)
      = case compare c c' of
          EQ -> compare p p'
          LT -> LT
          GT -> GT
                
-- | Definition of porder in midi 
instance POrd (Midi) where
  partialCompare m m' = Just $ compare m m'
                                              
-- | Types denoting a tone
type Tone = MidiPitch

-- | Type defining the direction of a tranposition
-- data Direction = Lower | Upper deriving (Show, Enum, Eq)


-- | Type denoting the pattern of a scale in semi-tones. For example:
--
-- >>> major pattern
-- majorP = [2,2,1,2,2,2,1]
-- >>> minor pattern
-- minorP = [2,1,2,2,1,2,2]
-- >>> tone pattern
-- toneP  = [2,2,2,2,2]
-- >>> diminished pattern
-- dimP = [2,1,2,1,2,1,2,1]
type ScalePattern = [Int]

-- | Major scale pattern
majorP :: ScalePattern
majorP = [2,2,1,2,2,2,1]

-- | Between scale pattern
betweenP :: ScalePattern
betweenP = [2,2,1,2,2,3]


-- | Minor scale pattern
minorP :: ScalePattern
minorP = [2,1,2,2,1,3,1]

-- | Tone scale pattern
toneP :: ScalePattern
toneP = [2,2,2,2,2,2]

-- | Half-tone (or chromatic) scale pattern
chromaticP :: ScalePattern
chromaticP = [1,1,1,1,1,1,1,1,1,1,1,1]

-- | Diminished scale pattern
dimP :: ScalePattern
dimP = [2,1,2,1,2,1,2,1]

-- | Diminished scale pattern
pentatonicP :: ScalePattern
pentatonicP = [2,2,3,2,3]

-- | Altered scale pattern
alteredP :: ScalePattern
alteredP = [1,3,1,2,1,3,1]

-- | Rotates a scaler patterns according to a mode nummber
rotateP :: ScalePattern -> NumMode -> ScalePattern
rotateP pa nm = (drop (fromEnum nm) pa) ++ (take (fromEnum nm) pa)

-- | Size of a pattern octave (in semitones)
sizeP :: ScalePattern -> Int
sizeP p = foldl (+) 0 p
       
-- | Type denoting a scale
data Scale = Scale
    {scalePitchClass:: PitchClass,
     scalePattern:: ScalePattern}

-- | Nth note of a scale
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 scales
major :: PitchClass -> Scale
major pc = (Scale pc majorP)

-- | Between scales
between :: PitchClass -> Scale
between pc = (Scale pc betweenP)

-- | Major mode scales (ex: D Dorian is majorMode C II)
majorMode :: PitchClass -> NumMode -> Scale
majorMode pc md  = (Scale pc (rotateP majorP md))

-- | Minor scales
minor :: PitchClass -> Scale
minor pc = (Scale pc minorP)

-- | Minor mode scales
minorMode :: PitchClass -> NumMode -> Scale
minorMode pc md  = (Scale pc (rotateP minorP md))

-- | Tone scales
tone :: PitchClass -> Scale
tone pc = (Scale pc toneP)

-- | Pentatonic scales
pentatonic :: PitchClass -> Scale
pentatonic pc = (Scale pc pentatonicP)

-- | Altered scales
altered :: PitchClass -> Scale
altered pc = (Scale pc alteredP)

-- | Chromatic scales
chromatic :: PitchClass -> Scale
chromatic pc = (Scale pc chromaticP)

-- | Diminished scales
dim :: PitchClass -> Scale
dim pc = (Scale pc dimP)

-- | Predefined type of scale
data ScaleType = Pentatonic  | Tone | Between | Diminished
               -- | Lydian
               | Major
               -- | Phrygian |   Dorian | Aeolian  | Mixolydian  | Locrian
               | Minor  | Altered    | Chromatic deriving (Show, Enum, Eq, Bounded,Read, Ord)

instance Updatable ScaleType d iv where
  update _ = id

-- | Scale out of scale type and pitchClass
scale :: PitchClass -> ScaleType -> Scale
scale pc st
    = case st of
        Major -> major pc
        Between -> between pc
        -- Dorian -> majorMode pc II
        -- Phrygian -> majorMode pc III
        -- Lydian -> majorMode pc IV
        -- Mixolydian -> majorMode pc V
        -- Aeolian -> majorMode pc VI
        -- Locrian -> majorMode pc VII         
        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)

-- | Moves a pitch to the nearest higher picth in a given 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
       
-- | Diatonic transpose given scale and interval (in Int)   
transpose :: Scale -> Int -> Midi -> Midi
transpose s@(Scale pc st) i m@(Midi c p v) =
    let -- s = sizeP st
        -- scale = scanl (+) 0 st
        r = rankInScale m s -- length (dropWhile (<= mod (p - pitchClassToPitch pc) s) scale)
        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
       
       
-- | Moves to a given scale range

toScale m n (Midi c p v) = Midi c (n*12 + m+(mod (p-m) 12)) v

       
-- | Chromatic pitch transpose
pitchShift :: MidiPitch -> Midi -> Midi
pitchShift i (Midi c p v) = Midi c (p+i) v