{- |
System Common messages
-}
module Sound.MIDI.Message.System.Common (
   T(..), TimeNibbleType(..), get, put,
   ) where

import           Sound.MIDI.Parser.Primitive
import qualified Sound.MIDI.Parser.Class as Parser

import Control.Monad.Trans.Class (lift, )
import Control.Monad (liftM, liftM2, )

import qualified Sound.MIDI.Writer.Basic as Writer
import Sound.MIDI.Monoid ((+#+))

import qualified Sound.MIDI.Bit as Bit

import Data.Ix(Ix)


data T =
     TimeCodeQuarterFrame TimeNibbleType Int
   | SongPositionPointer Int
   | SongSelect Int
   | TuneRequest
--   | EndOfSystemExclusive

data TimeNibbleType =
     FrameLS
   | FrameMS
   | SecondsLS
   | SecondsMS
   | MinutesLS
   | MinutesMS
   | HoursLS
   | HoursMS -- ^ also includes SMPTE type
   deriving (TimeNibbleType -> TimeNibbleType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeNibbleType -> TimeNibbleType -> Bool
$c/= :: TimeNibbleType -> TimeNibbleType -> Bool
== :: TimeNibbleType -> TimeNibbleType -> Bool
$c== :: TimeNibbleType -> TimeNibbleType -> Bool
Eq, Eq TimeNibbleType
TimeNibbleType -> TimeNibbleType -> Bool
TimeNibbleType -> TimeNibbleType -> Ordering
TimeNibbleType -> TimeNibbleType -> TimeNibbleType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TimeNibbleType -> TimeNibbleType -> TimeNibbleType
$cmin :: TimeNibbleType -> TimeNibbleType -> TimeNibbleType
max :: TimeNibbleType -> TimeNibbleType -> TimeNibbleType
$cmax :: TimeNibbleType -> TimeNibbleType -> TimeNibbleType
>= :: TimeNibbleType -> TimeNibbleType -> Bool
$c>= :: TimeNibbleType -> TimeNibbleType -> Bool
> :: TimeNibbleType -> TimeNibbleType -> Bool
$c> :: TimeNibbleType -> TimeNibbleType -> Bool
<= :: TimeNibbleType -> TimeNibbleType -> Bool
$c<= :: TimeNibbleType -> TimeNibbleType -> Bool
< :: TimeNibbleType -> TimeNibbleType -> Bool
$c< :: TimeNibbleType -> TimeNibbleType -> Bool
compare :: TimeNibbleType -> TimeNibbleType -> Ordering
$ccompare :: TimeNibbleType -> TimeNibbleType -> Ordering
Ord, Int -> TimeNibbleType -> ShowS
[TimeNibbleType] -> ShowS
TimeNibbleType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeNibbleType] -> ShowS
$cshowList :: [TimeNibbleType] -> ShowS
show :: TimeNibbleType -> String
$cshow :: TimeNibbleType -> String
showsPrec :: Int -> TimeNibbleType -> ShowS
$cshowsPrec :: Int -> TimeNibbleType -> ShowS
Show, Int -> TimeNibbleType
TimeNibbleType -> Int
TimeNibbleType -> [TimeNibbleType]
TimeNibbleType -> TimeNibbleType
TimeNibbleType -> TimeNibbleType -> [TimeNibbleType]
TimeNibbleType
-> TimeNibbleType -> TimeNibbleType -> [TimeNibbleType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TimeNibbleType
-> TimeNibbleType -> TimeNibbleType -> [TimeNibbleType]
$cenumFromThenTo :: TimeNibbleType
-> TimeNibbleType -> TimeNibbleType -> [TimeNibbleType]
enumFromTo :: TimeNibbleType -> TimeNibbleType -> [TimeNibbleType]
$cenumFromTo :: TimeNibbleType -> TimeNibbleType -> [TimeNibbleType]
enumFromThen :: TimeNibbleType -> TimeNibbleType -> [TimeNibbleType]
$cenumFromThen :: TimeNibbleType -> TimeNibbleType -> [TimeNibbleType]
enumFrom :: TimeNibbleType -> [TimeNibbleType]
$cenumFrom :: TimeNibbleType -> [TimeNibbleType]
fromEnum :: TimeNibbleType -> Int
$cfromEnum :: TimeNibbleType -> Int
toEnum :: Int -> TimeNibbleType
$ctoEnum :: Int -> TimeNibbleType
pred :: TimeNibbleType -> TimeNibbleType
$cpred :: TimeNibbleType -> TimeNibbleType
succ :: TimeNibbleType -> TimeNibbleType
$csucc :: TimeNibbleType -> TimeNibbleType
Enum, Ord TimeNibbleType
(TimeNibbleType, TimeNibbleType) -> Int
(TimeNibbleType, TimeNibbleType) -> [TimeNibbleType]
(TimeNibbleType, TimeNibbleType) -> TimeNibbleType -> Bool
(TimeNibbleType, TimeNibbleType) -> TimeNibbleType -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (TimeNibbleType, TimeNibbleType) -> Int
$cunsafeRangeSize :: (TimeNibbleType, TimeNibbleType) -> Int
rangeSize :: (TimeNibbleType, TimeNibbleType) -> Int
$crangeSize :: (TimeNibbleType, TimeNibbleType) -> Int
inRange :: (TimeNibbleType, TimeNibbleType) -> TimeNibbleType -> Bool
$cinRange :: (TimeNibbleType, TimeNibbleType) -> TimeNibbleType -> Bool
unsafeIndex :: (TimeNibbleType, TimeNibbleType) -> TimeNibbleType -> Int
$cunsafeIndex :: (TimeNibbleType, TimeNibbleType) -> TimeNibbleType -> Int
index :: (TimeNibbleType, TimeNibbleType) -> TimeNibbleType -> Int
$cindex :: (TimeNibbleType, TimeNibbleType) -> TimeNibbleType -> Int
range :: (TimeNibbleType, TimeNibbleType) -> [TimeNibbleType]
$crange :: (TimeNibbleType, TimeNibbleType) -> [TimeNibbleType]
Ix)


-- * serialization

get :: Parser.C parser => Int -> Parser.Fragile parser T
get :: forall (parser :: * -> *). C parser => Int -> Fragile parser T
get Int
code =
   case Int
code of
      Int
0xF1 ->
         do Int
dat <- forall (parser :: * -> *). C parser => Fragile parser Int
get1
            let (Int
nib, Int
value)  = forall a. Integral a => Int -> a -> (a, a)
Bit.splitAt Int
4 Int
dat
            let (Int
msb, Int
nibble) = forall a. Integral a => Int -> a -> (a, a)
Bit.splitAt Int
3 Int
nib
            forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (parser :: * -> *). C parser => Bool -> String -> parser ()
Parser.warnIf (Int
msbforall a. Eq a => a -> a -> Bool
/=Int
0)
               String
"TimeCodeQuarterFrame: most significant bit must 0"
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TimeNibbleType -> Int -> T
TimeCodeQuarterFrame (forall a. Enum a => Int -> a
toEnum Int
nibble) Int
value
      Int
0xF2 -> forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\Int
lsb Int
msb -> Int -> T
SongPositionPointer (Int
lsb forall a. Num a => a -> a -> a
+ forall a. Bits a => Int -> a -> a
Bit.shiftL Int
7 Int
msb)) forall (parser :: * -> *). C parser => Fragile parser Int
get1 forall (parser :: * -> *). C parser => Fragile parser Int
get1
      Int
0xF3 -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Int -> T
SongSelect forall (parser :: * -> *). C parser => Fragile parser Int
get1
      Int
0xF6 -> forall (m :: * -> *) a. Monad m => a -> m a
return T
TuneRequest
      Int
_    -> forall (m :: * -> *) a. Monad m => String -> T m a
Parser.giveUp (String
"invalid System Common code:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
code)

put :: Writer.C writer => T -> writer
put :: forall writer. C writer => T -> writer
put T
msg =
   case T
msg of
      TimeCodeQuarterFrame TimeNibbleType
nibble Int
value ->
         forall m. C m => Word8 -> m
Writer.putByte Word8
0xF1 forall m. Monoid m => m -> m -> m
+#+
         forall writer. C writer => Int -> writer
Writer.putIntAsByte (forall a. Bits a => Int -> a -> a
Bit.shiftL Int
4 (forall a. Enum a => a -> Int
fromEnum TimeNibbleType
nibble) forall a. Num a => a -> a -> a
+ Int
value)
      SongPositionPointer Int
pos ->
         forall m. C m => Word8 -> m
Writer.putByte Word8
0xF2 forall m. Monoid m => m -> m -> m
+#+
            let (Int
msb,Int
lsb) = forall a. Integral a => Int -> a -> (a, a)
Bit.splitAt Int
7 Int
pos
            in  forall writer. C writer => Int -> writer
Writer.putIntAsByte Int
lsb forall m. Monoid m => m -> m -> m
+#+
                forall writer. C writer => Int -> writer
Writer.putIntAsByte Int
msb
      SongSelect Int
song ->
         forall m. C m => Word8 -> m
Writer.putByte Word8
0xF3 forall m. Monoid m => m -> m -> m
+#+
         forall writer. C writer => Int -> writer
Writer.putIntAsByte Int
song
      T
TuneRequest ->
         forall m. C m => Word8 -> m
Writer.putByte Word8
0xF6