module Music.Theory.Diagram.Sequencer where
import Data.Char
import System.FilePath
import System.Process
import Text.Printf
import Music.Theory.Math (R)
import qualified Music.Theory.Dynamic_Mark as T
import qualified Music.Theory.Time.Seq as T
type P2 = (R,R)
type Grey = R
type C_Rect = (P2,P2,Grey)
type K_Rect = (Int,C_Rect)
k_rect_gnuplot :: K_Rect -> String
k_rect_gnuplot (i,((x0,y0),(x1,y1),c)) =
let fmt = "set object %d rect from %f,%f to %f,%f fc rgbcolor \"#%02x%02x%02x\""
c' = floor (c * 255) :: Int
in printf fmt i x0 y0 x1 y1 c' c' c'
type Seq_Plot_Opt = ((Int,Int),(R,R),(R,R))
default_seq_plot_opt :: (R,R) -> Seq_Plot_Opt
default_seq_plot_opt x = ((1200,400),x,(21,108))
to_k_rect :: [C_Rect] -> [K_Rect]
to_k_rect = zip [1..]
clean_name :: String -> String
clean_name =
let f c = if isAlphaNum c then c else '_'
in map f
sequencer_plot_rect :: Seq_Plot_Opt -> FilePath -> String -> [C_Rect] -> IO ()
sequencer_plot_rect ((w,h),(x0,x1),(y0,y1)) dir nm sq = do
let nm_plot = dir </> nm <.> "plot"
nm_svg = dir </> nm <.> "svg"
x_range = concat ["[",show x0,":",show x1,"]"]
y_range = concat ["[",show y0,":",show y1,"]"]
pre = [concat ["set terminal svg name \"",clean_name nm,"\" size ",show w,",", show h]
,"set output '" ++ nm_svg ++ "'"
,"set tics font \"cmr10, 10\""
,"unset key"
,concat ["set xrange ",x_range]
,concat ["set yrange ",y_range]
,"set bars 0"]
post = ["plot \"/dev/null\" with xyerrorbars lc rgbcolor \"black\""]
writeFile nm_plot (unlines (pre ++ map k_rect_gnuplot (to_k_rect sq) ++ post))
_ <- system ("gnuplot " ++ nm_plot)
return ()
amp_to_grey :: R -> R -> R
amp_to_grey z am =
let db = max (T.amp_db am) z
z' = abs z
in 1 ((db + z') / z')
vel_to_amp :: Int -> R
vel_to_amp vel = fromIntegral vel / 127
vel_to_grey :: R -> Int -> R
vel_to_grey z = amp_to_grey z . vel_to_amp
type Sequencer_Midi n = T.Wseq R (n,n)
sequencer_midi_to_rect :: Real n => ((R,R),(n,n)) -> C_Rect
sequencer_midi_to_rect ((st,du),(mnn,vel)) =
let x0 = st
x1 = st + du
y0 = realToFrac mnn
y1 = y0 + 1
c = vel_to_grey (60) (floor (realToFrac vel))
in ((x0,y0),(x1,y1),c)
sequencer_plot_midi :: Real n => Seq_Plot_Opt -> FilePath -> String -> Sequencer_Midi n -> IO ()
sequencer_plot_midi opt dir nm = sequencer_plot_rect opt dir nm . map sequencer_midi_to_rect