From 0aea9d73df0cc62aec5ad26b5b4197cda653d013 Mon Sep 17 00:00:00 2001 From: alex Date: Sat, 23 Sep 2017 23:38:51 +0100 Subject: [PATCH] moved from tidal repo --- Sound/Tidal/Cycle.hs | 283 +++++++++++++++++++++++++++++++++++++++ Sound/Tidal/Vis.hs | 67 +++++++++ Sound/Tidal/Vis2.hs | 91 +++++++++++++ Sound/Tidal/Vis2.hs~ | 85 ++++++++++++ Sound/Tidal/VisCycle.hs | 72 ++++++++++ Sound/Tidal/VisCycle.hs~ | 91 +++++++++++++ examples/0.pdf | Bin 0 -> 1980 bytes examples/1.pdf | 70 ++++++++++ examples/2.pdf | Bin 0 -> 2214 bytes examples/3.pdf | Bin 0 -> 1189 bytes examples/4.pdf | Bin 0 -> 8275 bytes examples/5.pdf | Bin 0 -> 2622 bytes examples/6.pdf | Bin 0 -> 3676 bytes examples/example.hs | 47 +++++++ tidal-vis.cabal | 25 ++++ 15 files changed, 831 insertions(+) create mode 100644 Sound/Tidal/Cycle.hs create mode 100644 Sound/Tidal/Vis.hs create mode 100644 Sound/Tidal/Vis2.hs create mode 100644 Sound/Tidal/Vis2.hs~ create mode 100644 Sound/Tidal/VisCycle.hs create mode 100644 Sound/Tidal/VisCycle.hs~ create mode 100644 examples/0.pdf create mode 100644 examples/1.pdf create mode 100644 examples/2.pdf create mode 100644 examples/3.pdf create mode 100644 examples/4.pdf create mode 100644 examples/5.pdf create mode 100644 examples/6.pdf create mode 100644 examples/example.hs create mode 100644 tidal-vis.cabal diff --git a/Sound/Tidal/Cycle.hs b/Sound/Tidal/Cycle.hs new file mode 100644 index 0000000..8182eeb --- /dev/null +++ b/Sound/Tidal/Cycle.hs @@ -0,0 +1,283 @@ +module Sound.Tidal.Cycle where + +import Control.Monad +import Control.Monad.State +import Control.Monad.Reader +import Control.Concurrent.MVar +import Data.Array.IArray + +import Graphics.UI.SDL +import Graphics.UI.SDL.Image +import qualified Graphics.UI.SDL.Framerate as FR +import qualified Graphics.UI.SDL.Primitives as SDLP +import qualified Graphics.UI.SDL.TTF.General as TTFG +import Graphics.UI.SDL.TTF.Management +import Graphics.UI.SDL.TTF.Render +import Graphics.UI.SDL.TTF.Types +import Data.Maybe (listToMaybe, fromMaybe, fromJust, isJust, catMaybes) +import GHC.Int (Int16) +import Data.List (intercalate, tails, nub, sortBy) +import Data.Colour +import Data.Colour.Names +import Data.Colour.SRGB +import Data.Colour.RGBSpace.HSV (hsv) +import qualified GHC.Word +import Data.Bits +import Data.Ratio +import Debug.Trace (trace) +import Data.Fixed (mod') +import Control.Concurrent +import System.Exit + +import Sound.OSC.FD + +import Sound.Tidal.Stream (ParamPattern) +import Sound.Tidal.Pattern +import Sound.Tidal.Parse +import Sound.Tidal.Tempo +import qualified Sound.Tidal.Time as Time +import Sound.Tidal.Utils + + +--enumerate :: [a] -> [(Int, a)] +--enumerate = zip [0..] + +maybeHead [] = Nothing +maybeHead (x:_) = Just x + +sortByFst :: Ord a => [(a, b)] -> [(a, b)] +sortByFst = sortBy (\a b -> compare (fst a) (fst b)) + +parenthesise :: String -> String +parenthesise x = "(" ++ x ++ ")" + +spaces :: Int -> String +spaces n = take n $ repeat ' ' + +single :: [a] -> Maybe a +single (x:[]) = Just x +single _ = Nothing + +fromJust' (Just x) = x +fromJust' Nothing = error "nothing is just" + +data Scene = Scene {mouseXY :: (Float, Float), + cursor :: (Float, Float) + } + +data AppConfig = AppConfig { + screen :: Surface, + font :: Font, + tempoMV :: MVar (Tempo), + fr :: FR.FPSManager, + mpat :: MVar (Pattern ColourD) +} + +type AppState = StateT Scene IO +type AppEnv = ReaderT AppConfig AppState + + + +screenWidth = 1024 +screenHeight = 768 +screenBpp = 32 +middle = (fromIntegral $ screenWidth`div`2,fromIntegral $ screenHeight`div`2) + +toScreen :: (Float, Float) -> (Int, Int) +toScreen (x, y) = (floor (x * (fromIntegral screenWidth)), + floor (y * (fromIntegral screenHeight)) + ) + +toScreen16 :: (Float, Float) -> (Int16, Int16) +toScreen16 (x, y) = (fromIntegral $ floor (x * (fromIntegral screenWidth)), + fromIntegral $ floor (y * (fromIntegral screenHeight)) + ) + +fromScreen :: (Int, Int) -> (Float, Float) +fromScreen (x, y) = ((fromIntegral x) / (fromIntegral screenWidth), + (fromIntegral y) / (fromIntegral screenHeight) + ) + +isInside :: Integral a => Rect -> a -> a -> Bool +isInside (Rect rx ry rw rh) x y = (x' > rx) && (x' < rx + rw) && (y' > ry) && (y' < ry + rh) + where (x', y') = (fromIntegral x, fromIntegral y) + +ctrlDown mods = or $ map (\x -> elem x [KeyModLeftCtrl, + KeyModRightCtrl + ] + ) mods + +shiftDown mods = or $ map (\x -> elem x [KeyModLeftShift, + KeyModRightShift, + KeyModShift + ] + ) mods + +handleEvent :: Scene -> Event -> AppEnv (Scene) +handleEvent scene (KeyDown k) = + handleKey scene (symKey k) (symUnicode k) (symModifiers k) + +handleEvent scene _ = return scene + +handleKey :: Scene -> SDLKey -> Char -> [Modifier] -> AppEnv Scene +handleKey scene SDLK_SPACE _ _ = return scene +handleKey scene _ _ _ = return scene + + +applySurface :: Int -> Int -> Surface -> Surface -> Maybe Rect -> IO Bool +applySurface x y src dst clip = blitSurface src clip dst offset + where offset = Just Rect { rectX = x, rectY = y, rectW = 0, rectH = 0 } + +initEnv :: MVar (Pattern ColourD) -> IO AppConfig +initEnv mp = do + screen <- setVideoMode screenWidth screenHeight screenBpp [SWSurface] + font <- openFont "futura.ttf" 22 + setCaption "Cycle" [] + tempoMV <- tempoMVar + fps <- FR.new + FR.init fps + FR.set fps 15 + return $ AppConfig screen font tempoMV fps mp + +blankWidth = 0.015 + +drawArc' :: Surface -> ColourD -> (Double, Double) -> (Double, Double) -> Double -> Double -> Double -> IO () +drawArc' screen c (x,y) (r,r') t o step | o <= 0 = return () + | otherwise = + do let pix = (colourToPixel c) + steps = [t, (t + step) .. (t + o)] + coords = map (\s -> (floor $ x + (r*cos(s)),floor $ y + (r*sin(s)))) steps + ++ map (\s -> (floor $ x + (r'*cos(s)),floor $ y + (r'*sin(s)))) (reverse steps) + SDLP.filledPolygon screen coords pix + --drawArc screen c (x,y) (r,r') t (o-step) step + return () + where a = max t (t + o - step) + b = t + o + + +drawArc :: Surface -> ColourD -> (Double, Double) -> (Double, Double) -> Double -> Double -> Double -> IO () +drawArc screen c (x,y) (r,r') t o step | o <= 0 = return () + | otherwise = + do let pix = (colourToPixel c) + SDLP.filledPolygon screen coords pix + drawArc screen c (x,y) (r,r') t (o-step) step + return () + where a = max t (t + o - step) + b = t + o + coords = map ((\(x',y') -> (floor $ x + x', floor $ y + y'))) + [(r * cos(a), r * sin(a)), + (r' * cos(a), r' * sin(a)), + (r' * cos(b), r' * sin(b)), + (r * cos(b), r * sin(b)) + ] + +loop :: AppEnv () +loop = do + quit <- whileEvents $ act + screen <- screen `liftM` ask + font <- font `liftM` ask + tempoM <- tempoMV `liftM` ask + fps <- fr `liftM` ask + scene <- get + mp <- mpat `liftM` ask + liftIO $ do + pat <- readMVar mp + tempo <- readMVar tempoM + beat <- beatNow tempo + bgColor <- (mapRGB . surfaceGetPixelFormat) screen 0x00 0x00 0x00 + clipRect <- Just `liftM` getClipRect screen + fillRect screen clipRect bgColor + --drawArc screen middle (100,110) ((beat) * pi) (pi/2) (pi/32) + drawPat middle (100,(fi screenHeight)/2) pat screen beat + Graphics.UI.SDL.flip screen + FR.delay fps + unless quit loop + where act e = do scene <- get + scene' <- handleEvent scene e + put $ scene' + +drawPat :: (Double, Double) -> (Double, Double) -> Pattern ColourD -> Surface -> Double -> IO () +drawPat (x, y) (r,r') p screen beat = mapM_ drawEvents es + where es = map (\(_, (s,e), evs) -> ((max s pos, min e (pos + 1)), evs)) $ arc (segment p) (pos, pos + 1) + pos = toRational $ beat / 8 + drawEvents ((s,e), cs) = + mapM_ (\(n', c) -> drawEvent (s,e) c n' (length cs)) (enumerate $ reverse cs) + drawEvent (s,e) c n' len = + do let thickness = (1 / fromIntegral len) * (r' - r) + let start = r + thickness * (fromIntegral n') + drawArc screen c middle (start,start+thickness) ((pi*2) * (fromRational (s-pos))) ((pi*2) * fromRational (e-s)) (pi/16) +{- (thickLine h (n*scale+n') (linesz/ (fromIntegral scale)) + (x1 + (xd * fromRational (e-pos))) + (y1 + (yd * fromRational (e-pos))) + (x1 + (xd * fromRational (s-pos))) + (y1 + (yd * fromRational (s-pos))) + ) + screen (colourToPixel c)-} + +segment2 :: Pattern a -> Pattern [(Bool, a)] +segment2 p = Pattern $ \(s,e) -> filter (\(_, (s',e'),_) -> s' < e && e' > s) $ groupByTime (segment2' (arc (fmap (\x -> (True, x)) p) (s,e))) + + +segment2' :: [Time.Event (Bool, a)] -> [Time.Event (Bool, a)] +segment2' es = foldr splitEs es pts + where pts = nub $ points es + +splitEs :: Time.Time -> [Time.Event (Bool, a)] -> [Time.Event (Bool, a)] +splitEs _ [] = [] +splitEs t ((ev@(a, (s,e), (h,v))):es) | t > s && t < e = (a, (s,t),(h,v)):(a, (t,e),(False,v)):(splitEs t es) + | otherwise = ev:splitEs t es + +whileEvents :: MonadIO m => (Event -> m ()) -> m Bool +whileEvents act = do + event <- liftIO pollEvent + case event of + Quit -> return True + NoEvent -> return False + _ -> do + act event + whileEvents act + +runLoop :: AppConfig -> Scene -> IO () +runLoop = evalStateT . runReaderT loop + +textSize :: String -> Font -> IO ((Float,Float)) +textSize text font = + do message <- renderTextSolid font text (Color 0 0 0) + return (fromScreen (surfaceGetWidth message, surfaceGetHeight message)) + +run = do mp <- newMVar silence + forkIO $ run' mp + return mp + + +run' mp = withInit [InitEverything] $ + do result <- TTFG.init + if not result + then putStrLn "Failed to init ttf" + else do enableUnicode True + env <- initEnv mp + --ws <- wordMenu (font env) things + let scene = Scene (0,0) (0.5,0.5) + --putStrLn $ show scene + runLoop env scene + + +-- colourToPixel :: Colour Double -> Pixel +-- colourToPixel c = rgbColor (floor $ 256*r) (floor $ 256* g) (floor $ 256*b) +-- where (RGB r g b) = toSRGB c + +colourToPixel :: Colour Double -> Pixel +colourToPixel c = rgbColor (floor $ r*255) (floor $ g*255) (floor $ b *255) -- mapRGB (surfaceGetPixelFormat screen) 255 255 255 + where (RGB r g b) = toSRGB c + +--colourToPixel :: Surface -> Colour Double -> IO Pixel +--colourToPixel s c = (mapRGB . surfaceGetPixelFormat) s (floor $ r*255) (floor $ g*255) (floor $ b*255) + + +fi a = fromIntegral a + +rgbColor :: GHC.Word.Word8 -> GHC.Word.Word8 -> GHC.Word.Word8 -> Pixel +rgbColor r g b = Pixel (shiftL (fi r) 24 .|. shiftL (fi g) 16 .|. shiftL (fi b) 8 .|. (fi 255)) + +pixel :: Surface -> (GHC.Word.Word8,GHC.Word.Word8,GHC.Word.Word8) -> IO Pixel +pixel surface (r,g,b) = mapRGB (surfaceGetPixelFormat surface) r g b diff --git a/Sound/Tidal/Vis.hs b/Sound/Tidal/Vis.hs new file mode 100644 index 0000000..216c720 --- /dev/null +++ b/Sound/Tidal/Vis.hs @@ -0,0 +1,67 @@ +module Sound.Tidal.Vis where + +import qualified Graphics.Rendering.Cairo as C +import Data.Colour +import Data.Colour.Names +import Data.Colour.SRGB +import Control.Applicative +import Sound.Tidal.Parse +import Sound.Tidal.Pattern +import Sound.Tidal.Utils +import Data.Ratio + +vPDF = v C.withPDFSurface +vSVG = v C.withSVGSurface + +v sf fn (x,y) pat = + sf fn x y $ \surf -> do + C.renderWith surf $ do + C.save + C.scale x y + C.setOperator C.OperatorOver + C.setSourceRGB 0 0 0 + C.rectangle 0 0 1 1 + C.fill + mapM_ renderEvent (events pat) + C.restore + + +vLines sf fn (x,y) pat cyclesPerLine nLines = + sf fn x y $ \surf -> do + C.renderWith surf $ do + C.save + C.scale x (y / (fromIntegral nLines)) + C.setOperator C.OperatorOver + C.setSourceRGB 0 0 0 + C.rectangle 0 0 1 1 + C.fill + mapM_ (\x -> do C.save + C.translate 0 (fromIntegral x) + drawLine ((cyclesPerLine * (fromIntegral x)) `rotR` pat) + C.restore + ) [0 .. (nLines - 1)] + C.restore + where drawLine p = mapM_ renderEvent (events (_density cyclesPerLine p)) + + +renderEvent (_, (s,e), (cs)) = do C.save + drawBlocks cs 0 + C.restore + where height = 1/(fromIntegral $ length cs) + drawBlocks [] _ = return () + drawBlocks (c:cs) n = do let (RGB r g b) = toSRGB c + C.setSourceRGBA r g b 1 + C.rectangle x y w h + C.fill + C.stroke + drawBlocks cs (n+1) + where x = (fromRational s) + y = (fromIntegral n) * height + w = (fromRational (e-s)) + h = height + + +events pat = (map (mapSnd' (\(s,e) -> ((s - (ticks/2))/speed,(e - (ticks/2))/speed))) $ arc (segment pat) ((ticks/2), (ticks/2)+speed)) + where speed = 1 +ticks = 0 +--pat = p "[red blue green,orange purple]" :: Sequence ColourD diff --git a/Sound/Tidal/Vis2.hs b/Sound/Tidal/Vis2.hs new file mode 100644 index 0000000..ed38e03 --- /dev/null +++ b/Sound/Tidal/Vis2.hs @@ -0,0 +1,91 @@ +module Sound.Tidal.Vis2 where + +import qualified Graphics.Rendering.Cairo as C +import Data.Colour +import Data.Colour.Names +import Data.Colour.SRGB +import Control.Applicative +import Sound.Tidal.Parse +import Sound.Tidal.Pattern +import Sound.Tidal.Time +import Sound.Tidal.Utils +import Data.Ratio +import Data.Maybe +import System.Cmd +import Data.List +import Data.Ord ( comparing ) + +totalWidth = 200 :: Double +ratio = 2/40 +levelHeight = totalWidth * ratio + +arrangeEvents [] = [] +arrangeEvents (e:es) = addEvent e (arrangeEvents es) +fits e es = null $ filter (id) $ map (\e' -> isJust $ subArc (snd' e) (snd' e')) es +addEvent e [] = [[e]] +addEvent e (level:levels) | fits e level = (e:level):levels + | otherwise = level:(addEvent e levels) + +v sf fn (x,y) levels = + sf fn x y $ \surf -> do + C.renderWith surf $ do + C.save + -- C.scale x (y / (fromIntegral $ length levels)) + C.setOperator C.OperatorOver + -- C.setSourceRGB 0 0 0 + -- C.rectangle 0 0 1 1 + --C.fill + mapM_ (renderLevel (length levels)) $ enumerate levels + C.restore + +renderLevel total (n, level) = do C.save + mapM_ drawEvent $ level + C.restore + where drawEvent ((sWhole, eWhole), (s,e), c) = + do let (RGB r g b) = toSRGB c + -- C.setSourceRGBA 0.6 0.6 0.6 1 + -- C.rectangle x y lineW levelHeight + C.withLinearPattern xWhole 0 (wholeLineW+xWhole) 0 $ \pattern -> + do --C.patternAddColorStopRGB pattern 0 0 0 0 + --C.patternAddColorStopRGB pattern 0.5 1 1 1 + C.save + C.patternAddColorStopRGBA pattern 0 r g b 1 + C.patternAddColorStopRGBA pattern 1 r g b 0.5 + C.patternSetFilter pattern C.FilterFast + C.setSource pattern + -- C.setSourceRGBA r g b 1 + --C.arc (x+half) (y+half) (w/2) 0 (2 * pi) + C.rectangle x y lineW levelHeight + C.fill + C.restore + -- C.stroke + --C.fill + -- C.stroke + where x = (fromRational s) * totalWidth + y = (fromIntegral n) * levelHeight + xWhole = (fromRational sWhole) * totalWidth + w = levelHeight + lineW = ((fromRational $ e-s) * totalWidth) + wholeLineW = ((fromRational $ eWhole-sWhole) * totalWidth) + lineH = 2 + lgap = 3 + rgap = 3 + border = 3 + half = levelHeight / 2 + quarter = levelHeight / 4 + vPDF = v C.withPDFSurface + +vis name pat = do v (C.withSVGSurface) (name ++ ".svg") (totalWidth, levelHeight*(fromIntegral $ length levels)) levels + -- rawSystem "/home/alex/Dropbox/bin/fixsvg.pl" [name ++ ".svg"] + -- rawSystem "convert" [name ++ ".svg", name ++ ".pdf"] + 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 + svg <- readFile "/tmp/vis2-tmp.svg" + return svg + + +magicallyMakeEverythingFaster = splitArcs 16 + where splitArcs n p = concatMap (\i -> arc p (i,i+(1/n))) [0, (1/n) .. (1-(1/n))] diff --git a/Sound/Tidal/Vis2.hs~ b/Sound/Tidal/Vis2.hs~ new file mode 100644 index 0000000..f254c69 --- /dev/null +++ b/Sound/Tidal/Vis2.hs~ @@ -0,0 +1,85 @@ +module Sound.Tidal.Vis2 where + +import qualified Graphics.Rendering.Cairo as C +import Data.Colour +import Data.Colour.Names +import Data.Colour.SRGB +import Control.Applicative +import Sound.Tidal.Parse +import Sound.Tidal.Pattern +import Sound.Tidal.Time +import Sound.Tidal.Utils +import Data.Ratio +import Data.Maybe +import System.Cmd +import Data.List + +totalWidth = 600 :: Double +ratio = 1/40 +levelHeight = totalWidth * ratio + +arrangeEvents [] = [] +arrangeEvents (e:es) = addEvent e (arrangeEvents es) +fits e es = null $ filter (id) $ map (\e' -> isJust $ subArc (snd' e) (snd' e')) es +addEvent e [] = [[e]] +addEvent e (level:levels) | fits e level = (e:level):levels + | otherwise = level:(addEvent e levels) + +v sf fn (x,y) levels = + sf fn x y $ \surf -> do + C.renderWith surf $ do + C.save + -- C.scale x (y / (fromIntegral $ length levels)) + C.setOperator C.OperatorOver + -- C.setSourceRGB 0 0 0 + -- C.rectangle 0 0 1 1 + --C.fill + mapM_ (renderLevel (length levels)) $ enumerate levels + C.restore + +renderLevel total (n, level) = do C.save + mapM_ drawEvent $ level + C.restore + where drawEvent ((sWhole, eWhole), (s,e), c) = + do let (RGB r g b) = toSRGB c + -- C.setSourceRGBA 0.6 0.6 0.6 1 + -- C.rectangle x y lineW levelHeight + C.withLinearPattern xWhole 0 (wholeLineW+xWhole) 0 $ \pattern -> + do --C.patternAddColorStopRGB pattern 0 0 0 0 + --C.patternAddColorStopRGB pattern 0.5 1 1 1 + C.save + C.patternAddColorStopRGBA pattern 0 r g b 1 + C.patternAddColorStopRGBA pattern 1 r g b 0.5 + C.patternSetFilter pattern C.FilterFast + C.setSource pattern + -- C.setSourceRGBA r g b 1 + --C.arc (x+half) (y+half) (w/2) 0 (2 * pi) + C.rectangle x y lineW levelHeight + C.fill + C.restore + -- C.stroke + --C.fill + -- C.stroke + where x = (fromRational s) * totalWidth + y = (fromIntegral n) * levelHeight + xWhole = (fromRational sWhole) * totalWidth + w = levelHeight + lineW = ((fromRational $ e-s) * totalWidth) + wholeLineW = ((fromRational $ eWhole-sWhole) * totalWidth) + lineH = 2 + lgap = 3 + rgap = 3 + border = 3 + half = levelHeight / 2 + quarter = levelHeight / 4 + vPDF = v C.withPDFSurface + +vis name pat = do v (C.withSVGSurface) (name ++ ".svg") (totalWidth, levelHeight*(fromIntegral $ length levels)) levels + rawSystem "/home/alex/Dropbox/bin/fixsvg.pl" [name ++ ".svg"] + -- rawSystem "convert" [name ++ ".svg", name ++ ".pdf"] + return () + where levels = arrangeEvents $ sortOn ((\x -> snd x - fst x) . snd') (arc pat (0,1)) + +visAsString pat = do vis "/tmp/vis2-tmp" pat + svg <- readFile "/tmp/vis2-tmp.svg" + return svg diff --git a/Sound/Tidal/VisCycle.hs b/Sound/Tidal/VisCycle.hs new file mode 100644 index 0000000..cecd3c5 --- /dev/null +++ b/Sound/Tidal/VisCycle.hs @@ -0,0 +1,72 @@ +module Sound.Tidal.VisCycle where + +import qualified Graphics.Rendering.Cairo as C +import Data.Colour +import Data.Colour.Names +import Data.Colour.SRGB +import Control.Applicative +import Sound.Tidal.Parse +import Sound.Tidal.Pattern +import Sound.Tidal.Time +import Sound.Tidal.Utils +import Data.Ratio +import Data.Maybe +import System.Cmd +import Data.List +import Data.Ord ( comparing ) + +totalWidth = 1080 :: Double +ratio = 1 + +arrangeEvents [] = [] +arrangeEvents (e:es) = addEvent e (arrangeEvents es) +fits e es = null $ filter (id) $ map (\e' -> isJust $ subArc (snd' e) (snd' e')) es +addEvent e [] = [[e]] +addEvent e (level:levels) | fits e level = (e:level):levels + | otherwise = level:(addEvent e levels) + +v sf fn (x,y) levels = + sf fn x y $ \surf -> do + C.renderWith surf $ do + C.setAntialias C.AntialiasBest + C.save + C.scale totalWidth totalWidth + C.setOperator C.OperatorOver + -- C.setSourceRGB 0 0 0 + -- C.rectangle 0 0 1 1 + --C.fill + mapM_ (renderLevel (length levels)) $ enumerate levels + C.restore + +renderLevel total (n, level) = do C.save + mapM_ drawEvent $ level + C.restore + where drawEvent ((sWhole, eWhole), (s,e), c) = + do let (RGB r g b) = toSRGB c + C.save + C.setSourceRGBA r g b 1 + C.arc 0.5 0.5 (h+levelHeight) ((fromRational s)*(pi*2)-(pi/2)) ((fromRational e)*(pi*2)-(pi/2)) + C.arcNegative 0.5 0.5 h ((fromRational e)*(pi*2)-(pi/2)) ((fromRational s)*(pi*2)-(pi/2)) + C.fill + C.setSourceRGBA 0.5 0.5 0.5 1 + C.setLineWidth 0.005 + C.arc 0.5 0.5 (h+levelHeight) ((fromRational s)*(pi*2)-(pi/2)) ((fromRational e)*(pi*2)-(pi/2)) + C.arcNegative 0.5 0.5 h ((fromRational e)*(pi*2)-(pi/2)) ((fromRational s)*(pi*2)-(pi/2)) + C.stroke + C.restore + where h = levelHeight * (fromIntegral (n + 1)) + levelHeight = (1 / fromIntegral (total+1))/2 + vPDF = v C.withPDFSurface + +vis name pat = do v (C.withPDFSurface) (name ++ ".pdf") (totalWidth, totalWidth) levels + 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 + svg <- readFile "/tmp/vis2-tmp.svg" + return svg + + +magicallyMakeEverythingFaster = splitArcs 16 + where splitArcs n p = concatMap (\i -> arc p (i,i+(1/n))) [0, (1/n) .. (1-(1/n))] diff --git a/Sound/Tidal/VisCycle.hs~ b/Sound/Tidal/VisCycle.hs~ new file mode 100644 index 0000000..96aec5d --- /dev/null +++ b/Sound/Tidal/VisCycle.hs~ @@ -0,0 +1,91 @@ +module Sound.Tidal.VisCycle where + +import qualified Graphics.Rendering.Cairo as C +import Data.Colour +import Data.Colour.Names +import Data.Colour.SRGB +import Control.Applicative +import Sound.Tidal.Parse +import Sound.Tidal.Pattern +import Sound.Tidal.Time +import Sound.Tidal.Utils +import Data.Ratio +import Data.Maybe +import System.Cmd +import Data.List +import Data.Ord ( comparing ) + +totalWidth = 200 :: Double +ratio = 2/40 +levelHeight = totalWidth * ratio + +arrangeEvents [] = [] +arrangeEvents (e:es) = addEvent e (arrangeEvents es) +fits e es = null $ filter (id) $ map (\e' -> isJust $ subArc (snd' e) (snd' e')) es +addEvent e [] = [[e]] +addEvent e (level:levels) | fits e level = (e:level):levels + | otherwise = level:(addEvent e levels) + +v sf fn (x,y) levels = + sf fn x y $ \surf -> do + C.renderWith surf $ do + C.save + -- C.scale x (y / (fromIntegral $ length levels)) + C.setOperator C.OperatorOver + -- C.setSourceRGB 0 0 0 + -- C.rectangle 0 0 1 1 + --C.fill + mapM_ (renderLevel (length levels)) $ enumerate levels + C.restore + +renderLevel total (n, level) = do C.save + mapM_ drawEvent $ level + C.restore + where drawEvent ((sWhole, eWhole), (s,e), c) = + do let (RGB r g b) = toSRGB c + -- C.setSourceRGBA 0.6 0.6 0.6 1 + -- C.rectangle x y lineW levelHeight + C.withLinearPattern xWhole 0 (wholeLineW+xWhole) 0 $ \pattern -> + do --C.patternAddColorStopRGB pattern 0 0 0 0 + --C.patternAddColorStopRGB pattern 0.5 1 1 1 + C.save + C.patternAddColorStopRGBA pattern 0 r g b 1 + C.patternAddColorStopRGBA pattern 1 r g b 0.5 + C.patternSetFilter pattern C.FilterFast + C.setSource pattern + -- C.setSourceRGBA r g b 1 + --C.arc (x+half) (y+half) (w/2) 0 (2 * pi) + C.rectangle x y lineW levelHeight + C.fill + C.restore + -- C.stroke + --C.fill + -- C.stroke + where x = (fromRational s) * totalWidth + y = (fromIntegral n) * levelHeight + xWhole = (fromRational sWhole) * totalWidth + w = levelHeight + lineW = ((fromRational $ e-s) * totalWidth) + wholeLineW = ((fromRational $ eWhole-sWhole) * totalWidth) + lineH = 2 + lgap = 3 + rgap = 3 + border = 3 + half = levelHeight / 2 + quarter = levelHeight / 4 + vPDF = v C.withPDFSurface + +vis name pat = do v (C.withSVGSurface) (name ++ ".svg") (totalWidth, levelHeight*(fromIntegral $ length levels)) levels + -- rawSystem "/home/alex/Dropbox/bin/fixsvg.pl" [name ++ ".svg"] + -- rawSystem "convert" [name ++ ".svg", name ++ ".pdf"] + 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 + svg <- readFile "/tmp/vis2-tmp.svg" + return svg + + +magicallyMakeEverythingFaster = splitArcs 16 + where splitArcs n p = concatMap (\i -> arc p (i,i+(1/n))) [0, (1/n) .. (1-(1/n))] diff --git a/examples/0.pdf b/examples/0.pdf new file mode 100644 index 0000000000000000000000000000000000000000..80ed41564bab9a1370dac96a644a88f29528cf02 GIT binary patch literal 1980 zcmb7FdsGw09=;*vsKHwmC>Zd3nQ*$ojAkV}vNfl2{`Xca+Y*zgdtVY5M^z1C1g zss%w1d5a2SO97z;5k+y$z&Yqc_Z-4Wf@0;JA zZ&-nz-m5umM;fa}Uok=B0vMn>qiL?L0P;iR5qKn6LqK90008oiiop?#7-J+j;)zJn zaD?XOMpNP#B8jCXUyk{p<(u1L1vZs0PGPz4286uQ ztt+W};Nn@I+IxRZ0lm9md!g+~`c^OOd$SR3wb#X`4Xmxy$OQ=XMCF3Gx`5^jbM&d# z^Byw%`I(Bti)9}NXp1K=)bu=Nx>0Ye;0>=fS6xvL>M|06#K zWdCmiawV@JqpI05xRc%qwKbjl%^|Jd&DM4O?K9mK)Sdq4pSmpTE!q_MX<}Jp$a|YC z82w#V!(m=oRxjh}?d5U7n1AQ(yj%Afw_Bll<}Xd@ZmWj68!eog_J=&=8BG;2a*Qcj z_u~D|;aiQk{zaN8%GYs{m)x{5%CBkt-7Q%e3hmv}wDk=G$JlrOsU9$6S9f#|eX#fI zV+tb-2|K7=QJ{chODA(JecjJ~qk7L_SY(=NujfAc(Pm)Nqt+`m%`SsRoKjY2a?$bC zjB0z^Gnp>blfHEqbiSSGa@=@hB0VD8K7Xl6kLlWUpYnNGRo>Bl^3JB+`+|S!a0u+O zXYR5E0@OD8SqoczsiikT@a@{-dM`DjD>|e0$Veqff5p_Fn7^ZqGRLQtx47M}sAZ$} zmZ`@(d;FGH#D@KAppAZ_Ys?z1ENtncsPb&=_IhALkM!@J>j531!UvZjb^bQS zOQO~}doUDYN<=;Cy_$N>B_HkmcPQP}%mb4up8fG>wJlwg-GZOZr;;kHw_&o>rY%*6 zAEmV0A4BIHygKl_#;k$vIW8;aUqeUf{BpaA4)>g_;`|d&C;ubpH(wR({ol++&fpT~ z7ok-@3YPA^s$niVoZ{iX=%@+P4C;{0dr~33T*WUac^L0HF*h{7)1uh@gU`dVyR25z zZ(5!2xcX#A-f>3Qy|3!Ihjy7=vsoJ`Xf!Qc8_3J~H8+Q{0?xKxa%Gv0#p3W*?c^J4 zj(mK^MyB|N`JpAPFGT064-%H6kz}o>)n!f9+HM5h9kBB|oCiZ2rSbaD9 z%POR2tpg}n$@5x%`T8uK?GK?NDMzz(Hkt1~*O*x93e$g!(-$A13t*2DveL!%al>W7zqmQ**Iw)msTB@1uQKcZI0$CnEQA&aICpR&$A zU$OIx@zJ3zLDcOgcTQF6A-Hjv)84B~_VW7NeNkERn47tVaWAjcNq~pg>6k zV#paN!4Nr4EPLaAA0pvV5)U*1gb)x6xG+pmfffqemvsSGSgAwnX`6N!(KB4UvT88WQ{5+h1fg-H=5AWuU) zOBKoajfuZir8E#-9~G`76p+HjGu&0A&{+wbW+f03=8mHnSSgi6VJP6RISy=&6IdCE z;|dpuI9URXz$A*uD5;W-Vi9(BhJ6AtG+ZSmZi~OM?rmLovj|Kp5K3@K3>q<=o2ZfU zb!FbJNx%>p4F-G~Jkx-aqa)W5$iQoiv&NY?E3yIk4CVk6a{q|IFo!sxKVlpXpQ!Dh zFb5w0FPNhv!TwKiPW)MW;Fu&T2Ehz>Y*5r5grH2;S&X7MAcar=KE84p3dlkjDyzgL S7;aF=;c@vi7RxKZoA!TTD*#Ra literal 0 HcmV?d00001 diff --git a/examples/1.pdf b/examples/1.pdf new file mode 100644 index 0000000..4e1a9cf --- /dev/null +++ b/examples/1.pdf @@ -0,0 +1,70 @@ +%PDF-1.5 +% +3 0 obj +<< /Length 4 0 R + /Filter /FlateDecode +>> +stream +xW[r! )!H;ci\ u{/{|Gؠ?~C/cʢ MSW+*op a2ƌPcl@{ڊ6^ף {"]b3P0Fӌ4X%c$lЭFX ѵa%Pѐp&`##]EF6Q.BsA*rJ c̭{obUN¤H68Q.PmWo0q~[VK)gvK|~,ʬ_i`X_,"HA}Sg߸*V㥆[y37]D;Ӕ]lO:v/aYB1nZUhF͌˕b^~͸S\-'eKZX*0p 4(U>NV3%\{ƭueEd9p PoCjH!tep2$Gf~ +K|_M53#1c{pJPt!ޢc~=jIqOQD2bD'KJ\\(GR=1LKJdl9M!߷SObfѪe36e"rnA #-rHhe\ӥ_Or"^ZxDyo8rIh>K۝!ElY˽Q7K}9r99rj:s@o_Z$2OSJGɁ4QrtyX+޲|eٳfEղ\Qqr\y9GJ҆ +5FNBS~~~4, +endstream +endobj +4 0 obj + 893 +endobj +2 0 obj +<< + /ExtGState << + /a0 << /CA 1 /ca 1 >> + >> +>> +endobj +5 0 obj +<< /Type /Page + /Parent 1 0 R + /MediaBox [ 0 0 300 100 ] + /Contents 3 0 R + /Group << + /Type /Group + /S /Transparency + /I true + /CS /DeviceRGB + >> + /Resources 2 0 R +>> +endobj +1 0 obj +<< /Type /Pages + /Kids [ 5 0 R ] + /Count 1 +>> +endobj +6 0 obj +<< /Creator (cairo 1.12.16 (http://cairographics.org)) + /Producer (cairo 1.12.16 (http://cairographics.org)) +>> +endobj +7 0 obj +<< /Type /Catalog + /Pages 1 0 R +>> +endobj +xref +0 8 +0000000000 65535 f +0000001293 00000 n +0000001007 00000 n +0000000015 00000 n +0000000985 00000 n +0000001079 00000 n +0000001358 00000 n +0000001487 00000 n +trailer +<< /Size 8 + /Root 7 0 R + /Info 6 0 R +>> +startxref +1539 +%%EOF diff --git a/examples/2.pdf b/examples/2.pdf new file mode 100644 index 0000000000000000000000000000000000000000..eb8b82c2e3d07a86fc5c74abff507123cb781778 GIT binary patch literal 2214 zcmb7Gc{p478oo8g5Mmm&j4DnHYRzh?W$gQ!30KwNX*Nqs!pYG_hql+CjoNpmwOpQ| zwN#1D3{zV#wU;iaK2=hxdQBCrwy1j!t(yLKe@}8w&YSP|{oeQc^1NR(D0U9|M4TZ? zL$FZ0h9Uz5fI~lqGB*eCZY*{%6apB)5ETUg0Nx=q3}S)sJ&Xpi>{tvAlZCRdKye|E zMGHsqic*gJ*z`zKYU9k+MX`A`32c2bu2j|iX4YSuMW}dkRZ3e=55J4Smz*xso$Wqs z`f##%GR<<+qkHwtTCmIWf2^%87Yiry3U76*+8x9Mdb*mp4)-Vs?`}xGImCO&^%y1J zw4CR8RO*zWbBoB`Z&s#In0qS33Y!tN4w1FZ?!*XEs}GuIF)LAy0?pAUllDSIRgI$; zm^3ma!Bz3JnR&kERYB@8oV7eyc4cg`J#_zj;W@I{@eu|+PA^uD5SXwww-)V{zP7La zp2c$Wlt-kBsJP(Iz-)n$dBGw$(NR$Iz%=Cc*P70PHz#MACE7|$NoZf+B6M_T;?P{Q z<-&pbJ@yqHuM8e(_lt=5giqYhMT5_I;Op4J)#kWoVZQb=>1h8P)1#NO{`D*KiH4#M zuy##}6eBh{^hdmZC7-11*?DPNZ%mcloI`p#hz-*GbG?Z-%k*_f83+7+ud^#?D0LeL zT#dvd7sAq&l}@MN)}mc+i^)HTLF5jV_vTEzvgR8I)@O9ahn&V=N}`W-s$J<4Sc`*> z)m+oLZ0SF0(Spph=Bw!9;nn3@jH;FFwY=FvM5%a9s>%jHq&HPCoPU>U)xTVFsJbjM z#!5T8*{_OganDM(Mm*z6M6c~v;aacu+z~FUP?MZ8^nR_1oMKDW5tJn4lzbadK`sN= z<-9BNUdYS#7u55mFed90Ci?5|$f_CXD>3RmxIpcrr7D)coXZkR9!t+}^KK_L___HL z)G%er!q^HOU;TwsH_l!Xc19I`Rn$ONFi}t36TBZkP%t%ATy?&&{Ny+Gw5MmVsxQR@ zog7N8`2*_n7dL{W>fRRVR9Ky9wHh_kG`ipCwmhNMYu)Y}KR|2Oa>m3QoH@Hc+9Sp3 zpQ-jf6IhiKUIwQf7wK;fU=n_#UmFO)V7e16_2$66Mtqlz_hU@UoeYXvBJ*m|ox$_X#Fmcay+OE|2TZva$x7-1 zk0ZElef0t_rs83n)DZ3a-$qMlsd1C+sCW0#ucvO@_N(kOJFAd2dLC;;&lP^yjNoTk zcZ_6q`>>l!tLR;Qk!ismX;F{TReF7vVu=PN=LVl+Bs_-1X3Yna61rNx=V5hA6ITeB zTd~HElc(f@MX#UOV7Rz7N{CD)mE;LO80nOBtFf2)($(}0(|4}z3Emeco$RmNbv>`X zC=(}n>7CUg{rzxCxu9iSMA?(U`;W%0Y|r_ZhqZsm(fB3G9Z^rQfz_vuW#nezmHSPm zhl&;X%*s_+7Y13+?wN9%WCnlu{!{)53ZqrIMX^)&fp6~}&Wd-{^w@}7-lRO{>;1jb3`upqB2R5@yi=ZdcTA9ye`J$CK;(e5=v){gc`xA6)(`~I!lM;>24 z9^S+A>m&|dNRXY6J@C*2_jp(!SKfD0vRX9!y(Vbg5vTTzd)zGHzp`$C4sS#K+ zOUAjZuDOnpAW8M{ybo+a{srCsh7AzYElIPp&0~Q;s|S{LNBhqA*TP^CqjhFm~>@wnmx2+MoOl z>9fK0iVXcae3R7aL^iC>?&{^EtD-VxI!6pPLL=$r5-#BmXuMeeZC63HY(Bmj9N z?HKZw1>5r=M=uDrU%=cP0pNwF5#R>^Z)*(@0X%~SUtv>*zksjs>ti0nojd^EJ34{| z;3>3V)>cjm4P>z)c-tqRcV{s}X*L`l@DmIX05X995aD;gR~xe>@&jOb6WGXQ~6TPzSEws4dk>qIDnMRl}6Lbi3_sVpuh z3S_Xj08$O=E>#HUPvh#dD()6h*H9)GR)7en?r@JngzidUv@3xvJjNgn2xu{Ap&$n! z;)o<1(Fo8AfuIOeJX~2A4F+iuA)yQ|jspg3Yj2%H0XfVl20R!4kA0u}V!VsMwgOuk zL<{2tZ|8=4#QoTr&wF?vD+omZ4xtD;3otS?BpU)jz(mdH6Vk3TAdnUs#satgO?ZW#V!@P=K2tdy2tb5y h|9qU;K^y>S#8zjy5DkR36cSC0Nhl2sdrt?{{{Uy*WYz!x literal 0 HcmV?d00001 diff --git a/examples/3.pdf b/examples/3.pdf new file mode 100644 index 0000000000000000000000000000000000000000..d105e8def8d42c35d68fa3ddf958d160970e493a GIT binary patch literal 1189 zcmY!laBGdILB?}!4=p7+{699C}J*gOBC`j-pucHaK) zeU$TdZtx1GE+y3zw(~q?c6tJTcEuk4tljeZ`8PiX#jC%+iQUr|@NR5+v!i28%%;QT zF3&!=h;)A7=+jx{!`|m1qA44t*1YF>f`?k>aq|oDdxV6uUDH`V7v(P8BvkMHJF#gc zQ?B-ftWb^Km^&9s&nmo}XtL$vo`2gM|Nl6!X!iRVBC4LX28OqLpUj(h_}-;*1?S#P z8gA#8XKAmzm9uKw4cQB(m)?GC(T;t$W~W{Gu?ybTOdU;JkJ>Nwo$S0~IQgCM+#UM% zKhsPlx3TAG>{w~T@htS9(Zsq)ul+vDHg#sfwL1Y8$(efu{r}_`e2@L{ z%VBwal<*PZm#>0$S3KoS@!KnWlTL{M`~;pQml zhg24%D(D9!rl*3<3`i_W%_{+FgT=FNYD#9JQ+|a)G*HL@=o$kBLm-X?t9H)MD*-Am zRsbaxNV;$@$}cTIauCFPuqe!p!9ZJ!67z}+Kz1cp!h}5)N{ULst^j$&8K}x7wJb9^ zHOSowqy*v*{h-w1{L-T2)M5otXapho3gl*3az*&680=8*%#>oF4?rFdg1fyG2LnA#yGX;%|l9B=|ePGA}MbnEC3o8=r<5iG^92d|5b7#cGOJrzZ%XjlW-@!uJ@@Q;=AJcoZD!4v@?5;!f&k{)o$^ZnKad9qv#N^ zw`42|>`_#}eP(7%Zp_}EKS#?}FnBJ!;nQaixlG=+QS8lo){)?+%_01pQQIY($%3|G zPX^ASF-$e@vvS9Vu>J7@F2Z&Cc*`WHtZ4tfZ8vgnS0_QM&K)STYdDPZ+{WKps6hC= zb;azS?#bbF)BS|0mYd5h0uT=!Qx304hl^tBFInl-443zvmY+`q9oa6V&*s4W)i3$V zf2Aqo(u{o5T_X1d6g91`gkEW(_a^6QD9@sM@f*wbi>ghc3YWS+UtDkZ0itY`gq31lKpE!d2E=o+7KR1N!3=DjCS_mXPwfLHJe9TfT3I5BA*g% z9irf~MKv!3c*&q3}J! zw{GpWYcG5GvPPr$O*cR9*+^8LGSIPk0ka8MOGkbE)ld0Aw0>%`0pvATJI&c!vWh(g z#+1L3n=rs7-TJIkGVWQEM2&nXrzD1@#r{eDy)zY?vlm2*=64G&vYTQ{81Fe>%5rit zTy`55Z*j&P7A5VDI{q>xA|fTG&k6FMU{XJ-Q%OHl%S5&ySIKf?Am1eYn*=ZpvdQ3v zAbAIsC_It_HaU zRih6`P$rCDV$wQPhcLj2_)MKlqpr6#ht0u0oic2 zFI8`l=#1OH3m&FzbGdh-mqRLgqR#C3N8lEYeVMDf*1Z6$88U#d#U<^ z3k-FK<&KqeIgIxDzeMCaXX_snHZsyx;kz^GZ?=mHMl+&@jXFAfmpF~HM0^yH*?XAu zLo0jK)ycP|?Pg2LJ8R4Wh{WKI+x|trh!0Gn?s;jf1uagU>&(@SMNHgoLNo2zmy}E^W?%Kkjgk35Scc6~DKg$Zp9Z?0bb#TM`+YZ-cK0`=a+z z<}b_V9Q$acL+eaj4t^YhBA4p4Lt2jKqRr8hbde9vLstI6XX@RLIPvOxb4BKo=HEDq z9I-N~iOt@klIN+K-ISFa6M5a)kX@zY@LOL&J-fkieMuRU|1P3Vm>#%2z;ira7jPmY ztDU_tUqCWQzI-t+ehZRfMyI>FI$Duiq#^MaCyLY8BHKpK8U1CYZvhm1Z+E7PI4j>X z@rNJ9V?ENsKTD8qp`#YQVomO$xiJ$+tBy(IQ9S@l`tk)WJAcf1W$@4OV) z_)w0s2nDFc5r%MirtkZ}CoFGA;!&m3g}cVzV@h@Y?bsa~`|~CGFQ@BUQn#qf{rC4| z#CgB6j=kyQHR)CFqW+oyZxah$P&eche`{wcd=g*~JyZ0_<2$9uT?fqzX!Dypcii@% z1-NkMNAYo^D_0@36g}j7M|2NP)(J`B(07 z8a*@uPu&%!6U#rfUKPzf}5+CUplo#@a{VHRuRi5~FV z9B|trk9N3zyTJ>SuL&5~fo37xL@=x_&0DHdsxj5En|};A(!qLAfsc zF6To9enQT=_dl2~w@HiiaI%+qOdz zkNz%Z_AEMdn@#vAe5&u!q?BLMa;XnU^%*T!Ej;FFx%&xy;BlNodP{_*K!2nxCHFw% z6`8X4w+VIfB3t$_ou@dlDs*-R-zL*3C8AB8{pi{Whd0!{0nC#}Ig%Fq26YiV1mBL5 z;yTae2gf zSC34*^nk=gsaNCKJzX-+>T zp+l4^T`r3Iw=m5N$x z!d=octS{bP7=)}|#8OB^Z@p#(3&eBDkLN=KQ6OY`M(?>2VJ;P@ubO>zKM#K-i0YLS z`Kj|*haO0dAmWL%+KYCWIJGHFXj1&Q{8!4V7LjIi)JwFjGadyq^3+^J+p-Ufs=B_u$6j`_`o+x&)x0FbVC=8NYI9Dx6+W5$$DijgRam7qC|UQHZ_wE zDy>nxALWyh?2#SAb7Z~3Ah4H{?-JRpdqL^;ZRe0=Vzc=duXEqbF4ByIz{J0x*SZ5T zRIFO+v~3H~>3!s(%GHx|bsdo~+#YJCs&&WQ$@z~GDpA^K=P)(Nvns+JU9YcG#S&^< zp_a_Uw$;f3sP+Ax7kYB3G**38k#z}?{PXMy57in*KU-^2AK#zD2uDBAo!4({iA6uZ z!?aZYo>^sQ_ct8I_XfdhhjwQt90|IR3Lx5qx$Zv7X#X?vnWFDQnvriDOY* zKVRok@l}S8(N5?Bvz$HXH#d7B>UFc=M=#oOPX*s?TCi=E%~AIKnAcEud7pTVt&SCl z{gg~W+G z%|{JCt7VDzE*M))$kXZ|n;W6gHvT@Z)Y^x~uqjnDU-0}qWl3l%R$5cKht^VsebQsWTq*2Z6pcxA|V zkC#%|ajDzBWiEJ@y_w!(iPQxVJnCGjB*^bwC#_)wXK6f6ipxXg)(VuA=|%M8O%X_2 zo5vpyELUx5y3_6Rhz_iMlKsLv)b)7!;8UGW_cQRUd!6iIV=KVB6W$SAEnS(yT)zWr z$1h_!Nc%|RMOPRy5wpt8p>yTn^-V}TTGwyTU$AwsJeNW{_o)+|459iDJGxEK)V0#} z^Q)8v#n2xkzmu-O?lN{M9cQHX6=rAA-kWu{(`S}m?JbI2fkyw*|$G@ z3KBQrS@fN2lE6`jV86zzFDjx7FAYzQ*8U|s^6hs*%6=sKD#;I>Oh^&zE31u-l?~}r znz%)}R_)a`yUnU|BuLMDW5o0sU;8ig1Ea0G#q=A&bgvO`CyEr;h$G?Qn4v;Lb}!^z zp@!VBGL9=Qed>TJH%qHy5d}X_93fy2A%p(I`?Rv#=2MJ>T<&Mi<2=TZlS9)6T@m+) zeTF@FYhUh`P)yW?@a?i&W;UY@Mwf~&gE4{qq>WX8sSjrvx(_b#j%&0K`d1N#2pX@S ztSW-?F7fkrs=Jwy(oJi)dFd6~11pLZ0QKlPH3W#M)Rqc zNU-TljfAMq>*u|ImfZcxz$uW{ zu~+SKu;^7o;8(I->RXaqrxJ~qTE7M^i&+(O5cnFc;Zr#3Hzy{2qIPDTy@c0Rajxj} zNoGjFFJJdXTbZYEQ1oU7MK)w`Ue~{@fG{J|nJMwH#b(!CRQYcQ&qrcsy~symwmhEz z^vvNHUUFDz7I7yfh;nzwFl={^@=jc0f0I!9#vJDIoqc36h zbUK(JAQ)(+^KeUq$*5%0>(Q)iXP!8hGv=o@l5@2PKN|OSwpBu@K zR?;nhM^D@#2qI@fn#t*nFDzjIH17(9O~_Xp@#0HGtNkn^TV`URY`>mP;Y2Ljn`+2}`rMLY zQ2#Jz2Y2cicQwtZ3bKlt6kF+-{v^H7AceE^Su=7ua6>1tNLDD1O{b6=7ju#12-gxn zedr}h^vWWnRkLKk0tXt*GL<9SKEfB6_nXkVhqiXyl^I-5+}T8Ph1)A1uR>iRMopU^ zz$Q_Ff$DsX&S(I=j@zZ_=>a9*FwYJZ;galmn{2-6Sdkk>5 zl@y`{`Ch9(PEWyo^-j%Z{(j5y99>ss=1*TkMw|zV{I}@HzM?Luqu)>Kng2 zNoJ2~9_#*SU0Z?172(UF>TG+&ykJhAqM1YgT9iK;oRh-3U`=i(IVM$-PTj{Xz22&C zV$u3K_pa%!*l;tS1JB<5xSaXouTzZV7QU*lu8IP;t*~uj^JX{E<4*12%n5^JVQ{MbPK3{l+DWsCU1}z})#S zh|ftDvL!!g7cTelzH0;1&{oJQ)_zWr{UD&^Ha7hz1gf0r#+Ukd5io|rCuer_<9rrRA2No70)4}xm$l(By^V7+`ew_B)pWjqQlzK+KP zUf3nS&hwK?dwo+}(BpWD$6)axJwvV0!mH58JyWS>c;e!WyA~$_RiS)7s>J76GCbV_ zDuOO-i6dq~oyNzcuQCxUE#?xxa=Mcd#A{WMZZlUW7$R`;v`W6Q>|JV`iRsv^CfO0v zb4Z;d$|R_!vsD7ezhY;qt5*f)9sh{xZZ_`31x`x`hkO86-^LTSoed2KAD=+ddAsK7 zXDkqA-$eudiXtnu)7Sm&uot1nFu6NANIX4!QTM%51gJEWQ`7s^k+ap{Y=!@zH*Zr{ zQ-ctF<15r2na@yPQXAV`gZ*axu{v$zlO6}LMy*|fVwf%!u z50iMGZ@-GdRd_k)#Hl#)OWXEB|IYKlK3%5zNf~O|usa%XPka#?nQy02Hf3@il%p-e znYmQ-kv1Hga0ybi>yIoRdl!K}mXtf8HE85|-*3J7lG1qxN24@&mk2(@8{R^BmJC{s z!IePbm9BC6;6;3>pgCcM1&~cLfdY~zCr0A~s%s&~cHx5Ttg|5eyryL(UCFfGDbxAa zT%Gm0`c2tJat4z4*KMbhI@7@vpH;Tm&#LgCHlLm)B8fWB4Ou>%2Go)a$F!=|WzBnk z?`1LE*zzsdG)5mo~H8-=eaNRaytEbM6qN9aj7ksVMfjb%zUcM9+&I~ z;2t46EZ)Au>HA&VNoD<6?6^P76X*PCr$QxEZg@Gm@|0ro-6{>BfH{+7k9D#0*PZ^1 zrbR7Lr?-j5lAf7+R`$dCE@MJM#GU!?W(|`w_40Mx`0jn*m3}5^nsmA??8LpJ7k|$!X>jhG>w#K*z#>HGG(6Fja8TZ~j zCaET7;YPNM*Krm21S<;Cym>DmuD>s06>&(qt>ov!YZ_8F?{@D4bqtwiKa1inm>+FO zDZ)#yeBI$z)aXHx&4s% zZs>jYNYSs?;VHSBWP+z`$89x}lM8r4vMRf97ZNg8^GQ5|&~Gap1|O_uBF6z=hBmVf ztIBOjNWUM6lrIctPDRa&gDe~e))$-%zVAh#ZN041rJ4WqWUBiC>@B$dfB^xkH2DtIY?M96m=6 z*Z})my#X`dW0}pHV7FGA*(k768Dvc&2?ew+VxqgZq&-8_?cPgs*uhYPBGovZA zv~0dzYA!|;sWG2(E5lQ+QMjYOrD4JCr#dokQ1yFP4O*uP-h|@O&_S)^kNAk7mrhAO zOnIfX2l|BSkvZ}+M@7!bDH>Eqr56sVMODZrt(=!}rn-M-<4kSwR*xBx&u4eEl;_qu z*?CVrW3wFm3fyHg9TjDr@PWTkjP&QleIJhTs9;}l_qZ&dyXNZ&;uXq^F8qWUc~%Y) z=Dn*ePv9!u*B$Q_>$Po_KP|EsS{pE${b=~kt|< zdb>LUqqXh-OIlN6+Z&)$vFTm>-7m|}bofCLSbJElM`Iis`P6QX!|I#kd?Rc7%2yH^ znMCHwhNlj8m*RfZIA80t@n%m`n(UqGh4PBl3cj;SO;B!S*AkkNB$+Iq8;(WbA}R9{ z@?xa8%`BcL&{eca)^ZFCp|xG4*3a45e}!;Ce0RCp#YUOM)#D11gCn<}{hBMG!RKYl z%$FE{GFWOwsbgo{m@EXGi{G<%NNp zaK9>1l^n4-(xkApA#VeXgVgCh}g3+mY)+8T;pg?ll?V}--tqFosyd77T9s5OT$tD2^CwZ z#b*9leuirgiox3J*e!kLuVVJYBvmzd!d-!>NcP!Hy(7Q2lJZ_!ufQf6SVxGCAnJ^; za=R4T3#o7eK)3l$mEWv7d6Je;X_jhrhzL9EQ&OZ6=ZE#8Ro>xYm_w*!8kQS0U;Qv( zq+feG*u_e@LBT(E#5Jtm4?{{TYCN8LxMmou5^+?fSw^;8DXNk zG^uFRo{URd@F-7_C{+rY5}{LJn^J7vXL=36lx$Tc6}9#hBm_&|Ub+|9f-T+G*wTGG zkyNC36_HeQQ@L%{7PC$~J%#Z_*$$U3m6o`y8s7kwjzh`e> zYG)raqwuvPJ!p#@wSL0K*;HVE#<-d8rWWd@=c+bUDLpD(b`*A8!FG&Y8<{TiMf%FK zv`QQvzE}6Q@xDOSH&%5_f^=}IzY2IXN(J}~tT7>%xpaF_vDEAlt#=fk%y!$0#ffTIx@R-60xh_db5Hj|bz@d#|D;r@xLMHOnBDhhGgq2sU)-uYi`88` z%m=Vl?l|*^*j3}Q=*gPHMG?m=G^c<|lK!Kshm6<6s)&!404pcUe~Fyf ze>d{zjV5|?#j2vh{31d(1~<2S|4~o>=%sQf2OhXYxx=Ijb{0kT2N?Ob3$UT$7KZeAfEo2{#> zvls|Fvsl!|#oXD}4uar@x!AC?{~1Tq1!n06!HU@bAN~HD7vX;d@HYclb60amn9bk5 zu{lEgD>MJ?gLJX72Jiqy06hO`Kp{avenFr$@L!m)un5-kO#?dp2NUGM&e#9OczAfR z6ZF3^VF6*0{|6Hk#^(F~*og>Y^YMQ$QIUU);p$>;=V;~fNBY;c^RmK*e3NG_7|a!T lL;Ua8N6E<=2E0kcpUfg$&0SpoFcjh8=Law|%W231{s&gFx(omS literal 0 HcmV?d00001 diff --git a/examples/5.pdf b/examples/5.pdf new file mode 100644 index 0000000000000000000000000000000000000000..4d653c7a5b63dbd8cdded6ac09e697898ff57f5f GIT binary patch literal 2622 zcmb7Gc|4SB8;(j0(pb`w^rj~JteFr#jJ1et$=cu@rkK%enC4`eC{ifNcGOIW97HK9 zOO|s!>5!&Gh%+c#4kg*D^A2s_Ie&f6Z{~gGz2JLnls!lZVgv)bAjla8007FG9Krx;&>TW!fRvd}{>JB~V{yoE9 zQrUZO$3S_a+8whPJ+AVFb%ley#EPG9o8cUGibbWUno$$RRG3wp8nO>6@m^exm@?mC z)IYwM+^=cM32Zr;G~ITW5xYJ0!)WZ$UV?$YheXODzSyO0kIL?0YLjlAy7_K(m;D91 zp((3a>^=3c-F|8JN!*VebdHpQv<@aGbt{m_a3+vDVzhx0^JL5 zFo({|xw2Y?aN>!%EHXBM$$6oDG$O#+gcDk&+SsadZU26}s<&cIOj{Og$bM=;sK)BMKO?py1RWZ4UKvu}^V?YA|{HyJHh$>^9> znlliE&uz+M!jt{EM|)>peKdT;RU8!@Tnw2dL43W-^+%R0%rqCD#@E^A$?{&P)Mj~d z#A-a;%P(t`l~yd3JYv6J8)9Y!Cq%y9=vPn5dUoZ%!=)-_*-1KoYI6M)(cpbjxUFV> zmwMVzL!zF%ogb;gjZ|};ptHZj>ZEbI&`VSy@u`;LUsG{wJiIzrVSG$##F_E_7c`%X z?UhP9`s7w^-&n~(hr_FpgO_wTTqadeAsbTAvI9P3{W!MSHK*um^N5eBTQrHwcXHjb zNvbikFjr1FLr%SEiD~+IPkO8aV$jMq{QkrC8xs=UO5)FD*$P~}t#KLYeTShw+gW$W zs=uNV?easbHvQIG9Pd;)!#Tt>YkNG|oA7l4L(0w#o*3sK!i7a^7cOMQb-d?Aq*ielc6oiW7 zlYYC#!MFLtvAe3?s;rTmHs!YYc!r;D&~Cyf>|C2vBrDsBFYhVnP@F5dyWVUv@`Vw$ zNPl5Awne;Dc-@`!#whxbk71D+t1c4G8y0rp^#59; znPx3Cx2X1z_dWJh*>QZ#(!=7StQfg_klCZlmv?ZZtHy<`4Fw) z@%m+{VpnP+UTw*9{lx7e{>)zaHJLRkOU?@J19jVFSTlGnfreA{-s~}eJZ$biW9}(^ zQoiK9tE7^B=Rmjg*_2sJi-m%{whJ`9iLsMgiVol1_Upw4O7>cpjoMl6lG>@lSII1T z?RI6>OsQ?hw6^15u76h;tXxXyiJQ26NCpu*&Qpnv6{r{s1Rfhc#5E@Nxv$sp9u9o* zZ2cZ*h4x$Sa`!?vI>wB!M@|8BFRtGaBk3pMJDSeDG|jd1yTa>sf;*>oSO!U9=M{En$`xQ@%-xP7y zm+WShMhPxQ=xQTF%7+oPRdsPUigfW;_!{QkN6#!*k7x4K$`wuG2C)-mx+7?Ph(voa z!6FZTuBsTr%8S)7^Da(;hWXWAY?e&^qL=P8H*wrsSA&b9g!B4bHtXy+ z7Y>ILyM0(ax;gUUvrei99;BO?9Dk6^3%hh?7(7t>qS?8iux>Ptaxi?tcI~rsloDfz zo2Sa0O;I}lwC1X5jbhR!8Fqt?p9yTzDbKwBjqQa>FOo@2L!$u<^z~V06Q~phM5hBH3t#bT8yb}v_CrD|@t4uB zIl4f*(ufp#m}swn$gi*+z@Ragvk(a(KrBm;MGgR+Z7f8T6&)yNkWOXN0zf(-s)q9q zszf<|y+(XjMPE*IA32Z?DG&*F{+2saB=m;>_#Xlgpz8&LN&_?lh-4ZSz#uVLBnA&? z1~V98MkuJV5E?`yh6R%Y=twFpNK0#ZA14|$kQo5oSN@N6-}|!rhXhs>5Qq$72sLOW zHq;~fm(F}&6F~z>Ff?EQLw_3pUSA)l50HQ_7#4$r4wPsBl&=`ZV3)x^F*F(j73iNl z?7uNXEOZq9mxsj|8vYBzVSm_zK_ikwK-%&x&xOnep_D~^cBWDpfJpet@v)ZNRuL6Hqu0q5Fmu6)DS=f3|Qy{2wegx^e#<7r04-f4n;Uf5u}Lp z-aCj9rTWoCN@#*Kxd|T6@w@leooDYU@2pv~-dXeG9T7uKt;6N8O z7c?-IA#(f7;~UOB;fP>u(6XzpsPpDvOlU~sg)Ilh?Pj12|MS6O84NNJ zuwk9?KR}rEY<67>>HognQm}L)#J@610TVqO=h(QRWF%nahCr$#1P#8@G}l=9JVA{M zhF&h3s6mVjH00+79dBMziC~#F=!6MsnD-1n!dU?F83$hbX zV@(*NkA;e5a(>KLOfOvf56GrB;@$1lC}W8+>p>0FXZI9Z|J$-f9LGjEstV3Bb**mg z?Rcj+`oC8tk=gad=~ADUuh6wY-h5zlvl*bD=Xf-ES7FB5dR1Z>nRUUl!>C~o+>$$%DN_L9;i-N~gWM|Kz_5sM^FZyic@IX)r3;F<26R_W+FLrFktrzR z9Ozo^DRmb7gI%t*$qpr%n+YAene|1iUiT?YT%xHUH)2g)Sf}JVQn@cpFhIY4*EKMVh?g3OjfF>AcLGo;U{}~(|Cw_GTup(XANbt zlv5Lq|H-*CniHxImz}Uu`EW=V#+&~@@S2yXbr#QeRWZ9}ot`q+Rmk9v9v2|(=3Alh z0ZeIw;RzoP9}5dBjY+nBRfXZbV%$`_8n;mCTy0lFj;HkkA18DB(B-*^{k&!v$1Nrd z*?n*de5yNmU7>poeMnc1lf1e5>Rc$~Ir)U_T|?KIsUc++hu=fNy;obZ|xtwJlI@-^Fs zc&jwmT>ACb(?ceB{hh>g*s|MK}cTfebJ>C2P6( zQRq9LF(w{^=`v~5GMq%4f7l7HuqJox@U3V{3VVpLV?4~$*%ZueF}^B8U$b+rcG>Wy zSQhMWRc@jdICI?F>0{>I>8-EcR|?)R89UBCBp)%jCcI)^)vBjaAFCJX(!fz=N>ljd z{Y7^~(H|j~eBUsc4@QSifh}Lr+}?B+|9)q2R!pRj^WL|OD9M_;?|b8_3n;C>xbqL`})2W(Ly_oWG52XQ@$AwSEexWt&CS1t9)aNTROrg=uQ z&rDBWc!=9SOGbA(%ihvyBxx+jUL_7CM2g-EBr|>ncwxv9Bo`&9QGu66{gLXZw!6*!6~^!curRI8*G*w?(YX9=yy+9 zt*56=VK{xK-Qs-@O>T0-GWRfIzDk6k>2!|qBHzK$kSknqX#38G6S2E$$r8|l(1EU$ z0F`w`O^ZsH==<8w0p$n&CvNIH3bph(MNKaUHpWMIXP>~z=L@QzH4m56tvc&)cX)vb zaXyrw*Qq9Nd?sqW!Re&7=aekXGe>J-n&+0uC>FJnmjZp0qpfIgUB+joF@uxM!8)~R z7wHGHna-!)U_rmnDHM{+)6jkK#hA>-gUI)NQED+(7wa*UA9(C_=oEcur>)n=>0pc0 zdAzz>OA*83F46sJpbd*iw_=_Eaimzb`^VJS6YK4cx2d5;DbODG7L!dY9q^3Z!Mc8g`1sIg z>7LR9HXcqmX~a&zk4wC-DVBsodMMsA(?UHD;eTb3@#i~Eg}awE7G8o=_B^50gL`_tO1ye1rEWkD@?>ZVWr)lN_W%{-T0mht4G91K|jqxY#%sGmI|% z0H<72;;rZ7vK6?mfA9HltOwT^ma}yyu(_~<2|f@% z*sq*A64ywl_(DP7at_vB-FOiH7`R$XXlX27Xq91l39qVM)5h|(J@Bc$5whX?VpQu8 z3Lw9PjmVSSU^)Ii^b!5?7YS=IFG6oqI=&`&?_xpFa}VRquiQvP(Vvt~$=2#5!7eUI zQF^NMyq8@=4#KUYq2M$>ciaY9QM!YfV3&^aOD1*PE3KApZEg7`;!@g8B(M4R;mKB3faU+k}fKokZ^qr^P%!Jd`#}u>#yS$yt$b4&N zJEDQ`$Y7q9)-e1)gf3-dM(s%jzlo~ye1K-=Kvc4UP<>uD)>S)}4Du%B+#my7A@99} z;fEevqgc+!`Gbf*w^6AbK9KkKY0iT*6@_H4sR2v|G|8pD?9~^akKkd?NWMFolF(S)RrQT zrQz~$ssVK<{f~@363z&30@8>;5zTe5%HRb!; z59}X50L0kG9RolN(GHj+pN420#*IK(_Dh{#$JjZc)v?}y83mF8WTd13DCM^}vev-5 z5h&((fGY5Rs(B<1OLYG&pr8Ja&|fhcQFg_l-SFQs}TJRm3x9!td8V(qQ?B|k?}7p{86CSob2!v22|pxe_|(6iT>t5 z?l%V-l*b1Fivup$qMdM904fQUmW0Xy7aR!$cSQ*0WGScv4(;yfWQ&)?;vB@qkM=Rd zVeN>vl-JDvW8J@bf&Ui3PX-!j0@@Yp@Y6RXNBF-p^Y0pO9L63j1;~S?{waVQ3?>5u z?18^A8K}HGa5M|J{lcUbq$uY{E&pOtQc%hP{Wm5p4_Ejy%nPe9`cM+{|TWn{r3 KA_xO5@c#fTIb1&g literal 0 HcmV?d00001 diff --git a/examples/example.hs b/examples/example.hs new file mode 100644 index 0000000..be3f907 --- /dev/null +++ b/examples/example.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Sound.Tidal.Context +import Sound.Tidal.Vis +import Data.Colour + +render :: [Pattern ColourD] -> IO () +render xs = mapM_ (\(n, p) -> vPDF (show n ++ ".pdf") (300,100) p) $ zip [0..] xs + +main = do render [a,b,c,d,e,f,g] + return () + +a = density 16 $ every 2 rev $ every 3 (superimpose (iter 4)) $ rev "[black blue darkblue, grey lightblue]" + +b = flip darken <$> "[black blue orange, red green]*16" <*> sinewave1 + +c = density 10 $ flip darken + <$> "[black blue, grey ~ navy, cornflowerblue blue]*2" + <*> (slow 5 $ (*) <$> sinewave1 <*> (slow 2 triwave1)) + +d = every 2 rev $ density 10 $ (blend' + <$> "blue navy" + <*> "orange [red, orange, purple]" + <*> (slow 6 $ sinewave1) + ) + where blend' a b c = blend c a b + +e = density 32 $ (flip over + <$> ("[grey olive, black ~ brown, darkgrey]") + <*> (withOpacity + <$> "[beige, lightblue white darkgreen, beige]" + <*> ((*) <$> (slow 8 $ slow 4 sinewave1) <*> (slow 3 $ sinewave1))) + ) + +f = density 2 $ (flip darken + <$> (density 8 $ "[black blue, grey ~ navy, cornflowerblue blue]*2") + <*> sinewave1 + ) + +g = density 2 $ + do let x = "[skyblue olive, grey ~ navy, cornflowerblue green]" + coloura <- density 8 x + colourb <- density 4 x + slide <- slow 2 sinewave1 + return $ blend slide coloura colourb + + diff --git a/tidal-vis.cabal b/tidal-vis.cabal new file mode 100644 index 0000000..289319a --- /dev/null +++ b/tidal-vis.cabal @@ -0,0 +1,25 @@ +name: tidal-vis +version: 0.9.5 +synopsis: Visual rendering for Tidal patterns +-- description: +homepage: http://yaxu.org/tidal/ +license: GPL-3 +license-file: LICENSE +author: Alex McLean +maintainer: alex@slab.org +Stability: Experimental +Copyright: (c) Alex McLean and others, 2017 +category: Sound +build-type: Simple +cabal-version: >=1.4 + +--Extra-source-files: README.md tidal.el doc/tidal.md doc/tidal.pdf + +Description: Tidal is a domain specific language for live coding pattern. This package allows colour patterns to be rendered as PDF or SVG files. + +library + Exposed-modules: Sound.Tidal.Vis + Sound.Tidal.Vis2 + Sound.Tidal.VisCycle + + Build-depends: base < 5, tidal>=0.9.5, colour, cairo, process