module ZMidi.Score.Datatypes (
MidiScore (..)
, Key (..)
, TimeSig (..)
, Voice
, Channel (..)
, Pitch (..)
, Octave (..)
, PitchClass (..)
, Interval (..)
, Velocity (..)
, Timed (..)
, Time (..)
, Bar (..)
, Beat (..)
, BeatRat (..)
, BarRat (..)
, TPB (..)
, ScoreEvent (..)
) where
import ZMidi.Score.Internal
import ZMidi.Core ( MidiFormat (..), MidiScaleType (..) )
import Data.Ratio ( Ratio, numerator, denominator, (%) )
import Data.Word ( Word8 )
import Data.Int ( Int8 )
import Data.Char ( toLower )
import Text.Printf ( PrintfArg )
import Data.Aeson ( ToJSON (..), FromJSON (..)
, (.=), (.:), Value (..), object)
import Data.Text ( pack )
import Data.Binary ( Binary, Get )
import qualified Data.Binary as B ( get, put )
import GHC.Generics ( Generic )
import Control.DeepSeq ( NFData (..) )
import Control.DeepSeq.Generics ( genericRnf)
import Control.Applicative ( (<$>), (<*>) )
import Control.Monad ( mzero )
data MidiScore = MidiScore {
getKey :: [Timed Key]
, getTimeSig :: [Timed TimeSig]
, ticksPerBeat :: TPB
, midiFormat :: MidiFormat
, tempo :: [Timed Time]
, minDur :: Time
, getVoices :: [Voice]
} deriving (Eq, Show, Generic)
data Key = Key { keyRoot :: Int8
, keyMode :: MidiScaleType
}
| NoKey deriving (Eq, Ord, Generic)
data TimeSig = TimeSig { tsNum :: Int
, tsDen :: Int
, metronome :: Word8
, nr32ndNotes:: Word8
}
| NoTimeSig deriving (Generic)
type Voice = [Timed ScoreEvent]
newtype Channel = Channel {channel :: Word8 }
deriving ( Eq, Show, Num, Ord, Enum, Real, Integral, Binary, NFData )
newtype Pitch = Pitch ( Octave, PitchClass )
deriving ( Eq, Ord, Binary, NFData, Generic )
newtype Octave = Octave { octave :: Int }
deriving ( Eq, Show, Num, Ord, Enum, Real, Integral, Binary, PrintfArg, NFData, Generic )
newtype PitchClass = PitchClass { pitchclass :: Int }
deriving ( Eq, Show, Num, Ord, Enum, Real, Integral, Binary, PrintfArg, NFData, Generic )
newtype Interval = Interval { interval :: Int }
deriving ( Eq, Show, Num, Ord, Enum, Real, Integral, Binary, PrintfArg, NFData, Generic )
newtype Velocity = Velocity { velocity :: Word8 }
deriving ( Eq, Show, Num, Ord, Enum, Real, Integral, Binary, NFData, Generic )
newtype Time = Time { time :: Int }
deriving ( Eq, Show, Num, Ord, Enum, Real, Integral, Binary, PrintfArg, NFData, Generic )
newtype Bar = Bar { bar :: Int }
deriving ( Eq, Show, Num, Ord, Enum, Real, Integral, Binary, PrintfArg, NFData, Generic )
newtype Beat = Beat { beat :: Int }
deriving ( Eq, Show, Num, Ord, Enum, Real, Integral, Binary, PrintfArg, NFData, Generic )
newtype BeatRat = BeatRat { beatRat :: Ratio Int }
deriving ( Eq, Show, Num, Ord, Enum, Real, Binary, NFData, Generic )
newtype BarRat = BarRat { barRat :: Ratio Int }
deriving ( Eq, Show, Num, Ord, Enum, Real, Binary, NFData, Generic )
newtype TPB = TPB { tpb :: Int }
deriving ( Eq, Show, Num, Ord, Enum, Real, Integral, Binary, PrintfArg, NFData, Generic )
data Timed a = Timed { onset :: Time
, getEvent :: a
} deriving (Functor, Eq, Ord, Generic)
data ScoreEvent = NoteEvent { chan :: Channel
, pitch :: Pitch
, velo :: Velocity
, duration :: Time
}
| KeyChange { keyChange :: Key
}
| TimeSigChange { tsChange :: TimeSig
}
| TempoChange { tempChange :: Time
} deriving (Eq, Ord, Show, Generic)
instance Show a => Show (Timed a) where
show (Timed t a) = show a ++ " @ " ++ show (time t)
instance Eq TimeSig where
(TimeSig a1 b1 _ _) == (TimeSig a2 b2 _ _) = a1 == a2 && b1 == b2
NoTimeSig == NoTimeSig = True
_ == _ = False
instance Ord TimeSig where
compare _ NoTimeSig = GT
compare NoTimeSig _ = LT
compare (TimeSig a1 b1 _ _) (TimeSig a2 b2 _ _) =
case compare b1 b2 of
EQ -> compare a1 a2
c -> c
instance Show TimeSig where
show (TimeSig n d _ _) = show n ++ '/' : show d
show NoTimeSig = "NoTimeSig"
instance Read TimeSig where
readsPrec _ = error "Read TimeSig: implement me"
instance Show Key where
show NoKey = "NoKey"
show (Key rt m) = showRoot rt ++ ' ' : (map toLower . show $ m) where
showRoot :: Int8 -> String
showRoot i = let r = fromIntegral i in case compare r 0 of
LT -> replicate (abs r) 'b'
EQ -> "0"
GT -> replicate r '#'
instance Show Pitch where
show (Pitch (oct, p)) = showOct oct ++ showPitch p where
showOct :: Octave -> String
showOct (Octave i) | i < 0 = show i
| otherwise = ' ' : show i
showPitch :: PitchClass -> String
showPitch p = case pitchclass p of
0 -> "C "
1 -> "C#"
2 -> "D "
3 -> "D#"
4 -> "E "
5 -> "F "
6 -> "F#"
7 -> "G "
8 -> "G#"
9 -> "A "
10 -> "Bb"
11 -> "B "
n -> invalidMidiNumberError n
instance Binary MidiScore
instance Binary TimeSig
instance Binary ScoreEvent
instance Binary Key
instance (Binary a) => Binary (Timed a)
instance Binary MidiScaleType where
put MAJOR = B.put (0 :: Word8)
put MINOR = B.put (1 :: Word8)
put (SCALE_OTHER i) = do B.put (2 :: Word8)
B.put i
get = do t <- B.get :: Get Word8
case t of
0 -> return MAJOR
1 -> return MINOR
2 -> do i <- B.get
return (SCALE_OTHER i)
_ -> error "invalid binary encoding of MidiScaleType"
instance Binary MidiFormat where
put MF0 = B.put (0 :: Word8)
put MF1 = B.put (1 :: Word8)
put MF2 = B.put (2 :: Word8)
get = do t <- B.get :: Get Word8
case t of
0 -> return MF0
1 -> return MF1
2 -> return MF2
_ -> error "invalid binary encoding of MidiFormat"
instance NFData MidiScore where rnf = genericRnf
instance NFData TimeSig where rnf = genericRnf
instance NFData ScoreEvent where rnf = genericRnf
instance NFData Key where rnf = genericRnf
instance NFData a => NFData (Timed a) where rnf = genericRnf
instance NFData MidiScaleType where rnf a = a `seq` ()
instance NFData MidiFormat where rnf a = a `seq` ()
instance ToJSON Beat
instance ToJSON BeatRat
instance ToJSON BarRat
instance (Integral a, ToJSON a) => ToJSON (Ratio a) where
toJSON r = object [pack "num" .= numerator r, pack "den" .= denominator r]
instance ToJSON (TimeSig) where
toJSON (TimeSig n d _ _) = object [pack "ts_num" .= n, pack "ts_den" .= d]
toJSON NoTimeSig = object [pack "ts" .= pack "none"]
instance FromJSON Beat
instance FromJSON BeatRat
instance FromJSON BarRat
instance (Integral a, FromJSON a) => FromJSON (Ratio a) where
parseJSON (Object v) = (%) <$> v .: (pack "num") <*> v .: (pack "den")
parseJSON _ = mzero
instance FromJSON (TimeSig) where
parseJSON (Object v) = (\n d -> TimeSig n d 0 0)
<$> v .: (pack "ts_num") <*> v .: (pack "ts_den")
parseJSON _ = mzero