loooph
/
tidal-vis
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

add text label

master
alex 2017-12-01 22:36:10 +00:00
parent fed74d248a
commit 4c9548587e
1 changed files with 19 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
Sound/Tidal/VisCycle.hs
View File

@ -15,7 +15,8 @@ import System.Cmd
import Data.List import Data.List
import Data.Ord ( comparing ) import Data.Ord ( comparing )
totalWidth = 1080 :: Double totalWidth = 50 :: Double
border = 5
ratio = 1 ratio = 1
arrangeEvents [] = [] arrangeEvents [] = []
@ -25,13 +26,21 @@ addEvent e [] = [[e]]
addEvent e (level:levels) | fits e level = (e:level):levels addEvent e (level:levels) | fits e level = (e:level):levels
| otherwise = level:(addEvent e levels) | otherwise = level:(addEvent e levels)
v sf fn (x,y) levels = v sf fn (x,y) levels label =
sf fn x y $ \surf -> do sf fn x y $ \surf -> do
C.renderWith surf $ do C.renderWith surf $ do
C.setAntialias C.AntialiasBest C.setAntialias C.AntialiasBest
C.save C.save
C.scale totalWidth totalWidth C.translate border border
C.scale (totalWidth-(border*2)) (totalWidth-(border*2))
C.setOperator C.OperatorOver C.setOperator C.OperatorOver
C.selectFontFace "Inconsolata" C.FontSlantNormal C.FontWeightNormal
C.setFontSize 0.2
(C.TextExtents _ _ textW textH _ _) <- C.textExtents (label :: String)
C.moveTo (0) (textH)
C.textPath (label :: String)
C.setSourceRGB 0 0 0
C.fill
-- C.setSourceRGB 0 0 0 -- C.setSourceRGB 0 0 0
-- C.rectangle 0 0 1 1 -- C.rectangle 0 0 1 1
--C.fill --C.fill
@ -58,12 +67,14 @@ renderLevel total (n, level) = do C.save
levelHeight = (1 / fromIntegral (total+1))/2 levelHeight = (1 / fromIntegral (total+1))/2
vPDF = v C.withPDFSurface vPDF = v C.withPDFSurface
vis name pat = do v (C.withPDFSurface) (name ++ ".pdf") (totalWidth, totalWidth) levels visCycle :: [Char] -> String -> Pattern ColourD -> IO ()
return () visCycle name label pat =
where levels = arrangeEvents $ sortOn ((\x -> snd x - fst x) . snd') (arc pat (0,1)) do v (C.withPDFSurface) (name ++ ".pdf") (totalWidth, totalWidth) levels label
sortOn f = map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) return ()
where levels = arrangeEvents $ sortOn ((\x -> snd x - fst x) . snd') (arc pat (0,1))
sortOn f = map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))
visAsString pat = do vis "/tmp/vis2-tmp" pat visAsString pat = do visCycle "/tmp/vis2-tmp" "" pat
svg <- readFile "/tmp/vis2-tmp.svg" svg <- readFile "/tmp/vis2-tmp.svg"
return svg return svg