module Music.Theory.Array.Csv.Midi.Skini where
import Data.List
import qualified Music.Theory.Array.Csv.Midi.Mnd as T
import qualified Music.Theory.Time.Seq as T
data Time t = Delta t | Absolute t
type Skini t n = (String,Time t,T.Channel,n,n)
mnd_msg_to_skini_msg :: String -> String
mnd_msg_to_skini_msg :: String -> String
mnd_msg_to_skini_msg String
msg =
case String
msg of
String
"on" -> String
"NoteOn"
String
"off" -> String
"NoteOff"
String
_ -> forall a. HasCallStack => String -> a
error String
"mnd_msg_to_skini_msg"
mnd_to_skini_f :: (t -> Time t) -> T.Mnd t n -> Skini t n
mnd_to_skini_f :: forall t n. (t -> Time t) -> Mnd t n -> Skini t n
mnd_to_skini_f t -> Time t
f Mnd t n
mnd =
case Mnd t n
mnd of
(t
t,String
msg,n
d1,n
d2,Channel
ch,[]) -> (String -> String
mnd_msg_to_skini_msg String
msg,t -> Time t
f t
t,Channel
ch,n
d1,n
d2)
Mnd t n
_ -> forall a. HasCallStack => String -> a
error String
"mnd_to_skini"
mnd_to_skini_abs :: T.Mnd t n -> Skini t n
mnd_to_skini_abs :: forall t n. Mnd t n -> Skini t n
mnd_to_skini_abs = forall t n. (t -> Time t) -> Mnd t n -> Skini t n
mnd_to_skini_f forall t. t -> Time t
Absolute
midi_tseq_to_skini_seq :: (Num t,Eq n) => T.Tseq t (T.Begin_End (T.Event n)) -> [Skini t n]
midi_tseq_to_skini_seq :: forall t n.
(Num t, Eq n) =>
Tseq t (Begin_End (Event n)) -> [Skini t n]
midi_tseq_to_skini_seq =
let f :: (t, Begin_End (d, e, c, [a])) -> (String, Time t, c, d, e)
f (t, Begin_End (d, e, c, [a]))
e =
case (t, Begin_End (d, e, c, [a]))
e of
(t
t,T.Begin (d
d1,e
d2,c
ch,[])) -> (String
"NoteOn",forall t. t -> Time t
Delta t
t,c
ch,d
d1,e
d2)
(t
t,T.End (d
d1,e
d2,c
ch,[])) -> (String
"NoteOff",forall t. t -> Time t
Delta t
t,c
ch,d
d1,e
d2)
(t, Begin_End (d, e, c, [a]))
_ -> forall a. HasCallStack => String -> a
error String
"midi_tseq_to_skini_seq"
in forall a b. (a -> b) -> [a] -> [b]
map forall {t} {d} {e} {c} {a}.
(t, Begin_End (d, e, c, [a])) -> (String, Time t, c, d, e)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Num t => Tseq t a -> Tseq t a
T.tseq_to_iseq
time_pp :: Real t => Int -> Time t -> String
time_pp :: forall t. Real t => Channel -> Time t -> String
time_pp Channel
k Time t
t =
case Time t
t of
Delta t
x -> forall t. Real t => Channel -> t -> String
T.data_value_pp Channel
k t
x
Absolute t
x -> Char
'=' forall a. a -> [a] -> [a]
: forall t. Real t => Channel -> t -> String
T.data_value_pp Channel
k t
x
skini_pp_csv :: (Real t,Real n) => Int -> Skini t n -> String
skini_pp_csv :: forall t n. (Real t, Real n) => Channel -> Skini t n -> String
skini_pp_csv Channel
k (String
msg,Time t
t,Channel
ch,n
d1,n
d2) =
let f :: n -> String
f = forall t. Real t => Channel -> t -> String
T.data_value_pp Channel
k
in forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String
msg,forall t. Real t => Channel -> Time t -> String
time_pp Channel
k Time t
t,forall a. Show a => a -> String
show Channel
ch,n -> String
f n
d1,n -> String
f n
d2]
skini_write_csv :: (Real t,Real n) => Int -> FilePath -> [Skini t n] -> IO ()
skini_write_csv :: forall t n.
(Real t, Real n) =>
Channel -> String -> [Skini t n] -> IO ()
skini_write_csv Channel
k String
fn = String -> String -> IO ()
writeFile String
fn forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall t n. (Real t, Real n) => Channel -> Skini t n -> String
skini_pp_csv Channel
k)