{-# OPTIONS_GHC -funbox-strict-fields #-}
module Midi.Midi (
WriteMessages, ReadMessages
, WriteMessage(..), ReadMessage(..)
, ReadDevice, WriteDevice, read_device, write_device
, read_device_text, write_device_text
, peek_wdev, peek_rdev, with_wdev, with_rdev
, add_timestamp, modify_timestamp
, program_change, reset_channel
, realtime_sysex
, pitch_bend_range, nrpn_tuning
, MpeZone(..), mpe_2_to_16
, rpn, nrpn
, set_channel
, valid_msg, valid_chan_msg, is_cc, is_sysex, is_note, is_note_on, is_state
, is_pitched
, channel_message, message_channel
, Message(..), Channel, Velocity, Control, Program, ControlValue
, PitchBendValue, Manufacturer
, Key(..), from_key, to_key, to_closest_key
, ChannelMessage(..), CommonMessage(..), RealtimeMessage(..)
, Mtc(..), FrameRate(..), SmpteFragment(..), Smpte(..)
, seconds_to_frame, frame_to_seconds, frame_to_smpte, seconds_to_smpte
, generate_mtc
, mtc_sync, mtc_fragments
, NoteNumber
, realtime_tuning
, join14, split14, join4, split4
, manufacturer_name
, yamaha_code, korg_code
) where
import qualified Control.DeepSeq as DeepSeq
import Control.DeepSeq (rnf)
import qualified Data.Bits as Bits
import Data.Bits ((.&.), (.|.))
import qualified Data.ByteString as ByteString
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Text.Encoding as Encoding
import Data.Word (Word8)
import qualified Foreign.C
import qualified Util.FFI as FFI
import qualified Util.Num as Num
import qualified Util.Pretty as Pretty
import Util.Pretty (format, (<+>))
import qualified Util.Seq as Seq
import qualified Util.Serialize as Serialize
import qualified Midi.CC as CC
import Perform.RealTime (RealTime)
import Global
type WriteMessages = [WriteMessage]
type ReadMessages = [ReadMessage]
data WriteMessage = WriteMessage {
WriteMessage -> WriteDevice
wmsg_dev :: !WriteDevice
, WriteMessage -> RealTime
wmsg_ts :: !RealTime
, WriteMessage -> Message
wmsg_msg :: !Message
} deriving (WriteMessage -> WriteMessage -> Bool
(WriteMessage -> WriteMessage -> Bool)
-> (WriteMessage -> WriteMessage -> Bool) -> Eq WriteMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriteMessage -> WriteMessage -> Bool
$c/= :: WriteMessage -> WriteMessage -> Bool
== :: WriteMessage -> WriteMessage -> Bool
$c== :: WriteMessage -> WriteMessage -> Bool
Eq, Eq WriteMessage
Eq WriteMessage
-> (WriteMessage -> WriteMessage -> Ordering)
-> (WriteMessage -> WriteMessage -> Bool)
-> (WriteMessage -> WriteMessage -> Bool)
-> (WriteMessage -> WriteMessage -> Bool)
-> (WriteMessage -> WriteMessage -> Bool)
-> (WriteMessage -> WriteMessage -> WriteMessage)
-> (WriteMessage -> WriteMessage -> WriteMessage)
-> Ord WriteMessage
WriteMessage -> WriteMessage -> Bool
WriteMessage -> WriteMessage -> Ordering
WriteMessage -> WriteMessage -> WriteMessage
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 :: WriteMessage -> WriteMessage -> WriteMessage
$cmin :: WriteMessage -> WriteMessage -> WriteMessage
max :: WriteMessage -> WriteMessage -> WriteMessage
$cmax :: WriteMessage -> WriteMessage -> WriteMessage
>= :: WriteMessage -> WriteMessage -> Bool
$c>= :: WriteMessage -> WriteMessage -> Bool
> :: WriteMessage -> WriteMessage -> Bool
$c> :: WriteMessage -> WriteMessage -> Bool
<= :: WriteMessage -> WriteMessage -> Bool
$c<= :: WriteMessage -> WriteMessage -> Bool
< :: WriteMessage -> WriteMessage -> Bool
$c< :: WriteMessage -> WriteMessage -> Bool
compare :: WriteMessage -> WriteMessage -> Ordering
$ccompare :: WriteMessage -> WriteMessage -> Ordering
Ord, ReadPrec [WriteMessage]
ReadPrec WriteMessage
Int -> ReadS WriteMessage
ReadS [WriteMessage]
(Int -> ReadS WriteMessage)
-> ReadS [WriteMessage]
-> ReadPrec WriteMessage
-> ReadPrec [WriteMessage]
-> Read WriteMessage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WriteMessage]
$creadListPrec :: ReadPrec [WriteMessage]
readPrec :: ReadPrec WriteMessage
$creadPrec :: ReadPrec WriteMessage
readList :: ReadS [WriteMessage]
$creadList :: ReadS [WriteMessage]
readsPrec :: Int -> ReadS WriteMessage
$creadsPrec :: Int -> ReadS WriteMessage
Read, Int -> WriteMessage -> ShowS
[WriteMessage] -> ShowS
WriteMessage -> String
(Int -> WriteMessage -> ShowS)
-> (WriteMessage -> String)
-> ([WriteMessage] -> ShowS)
-> Show WriteMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriteMessage] -> ShowS
$cshowList :: [WriteMessage] -> ShowS
show :: WriteMessage -> String
$cshow :: WriteMessage -> String
showsPrec :: Int -> WriteMessage -> ShowS
$cshowsPrec :: Int -> WriteMessage -> ShowS
Show)
data ReadMessage = ReadMessage {
ReadMessage -> ReadDevice
rmsg_dev :: !ReadDevice
, ReadMessage -> RealTime
rmsg_ts :: !RealTime
, ReadMessage -> Message
rmsg_msg :: !Message
} deriving (ReadMessage -> ReadMessage -> Bool
(ReadMessage -> ReadMessage -> Bool)
-> (ReadMessage -> ReadMessage -> Bool) -> Eq ReadMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadMessage -> ReadMessage -> Bool
$c/= :: ReadMessage -> ReadMessage -> Bool
== :: ReadMessage -> ReadMessage -> Bool
$c== :: ReadMessage -> ReadMessage -> Bool
Eq, Eq ReadMessage
Eq ReadMessage
-> (ReadMessage -> ReadMessage -> Ordering)
-> (ReadMessage -> ReadMessage -> Bool)
-> (ReadMessage -> ReadMessage -> Bool)
-> (ReadMessage -> ReadMessage -> Bool)
-> (ReadMessage -> ReadMessage -> Bool)
-> (ReadMessage -> ReadMessage -> ReadMessage)
-> (ReadMessage -> ReadMessage -> ReadMessage)
-> Ord ReadMessage
ReadMessage -> ReadMessage -> Bool
ReadMessage -> ReadMessage -> Ordering
ReadMessage -> ReadMessage -> ReadMessage
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 :: ReadMessage -> ReadMessage -> ReadMessage
$cmin :: ReadMessage -> ReadMessage -> ReadMessage
max :: ReadMessage -> ReadMessage -> ReadMessage
$cmax :: ReadMessage -> ReadMessage -> ReadMessage
>= :: ReadMessage -> ReadMessage -> Bool
$c>= :: ReadMessage -> ReadMessage -> Bool
> :: ReadMessage -> ReadMessage -> Bool
$c> :: ReadMessage -> ReadMessage -> Bool
<= :: ReadMessage -> ReadMessage -> Bool
$c<= :: ReadMessage -> ReadMessage -> Bool
< :: ReadMessage -> ReadMessage -> Bool
$c< :: ReadMessage -> ReadMessage -> Bool
compare :: ReadMessage -> ReadMessage -> Ordering
$ccompare :: ReadMessage -> ReadMessage -> Ordering
Ord, ReadPrec [ReadMessage]
ReadPrec ReadMessage
Int -> ReadS ReadMessage
ReadS [ReadMessage]
(Int -> ReadS ReadMessage)
-> ReadS [ReadMessage]
-> ReadPrec ReadMessage
-> ReadPrec [ReadMessage]
-> Read ReadMessage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReadMessage]
$creadListPrec :: ReadPrec [ReadMessage]
readPrec :: ReadPrec ReadMessage
$creadPrec :: ReadPrec ReadMessage
readList :: ReadS [ReadMessage]
$creadList :: ReadS [ReadMessage]
readsPrec :: Int -> ReadS ReadMessage
$creadsPrec :: Int -> ReadS ReadMessage
Read, Int -> ReadMessage -> ShowS
[ReadMessage] -> ShowS
ReadMessage -> String
(Int -> ReadMessage -> ShowS)
-> (ReadMessage -> String)
-> ([ReadMessage] -> ShowS)
-> Show ReadMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadMessage] -> ShowS
$cshowList :: [ReadMessage] -> ShowS
show :: ReadMessage -> String
$cshow :: ReadMessage -> String
showsPrec :: Int -> ReadMessage -> ShowS
$cshowsPrec :: Int -> ReadMessage -> ShowS
Show)
instance DeepSeq.NFData WriteMessage where rnf :: WriteMessage -> ()
rnf WriteMessage
_ = ()
instance DeepSeq.NFData ReadMessage where rnf :: ReadMessage -> ()
rnf ReadMessage
_ = ()
instance Pretty ReadMessage where
pretty :: ReadMessage -> Text
pretty (ReadMessage ReadDevice
dev RealTime
ts Message
msg) =
ReadDevice -> Text
forall a. Pretty a => a -> Text
pretty ReadDevice
dev Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealTime -> Text
forall a. Pretty a => a -> Text
pretty RealTime
ts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Message -> Text
forall a. Pretty a => a -> Text
pretty Message
msg
instance Pretty WriteMessage where
pretty :: WriteMessage -> Text
pretty (WriteMessage WriteDevice
dev RealTime
ts Message
msg) =
WriteDevice -> Text
forall a. Pretty a => a -> Text
pretty WriteDevice
dev Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealTime -> Text
forall a. Pretty a => a -> Text
pretty RealTime
ts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Message -> Text
forall a. Pretty a => a -> Text
pretty Message
msg
newtype ReadDevice = ReadDevice ByteString.ByteString
deriving (ReadDevice -> ReadDevice -> Bool
(ReadDevice -> ReadDevice -> Bool)
-> (ReadDevice -> ReadDevice -> Bool) -> Eq ReadDevice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadDevice -> ReadDevice -> Bool
$c/= :: ReadDevice -> ReadDevice -> Bool
== :: ReadDevice -> ReadDevice -> Bool
$c== :: ReadDevice -> ReadDevice -> Bool
Eq, Eq ReadDevice
Eq ReadDevice
-> (ReadDevice -> ReadDevice -> Ordering)
-> (ReadDevice -> ReadDevice -> Bool)
-> (ReadDevice -> ReadDevice -> Bool)
-> (ReadDevice -> ReadDevice -> Bool)
-> (ReadDevice -> ReadDevice -> Bool)
-> (ReadDevice -> ReadDevice -> ReadDevice)
-> (ReadDevice -> ReadDevice -> ReadDevice)
-> Ord ReadDevice
ReadDevice -> ReadDevice -> Bool
ReadDevice -> ReadDevice -> Ordering
ReadDevice -> ReadDevice -> ReadDevice
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 :: ReadDevice -> ReadDevice -> ReadDevice
$cmin :: ReadDevice -> ReadDevice -> ReadDevice
max :: ReadDevice -> ReadDevice -> ReadDevice
$cmax :: ReadDevice -> ReadDevice -> ReadDevice
>= :: ReadDevice -> ReadDevice -> Bool
$c>= :: ReadDevice -> ReadDevice -> Bool
> :: ReadDevice -> ReadDevice -> Bool
$c> :: ReadDevice -> ReadDevice -> Bool
<= :: ReadDevice -> ReadDevice -> Bool
$c<= :: ReadDevice -> ReadDevice -> Bool
< :: ReadDevice -> ReadDevice -> Bool
$c< :: ReadDevice -> ReadDevice -> Bool
compare :: ReadDevice -> ReadDevice -> Ordering
$ccompare :: ReadDevice -> ReadDevice -> Ordering
Ord, Int -> ReadDevice -> ShowS
[ReadDevice] -> ShowS
ReadDevice -> String
(Int -> ReadDevice -> ShowS)
-> (ReadDevice -> String)
-> ([ReadDevice] -> ShowS)
-> Show ReadDevice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadDevice] -> ShowS
$cshowList :: [ReadDevice] -> ShowS
show :: ReadDevice -> String
$cshow :: ReadDevice -> String
showsPrec :: Int -> ReadDevice -> ShowS
$cshowsPrec :: Int -> ReadDevice -> ShowS
Show, ReadPrec [ReadDevice]
ReadPrec ReadDevice
Int -> ReadS ReadDevice
ReadS [ReadDevice]
(Int -> ReadS ReadDevice)
-> ReadS [ReadDevice]
-> ReadPrec ReadDevice
-> ReadPrec [ReadDevice]
-> Read ReadDevice
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReadDevice]
$creadListPrec :: ReadPrec [ReadDevice]
readPrec :: ReadPrec ReadDevice
$creadPrec :: ReadPrec ReadDevice
readList :: ReadS [ReadDevice]
$creadList :: ReadS [ReadDevice]
readsPrec :: Int -> ReadS ReadDevice
$creadsPrec :: Int -> ReadS ReadDevice
Read, Get ReadDevice
Putter ReadDevice
Putter ReadDevice -> Get ReadDevice -> Serialize ReadDevice
forall a. Putter a -> Get a -> Serialize a
get :: Get ReadDevice
$cget :: Get ReadDevice
put :: Putter ReadDevice
$cput :: Putter ReadDevice
Serialize.Serialize)
newtype WriteDevice = WriteDevice ByteString.ByteString
deriving (WriteDevice -> WriteDevice -> Bool
(WriteDevice -> WriteDevice -> Bool)
-> (WriteDevice -> WriteDevice -> Bool) -> Eq WriteDevice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriteDevice -> WriteDevice -> Bool
$c/= :: WriteDevice -> WriteDevice -> Bool
== :: WriteDevice -> WriteDevice -> Bool
$c== :: WriteDevice -> WriteDevice -> Bool
Eq, Eq WriteDevice
Eq WriteDevice
-> (WriteDevice -> WriteDevice -> Ordering)
-> (WriteDevice -> WriteDevice -> Bool)
-> (WriteDevice -> WriteDevice -> Bool)
-> (WriteDevice -> WriteDevice -> Bool)
-> (WriteDevice -> WriteDevice -> Bool)
-> (WriteDevice -> WriteDevice -> WriteDevice)
-> (WriteDevice -> WriteDevice -> WriteDevice)
-> Ord WriteDevice
WriteDevice -> WriteDevice -> Bool
WriteDevice -> WriteDevice -> Ordering
WriteDevice -> WriteDevice -> WriteDevice
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 :: WriteDevice -> WriteDevice -> WriteDevice
$cmin :: WriteDevice -> WriteDevice -> WriteDevice
max :: WriteDevice -> WriteDevice -> WriteDevice
$cmax :: WriteDevice -> WriteDevice -> WriteDevice
>= :: WriteDevice -> WriteDevice -> Bool
$c>= :: WriteDevice -> WriteDevice -> Bool
> :: WriteDevice -> WriteDevice -> Bool
$c> :: WriteDevice -> WriteDevice -> Bool
<= :: WriteDevice -> WriteDevice -> Bool
$c<= :: WriteDevice -> WriteDevice -> Bool
< :: WriteDevice -> WriteDevice -> Bool
$c< :: WriteDevice -> WriteDevice -> Bool
compare :: WriteDevice -> WriteDevice -> Ordering
$ccompare :: WriteDevice -> WriteDevice -> Ordering
Ord, Int -> WriteDevice -> ShowS
[WriteDevice] -> ShowS
WriteDevice -> String
(Int -> WriteDevice -> ShowS)
-> (WriteDevice -> String)
-> ([WriteDevice] -> ShowS)
-> Show WriteDevice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriteDevice] -> ShowS
$cshowList :: [WriteDevice] -> ShowS
show :: WriteDevice -> String
$cshow :: WriteDevice -> String
showsPrec :: Int -> WriteDevice -> ShowS
$cshowsPrec :: Int -> WriteDevice -> ShowS
Show, ReadPrec [WriteDevice]
ReadPrec WriteDevice
Int -> ReadS WriteDevice
ReadS [WriteDevice]
(Int -> ReadS WriteDevice)
-> ReadS [WriteDevice]
-> ReadPrec WriteDevice
-> ReadPrec [WriteDevice]
-> Read WriteDevice
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WriteDevice]
$creadListPrec :: ReadPrec [WriteDevice]
readPrec :: ReadPrec WriteDevice
$creadPrec :: ReadPrec WriteDevice
readList :: ReadS [WriteDevice]
$creadList :: ReadS [WriteDevice]
readsPrec :: Int -> ReadS WriteDevice
$creadsPrec :: Int -> ReadS WriteDevice
Read, Get WriteDevice
Putter WriteDevice
Putter WriteDevice -> Get WriteDevice -> Serialize WriteDevice
forall a. Putter a -> Get a -> Serialize a
get :: Get WriteDevice
$cget :: Get WriteDevice
put :: Putter WriteDevice
$cput :: Putter WriteDevice
Serialize.Serialize)
read_device :: Text -> ReadDevice
read_device :: Text -> ReadDevice
read_device = ByteString -> ReadDevice
ReadDevice (ByteString -> ReadDevice)
-> (Text -> ByteString) -> Text -> ReadDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Encoding.encodeUtf8
write_device :: Text -> WriteDevice
write_device :: Text -> WriteDevice
write_device = ByteString -> WriteDevice
WriteDevice (ByteString -> WriteDevice)
-> (Text -> ByteString) -> Text -> WriteDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Encoding.encodeUtf8
read_device_text :: ReadDevice -> Text
read_device_text :: ReadDevice -> Text
read_device_text (ReadDevice ByteString
bs) = ByteString -> Text
FFI.decodeUtf8 ByteString
bs
write_device_text :: WriteDevice -> Text
write_device_text :: WriteDevice -> Text
write_device_text (WriteDevice ByteString
bs) = ByteString -> Text
FFI.decodeUtf8 ByteString
bs
peek_wdev :: Foreign.C.CString -> IO WriteDevice
peek_wdev :: CString -> IO WriteDevice
peek_wdev = (ByteString -> WriteDevice) -> IO ByteString -> IO WriteDevice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> WriteDevice
WriteDevice (IO ByteString -> IO WriteDevice)
-> (CString -> IO ByteString) -> CString -> IO WriteDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> IO ByteString
ByteString.packCString
peek_rdev :: Foreign.C.CString -> IO ReadDevice
peek_rdev :: CString -> IO ReadDevice
peek_rdev = (ByteString -> ReadDevice) -> IO ByteString -> IO ReadDevice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ReadDevice
ReadDevice (IO ByteString -> IO ReadDevice)
-> (CString -> IO ByteString) -> CString -> IO ReadDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> IO ByteString
ByteString.packCString
with_wdev :: WriteDevice -> (Foreign.C.CString -> IO a) -> IO a
with_wdev :: forall a. WriteDevice -> (CString -> IO a) -> IO a
with_wdev (WriteDevice ByteString
dev) = ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
ByteString.useAsCString ByteString
dev
with_rdev :: ReadDevice -> (Foreign.C.CString -> IO a) -> IO a
with_rdev :: forall a. ReadDevice -> (CString -> IO a) -> IO a
with_rdev (ReadDevice ByteString
dev) = ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
ByteString.useAsCString ByteString
dev
instance Pretty ReadDevice where pretty :: ReadDevice -> Text
pretty = ReadDevice -> Text
read_device_text
instance Pretty WriteDevice where pretty :: WriteDevice -> Text
pretty = WriteDevice -> Text
write_device_text
add_timestamp :: RealTime -> WriteMessage -> WriteMessage
add_timestamp :: RealTime -> WriteMessage -> WriteMessage
add_timestamp RealTime
ts WriteMessage
wmsg = WriteMessage
wmsg { wmsg_ts :: RealTime
wmsg_ts = WriteMessage -> RealTime
wmsg_ts WriteMessage
wmsg RealTime -> RealTime -> RealTime
forall a. Num a => a -> a -> a
+ RealTime
ts }
modify_timestamp :: (RealTime -> RealTime) -> WriteMessage -> WriteMessage
modify_timestamp :: (RealTime -> RealTime) -> WriteMessage -> WriteMessage
modify_timestamp RealTime -> RealTime
f WriteMessage
wmsg = WriteMessage
wmsg { wmsg_ts :: RealTime
wmsg_ts = RealTime -> RealTime
f (WriteMessage -> RealTime
wmsg_ts WriteMessage
wmsg) }
program_change :: Int -> Program -> [ChannelMessage]
program_change :: Int -> Manufacturer -> [ChannelMessage]
program_change Int
bank Manufacturer
program =
[ Manufacturer -> Manufacturer -> ChannelMessage
ControlChange Manufacturer
CC.bank Manufacturer
msb, Manufacturer -> Manufacturer -> ChannelMessage
ControlChange Manufacturer
CC.bank_lsb Manufacturer
lsb
, Manufacturer -> ChannelMessage
ProgramChange Manufacturer
program
]
where (Manufacturer
lsb, Manufacturer
msb) = Int -> (Manufacturer, Manufacturer)
split14 Int
bank
reset_channel :: Channel -> [Message]
reset_channel :: Manufacturer -> [Message]
reset_channel Manufacturer
chan =
[ Manufacturer -> ChannelMessage -> Message
ChannelMessage Manufacturer
chan ChannelMessage
AllSoundOff
, Manufacturer -> ChannelMessage -> Message
ChannelMessage Manufacturer
chan ChannelMessage
ResetAllControls
]
realtime_sysex :: ByteString.ByteString -> Message
realtime_sysex :: ByteString -> Message
realtime_sysex = CommonMessage -> Message
CommonMessage (CommonMessage -> Message)
-> (ByteString -> CommonMessage) -> ByteString -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Manufacturer -> ByteString -> CommonMessage
SystemExclusive Manufacturer
0x7f
pitch_bend_range :: Double -> [ChannelMessage]
pitch_bend_range :: Double -> [ChannelMessage]
pitch_bend_range Double
range = (Manufacturer, Manufacturer)
-> (Manufacturer, Manufacturer) -> [ChannelMessage]
rpn (Manufacturer
0, Manufacturer
0) (Manufacturer
semitones, Manufacturer
cents) [ChannelMessage] -> [ChannelMessage] -> [ChannelMessage]
forall a. [a] -> [a] -> [a]
++ [ChannelMessage]
cancel_rpn
where
(Manufacturer
semitones, Double
frac) = Double -> (Manufacturer, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Double
range
cents :: Manufacturer
cents = Double -> Manufacturer
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
frac Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100)
data MpeZone = Lower | Upper deriving (MpeZone -> MpeZone -> Bool
(MpeZone -> MpeZone -> Bool)
-> (MpeZone -> MpeZone -> Bool) -> Eq MpeZone
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MpeZone -> MpeZone -> Bool
$c/= :: MpeZone -> MpeZone -> Bool
== :: MpeZone -> MpeZone -> Bool
$c== :: MpeZone -> MpeZone -> Bool
Eq, Int -> MpeZone -> ShowS
[MpeZone] -> ShowS
MpeZone -> String
(Int -> MpeZone -> ShowS)
-> (MpeZone -> String) -> ([MpeZone] -> ShowS) -> Show MpeZone
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MpeZone] -> ShowS
$cshowList :: [MpeZone] -> ShowS
show :: MpeZone -> String
$cshow :: MpeZone -> String
showsPrec :: Int -> MpeZone -> ShowS
$cshowsPrec :: Int -> MpeZone -> ShowS
Show)
mpe_2_to_16 :: [Message]
mpe_2_to_16 :: [Message]
mpe_2_to_16 = MpeZone -> Maybe Manufacturer -> [Message]
mpe_configure MpeZone
Lower (Manufacturer -> Maybe Manufacturer
forall a. a -> Maybe a
Just Manufacturer
15)
mpe_configure :: MpeZone -> Maybe Channel -> [Message]
mpe_configure :: MpeZone -> Maybe Manufacturer -> [Message]
mpe_configure MpeZone
zone Maybe Manufacturer
channels =
(ChannelMessage -> Message) -> [ChannelMessage] -> [Message]
forall a b. (a -> b) -> [a] -> [b]
map (Manufacturer -> ChannelMessage -> Message
ChannelMessage Manufacturer
chan) ((Manufacturer, Manufacturer)
-> (Manufacturer, Manufacturer) -> [ChannelMessage]
rpn (Manufacturer
0, Manufacturer
6) (Manufacturer -> Maybe Manufacturer -> Manufacturer
forall a. a -> Maybe a -> a
fromMaybe Manufacturer
0 Maybe Manufacturer
channels, Manufacturer
0))
where
chan :: Manufacturer
chan = case MpeZone
zone of
MpeZone
Lower -> Manufacturer
0
MpeZone
Upper -> Manufacturer
15
nrpn_tuning :: [(Key, NoteNumber)] -> [ChannelMessage]
nrpn_tuning :: [(Key, Double)] -> [ChannelMessage]
nrpn_tuning = ((Key, Double) -> [ChannelMessage])
-> [(Key, Double)] -> [ChannelMessage]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Key, Double) -> [ChannelMessage]
forall {b}. RealFrac b => (Key, b) -> [ChannelMessage]
retune_key
where
retune_key :: (Key, b) -> [ChannelMessage]
retune_key (Key
key, b
nn) = [[ChannelMessage]] -> [ChannelMessage]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ Manufacturer -> Manufacturer -> [ChannelMessage]
emit Manufacturer
50 (Key -> Manufacturer
forall a. Num a => Key -> a
from_key Key
key)
, Manufacturer -> Manufacturer -> [ChannelMessage]
emit Manufacturer
51 Manufacturer
to_key
, (Manufacturer, Manufacturer)
-> (Manufacturer, Manufacturer) -> [ChannelMessage]
nrpn (Manufacturer
0, Manufacturer
52) (Manufacturer
msb, Manufacturer
lsb)
]
where
emit :: Manufacturer -> Manufacturer -> [ChannelMessage]
emit Manufacturer
key Manufacturer
value = (Manufacturer, Manufacturer)
-> (Manufacturer, Manufacturer) -> [ChannelMessage]
nrpn (Manufacturer
0, Manufacturer
key) (Manufacturer
value, Manufacturer
0)
(Manufacturer
lsb, Manufacturer
msb) = Int -> (Manufacturer, Manufacturer)
split14 (Int -> (Manufacturer, Manufacturer))
-> Int -> (Manufacturer, Manufacturer)
forall a b. (a -> b) -> a -> b
$ b -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (b -> Int) -> b -> Int
forall a b. (a -> b) -> a -> b
$ b
frac b -> b -> b
forall a. Num a => a -> a -> a
* b
centicent
centicent :: b
centicent = b
100 b -> b -> b
forall a. Num a => a -> a -> a
* b
100
(Manufacturer
to_key, b
frac) = b -> (Manufacturer, b)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction b
nn
rpn :: (ControlValue, ControlValue) -> (ControlValue, ControlValue)
-> [ChannelMessage]
rpn :: (Manufacturer, Manufacturer)
-> (Manufacturer, Manufacturer) -> [ChannelMessage]
rpn (Manufacturer
key_msb, Manufacturer
key_lsb) (Manufacturer
value_msb, Manufacturer
value_lsb) =
[ Manufacturer -> Manufacturer -> ChannelMessage
ControlChange Manufacturer
CC.rpn_msb Manufacturer
key_msb
, Manufacturer -> Manufacturer -> ChannelMessage
ControlChange Manufacturer
CC.rpn_lsb Manufacturer
key_lsb
, Manufacturer -> Manufacturer -> ChannelMessage
ControlChange Manufacturer
CC.data_entry Manufacturer
value_msb
, Manufacturer -> Manufacturer -> ChannelMessage
ControlChange Manufacturer
CC.data_entry_lsb Manufacturer
value_lsb
]
cancel_rpn :: [ChannelMessage]
cancel_rpn :: [ChannelMessage]
cancel_rpn = [Manufacturer -> Manufacturer -> ChannelMessage
ControlChange Manufacturer
CC.rpn_msb Manufacturer
127, Manufacturer -> Manufacturer -> ChannelMessage
ControlChange Manufacturer
CC.rpn_lsb Manufacturer
127]
nrpn :: (ControlValue, ControlValue) -> (ControlValue, ControlValue)
-> [ChannelMessage]
nrpn :: (Manufacturer, Manufacturer)
-> (Manufacturer, Manufacturer) -> [ChannelMessage]
nrpn (Manufacturer
key_msb, Manufacturer
key_lsb) (Manufacturer
value_msb, Manufacturer
value_lsb) =
[ Manufacturer -> Manufacturer -> ChannelMessage
ControlChange Manufacturer
CC.nrpn_msb Manufacturer
key_msb
, Manufacturer -> Manufacturer -> ChannelMessage
ControlChange Manufacturer
CC.nrpn_lsb Manufacturer
key_lsb
, Manufacturer -> Manufacturer -> ChannelMessage
ControlChange Manufacturer
CC.data_entry Manufacturer
value_msb
, Manufacturer -> Manufacturer -> ChannelMessage
ControlChange Manufacturer
CC.data_entry_lsb Manufacturer
value_lsb
]
set_channel :: Channel -> Message -> Message
set_channel :: Manufacturer -> Message -> Message
set_channel Manufacturer
chan (ChannelMessage Manufacturer
_ ChannelMessage
msg) = Manufacturer -> ChannelMessage -> Message
ChannelMessage Manufacturer
chan ChannelMessage
msg
set_channel Manufacturer
_ Message
msg = Message
msg
valid_msg :: Message -> Bool
valid_msg :: Message -> Bool
valid_msg (ChannelMessage Manufacturer
chan ChannelMessage
msg) =
Manufacturer
0 Manufacturer -> Manufacturer -> Bool
forall a. Ord a => a -> a -> Bool
<= Manufacturer
chan Bool -> Bool -> Bool
&& Manufacturer
chan Manufacturer -> Manufacturer -> Bool
forall a. Ord a => a -> a -> Bool
< Manufacturer
16 Bool -> Bool -> Bool
&& ChannelMessage -> Bool
valid_chan_msg ChannelMessage
msg
valid_msg Message
_ = Bool
True
valid_chan_msg :: ChannelMessage -> Bool
valid_chan_msg :: ChannelMessage -> Bool
valid_chan_msg ChannelMessage
msg = case ChannelMessage
msg of
ControlChange Manufacturer
cc Manufacturer
val -> Manufacturer -> Bool
forall {a}. (Ord a, Num a) => a -> Bool
val7 Manufacturer
cc Bool -> Bool -> Bool
&& Manufacturer -> Bool
forall {a}. (Ord a, Num a) => a -> Bool
val7 Manufacturer
val
NoteOn (Key Int
key) Manufacturer
vel -> Int -> Bool
forall {a}. (Ord a, Num a) => a -> Bool
val7 Int
key Bool -> Bool -> Bool
&& Manufacturer -> Bool
forall {a}. (Ord a, Num a) => a -> Bool
val7 Manufacturer
vel
NoteOff (Key Int
key) Manufacturer
vel -> Int -> Bool
forall {a}. (Ord a, Num a) => a -> Bool
val7 Int
key Bool -> Bool -> Bool
&& Manufacturer -> Bool
forall {a}. (Ord a, Num a) => a -> Bool
val7 Manufacturer
vel
PitchBend PitchBendValue
val -> -PitchBendValue
1 PitchBendValue -> PitchBendValue -> Bool
forall a. Ord a => a -> a -> Bool
<= PitchBendValue
val Bool -> Bool -> Bool
&& PitchBendValue
val PitchBendValue -> PitchBendValue -> Bool
forall a. Ord a => a -> a -> Bool
<= PitchBendValue
1
ChannelMessage
_ -> Bool
True
where val7 :: a -> Bool
val7 a
v = a
0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
v Bool -> Bool -> Bool
&& a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
128
is_cc :: Message -> Bool
is_cc :: Message -> Bool
is_cc (ChannelMessage Manufacturer
_ (ControlChange Manufacturer
_ Manufacturer
_)) = Bool
True
is_cc Message
_ = Bool
False
is_sysex :: Message -> Bool
is_sysex :: Message -> Bool
is_sysex (CommonMessage (SystemExclusive Manufacturer
_ ByteString
_)) = Bool
True
is_sysex Message
_ = Bool
False
is_note :: Message -> Bool
is_note :: Message -> Bool
is_note (ChannelMessage Manufacturer
_ (NoteOn Key
_ Manufacturer
_)) = Bool
True
is_note (ChannelMessage Manufacturer
_ (NoteOff Key
_ Manufacturer
_)) = Bool
True
is_note Message
_ = Bool
False
is_note_on :: Message -> Bool
is_note_on :: Message -> Bool
is_note_on (ChannelMessage Manufacturer
_ (NoteOn Key
_ Manufacturer
_)) = Bool
True
is_note_on Message
_ = Bool
False
is_state :: Message -> Bool
is_state :: Message -> Bool
is_state (ChannelMessage Manufacturer
_ ChannelMessage
msg) = case ChannelMessage
msg of
NoteOn {} -> Bool
False
NoteOff {} -> Bool
False
ChannelMessage
_ -> Bool
True
is_state Message
_ = Bool
False
is_pitched :: Message -> Bool
is_pitched :: Message -> Bool
is_pitched Message
msg = Message -> Bool
is_note Message
msg Bool -> Bool -> Bool
|| case Message
msg of
ChannelMessage Manufacturer
_ (PitchBend PitchBendValue
_) -> Bool
True
Message
_ -> Bool
False
channel_message :: Message -> Maybe ChannelMessage
channel_message :: Message -> Maybe ChannelMessage
channel_message (ChannelMessage Manufacturer
_ ChannelMessage
m) = ChannelMessage -> Maybe ChannelMessage
forall a. a -> Maybe a
Just ChannelMessage
m
channel_message Message
_ = Maybe ChannelMessage
forall a. Maybe a
Nothing
message_channel :: Message -> Maybe Channel
message_channel :: Message -> Maybe Manufacturer
message_channel (ChannelMessage Manufacturer
chan ChannelMessage
_) = Manufacturer -> Maybe Manufacturer
forall a. a -> Maybe a
Just Manufacturer
chan
message_channel Message
_ = Maybe Manufacturer
forall a. Maybe a
Nothing
data Message =
ChannelMessage !Channel !ChannelMessage
| CommonMessage !CommonMessage
| RealtimeMessage !RealtimeMessage
| UnknownMessage !Word8 !Word8 !Word8
deriving (Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq, Eq Message
Eq Message
-> (Message -> Message -> Ordering)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Message)
-> (Message -> Message -> Message)
-> Ord Message
Message -> Message -> Bool
Message -> Message -> Ordering
Message -> Message -> Message
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 :: Message -> Message -> Message
$cmin :: Message -> Message -> Message
max :: Message -> Message -> Message
$cmax :: Message -> Message -> Message
>= :: Message -> Message -> Bool
$c>= :: Message -> Message -> Bool
> :: Message -> Message -> Bool
$c> :: Message -> Message -> Bool
<= :: Message -> Message -> Bool
$c<= :: Message -> Message -> Bool
< :: Message -> Message -> Bool
$c< :: Message -> Message -> Bool
compare :: Message -> Message -> Ordering
$ccompare :: Message -> Message -> Ordering
Ord, Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show, ReadPrec [Message]
ReadPrec Message
Int -> ReadS Message
ReadS [Message]
(Int -> ReadS Message)
-> ReadS [Message]
-> ReadPrec Message
-> ReadPrec [Message]
-> Read Message
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Message]
$creadListPrec :: ReadPrec [Message]
readPrec :: ReadPrec Message
$creadPrec :: ReadPrec Message
readList :: ReadS [Message]
$creadList :: ReadS [Message]
readsPrec :: Int -> ReadS Message
$creadsPrec :: Int -> ReadS Message
Read)
instance Pretty Message where
pretty :: Message -> Text
pretty (CommonMessage (SystemExclusive Manufacturer
manuf ByteString
bytes)) =
Text
"sysex " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Manufacturer -> Text
manufacturer_name Manufacturer
manuf
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" <" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt (ByteString -> Int
ByteString.length ByteString
bytes) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" bytes>"
pretty (ChannelMessage Manufacturer
chan ChannelMessage
msg) =
Text
"chan:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Manufacturer -> Text
forall a. Show a => a -> Text
showt Manufacturer
chan Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChannelMessage -> Text
forall a. Pretty a => a -> Text
pretty ChannelMessage
msg
pretty Message
msg = Message -> Text
forall a. Show a => a -> Text
showt Message
msg
type Word7 = Word8
type Word4 = Word8
type Channel = Word4
type Velocity = Word7
type Control = CC.Control
type Program = Word7
type ControlValue = Word7
type PitchBendValue = Float
type Manufacturer = Word7
newtype Key = Key Int
deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq Key
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
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 :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
Ord, Integer -> Key
Key -> Key
Key -> Key -> Key
(Key -> Key -> Key)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> (Key -> Key)
-> (Key -> Key)
-> (Key -> Key)
-> (Integer -> Key)
-> Num Key
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Key
$cfromInteger :: Integer -> Key
signum :: Key -> Key
$csignum :: Key -> Key
abs :: Key -> Key
$cabs :: Key -> Key
negate :: Key -> Key
$cnegate :: Key -> Key
* :: Key -> Key -> Key
$c* :: Key -> Key -> Key
- :: Key -> Key -> Key
$c- :: Key -> Key -> Key
+ :: Key -> Key -> Key
$c+ :: Key -> Key -> Key
Num, Int -> Key
Key -> Int
Key -> [Key]
Key -> Key
Key -> Key -> [Key]
Key -> Key -> Key -> [Key]
(Key -> Key)
-> (Key -> Key)
-> (Int -> Key)
-> (Key -> Int)
-> (Key -> [Key])
-> (Key -> Key -> [Key])
-> (Key -> Key -> [Key])
-> (Key -> Key -> Key -> [Key])
-> Enum Key
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 :: Key -> Key -> Key -> [Key]
$cenumFromThenTo :: Key -> Key -> Key -> [Key]
enumFromTo :: Key -> Key -> [Key]
$cenumFromTo :: Key -> Key -> [Key]
enumFromThen :: Key -> Key -> [Key]
$cenumFromThen :: Key -> Key -> [Key]
enumFrom :: Key -> [Key]
$cenumFrom :: Key -> [Key]
fromEnum :: Key -> Int
$cfromEnum :: Key -> Int
toEnum :: Int -> Key
$ctoEnum :: Int -> Key
pred :: Key -> Key
$cpred :: Key -> Key
succ :: Key -> Key
$csucc :: Key -> Key
Enum, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show, ReadPrec [Key]
ReadPrec Key
Int -> ReadS Key
ReadS [Key]
(Int -> ReadS Key)
-> ReadS [Key] -> ReadPrec Key -> ReadPrec [Key] -> Read Key
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Key]
$creadListPrec :: ReadPrec [Key]
readPrec :: ReadPrec Key
$creadPrec :: ReadPrec Key
readList :: ReadS [Key]
$creadList :: ReadS [Key]
readsPrec :: Int -> ReadS Key
$creadsPrec :: Int -> ReadS Key
Read, Key -> ()
(Key -> ()) -> NFData Key
forall a. (a -> ()) -> NFData a
rnf :: Key -> ()
$crnf :: Key -> ()
DeepSeq.NFData)
instance Serialize.Serialize Key where
put :: Putter Key
put Key
key = Putter Manufacturer
forall a. Serialize a => Putter a
Serialize.put (Key -> Manufacturer
forall a. Num a => Key -> a
from_key Key
key :: Word8)
get :: Get Key
get = (Manufacturer -> Key
forall a. Integral a => a -> Key
to_key :: Word8 -> Key) (Manufacturer -> Key) -> Get Manufacturer -> Get Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Manufacturer
forall a. Serialize a => Get a
Serialize.get
instance Pretty Key where
pretty :: Key -> Text
pretty (Key Int
key) = Text
note Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt (Int
oct Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt Int
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
where
(Int
oct, Int
k) = Int
key Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
12
note :: Text
note = case Int
k of
Int
0 -> Text
"c"; Int
1 -> Text
"cs"
Int
2 -> Text
"d"; Int
3 -> Text
"ds"
Int
4 -> Text
"e"
Int
5 -> Text
"f"; Int
6 -> Text
"fs"
Int
7 -> Text
"g"; Int
8 -> Text
"gs"
Int
9 -> Text
"a"; Int
10 -> Text
"as"
Int
11 -> Text
"b"
Int
_ -> Text
""
from_key :: Num a => Key -> a
from_key :: forall a. Num a => Key -> a
from_key (Key Int
k) = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
to_key :: Integral a => a -> Key
to_key :: forall a. Integral a => a -> Key
to_key = Int -> Key
Key (Int -> Key) -> (a -> Int) -> a -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int) -> (a -> a) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Ord a => a -> a -> a
min a
127 (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Ord a => a -> a -> a
max a
0
to_closest_key :: RealFrac a => a -> (Key, a)
to_closest_key :: forall a. RealFrac a => a -> (Key, a)
to_closest_key a
nn
| a
frac a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0.5 = (Integer -> Key
forall a. Integral a => a -> Key
to_key (Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1), a
frac a -> a -> a
forall a. Num a => a -> a -> a
- a
1)
| Bool
otherwise = (Integer -> Key
forall a. Integral a => a -> Key
to_key Integer
d, a
frac)
where (Integer
d, a
frac) = a -> (Integer, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction a
nn
data ChannelMessage =
NoteOff !Key !Velocity
| NoteOn !Key !Velocity
| Aftertouch !Key !ControlValue
| ControlChange !Control !ControlValue
| ProgramChange !Program
| ChannelPressure !ControlValue
| PitchBend !PitchBendValue
| PitchBendInt !Word7 !Word7
| AllSoundOff
| ResetAllControls
| LocalControl !Bool
| AllNotesOff
| UndefinedChannelMode !Word7 !Word7
deriving (ChannelMessage -> ChannelMessage -> Bool
(ChannelMessage -> ChannelMessage -> Bool)
-> (ChannelMessage -> ChannelMessage -> Bool) -> Eq ChannelMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelMessage -> ChannelMessage -> Bool
$c/= :: ChannelMessage -> ChannelMessage -> Bool
== :: ChannelMessage -> ChannelMessage -> Bool
$c== :: ChannelMessage -> ChannelMessage -> Bool
Eq, Eq ChannelMessage
Eq ChannelMessage
-> (ChannelMessage -> ChannelMessage -> Ordering)
-> (ChannelMessage -> ChannelMessage -> Bool)
-> (ChannelMessage -> ChannelMessage -> Bool)
-> (ChannelMessage -> ChannelMessage -> Bool)
-> (ChannelMessage -> ChannelMessage -> Bool)
-> (ChannelMessage -> ChannelMessage -> ChannelMessage)
-> (ChannelMessage -> ChannelMessage -> ChannelMessage)
-> Ord ChannelMessage
ChannelMessage -> ChannelMessage -> Bool
ChannelMessage -> ChannelMessage -> Ordering
ChannelMessage -> ChannelMessage -> ChannelMessage
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 :: ChannelMessage -> ChannelMessage -> ChannelMessage
$cmin :: ChannelMessage -> ChannelMessage -> ChannelMessage
max :: ChannelMessage -> ChannelMessage -> ChannelMessage
$cmax :: ChannelMessage -> ChannelMessage -> ChannelMessage
>= :: ChannelMessage -> ChannelMessage -> Bool
$c>= :: ChannelMessage -> ChannelMessage -> Bool
> :: ChannelMessage -> ChannelMessage -> Bool
$c> :: ChannelMessage -> ChannelMessage -> Bool
<= :: ChannelMessage -> ChannelMessage -> Bool
$c<= :: ChannelMessage -> ChannelMessage -> Bool
< :: ChannelMessage -> ChannelMessage -> Bool
$c< :: ChannelMessage -> ChannelMessage -> Bool
compare :: ChannelMessage -> ChannelMessage -> Ordering
$ccompare :: ChannelMessage -> ChannelMessage -> Ordering
Ord, Int -> ChannelMessage -> ShowS
[ChannelMessage] -> ShowS
ChannelMessage -> String
(Int -> ChannelMessage -> ShowS)
-> (ChannelMessage -> String)
-> ([ChannelMessage] -> ShowS)
-> Show ChannelMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelMessage] -> ShowS
$cshowList :: [ChannelMessage] -> ShowS
show :: ChannelMessage -> String
$cshow :: ChannelMessage -> String
showsPrec :: Int -> ChannelMessage -> ShowS
$cshowsPrec :: Int -> ChannelMessage -> ShowS
Show, ReadPrec [ChannelMessage]
ReadPrec ChannelMessage
Int -> ReadS ChannelMessage
ReadS [ChannelMessage]
(Int -> ReadS ChannelMessage)
-> ReadS [ChannelMessage]
-> ReadPrec ChannelMessage
-> ReadPrec [ChannelMessage]
-> Read ChannelMessage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChannelMessage]
$creadListPrec :: ReadPrec [ChannelMessage]
readPrec :: ReadPrec ChannelMessage
$creadPrec :: ReadPrec ChannelMessage
readList :: ReadS [ChannelMessage]
$creadList :: ReadS [ChannelMessage]
readsPrec :: Int -> ReadS ChannelMessage
$creadsPrec :: Int -> ReadS ChannelMessage
Read)
data CommonMessage =
SystemExclusive !Manufacturer !ByteString.ByteString
| SongPositionPointer !Int
| SongSelect !Word8
| TuneRequest
| EOX
| UndefinedCommon !Word8
deriving (CommonMessage -> CommonMessage -> Bool
(CommonMessage -> CommonMessage -> Bool)
-> (CommonMessage -> CommonMessage -> Bool) -> Eq CommonMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommonMessage -> CommonMessage -> Bool
$c/= :: CommonMessage -> CommonMessage -> Bool
== :: CommonMessage -> CommonMessage -> Bool
$c== :: CommonMessage -> CommonMessage -> Bool
Eq, Eq CommonMessage
Eq CommonMessage
-> (CommonMessage -> CommonMessage -> Ordering)
-> (CommonMessage -> CommonMessage -> Bool)
-> (CommonMessage -> CommonMessage -> Bool)
-> (CommonMessage -> CommonMessage -> Bool)
-> (CommonMessage -> CommonMessage -> Bool)
-> (CommonMessage -> CommonMessage -> CommonMessage)
-> (CommonMessage -> CommonMessage -> CommonMessage)
-> Ord CommonMessage
CommonMessage -> CommonMessage -> Bool
CommonMessage -> CommonMessage -> Ordering
CommonMessage -> CommonMessage -> CommonMessage
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 :: CommonMessage -> CommonMessage -> CommonMessage
$cmin :: CommonMessage -> CommonMessage -> CommonMessage
max :: CommonMessage -> CommonMessage -> CommonMessage
$cmax :: CommonMessage -> CommonMessage -> CommonMessage
>= :: CommonMessage -> CommonMessage -> Bool
$c>= :: CommonMessage -> CommonMessage -> Bool
> :: CommonMessage -> CommonMessage -> Bool
$c> :: CommonMessage -> CommonMessage -> Bool
<= :: CommonMessage -> CommonMessage -> Bool
$c<= :: CommonMessage -> CommonMessage -> Bool
< :: CommonMessage -> CommonMessage -> Bool
$c< :: CommonMessage -> CommonMessage -> Bool
compare :: CommonMessage -> CommonMessage -> Ordering
$ccompare :: CommonMessage -> CommonMessage -> Ordering
Ord, Int -> CommonMessage -> ShowS
[CommonMessage] -> ShowS
CommonMessage -> String
(Int -> CommonMessage -> ShowS)
-> (CommonMessage -> String)
-> ([CommonMessage] -> ShowS)
-> Show CommonMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommonMessage] -> ShowS
$cshowList :: [CommonMessage] -> ShowS
show :: CommonMessage -> String
$cshow :: CommonMessage -> String
showsPrec :: Int -> CommonMessage -> ShowS
$cshowsPrec :: Int -> CommonMessage -> ShowS
Show, ReadPrec [CommonMessage]
ReadPrec CommonMessage
Int -> ReadS CommonMessage
ReadS [CommonMessage]
(Int -> ReadS CommonMessage)
-> ReadS [CommonMessage]
-> ReadPrec CommonMessage
-> ReadPrec [CommonMessage]
-> Read CommonMessage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommonMessage]
$creadListPrec :: ReadPrec [CommonMessage]
readPrec :: ReadPrec CommonMessage
$creadPrec :: ReadPrec CommonMessage
readList :: ReadS [CommonMessage]
$creadList :: ReadS [CommonMessage]
readsPrec :: Int -> ReadS CommonMessage
$creadsPrec :: Int -> ReadS CommonMessage
Read)
data RealtimeMessage = MtcQuarterFrame !Mtc | TimingClock | Start | Continue
| Stop | ActiveSense | Reset | UndefinedRealtime !Word8
deriving (RealtimeMessage -> RealtimeMessage -> Bool
(RealtimeMessage -> RealtimeMessage -> Bool)
-> (RealtimeMessage -> RealtimeMessage -> Bool)
-> Eq RealtimeMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RealtimeMessage -> RealtimeMessage -> Bool
$c/= :: RealtimeMessage -> RealtimeMessage -> Bool
== :: RealtimeMessage -> RealtimeMessage -> Bool
$c== :: RealtimeMessage -> RealtimeMessage -> Bool
Eq, Eq RealtimeMessage
Eq RealtimeMessage
-> (RealtimeMessage -> RealtimeMessage -> Ordering)
-> (RealtimeMessage -> RealtimeMessage -> Bool)
-> (RealtimeMessage -> RealtimeMessage -> Bool)
-> (RealtimeMessage -> RealtimeMessage -> Bool)
-> (RealtimeMessage -> RealtimeMessage -> Bool)
-> (RealtimeMessage -> RealtimeMessage -> RealtimeMessage)
-> (RealtimeMessage -> RealtimeMessage -> RealtimeMessage)
-> Ord RealtimeMessage
RealtimeMessage -> RealtimeMessage -> Bool
RealtimeMessage -> RealtimeMessage -> Ordering
RealtimeMessage -> RealtimeMessage -> RealtimeMessage
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 :: RealtimeMessage -> RealtimeMessage -> RealtimeMessage
$cmin :: RealtimeMessage -> RealtimeMessage -> RealtimeMessage
max :: RealtimeMessage -> RealtimeMessage -> RealtimeMessage
$cmax :: RealtimeMessage -> RealtimeMessage -> RealtimeMessage
>= :: RealtimeMessage -> RealtimeMessage -> Bool
$c>= :: RealtimeMessage -> RealtimeMessage -> Bool
> :: RealtimeMessage -> RealtimeMessage -> Bool
$c> :: RealtimeMessage -> RealtimeMessage -> Bool
<= :: RealtimeMessage -> RealtimeMessage -> Bool
$c<= :: RealtimeMessage -> RealtimeMessage -> Bool
< :: RealtimeMessage -> RealtimeMessage -> Bool
$c< :: RealtimeMessage -> RealtimeMessage -> Bool
compare :: RealtimeMessage -> RealtimeMessage -> Ordering
$ccompare :: RealtimeMessage -> RealtimeMessage -> Ordering
Ord, Int -> RealtimeMessage -> ShowS
[RealtimeMessage] -> ShowS
RealtimeMessage -> String
(Int -> RealtimeMessage -> ShowS)
-> (RealtimeMessage -> String)
-> ([RealtimeMessage] -> ShowS)
-> Show RealtimeMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RealtimeMessage] -> ShowS
$cshowList :: [RealtimeMessage] -> ShowS
show :: RealtimeMessage -> String
$cshow :: RealtimeMessage -> String
showsPrec :: Int -> RealtimeMessage -> ShowS
$cshowsPrec :: Int -> RealtimeMessage -> ShowS
Show, ReadPrec [RealtimeMessage]
ReadPrec RealtimeMessage
Int -> ReadS RealtimeMessage
ReadS [RealtimeMessage]
(Int -> ReadS RealtimeMessage)
-> ReadS [RealtimeMessage]
-> ReadPrec RealtimeMessage
-> ReadPrec [RealtimeMessage]
-> Read RealtimeMessage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RealtimeMessage]
$creadListPrec :: ReadPrec [RealtimeMessage]
readPrec :: ReadPrec RealtimeMessage
$creadPrec :: ReadPrec RealtimeMessage
readList :: ReadS [RealtimeMessage]
$creadList :: ReadS [RealtimeMessage]
readsPrec :: Int -> ReadS RealtimeMessage
$creadsPrec :: Int -> ReadS RealtimeMessage
Read)
instance DeepSeq.NFData Message where rnf :: Message -> ()
rnf Message
_ = ()
instance DeepSeq.NFData ChannelMessage where rnf :: ChannelMessage -> ()
rnf ChannelMessage
_ = ()
instance DeepSeq.NFData CommonMessage where rnf :: CommonMessage -> ()
rnf CommonMessage
_ = ()
instance DeepSeq.NFData RealtimeMessage where rnf :: RealtimeMessage -> ()
rnf RealtimeMessage
_ = ()
instance Pretty ChannelMessage where
format :: ChannelMessage -> Doc
format ChannelMessage
msg = case ChannelMessage
msg of
NoteOff Key
key Manufacturer
vel -> Doc
"NoteOff" Doc -> Doc -> Doc
<+> Key -> Doc
forall a. Pretty a => a -> Doc
format Key
key Doc -> Doc -> Doc
<+> Manufacturer -> Doc
forall a. Pretty a => a -> Doc
format Manufacturer
vel
NoteOn Key
key Manufacturer
vel -> Doc
"NoteOn" Doc -> Doc -> Doc
<+> Key -> Doc
forall a. Pretty a => a -> Doc
format Key
key Doc -> Doc -> Doc
<+> Manufacturer -> Doc
forall a. Pretty a => a -> Doc
format Manufacturer
vel
Aftertouch Key
key Manufacturer
vel -> Doc
"Aftertouch" Doc -> Doc -> Doc
<+> Key -> Doc
forall a. Pretty a => a -> Doc
format Key
key Doc -> Doc -> Doc
<+> Manufacturer -> Doc
forall a. Pretty a => a -> Doc
format Manufacturer
vel
ChannelMessage
_ -> Text -> Doc
Pretty.text (ChannelMessage -> Text
forall a. Show a => a -> Text
showt ChannelMessage
msg)
data Mtc = Mtc !SmpteFragment !Word4
deriving (Mtc -> Mtc -> Bool
(Mtc -> Mtc -> Bool) -> (Mtc -> Mtc -> Bool) -> Eq Mtc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mtc -> Mtc -> Bool
$c/= :: Mtc -> Mtc -> Bool
== :: Mtc -> Mtc -> Bool
$c== :: Mtc -> Mtc -> Bool
Eq, Eq Mtc
Eq Mtc
-> (Mtc -> Mtc -> Ordering)
-> (Mtc -> Mtc -> Bool)
-> (Mtc -> Mtc -> Bool)
-> (Mtc -> Mtc -> Bool)
-> (Mtc -> Mtc -> Bool)
-> (Mtc -> Mtc -> Mtc)
-> (Mtc -> Mtc -> Mtc)
-> Ord Mtc
Mtc -> Mtc -> Bool
Mtc -> Mtc -> Ordering
Mtc -> Mtc -> Mtc
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 :: Mtc -> Mtc -> Mtc
$cmin :: Mtc -> Mtc -> Mtc
max :: Mtc -> Mtc -> Mtc
$cmax :: Mtc -> Mtc -> Mtc
>= :: Mtc -> Mtc -> Bool
$c>= :: Mtc -> Mtc -> Bool
> :: Mtc -> Mtc -> Bool
$c> :: Mtc -> Mtc -> Bool
<= :: Mtc -> Mtc -> Bool
$c<= :: Mtc -> Mtc -> Bool
< :: Mtc -> Mtc -> Bool
$c< :: Mtc -> Mtc -> Bool
compare :: Mtc -> Mtc -> Ordering
$ccompare :: Mtc -> Mtc -> Ordering
Ord, Int -> Mtc -> ShowS
[Mtc] -> ShowS
Mtc -> String
(Int -> Mtc -> ShowS)
-> (Mtc -> String) -> ([Mtc] -> ShowS) -> Show Mtc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mtc] -> ShowS
$cshowList :: [Mtc] -> ShowS
show :: Mtc -> String
$cshow :: Mtc -> String
showsPrec :: Int -> Mtc -> ShowS
$cshowsPrec :: Int -> Mtc -> ShowS
Show, ReadPrec [Mtc]
ReadPrec Mtc
Int -> ReadS Mtc
ReadS [Mtc]
(Int -> ReadS Mtc)
-> ReadS [Mtc] -> ReadPrec Mtc -> ReadPrec [Mtc] -> Read Mtc
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Mtc]
$creadListPrec :: ReadPrec [Mtc]
readPrec :: ReadPrec Mtc
$creadPrec :: ReadPrec Mtc
readList :: ReadS [Mtc]
$creadList :: ReadS [Mtc]
readsPrec :: Int -> ReadS Mtc
$creadsPrec :: Int -> ReadS Mtc
Read)
data FrameRate = Frame24 | Frame25 | Frame29_97df | Frame30
deriving (Int -> FrameRate
FrameRate -> Int
FrameRate -> [FrameRate]
FrameRate -> FrameRate
FrameRate -> FrameRate -> [FrameRate]
FrameRate -> FrameRate -> FrameRate -> [FrameRate]
(FrameRate -> FrameRate)
-> (FrameRate -> FrameRate)
-> (Int -> FrameRate)
-> (FrameRate -> Int)
-> (FrameRate -> [FrameRate])
-> (FrameRate -> FrameRate -> [FrameRate])
-> (FrameRate -> FrameRate -> [FrameRate])
-> (FrameRate -> FrameRate -> FrameRate -> [FrameRate])
-> Enum FrameRate
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 :: FrameRate -> FrameRate -> FrameRate -> [FrameRate]
$cenumFromThenTo :: FrameRate -> FrameRate -> FrameRate -> [FrameRate]
enumFromTo :: FrameRate -> FrameRate -> [FrameRate]
$cenumFromTo :: FrameRate -> FrameRate -> [FrameRate]
enumFromThen :: FrameRate -> FrameRate -> [FrameRate]
$cenumFromThen :: FrameRate -> FrameRate -> [FrameRate]
enumFrom :: FrameRate -> [FrameRate]
$cenumFrom :: FrameRate -> [FrameRate]
fromEnum :: FrameRate -> Int
$cfromEnum :: FrameRate -> Int
toEnum :: Int -> FrameRate
$ctoEnum :: Int -> FrameRate
pred :: FrameRate -> FrameRate
$cpred :: FrameRate -> FrameRate
succ :: FrameRate -> FrameRate
$csucc :: FrameRate -> FrameRate
Enum, Int -> FrameRate -> ShowS
[FrameRate] -> ShowS
FrameRate -> String
(Int -> FrameRate -> ShowS)
-> (FrameRate -> String)
-> ([FrameRate] -> ShowS)
-> Show FrameRate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FrameRate] -> ShowS
$cshowList :: [FrameRate] -> ShowS
show :: FrameRate -> String
$cshow :: FrameRate -> String
showsPrec :: Int -> FrameRate -> ShowS
$cshowsPrec :: Int -> FrameRate -> ShowS
Show)
data SmpteFragment = FrameLsb | FrameMsb | SecondLsb | SecondMsb
| MinuteLsb | MinuteMsb | HourLsb | RateHourMsb
deriving (Int -> SmpteFragment
SmpteFragment -> Int
SmpteFragment -> [SmpteFragment]
SmpteFragment -> SmpteFragment
SmpteFragment -> SmpteFragment -> [SmpteFragment]
SmpteFragment -> SmpteFragment -> SmpteFragment -> [SmpteFragment]
(SmpteFragment -> SmpteFragment)
-> (SmpteFragment -> SmpteFragment)
-> (Int -> SmpteFragment)
-> (SmpteFragment -> Int)
-> (SmpteFragment -> [SmpteFragment])
-> (SmpteFragment -> SmpteFragment -> [SmpteFragment])
-> (SmpteFragment -> SmpteFragment -> [SmpteFragment])
-> (SmpteFragment
-> SmpteFragment -> SmpteFragment -> [SmpteFragment])
-> Enum SmpteFragment
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 :: SmpteFragment -> SmpteFragment -> SmpteFragment -> [SmpteFragment]
$cenumFromThenTo :: SmpteFragment -> SmpteFragment -> SmpteFragment -> [SmpteFragment]
enumFromTo :: SmpteFragment -> SmpteFragment -> [SmpteFragment]
$cenumFromTo :: SmpteFragment -> SmpteFragment -> [SmpteFragment]
enumFromThen :: SmpteFragment -> SmpteFragment -> [SmpteFragment]
$cenumFromThen :: SmpteFragment -> SmpteFragment -> [SmpteFragment]
enumFrom :: SmpteFragment -> [SmpteFragment]
$cenumFrom :: SmpteFragment -> [SmpteFragment]
fromEnum :: SmpteFragment -> Int
$cfromEnum :: SmpteFragment -> Int
toEnum :: Int -> SmpteFragment
$ctoEnum :: Int -> SmpteFragment
pred :: SmpteFragment -> SmpteFragment
$cpred :: SmpteFragment -> SmpteFragment
succ :: SmpteFragment -> SmpteFragment
$csucc :: SmpteFragment -> SmpteFragment
Enum, SmpteFragment -> SmpteFragment -> Bool
(SmpteFragment -> SmpteFragment -> Bool)
-> (SmpteFragment -> SmpteFragment -> Bool) -> Eq SmpteFragment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmpteFragment -> SmpteFragment -> Bool
$c/= :: SmpteFragment -> SmpteFragment -> Bool
== :: SmpteFragment -> SmpteFragment -> Bool
$c== :: SmpteFragment -> SmpteFragment -> Bool
Eq, Eq SmpteFragment
Eq SmpteFragment
-> (SmpteFragment -> SmpteFragment -> Ordering)
-> (SmpteFragment -> SmpteFragment -> Bool)
-> (SmpteFragment -> SmpteFragment -> Bool)
-> (SmpteFragment -> SmpteFragment -> Bool)
-> (SmpteFragment -> SmpteFragment -> Bool)
-> (SmpteFragment -> SmpteFragment -> SmpteFragment)
-> (SmpteFragment -> SmpteFragment -> SmpteFragment)
-> Ord SmpteFragment
SmpteFragment -> SmpteFragment -> Bool
SmpteFragment -> SmpteFragment -> Ordering
SmpteFragment -> SmpteFragment -> SmpteFragment
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 :: SmpteFragment -> SmpteFragment -> SmpteFragment
$cmin :: SmpteFragment -> SmpteFragment -> SmpteFragment
max :: SmpteFragment -> SmpteFragment -> SmpteFragment
$cmax :: SmpteFragment -> SmpteFragment -> SmpteFragment
>= :: SmpteFragment -> SmpteFragment -> Bool
$c>= :: SmpteFragment -> SmpteFragment -> Bool
> :: SmpteFragment -> SmpteFragment -> Bool
$c> :: SmpteFragment -> SmpteFragment -> Bool
<= :: SmpteFragment -> SmpteFragment -> Bool
$c<= :: SmpteFragment -> SmpteFragment -> Bool
< :: SmpteFragment -> SmpteFragment -> Bool
$c< :: SmpteFragment -> SmpteFragment -> Bool
compare :: SmpteFragment -> SmpteFragment -> Ordering
$ccompare :: SmpteFragment -> SmpteFragment -> Ordering
Ord, Int -> SmpteFragment -> ShowS
[SmpteFragment] -> ShowS
SmpteFragment -> String
(Int -> SmpteFragment -> ShowS)
-> (SmpteFragment -> String)
-> ([SmpteFragment] -> ShowS)
-> Show SmpteFragment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SmpteFragment] -> ShowS
$cshowList :: [SmpteFragment] -> ShowS
show :: SmpteFragment -> String
$cshow :: SmpteFragment -> String
showsPrec :: Int -> SmpteFragment -> ShowS
$cshowsPrec :: Int -> SmpteFragment -> ShowS
Show, ReadPrec [SmpteFragment]
ReadPrec SmpteFragment
Int -> ReadS SmpteFragment
ReadS [SmpteFragment]
(Int -> ReadS SmpteFragment)
-> ReadS [SmpteFragment]
-> ReadPrec SmpteFragment
-> ReadPrec [SmpteFragment]
-> Read SmpteFragment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SmpteFragment]
$creadListPrec :: ReadPrec [SmpteFragment]
readPrec :: ReadPrec SmpteFragment
$creadPrec :: ReadPrec SmpteFragment
readList :: ReadS [SmpteFragment]
$creadList :: ReadS [SmpteFragment]
readsPrec :: Int -> ReadS SmpteFragment
$creadsPrec :: Int -> ReadS SmpteFragment
Read)
rate_fps :: FrameRate -> Double
rate_fps :: FrameRate -> Double
rate_fps FrameRate
Frame24 = Double
24
rate_fps FrameRate
Frame25 = Double
25
rate_fps FrameRate
Frame29_97df = Double
29.97
rate_fps FrameRate
Frame30 = Double
30
data Smpte = Smpte {
Smpte -> Manufacturer
smpte_hours :: !Word8
, Smpte -> Manufacturer
smpte_minutes :: !Word8
, Smpte -> Manufacturer
smpte_seconds :: !Word8
, Smpte -> Manufacturer
smpte_frames :: !Word8
} deriving (Smpte -> Smpte -> Bool
(Smpte -> Smpte -> Bool) -> (Smpte -> Smpte -> Bool) -> Eq Smpte
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Smpte -> Smpte -> Bool
$c/= :: Smpte -> Smpte -> Bool
== :: Smpte -> Smpte -> Bool
$c== :: Smpte -> Smpte -> Bool
Eq, Int -> Smpte -> ShowS
[Smpte] -> ShowS
Smpte -> String
(Int -> Smpte -> ShowS)
-> (Smpte -> String) -> ([Smpte] -> ShowS) -> Show Smpte
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Smpte] -> ShowS
$cshowList :: [Smpte] -> ShowS
show :: Smpte -> String
$cshow :: Smpte -> String
showsPrec :: Int -> Smpte -> ShowS
$cshowsPrec :: Int -> Smpte -> ShowS
Show)
type Seconds = Double
type Frames = Int
seconds_to_frame :: FrameRate -> Seconds -> Frames
seconds_to_frame :: FrameRate -> Double -> Int
seconds_to_frame FrameRate
rate = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> (Double -> Double) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
* FrameRate -> Double
rate_fps FrameRate
rate)
frame_to_seconds :: FrameRate -> Frames -> Seconds
frame_to_seconds :: FrameRate -> Int -> Double
frame_to_seconds FrameRate
rate = (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ FrameRate -> Double
rate_fps FrameRate
rate) (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
frame_to_smpte :: FrameRate -> Frames -> Smpte
frame_to_smpte :: FrameRate -> Int -> Smpte
frame_to_smpte FrameRate
rate Int
frame = Manufacturer
-> Manufacturer -> Manufacturer -> Manufacturer -> Smpte
Smpte (Int -> Manufacturer
w7 Int
hours) (Int -> Manufacturer
w7 Int
mins) (Int -> Manufacturer
w7 Int
secs) (Int -> Manufacturer
w7 Int
t3)
where
fps :: Int
fps = case FrameRate
rate of
FrameRate
Frame29_97df -> Int
30
FrameRate
_ -> Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (FrameRate -> Double
rate_fps FrameRate
rate)
(Int
hours, Int
t1) = FrameRate -> Int -> Int
undrop_frames FrameRate
rate Int
frame Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` (Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
fps)
(Int
mins, Int
t2) = Int
t1 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` (Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
fps)
(Int
secs, Int
t3) = Int
t2 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
fps
w7 :: Int -> Word7
w7 :: Int -> Manufacturer
w7 = Int -> Manufacturer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Manufacturer) -> (Int -> Int) -> Int -> Manufacturer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
Num.clamp Int
0 Int
0x7f
seconds_to_smpte :: FrameRate -> Seconds -> Smpte
seconds_to_smpte :: FrameRate -> Double -> Smpte
seconds_to_smpte FrameRate
rate = FrameRate -> Int -> Smpte
frame_to_smpte FrameRate
rate (Int -> Smpte) -> (Double -> Int) -> Double -> Smpte
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FrameRate -> Double -> Int
seconds_to_frame FrameRate
rate
undrop_frames :: FrameRate -> Frames -> Frames
undrop_frames :: FrameRate -> Int -> Int
undrop_frames FrameRate
Frame29_97df Int
frames =
Int
frames Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
frames Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
30 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
frames Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
30 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60))
undrop_frames FrameRate
_ Int
frames = Int
frames
mtc_sync :: FrameRate -> Smpte -> Message
mtc_sync :: FrameRate -> Smpte -> Message
mtc_sync FrameRate
rate (Smpte Manufacturer
hours Manufacturer
mins Manufacturer
secs Manufacturer
frames) =
ByteString -> Message
realtime_sysex (ByteString -> Message) -> ByteString -> Message
forall a b. (a -> b) -> a -> b
$ [Manufacturer] -> ByteString
ByteString.pack
[Manufacturer
chan, Manufacturer
01, Manufacturer
01, Manufacturer
rate_code Manufacturer -> Manufacturer -> Manufacturer
forall a. Bits a => a -> a -> a
.|. Manufacturer
hours, Manufacturer
mins, Manufacturer
secs, Manufacturer
frames]
where
chan :: Manufacturer
chan = Manufacturer
0x7f
rate_code :: Manufacturer
rate_code = Manufacturer -> Int -> Manufacturer
forall a. Bits a => a -> Int -> a
Bits.shiftL (Int -> Manufacturer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FrameRate -> Int
forall a. Enum a => a -> Int
fromEnum FrameRate
rate)) Int
5
generate_mtc :: FrameRate -> Frames -> [(Double, Message)]
generate_mtc :: FrameRate -> Int -> [(Double, Message)]
generate_mtc FrameRate
rate Int
frame = [Double] -> [Message] -> [(Double, Message)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
times ((Int -> [Message]) -> [Int] -> [Message]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> [Message]
msgs (Int -> Int -> [Int]
forall a. Num a => a -> a -> [a]
Seq.range_ Int
frame Int
2))
where
msgs :: Int -> [Message]
msgs Int
frame = (Mtc -> Message) -> [Mtc] -> [Message]
forall a b. (a -> b) -> [a] -> [b]
map (RealtimeMessage -> Message
RealtimeMessage (RealtimeMessage -> Message)
-> (Mtc -> RealtimeMessage) -> Mtc -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mtc -> RealtimeMessage
MtcQuarterFrame) ([Mtc] -> [Message]) -> [Mtc] -> [Message]
forall a b. (a -> b) -> a -> b
$
FrameRate -> Smpte -> [Mtc]
mtc_fragments FrameRate
rate (FrameRate -> Int -> Smpte
frame_to_smpte FrameRate
rate Int
frame)
times :: [Double]
times = Double -> Double -> [Double]
forall a. Num a => a -> a -> [a]
Seq.range_ Double
start Double
fragment
start :: Double
start = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frame Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ FrameRate -> Double
rate_fps FrameRate
rate
fragment :: Double
fragment = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ FrameRate -> Double
rate_fps FrameRate
rate Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
4
mtc_fragments :: FrameRate -> Smpte -> [Mtc]
mtc_fragments :: FrameRate -> Smpte -> [Mtc]
mtc_fragments FrameRate
rate (Smpte Manufacturer
hours Manufacturer
minutes Manufacturer
seconds Manufacturer
frames) = ((SmpteFragment, Manufacturer) -> Mtc)
-> [(SmpteFragment, Manufacturer)] -> [Mtc]
forall a b. (a -> b) -> [a] -> [b]
map ((SmpteFragment -> Manufacturer -> Mtc)
-> (SmpteFragment, Manufacturer) -> Mtc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SmpteFragment -> Manufacturer -> Mtc
Mtc)
[ (SmpteFragment
FrameLsb, Manufacturer
frame_lsb), (SmpteFragment
FrameMsb, Manufacturer
frame_msb)
, (SmpteFragment
SecondLsb, Manufacturer
sec_lsb), (SmpteFragment
SecondMsb, Manufacturer
sec_msb)
, (SmpteFragment
MinuteLsb, Manufacturer
min_lsb), (SmpteFragment
MinuteMsb, Manufacturer
min_msb)
, (SmpteFragment
HourLsb, Manufacturer
hour_lsb), (SmpteFragment
RateHourMsb, Manufacturer
rate_code Manufacturer -> Manufacturer -> Manufacturer
forall a. Bits a => a -> a -> a
.|. Manufacturer
hour_msb)
]
where
(Manufacturer
frame_msb, Manufacturer
frame_lsb) = Manufacturer -> (Manufacturer, Manufacturer)
split4 Manufacturer
frames
(Manufacturer
sec_msb, Manufacturer
sec_lsb) = Manufacturer -> (Manufacturer, Manufacturer)
split4 Manufacturer
seconds
(Manufacturer
min_msb, Manufacturer
min_lsb) = Manufacturer -> (Manufacturer, Manufacturer)
split4 Manufacturer
minutes
(Manufacturer
hour_msb, Manufacturer
hour_lsb) = Manufacturer -> (Manufacturer, Manufacturer)
split4 Manufacturer
hours
rate_code :: Manufacturer
rate_code = Manufacturer -> Int -> Manufacturer
forall a. Bits a => a -> Int -> a
Bits.shiftL (Int -> Manufacturer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FrameRate -> Int
forall a. Enum a => a -> Int
fromEnum FrameRate
rate)) Int
1
type NoteNumber = Double
realtime_tuning :: [(Key, NoteNumber)] -> Message
realtime_tuning :: [(Key, Double)] -> Message
realtime_tuning [(Key, Double)]
nns = ByteString -> Message
realtime_sysex (ByteString -> Message) -> ByteString -> Message
forall a b. (a -> b) -> a -> b
$ [Manufacturer] -> ByteString
ByteString.pack ([Manufacturer] -> ByteString) -> [Manufacturer] -> ByteString
forall a b. (a -> b) -> a -> b
$
[Manufacturer
generic_device, Manufacturer
8, Manufacturer
2, Manufacturer
0, Int -> Manufacturer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([(Key, Double)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Key, Double)]
nns)]
[Manufacturer] -> [Manufacturer] -> [Manufacturer]
forall a. [a] -> [a] -> [a]
++ ((Key, Double) -> [Manufacturer])
-> [(Key, Double)] -> [Manufacturer]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Key -> Double -> [Manufacturer])
-> (Key, Double) -> [Manufacturer]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Double -> [Manufacturer]
retune_key) [(Key, Double)]
nns
where
retune_key :: Key -> NoteNumber -> [Word7]
retune_key :: Key -> Double -> [Manufacturer]
retune_key Key
key Double
nn = [Key -> Manufacturer
forall a. Num a => Key -> a
from_key Key
key, Manufacturer
nn_key, Manufacturer
msb, Manufacturer
lsb]
where
(Manufacturer
lsb, Manufacturer
msb) = Int -> (Manufacturer, Manufacturer)
split14 (Int -> (Manufacturer, Manufacturer))
-> Int -> (Manufacturer, Manufacturer)
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
frac Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
14
(Manufacturer
nn_key, Double
frac) = Double -> (Manufacturer, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Double
nn
split14 :: Int -> (Word7, Word7)
split14 :: Int -> (Manufacturer, Manufacturer)
split14 Int
i = (Int -> Manufacturer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x7f), Int -> Manufacturer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
Bits.shiftR Int
i Int
7 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x7f))
join14 :: Word7 -> Word7 -> Int
join14 :: Manufacturer -> Manufacturer -> Int
join14 Manufacturer
lsb Manufacturer
msb =
Int -> Int -> Int
forall a. Bits a => a -> Int -> a
Bits.shiftL (Manufacturer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Manufacturer
msb Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x7f) Int
7 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Manufacturer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Manufacturer
lsb Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x7f)
split4 :: Word8 -> (Word4, Word4)
split4 :: Manufacturer -> (Manufacturer, Manufacturer)
split4 Manufacturer
word = (Manufacturer -> Int -> Manufacturer
forall a. Bits a => a -> Int -> a
Bits.shiftR Manufacturer
word Int
4 Manufacturer -> Manufacturer -> Manufacturer
forall a. Bits a => a -> a -> a
.&. Manufacturer
0xf, Manufacturer
word Manufacturer -> Manufacturer -> Manufacturer
forall a. Bits a => a -> a -> a
.&. Manufacturer
0xf)
join4 :: Word4 -> Word4 -> Word7
join4 :: Manufacturer -> Manufacturer -> Manufacturer
join4 Manufacturer
d1 Manufacturer
d2 = (Manufacturer -> Int -> Manufacturer
forall a. Bits a => a -> Int -> a
Bits.shiftL Manufacturer
d1 Int
4 Manufacturer -> Manufacturer -> Manufacturer
forall a. Bits a => a -> a -> a
.&. Manufacturer
0xf0) Manufacturer -> Manufacturer -> Manufacturer
forall a. Bits a => a -> a -> a
.|. (Manufacturer
d2 Manufacturer -> Manufacturer -> Manufacturer
forall a. Bits a => a -> a -> a
.&. Manufacturer
0x0f)
generic_device :: Word7
generic_device :: Manufacturer
generic_device = Manufacturer
0x7f
manufacturer_name :: Manufacturer -> Text
manufacturer_name :: Manufacturer -> Text
manufacturer_name Manufacturer
code = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Maybe.fromMaybe (Manufacturer -> Text
forall a. Show a => a -> Text
showt Manufacturer
code) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
Manufacturer -> Map Manufacturer Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Manufacturer
code Map Manufacturer Text
manufacturer_codes
korg_code, yamaha_code :: Manufacturer
korg_code :: Manufacturer
korg_code = Manufacturer
0x42
yamaha_code :: Manufacturer
yamaha_code = Manufacturer
0x43
manufacturer_codes :: Map Manufacturer Text
manufacturer_codes :: Map Manufacturer Text
manufacturer_codes = [(Manufacturer, Text)] -> Map Manufacturer Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[(Manufacturer
korg_code, Text
"korg"), (Manufacturer
yamaha_code, Text
"yamaha")]