From 2c6568acef8e0b658ad751ea1f1f632b66b541bc Mon Sep 17 00:00:00 2001 From: willbasky Date: Tue, 26 Feb 2019 18:59:25 +0500 Subject: [PATCH] Upgrade to tidal-1.0.7 version. Added comments. Added howto run animated pattern. Refactored all code. Upraded to 13.08 lts. Added 'stack.yml' Improved '.cabal' config --- Sound/Tidal/Cycle.hs | 283 ----------------------------------- Sound/Tidal/Vis.hs | 67 --------- Sound/Tidal/Vis2.hs | 91 ----------- Sound/Tidal/Vis2.hs~ | 85 ----------- Sound/Tidal/VisCycle.hs | 83 ----------- Sound/Tidal/VisCycle.hs~ | 91 ----------- examples/example.hs | 47 ------ futura.ttf | Bin 0 -> 50452 bytes src/Common.hs | 116 ++++++++++++++ src/CycleAnimation.hs | 315 +++++++++++++++++++++++++++++++++++++++ src/Examples.hs | 108 ++++++++++++++ src/Vis.hs | 117 +++++++++++++++ src/VisCycle.hs | 91 +++++++++++ src/VisGradient.hs | 95 ++++++++++++ stack.yaml | 14 ++ tidal-vis.cabal | 38 ++++- 16 files changed, 886 insertions(+), 755 deletions(-) delete mode 100644 Sound/Tidal/Cycle.hs delete mode 100644 Sound/Tidal/Vis.hs delete mode 100644 Sound/Tidal/Vis2.hs delete mode 100644 Sound/Tidal/Vis2.hs~ delete mode 100644 Sound/Tidal/VisCycle.hs delete mode 100644 Sound/Tidal/VisCycle.hs~ delete mode 100644 examples/example.hs create mode 100644 futura.ttf create mode 100644 src/Common.hs create mode 100644 src/CycleAnimation.hs create mode 100644 src/Examples.hs create mode 100644 src/Vis.hs create mode 100644 src/VisCycle.hs create mode 100644 src/VisGradient.hs create mode 100644 stack.yaml diff --git a/Sound/Tidal/Cycle.hs b/Sound/Tidal/Cycle.hs deleted file mode 100644 index 8182eeb..0000000 --- a/Sound/Tidal/Cycle.hs +++ /dev/null @@ -1,283 +0,0 @@ -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 deleted file mode 100644 index 216c720..0000000 --- a/Sound/Tidal/Vis.hs +++ /dev/null @@ -1,67 +0,0 @@ -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 deleted file mode 100644 index ed38e03..0000000 --- a/Sound/Tidal/Vis2.hs +++ /dev/null @@ -1,91 +0,0 @@ -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~ deleted file mode 100644 index f254c69..0000000 --- a/Sound/Tidal/Vis2.hs~ +++ /dev/null @@ -1,85 +0,0 @@ -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 deleted file mode 100644 index 6b06615..0000000 --- a/Sound/Tidal/VisCycle.hs +++ /dev/null @@ -1,83 +0,0 @@ -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 = 50 :: Double -border = 5 -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 label = - sf fn x y $ \surf -> do - C.renderWith surf $ do - C.setAntialias C.AntialiasBest - C.save - C.translate border border - C.scale (totalWidth-(border*2)) (totalWidth-(border*2)) - 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.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 - -visCycle :: [Char] -> String -> Pattern ColourD -> IO () -visCycle name label pat = - do v (C.withPDFSurface) (name ++ ".pdf") (totalWidth, totalWidth) levels label - 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 visCycle "/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~ deleted file mode 100644 index 96aec5d..0000000 --- a/Sound/Tidal/VisCycle.hs~ +++ /dev/null @@ -1,91 +0,0 @@ -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/example.hs b/examples/example.hs deleted file mode 100644 index be3f907..0000000 --- a/examples/example.hs +++ /dev/null @@ -1,47 +0,0 @@ -{-# 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/futura.ttf b/futura.ttf new file mode 100644 index 0000000000000000000000000000000000000000..cde2c37adfe93844d940b3a92d01d0d7de94d7c9 GIT binary patch literal 50452 zcmeFa34B!5**|`sduPeMO(y#?lgVV?C&?rsgdyzvmO$8LN4Btupn$08Yf%BU;Ep@C zmLgh-XmNRMYPD$hx?!!gi`YelT5bEv1Y6(t{eS*%;LO~)bLZakJm=ZZ zbDkqe2oWc?30+(?VM=8UKJnk5(Z(-WIdApi#K;mMs96Z}wgns3JD%UW{1qWANAZ2a z;?+x5KIYM`#%G)pBbTh$w0QgQH+(`^lZANT!KI7lEyQ{JJ#qvu^-FOgVxRdJ`1~bn$~Me)NQlSUgwVQIbS{`DzVrTTLOhYi->;mvakV~) zo)F^c4*cG+YTn94c*oz<8_~y0S9h*kuRebl_m8x#Ub|@Z5$d@{i0_+l9!;~+C&G;P z548_*<|Xw`Wuk_Ro~qxU`Rc%*@CnDqnm(dOkjGR(5%L;MF#d!{2L5nF8E6(k>LiXe ze8(;P4`1pgv&9+_85JE98yBCDm}E<~r=+H(XJlq&=j1w^d9HkSL19sGNoiSmMP*fW zjibV1>YZP|D@>-vz{k^Ko3Mx` zu~qbtl@ckFa;ch{Xef=OcA80xXbo+po3*F4A80RYZ|k?{x9Jb)`}J??kLic?=k;#= zMMttD!;$02a}+qL98Hd9#}$qT91lD5oO_(#$kXyHdGUEkdG@@FyxhFvywbdpdGqoX zxinXT%jp(w%^l-Ta3{Od+*$5?cbU7^-RxfB-sax!zRrDv`xf`T?gQ?}-A}uZy1U)S z+;0{%7x)TV3oa^HP_VdQ`NvvM4=~~o_mW02ltwvJMU6C&M$km+pgFXPHp;%gh`ztk ztM5;s@83h;ZH`n&7D$Kt-Wb;R-M#vro|j|v{i3{uvhR+w^nGHm@4I{T{fF*13Yvm_ zUsSN{W6{&o^IL=HDtg|;Q6gHTaRzTa$^LvH{0TywzWns1pMQFK8QMjs=X`$r^rX`h z1J}KK&AWTv-Tv;6-@WnODeo@+^)exTz5boO@7({+_3ym>4hTeucmDRyns?^nz3LtD zPQp9%_L8?3zdify8E;Q}yY1~sZ;yU^$lJ|t*S(#0{J`;V9^Zfbf#dfcUv&J^v@L#7E*L@k{Y@@e8q3{1GzyYhszWSS%MS z#R{=X+$%c88nIfe73;($V!hZPE)^e$jp8z~Nn9?rh|S_jai6#X+__C$DgGq>BA%i_ z+6ngRZvMYF*t7tvhtG|i*=v;b1}_u>!Y4e_pcOB@$(i(iY^Nf(b(lsGK9 z#P`H^#1o=hTqXXKER+hKBTA~Q4ud< zajrT|__TPOPTagI%5fOKY2JxkbsN{&S95M~^5wKWN=qU-tUp+l>=&3WdT*Jx;U)zG0;)k90^ls^uAtfYtO`{<(yeOkbM z^l6cVCq07aK*yEx36na(EEPIId$}h#!F{$6bWx<)XVR?^IyycEUqEA_pXk(}z}MVA zn@4x)9)78OBy)Y{pZP^Qosyc9YxY@U6B3i{X8BbVMuGdI9TMn|`mw~F?4TL_ z&oar+ag0k-e3DJ)?vlsq@uJyXvbnr2D_WgLHXFWkQRK41MTHj^PMn`MXM=N@a}nCi zHE9=JQdp6;IAf{y+OcED)@)w$ZT#Wwn7@1TW{4dzwC5UanZ69rt`AbibD~V7qn8Gu zJSXbZ=$mpI8g-v3yJ-M$E9QtC;6~!zxNslvGC)F?&d`|(%4)dtM?{t+l3Yb34Gfq* zphaW2yr7fRloU@*y|=!;uC}1CprA0Xz*WFxYIoJ; z$*b{$p_4O56-1{*nWN2_6}1Hkd5K`Pri<3hoNbM_7EQ<-o!RPg))u5hB}YuXdiDI- zPM<@!XxZM>X}4ySMQJ*b*_E4<6KjsPP|B1U({Hd`wh8QL$w=94&&*?duaoVXU{$}pnUf;0ZDd_pLK2bM|Lf~|a z*c8O-Q87$%o&oTkB2x?sVdxle9;MJ|T<|E6ZVg>=*iXzh(Lk6~l zWIJm?p=3K}p~Yg&%Tr>^>t*Vcr0J=VM3`D%?@hH@Q(c98oy1;hN(~dU9w6ut-D)!j z*KHYWvYO`IG;>5!f^N|hGIq_Jar2}BbF*sfopU3<`L_d?;%mFBA`@R`)u$GaPU%JY zIT`Ns1XGl0xVuJQy`+6kZe)rcX-cUpoWF9#yy26x7o^qZT)a5)@$YWa&3as6W{yjz zq*!tj#g}Ji7w2W!ixVwT5TYcC=wb0QDPf<5Oo)n%j7k`UXSIyn-=5d%D4kn9az}lO@8PNS%c{!fR!@C!aIgN< z^w%Fn9q0{7_A#`BPDXFMK`Dc76`~VC(Nw*%a**o6!0MIxRk4wgCR226nf69Y>w{CP z=ayG3tDpL?ucdy+$m+SJj@G>P{Uh*5lG1%!#=!lh0&{jAD(j2j^K=9}yUBu$QLT%gQVT?J4yb zWIB`>q&Jio#q2$N82@Q3-nzQ>^0QNV*3l5yLncui#8ny2>p|4?q0cHW)VS@oZymYh zs^|Pq&{$kuCqAVqbOY{E!J1oxC8L|zlF7lBf!;GgD^iy|XFH+F=CnKO>L|zm9^J5a zFD~}Nc5;f>fQt|%1uQ3NCH1k0&SnH12-rU%;|KT8?0G;d(p%8eR&E?_g`@g2sXhqZ`Vg)IgiYXsBlTIRNm( zl=}hb6lIY}`oVQlW5@8ADN7D2A~l)C9n=E^VPP%n=DPZN4?YKEUM~giqG@;E9!V5= z+rE9b@%!y}SJ%Z@%w|hWU3KV4PoO{Sh_XfD|Bm1PK5+Dh1JqWNRco`=WqI1#JXv)% zTWwZN8!&Po$m6HrB8wQwz?d+mW(ymw-HfaNoH|aEJiXr_RJOGsYar7kWF|?CW<`yz zI%lFQkz!X+Rkt>FKU5M^j}s`qLXXG$>L6~9LAHfyl3zlB8^X;{HTy-XvXXRi2FPkZ zx~0s|3}y(kHNlpwlyGX8%F$$xWcRAv9=nrR+|sTza6Y+!_~g$^QK`!8NazbSjvVCPxC74f3v8EEfS=&{f4>7ViZtXsovY<8*Y)O@G)VF+);dp$v`t_ORwY;Ce@~aCB0qnA z)1n(lFL2j1M{3#=Ykcb}(n_H-UK&tQ-aM!{GBF~#psLL2F4fYTW;z_sHOtIV=AzN| z*r_#9_NdKU3M$e^xZ^TnVKfp|w0J8@n@rkvDl2pqSLYMtg@(Zv+Ah#uG>#^N`XKnC zqD?+fbZi0(#lskAmVC+wiH?a+U>^i>(~yda2qGmiqWYmjB@&%=#N-ImORJqZv&(-o z^M03h=y9sqd)HlC=uN+m^8D{$92+r?E6|@(F)uid$DkH+jXr24%m$^*9s5PGr&Kd?w*L2pvM?|sgTZ!sh5)YIflO~ljIj!Cr7&X%3ku2|mMT9YenpCzTTkIGe z$WE=!|6j2!=4jK3>uV|<6H5}E38qL>^9E0L*@~vhQPb;qo&$853TOksJwQVN&iJ%4 zMXh%Tht#x3L?lCO()64#g{f1nLO{IaLc5X+9xI!60lo{;WFgoReu>u>BtuXq)x7hX zW{EZ@7o~Py{k<#UeH4w$Ep5<7R^RWa9X71iGisDaJJq9UCe3QSZ|U_n>6$ewEq{3f zPE5YT_si2eXjH9du; zUZ;+Ll+&Tv-qS9H4snQb@c$iwr$LzHdnaTW3+pH|K%_K8}Ss)3vAgJBPrf}v2$LlQK-Sxh?=2_}SOh4N9X@CDiNQ%cBi z5S1~W81A?9`asj>-8-aq=;U4P@j3DM-@a?gklG>l&U4q*xeID*3-YR~^ITO`F6g4= zE1KsdQtIN-3s%PInx@CCTrhfZik>j1dBt*n1;O^OuLsQ|aHQNFR}IrBM(b9{(=%z* zC3UKS!RJ7s;6WA+Y{iu+gv0~!L4@o9$+DGqL}W@Djd2w#8jY81DXEghE3>5{*ea*X zTWD~jjIq?Dq)Hi@nw-pNvg+YTp)J3DU4zt1E=dc~Xqgu@dY_YNw06{}TE7Mp$r^G0 z((7;5bW3)6{_-XmNRw|L{4?zm8d+OAk{e)_7Lis62-8IyYhr|tWLzW|QId91y5hbQ zP>MD{)=%gtmO+IhE9KAGtfs_p4>V{(^);msz(YuB*f4~Y(8mZ^krU8I6Cz%oAZ7m% zVHx&5Wd9Na{WD9m`-m{h?%*_sCD@|0g+F=+o0k&<&y{v2Ee$;qoV!58Yh&rJcm_Dv zu$py>V5{>3bP0co0yuz1zrz_eCyYRl!2!}zR#um{&TTj2pL+p);Qx@4{HfpH*tK`2 zHgj(memYIGXw#@0@I{Id{4|YibPHx;A|erI!qX`5K%Z`j)Y$w68}5M^;irO#`kKC8 zY5MZZG!5ZWZok;O_hV@V_lAw33aB^01|B#AHmf{yL|DVPTUt4WMQJzJx$)1ejrFGj zv=8Y68W;v$e9xb?0(k#1ko;XddI(RJu`bJk=;1hIkg*Dx13_DenHZNGhOi2|B+OJd zezXsQ2oqcEQ0X~^eAg2=qePldFO|=E7G!glcxSfc&(s_lA2=eMl0WnN&~UH7Nnu@B zgo^_L%Ay0mGN;;Ilpdg~xzYA0Yl79?QtZgf{{cO`ta7Hipla#3Cqq6%;S0J>nzgDp zx2()TYc}OLa%a`FFHalJ!(ayH-T~&?5jTG>NcVH3e3BrmxKTSCB#t-vwB?EmHj1fY zoJ5KY@3uqcV;V#;3P*>Bj%Gy722xr=SIvf<$N@kDv7KTf;`<7*>iSMGz4!Hbg5}^5 zF-5Z4B89a|Mxns~#Zn0uNFF3zN_z-=8I-E=NR8}e6>LNUInaX00n{@GnWX?!8bT_G zylQ2pgkRwGn58`l)$Xk~Ze+D2+qH=`()uH^!eOC^#Hf@4{qD}K_Z-~TGCOT@?bjyW z_uF^wZQWSy8R*DKDoReu=MW>2-DR=)%3BwA&Mp{~5;fQVQlY!3Bmx0KDsmRqn@DT& ze-5b%8^|1Kj*6k^$ket9bEIj*)&o~x|6qFj;H;u|4?ObQlJfEmBU(C((p*tdk>pHE z$zM5c)}9F)vHcxuo0L-i*e3fz~^=&po)n{x?6@8McN`w5vJr6oN*6oc43?m*QAaWo{6axy=20MnbdGUk?tt-d)I_B2Ae$#-ek|y2(lQABb|5M zRiJEHId`BXD>kwR97$#u<+Ce;mQ7jkfwb*YwV64yYG!nH?t}=$(=mmrU5Mj z8tdzC9^9hGR7|rw+qdKU-khBW!k$u+W`1mv{3?VsbwI8IUq(_`EX{~O#5 zrqcKIDm@BuqUB*!njyz2M5X(|$4r*!id*w(`HY!6(3db@Z67RNW%DF5uNssa8z%n4 z>>qNTVcc3J8MCm4fvfasVI6&ouAz(??|pM0fA_at>mRLtI=OAY%mrrB7SHu{Snj2V zrrb1Q-0-|-K~QO-IF-hek&;evyO<+L~uY;MOwSjeI@}J zYcgq|4N1p3ex)$aG{K{8fNH^MBiLlpqoS1oFT+i2mdU6r{CmuVCbF0BNhA|xc6a-K z-`!0=CfDgWs`DSi6y&c|uVA6^Y-k;NrH8CF?vr6{1)|o_FBnA@2aw^4JF18uK&I|) z7Sy;8^_)T+^V>MelGdq=h-PLf#tfQ@25;_1fPmf2zyl~tJ;2NlP!^oclPD*5IR*eT z2LD;Outu$|OZ=dF%a%d&oU0L9h)RjZ6kKi!Pj375jW;#bZp0i#OlpMLQl1f&BsC>^ z$9xE*<`ifM^AbK21|h_U)&L(eh#+B;b{5>)JVY)X@e|NS8B#2zKub%}Nv;R4#3 zpMm&4`6n^zp8zN0XYhY?e1yPjU=HHx^1&wkF+3T6{FoqQCUYP(0aRNp)~M*Xcn+jh zd2AjV{sTPq&$jJ9Z@>S0YrDPL;ql+r27M1et)yE(Ly!B%b2D&Sji<(l@k~Qe(JYIl z5bI_V!jq-M(#_IJ;9xOpneg6#;w6Yu)GF4HeF22PaH5NVYhO1l0fzmzYk<)2p;ys| zANkogX1Os-kCuL7C`Nq@b^0x2)Un;ZE*H!O#1Ev z{y%jc{8QN-h2M8(9~ zO~6^SViWW_yx(SNi%0>?`U^HBh-4q|&e3$A78lS3`v8g31z`@RG2p#*8AeEQ;n%-=8r&6jk(R)(!+^Ha%s_8j+F81M>EfF;@@RMw7gW zB`FXb?N{;mn9Z9~jq&*o#wQMQ?Mr!l%<&01kkwNDvMbE;Hwa?1^bFYZ2+3^2dG@?(lfGl*AHG*UE`y2{R9G}Eb5yvLO;Uu@og-DK zE5CmgdI0RilevbnFq1tcpSk9Uhz=VJR-$lKrMGIJx(;$RXy33h)uOsn8}b*_COG2b z9SOiyLuxmbPn%ZG8nt8e4sX8Og7~>+ap!w?jG}M)*IA=2L)WeyYC$r~PGGL*B(zTi zAhCvKFySlel3k>eDgP;8!OuGaS5^>uCMD<@yt zu6_Lnzj+1EOQ-j_L9-n8kHOQZ=kI_i3r8_xP~f?GJ|JYAOPKU93)8R~0=iWinWhM3 zL{yRPNkz1eT!rv?Dfi^bb?Z)^q|`s}`}SX`kZz&5-}|2bKL5&3Kc!pn+`oVde}(5p zidLoy82pBl!s?TW?Ytfymh+jj$oWQkVCa-}28}dpD$8_E} z>08?GCLS1YD^pl%&qvxyEfM($ZgHcO&uJRsNhzu9GV$an6QOa}qwqo4xWhQ|*t!|j z`yfHWk`neIUQBpW2y~}^x+tT7~7&x#&qtiW&`7Vtf zSheZ_(w#Y;8);Z&b!%&N=C~pxnXTQm zdmWO@O2(&ZUE~hHskiuV%5mxstm?d9bLC@w!1@rFz%@ph4q}wESrP={u?8$Hgr`3vDgq9I%A zBW(;u#Evlu<*G2r85-DtXd7fQ`z6N5OW`1JkP-ZqZAcM_?G(vQGDO5V-j4zY{F@^p zDGbE0#2~lbseVG2)Ln?{n9U_+labG+iS!$!-{*%v?Ub0Qb@4CD#Jj zuuJw~>YY;}d>X=zJdhlE<=+GZrL(}8yvmd;m@3TxG6FgP+Y=VksjCYc+f-y^_ZFL- zckZ;6*hgOx`HCqi#+ncT4jopKO{>>EAS)OWX>AFwP$W-zaLSKRx15dxS_o=R~nI+B5CEQq3VfLw%)W;G=B(ifu zJ#7CfdI(eQ+@1Qo2OeEmr_=}^0Rp2rCI((d;586;Wi)Y!$T0LcNx;b6lMzUh#R#U_ z5;2_z!<~)DQ_uXv-$RK#Kj`AYihAlV{y+cpr#wFLN#Ya^O`=fpUw^}4xcw>~qo4s+ z4P#Q>L%$zf>=D=E9-0%)r6|uKwYgj@qw;tUW7s*j1u#`sc>q(5x==8oFib(d+>N1E zQn<#08Yw&JKg{E-!zI! zi^*$fEsRWx_~dU^XBrrn2V@j}bB;9CC)4=YkC&nQIxs33W@Scai3(^cFEd ztrhtj=K8z;saf>Mlw`obxaOq(gw9jGa!lIMU!TjZUaye?j=;S_h zG%Px~FDyFAw0c3&$uXOsdTR6KPd~LepzyUM+I96+J8!)D>Roq-BqH0GLc0O@W*bvR zC#5yRfeDFT5uUPj6kHXwF@qL%gfwCLH>u?Su-U^RE1)L~JBHVI!O%3O6D8pV^8pPj zlW~uU_|W2!KWnMuOJHBF+r4Wotj(fvnOz~9Mx!Q|TYG3#=e>GvuKy=Gg&ETrnH)g6 zJ`7T}qtE3_u#F;(f*_>v=L0DZa{yAqhBkr|hC9ZNd0)q&j|yDhl|H5r9>cnwH?4*L zP&_uJx7Pc-hpKaPb-K56)kBB?x~M4(Tq&LC87%^oKSuHqR*Hd-Y=Kc_CC1dJ+maQR z>@kSX=sJ?B11ZJIpiYw7T!{y7m=PnnBV$^f3&RnglQ_19xudP3j2?x#Vlho`{Snv# zk}d-_{&8TxMa&Lrio+nTGIYc+Qx1dr>jFqOr4Q7vmPqLb?_Q96z_Jw7fm(WL7XJ9NbS>3UAq zwpcr+rQk{=C8XFanpuzb4x8OU@kzi6hJlu8cS2go>|ePSqCd-2ErnoH6w`=c%s!?l z7D`C<-kH1M%41J zIEoELQ;^nXkse9t-c}830AgZQWU+T(k0Y1(j~PK7@yqXSyK=>qSHA53WWyC#Z18{b zLplk%r!%MjkX?KXlwK};4h?mj#zLdXagj}qA1jFC1l*Xv1DUR{A=`{3_C z``WcX_Ah$n(c$!6#ulW@aQq76trf}pg`$K!+1@uwxCb~?4n!z~&N77qG={a@ZK{Xb!vFy^xseZR1+WHdMhov)z52W@)03yMuf0ctryBHD#j|&Xsi_l2kd}}!=W4& zV$f}@MsW60*vcv^v)&Bh1f#k$N)#%lpyog1(S1>d*<;X=L!M?7LE#@t0kiN zl+5Y}zM5P>P^Ts@SU=?>9m^7DjZZ61k4=x9m!2E%vPat^BJkphb*9gY#OdO+c+B0H zEZT3ELNeGh{hlF-krA|!9LX@>-z_bTGQ(lfunw)V_E+#+?5>Rwk%_II(~fi)w#=cg z<7H)kRwnpYB3BaanQZT&m3#LFW0q&&kum5qF*YS0qolDY@mK?-RVh4Hs~jt!l~E>9 zYm+mRM?|&6V~uj}>>L2IV5-5un+p+4Ug%j1Okw68i){mVlb%o^mRj%x5w6A?=SO*{ zS+fEGkf{bDov|TA#^(kRX^pc0<1}U|@T8|ZKlii(l^b1le0;}Ki3M|{o6S+BCGSD; zBs+j(U~)+9=UH~0>yK26OSLVu1M5qIdAr(JoM%HBuqzcrHlb2U42{GqP+0#|5v&lv zsAvG{C8%MHWqc}0kOP2$j7+ZzMd%&Tp9~F3jZ5&_Imk;y>e0eX7l~5xUsRgxT&d_MBpft;HUka@Fic+NWmi! zgo)>sW1;N_iA&foLgFU7F^iyWSjMQ)2~SMqh?<-`7zsouG4yZDRMbJJAsZqOgKroN zsUUu7o~DA1@jp0$+ZP*c$g!-O-cbij0<`X#I@8O>0z%)(4k-&TqiM^@vEeO*B;ATx zq=5r#HPUOE2i2mcie^hmv1u9$DF{}cm$%7GKNBK6%Yt^*F=!fN#g0M9uR>z84lq7G zi?~jhJMt`|dhA&Bj%vs$6}_lb#SLt1W9fRj41Qyd-kWMWzXU)!dh7VB7TohiS%7nP zRqylZE$2)Hl$n6^7Za~6OcYmwGUR-EFs&+>SqE}3Qc_N`fdbIjUksev&x%8yLtbcL zj_Y5}wbL0Vp@h3x-7e}j^VO$Gp0i7{ zzS%uj1Y}r9n)RFTL*EaIvoOJ?t9gGwoexdaB36KQ_0nq1nEXEm=UWCX{^#-mdSyEG zmh5NE6!8C7U!NvTj|-cXKfB!j z0+L(TkGwk<0e<^ja?T?0JViWy0a(^rVDl6Xox+~mJ~0q@{;Fuw%hJwVS~0LiO%!|y z8ZEpa6XXj}zvTR_l5>p6-_FZO32;KC9HADhiadIOV}wPN7@?8Ug9%#QBT;gw<|`Yp zK~g(4L?VBq#Uv+&ty?qD^!{gZhYuz)!4 zB2U~9^yvC#Uhv{l_VEml?%$V)kt69SPtnnNXJshk<{YUR@3LjnUw#JNVOTU50(&l? z|6c>UGFHw3dlp+N{ljipC<^w0a@_O9%{=aEtrIUSd8e@ulZSoC(Y&Vjs~zII2yhRAoRu)ErCh4K;nqXur-$Xg~yv^jt18POGRpfE8xIr^jpc-7yR_V3P+XI zcYaUDv#o`A`kMil08f{krS*Ilu&>nz!n%zX!_NV`5k&e7u=6C>nb7wE*v*fW5B0ws zva&V0&7fty2k9oX3Dz{{@8qa;t7$m_ydTGu8zOjTP2({oCgp&L)08>ge=3h05qV+A z5Dw2YIlGw)R2^rMDr#yf3dJ*w9G`xjb97c_X6P1VW{eVF2PRQ_HZ3zB%dgKPIfFCG zxWMNqWw?5zYBmV&0x~vGc@{>gGv8CIjMDSZ;J7eb^vryZtP3zc`_Bwna$bg~VF7Fd zud3Rg$jC6TboLCAAm3&i>3J8JP?8}PevVT3VdYYKMTC$z8_L3v%AWe9m~552-(Q|d zFlxbi?n^?K36lu?5-L)9e(5q74xLnH{Xi#WOaIV?Y4L54H9U5Xu)NuGjUDGLz*YDR zWA~-tJFfvV^mAXJ-Zn&6zhD)FA_HpN9Ko3F)#pK%sMA~Mfee#{nz}JBB+^`}yDn^U|1pZ5W|sVYQrsykNR6m7*{= zuewHw!t+ARg-OA_$Xb8?au0M8_{237HCb)`TJ1@m^i83)oy|c0Oo-8NGL) z_gqD7^M&-^XUcVyL39-;^UKB-^cTY*M?(HmimG#igo#|anntdG?d1rB4bV;f2&X;? zQ~l4TkZ9`}i`*_=%gDK9YNk{zwuipqrKmgy%4r|6sDw|}lE62+G4MQt&TGgxD=AoU zLY0ESN`F9yy78P;hD=7Jd(@F>|6`BsKXgbt_3G}^PimufzsfV6HS{LU!CK@b%;s=fOQ+7>{S z_mp*;?5HWrD=kz_Pr0U~j^<2n88mfTOUv~3f~@qyg3QbUt+S=0V<6904xBo@MN2Pq zql`{wK>-#!5cZ&m(wy4+@IL>8u^5%>;F`tO2)QC;4o8qer12bJWz@--lTUXzIg{=) zIJ10BaQ(|kI2dYOmh@!z;CqY(@EyONTJ8ht4SC@22Iwn zf|w^_`uwo07^h>P8K%#j@$NiiEiA_}NhlO#3cgvo~tag2V?B>_h84BPq#t zKkB&gLP}fD$J$+54+?bsG)#-lfVIzV%AC1yUD}u*khLbJ;G8i|yzbE_KN{b6i^=l) zP~?plm&lbPdRmjpHhmV7ozEEexI;|f;?Si&)9~4I7{5b?&gC@6u_((famPP2R;4_O zpL%fZ5ix`DWgdlneUu8Ez|!1UlHuX7ojEhVTzU#9MZ@ft%;-@`Ix0_xXT!sDdV-lf z$m+1FO0t~7gtQK%{2+BnAzm%yDO3wPIFHF|r+0RmO@x}=*7(Ti)aYb)d}`KZmg&>& zMafag(MaF5#zjUXMJ768O%ZxRmgy=?r^iog)paB^QGCpOD-vxbg=H(7_H3gU>Iy2V zQ*3upS)3~wLzj>njZ`4bWI;w^Mk-BNWkm*w4wZ=SkS(HPzCAHsk1#baB8vr)iW%Jd9v1GsWBc0u`eaGdvIgl2@sV=wjy7!vw; z7^Z1s_(v;7COovd8RN%<&&HlH6I&+DJ(-9xnc3heT*5E*!3BSKYc9Io7t z@FA??A+%%{l$AHir3r-Eu!`7u2-PrhuAa#?3(b=+#}yvfPc7#U8>38eWNX*)7` z3;8>o7!fKg!6RR&Qh9Jc&2zWKot2VTlok zN^ZG3#TsMTS39^SKhBQ9*g19jZj=9y4@blzeb1SU^z8@Z67%eM*T$viWu|32W02Y9 z#kgmW99=arJIRw7nGmsZnR(R;WJhp%n?~+x&E?2&L?g|8eERr-)onR(MJXsKJolpZ zh5i?&SR_5A>L0e>YVtP&#j=;ZnilbVxRu6e!5Exh51ewV}ZWi+_S&&7Ab83&3 zs$LErbxc~meA1*9D<*06)H!}!XXm)_ow#d7&s153Ek(>^8IJ1MY7z4y+!@Q^Fyy>_ ziL4;M2)S~Bhv}38hLt5WW*g5747E)SwV_T@lsZAJ1Xd>ahk@Wq;K&xNN3k8+)VgT) zqG?yh()Kp()XdMH(|w;mPp?>Kt_RS_rJlMAeT;xtd5Jy(MEP6*a?C-d$RZa8y*-Kr z7z1T@NARkWk)y_{6`RA+IRiZ?ZLAjG>=XHNnFAM{^`V9asCPGlja9hNxEt4A@$udC zF=GMdXmyEDqLOPQYa{v84Y<(=TxOJ`#qFeFAj^Una%zN>Q(1Ygku1ZiYz(-RI1oC# z07ufdk&&u0cU&rSRnavkwe#mHgU%&?$dzW$%gvNhm^-;NDkW<1EtMss$LPA%os%=J zDAAQrs7S4T)aY8s5PZ<6sJ7Tum)ccZOHbcIX03X5UUm+0Q#)7Hk8otqogSAHUo*|chcYn?@+p#3QAqYLyN!%r(dGtn|KDqOuRVuj394PcD}kW-MGd%Qx$#5z`yJ zcdc@{OVc4SrYFDu;QkXQ_CNUk9C~E?wU0bD_=7?t`))&aimh1AO|B23M0dBVxs{g&Wr|90qb5h&P(>g)1JS=1%R@c>mKhe7t`J4d(;2uYdFr9^b3# zf~+RNxw4<5YaCz>@y-cQ5_gtE+c1K@Z*pGqVkf5t*5B5Yb$c48< zVDTROm>}(QRxKvvFT-7utBbnv;K2L=9wWb!qV22>&%wT4j_&ApCWAAcVfAobm}Idt z&@=3}5+58WUeII|a@d1mW`J2^8HI|uc8^t_3NG^951@DsHDj9ISo(!UMnt`K6!fmh6xY;MmI&|<;ACaWWBx@NMqxKX%i(96B4o9AKb}` zfmcqc5+I@V(|ZhFF=}rkxEhzIf!NA2jZqb;mo~x4(1eOnSC$EOwvC8QV7Y z#H+8K;I$8pSS`e>zcQq4XVOq#!l$QaT+sTjMA>CIS;y`QrGu`g)Y>u)=4_5QDH&}Qs4#u)EvGkglD{jT*C<8UqLTC6yqzIM8x>XFGYYC;*TS;O$~r6p7(Z&( z1T0jHuq4#FqpaY~uUTT?x)NE6N()OZ8r^X<>aSvnRz_M{IxiB?&1uQ0Y4Fz8%5p41 z@A;_bSK0xsK;%nZ7usp&Ijo83WnpAW)fZyieQ+$oblpDaIyPXBh!`FO6LyGJ+?ON0 zDnXhoj#tIW2~uMzyu)lyg-Vkejct3iGZ5i~5iGE(s}23O?V{@G@hR8?;mGF5q{xbC zu0_>z%@KN1;-l9kI1&m*WKqL`xSWLQVY>d-K|}|lQsQccn@pwSTZSjsX2xg7U9*!+ zS=m!s#=!8;Y;@hg+hAm*5M3V~*;T!}9gJuGDJw_0m5M1UQI$O*6^m5F%82xYQ9D+*_YwniJE%}@ zNKlgNav2*ExT`N7`{dlfmIb7}fRG3_Bq-ty3D&Cp2-=pXA!Hfa9)tIwjl~|cT)ZZc zwO9~vqe_aLIzkc&pg77}Kp_JtGeIMB1`PI~g|23B1C>)wK=QH7ICJL?=&N2q`}xm2 zGbhm59)BF2B73M~umS$rGg{k=+2Dbpy>Yd>K=C{k6+R%v2!-MCW^(2Ye(M5t7QaK`pRTmuS2fc2?`vfySwXds;6^}4(se&@)7R6f># z8HZnB1F+Xu#jf&1JBy3v48W#e%W|NO+3T-Nutu42TrxGLBRL{1$1%Ce5@W?SlG(Aj z*oDdL%tCaMqUaxE{T~e8Q0u9n$cMoGrW|)-u|3fl|HrW_N=7>KoutJl+!c`kSy7RN z(jNdC>(|6+tpG7A3)F9L#{sOuRQ2K1VB(`H@}WLzG58o%5p=h)Ue%59i-m0w9PjXjod4Dx zCRAc(pKT_7!qc9iRhHUOHQ#CU4{P(de*^wI`gdUo@_hjL!Ff-|he7K*-%KP`XPZ|l za%RK-;3~Zf!cyOrd*`3D(EozI*z-aduf=`e)QlS0%&GSTHPJC}D$5R7C-xL&a36!J zV&;`fz?fv_-8Wd78yx&Bw6fH}yji-c|Fj>9L)L%dT}o8VU@oZ7c@DCSu%4FA49>A9 zmPG7E5~7?@@yak&B?L`Iu_I@lRL+JS%9Vf7HfG z`o`~n`ODw?JC0A=ym?y3WtVkKX{bGU?|mmLD~HQC25Nt9?wGb^%e0Qo0XzKz*y+69 zu~8fh;^R5Qh3(vDy{1uF7mq;la@^5Chb%S_NYrJSY1AJGlnwMDkZff4?vv{?7=EX+ z?k~j&sZ4cGqh>^bF2xA?dd8Z&|C#6kc4x;_!?LgoWYA3YzBb za7>wv>V*0SVb=K2i(O^&hHQQ0k2C+xPx>`)5bt2kh7tzYg#-IQa3wUB<9S zy@hufqcPlLIYOXaPC>xeJS;XB_K0@!%QKH0S$`D?`T8)8@gL^K8XP^DXY?dkX9$m0 zNxkaP_!w?pX#8!!o-q2L9w~dGuxG?fjjv^2cqca}zdRZ03l_i1o&W;Or_;lvuoA3c z9mI*W6M~-fnE=Bu4T7s6l`!I-fR7Y>-T+4h!Qp#`*|lSgfj7F&-vs+DyR16PdRbPD z(YfY=9TQ){h%eYPSUJXLvZv%B#G3{42XkwYGJ~N{;TpLSsl1XO6|64P%k=MMP=xBv z5IblY4FkEh_{)XH8s zmFz#`5iAbno|=0Q3}f+YT(Sq@4+L7EKV)FT6qVj2dCw~&!g6vF<|~9CPpt?1Xs(fi z%nGX#ln5X9stsJ-nwm-JX{{|ovL}_mL9UpZHKe5l6=HKTTAPRDOslN!aJ05ial@Fg z-i9$_8g6UNnNoonowByaK>NZ&>(-Y0tVb0zzd2=Bu5s6g=Wv0SXYu5YyyYW}l7?w~VE;hryBgeD3UJYk7`Z zx&f~uv{fD&N-lma0|ZvovCVTASk79?HgEyBmS^eNZYZfzc7t5_U_#YqC4p6_8FoX! zkxV(GqOBWO^!D}rXDxBNGOWPpx$52S?Wgu=I1YJs@4`@K5PJYa7+JL!T+cti4S9_2 zFJ1fh0&vBZ06k|%&&IBCiG5rUpWlKuC0z^%s`;C$s;|Nc}r> z2q}P%J*J&{YWL3F{uihPZ%;8-dc_WM(j_7+E2Z~-t|}`f=$KaZim?PYW~EEQVk@vX zde&=$#BJ)SIH5A*@^ z52H}8EGSMlV%ZE5p90c#BUmyl!nqN`0Ooq=+mdjvext~i;($j@8wR6yGArMOFsFxy zezOpfqCxnGiPnq)3}8BP?&VdgmMCXr`80?6q0Mmp$8t2nn9Q$bZa3F8G!9cUH}xDk zHCY^9$?v^VgnGs9d#UkW-$(^@_OG=M+b-KUb?U~;+FUhi$7A~anP*NvtJIr+;+fyj z5}G|@=A1b*XUtx}8zxs*yIeJk`Z-4*^Hw5J{LS3Cy{-;LA}Sz>IUE|)mtR>Vf;i%X zat(c4c>m8-B6FC7zQ$N~fgO>-Kp&baKx;OE6&Gi#b|f=vje18Ms%1|9>gydDAcZO( z`9~W$*@3MFsU^4;4)gYU0_ryXcSU~Ga^ybPF5@(ZFjOCv2@haGXkGeSuqF{!arBGp zeosp7{Hlvf_2R=`ycLH3{e4a7Pywob%M!tE^a1ifMXg(ujl;=&&=*Ql`7kwMi9`C9 zO!4c6L}&RWEgz@_x$WD@|6ZC4gZLYA0Yi}9zNXfE3fN2J0JX6{TF16QFxn5-MLBc; zAYfz%mY9Yw@syg`%dunL>@Z7a$4FCKE$_fyxi8`wTfm!~5B)DZ!&pYjPw~HC@Q-{@ za2-R>^LWyB(59Nr9o0WPUlzu5csc0OdrVPhEE1Ky>wnFG_V2>H43INU-jxHaFmFU@ zjrw6+11=r2f1%we&b|X68}8|>0#9P1Tg~$a*GTeg7oRdL!hdB;K(#Eg&%S_HF!l5w zS~RM{=>|+J>3QYg+MqRYc9?kGpaInh*a=@9RDrdFec(E-$hCjS0-_%hM(%h9Zp;_O z|HFHpab8pE**8A3DmMS(-OmDRycA>=fUHzibaUmyZR73S=tm%{U}*M#W`{RJw45DY z|2+YL^Ti+s#L@q%@stpr1HRKrdVDc-s#pMYTQi336f&av?2pS6>zY!0tT$jk2Y1v6 z*Bi1H0#?_nrSuTo$j%(5X_y7Jh$5w3_U9uoaduI=35E z6yIwJy@kA@SphJopU6d2yv&bz(!d2(lTx z#!8_vtIg#OXSuo4v})qSm1aG`>2f(}%Cu>d(Ss%0Oe)hkZ`KnS9~c~=xmaTbhBQJf zA&888^Inec4+FMbSSBp6Fa`??w(4A$sygJgAU7#DJXdQDh^^EBnMp#GLKz8&(?bxC zL~gyB1(BJdxJE{YFSrQQZ_m5RlU{l5N=~2*RC227c@JZOXj?Fo`S<9!LE*+|1u8im z5pt7c6>XC>X{m~nR~*$HD#>798nCptL|9olZGwa*J=r(_Kc- zXM^bYBhxbb*`(!2KO6PM19@IdY@ClFlQ@t!&#|_9#vsokAtTckpAnl9nI03F7=iex zv!NzWLv7UC_|oq+au&g~AW=fqHD53O340`+;37?OwZ;XCxD?bzbZYU9@f;cE6s)`(GcO^5FQB z`>CY)-T_pM-r!-h7&X$79EMTm-e9kF6E?Z#0cFX}%qA^I zaq3Zt?d@GtrtpS8zi57_!M}^*20YjRNy~ePV1Hd${jG@dY*kWb6ib2$;q%XV+ZHhZo+DJ{AKG8RoO< z(J^uHsTSB=v7ABD&AKs!6JCJAOYVS0R>?kWzRFka0|`jV&=R0naJ}e-Qu6ao zoEN@#RdDnJ`&31Qsfk{jRPoM!YUWcW4(CBX7xE;IEj$rRFnDL8COg_CxUW%s}Y4B1;auPg`u}tk{M)@lYNS>JBCA^q1!p3;G|3c_dHk*!! z>@fUD4X*Ak2UzZ)EPuirFDC`Cq>Dj}-e}$U$KK-561urKL$VHZLveS`jiZau8e( zZpuJLJN;>aznSJqTkhYMG4oZdux3^Z{P8Mo{^MQLaYPtzvItTqam;)vc~f4cUhpL> zSPPaXMn%WO#>FQjA`9N0lA4yDk(p)OPhL4UzWHw=Qa=&)TY1>i?*F^_KG-z8ZU#FF z$&-B7yq*DKulb3d_MUe0&hR_&6|{?{$twlF%eGC7!IsgL+CedtoBm^A(>mmc*CGzUfaxk$wT4d-h;iI8wAM~8kKE?Y-IR85Ow+8Q* z;`%+t`#12Lr6NbO3kx#&nzeuQoHWhuIjP%w{;vJ7=P%m#umWk0sO3J(_k&^yZ<9?o z!`glXeSJjK({JT_jy4}KZWnRrQ#$V7OclTZ8vFu2Zq|Q=`{TT}SETUo&~oVe_>4>j zEc;E;ZUOwAc=qplPHHcq?L?~-5x`?Up8vXhKPajhZV5ZX4VVKk$^NT8ald*s*+=w` z`xt2GQ@UzB-=&J4!@<6B|H2#hE4&>PZM0j|U@UG#v!U_0-HBGAT`wYZWHQQj04s7C zPqRQLpc#{feqRcF;uzO5O-MS@4)*+w?;rTw>-~0Ie}^#hIsJgJYkOe_OcCY8v={pQ zKZD0Jfs>h{4pd(gz!Q(RX+3DdFR*zz?gNg{)}!C+L63MxW4cs*VVq;!#S1;{=wmg_ z$Joplb=t$A!N(;Xw&7Z)Nuf;^HuDppDW<~$;Wgf?cuYWh`82fWMYQMnnESvj@Ejhi zKx5j_#sg1ow3%p`fbC|`*~@s}EI)UG_QuF-?C9?*^n+=Z>Bi`{?9a#WRrdDy1Lv5= zK?lu&&*ASTvsf7Z`Mi&r_W7CoZZsbI^ZtEUfB)|{1}^`9f)iFE;F{<0x(@tnp&F4d zygl7`ZS1)juT4FN@Y>vS9bTu)^D}ym<9L=l?&|3h#Uj4v3cM!D*ZiKBvAV`9UmJTK z#Bq~6ZkETh@Y_nkzw+Q$>+#CJ@?ej-E@XLm(VIFv_s@83lCRA@Z{TzX-1hxTX>JUyj#od7Ojm8*%^rc;)*y3chnAGCq>=%6D!Q?dVCP=#a0odOn21 z!_YP1ZpZPOh&wdlZhSrm{cOVB4&imE{B|T@Y{K0HUMI`rcKO;NUm5mh-0eENCg48J zxEmj5|ZAHVm zxGo{$acu%D^28ZJB#lSI?`(_F@O?6_OFo1+;~#}c{fQ81SgV?Tn-CdGv9K35Wabee zvRbe(5dF!196?JH+WkW0;(od4OYWyaI5r63EI`9O^3Vs@%|hgN3*oLs^9xac=N8~u zg`?4qVqbXNuL#d9g48cYKZ^02k_0rsSbC8VWf-}#Q$m!#B}BzHgs9vsL=~Q0jlR_Y zYc*d-!+kyIdu)0WKQKglNQfjW2*Wfy1UJgcwkSb~D<0AWS@C;6gOq zy9Kxz1UP)S&)}h!J@HNL)J#_!-k6#8~ue{Ix<%m@LFZ z;Byk-nvCNqxTdWD?Lm-P4%&x8Ov8OUYJ`{$_@)CtGfhIwLZ4=5p}i}_oP9#fMY{;s zU-Ua6=KV;B1?cahooM*H_&On$CJAxzQX!V%y5)H8@;8K7u~xN}V})3CnQEOGLIm6M zLafF${k1i>39)v)YU=^dB~yjiuw95t(T70W2>b;b;NCP}h|8+baD4eYLTrf>Vk=;{ z0{6M%Ss}JXpxrFQmAJ>1c(xzYHwdvEaBY82h->iNYk}AQ0DRZwqX7ol zJ`rNa(?VR2F}k4y?T13#*e%3P^m*s!LhM>B#O@?C(A-VH`^~_2pxq*bxaCtJzWy^I z_TZj-RtvEgJzb%8 z?=~UsYwN$=zh8)dseO#!8|{JNLi}I*KOCHc24DeUUSS17Y~0xQ*6@!I*M1$J_;Z4I zQNH6){_#1soG^K5oacff(Z;ckFiw(j%$Z4U;~29$h?T0}T5vvaj5s-><%l+zkku7- zOo;vj&TAqL#SYXpI{f*$#xZtl5Z4&TeE&O*V++m)j`{wN4ZmdlC2QxEw|1^rIC;^M zOIFNV8+OLg_f*)oFa|CW>(SPVc?gHKicTPEArfvEi6uC@0%zBrF%UDf~n15p;( zN;Qm@GygDV@(*RxbTW|{b?U4XL6KMm9ZfM5OK}uW36zMX>NZLyJEc%6rBOO%P$p$j zHsv6J%0W)bLwGx%+*Ck?R7Ay8LZwtj*Lt|+iji(7TktWe(nnG>Zym2Z`qYj!*GiWBwqS-Wu z=F&wpkLJ??tfE*%i;-8mlrF~FmF2X8R?;f!q}8;B*3vp!kKF4GbSXB}-9(qs<+Pc$ z&{n#Fw$YVz6h`WWpPJ3uC-AcF7?Q{p- zi3(?T(>}U~?xp+aetLi&q=#rf)-`>DzDbYJx99*$Z6Cz;@rUR!dYryPPtalNq9^GH zJw;E`cj+iSL(kH4^gR71y+GfiZfv>uBK?3~qL=B1s2lPMy-Gi#AJb3hr}Q)WIsJlu zNw3lC^akqDzD39B?K4O7|33e_F<@S|dftLXmPH#EteE%zI(?q*VVdXUBFIj+Hkl55 zP@`qiX?zD(XYf7P$b~^G2rJhF4$6)i_*rc4qj9}B{ zJb`5xLpfOoEyA??1>P;3g++XIb(}oFa&XBn2lWDrpx){LFJNoPL6=rpz*yQ@9>6HF zmKs8+;W-Jt8a)U+7Ow&!DrYMZ-_w2T&Wrv8G2e-IXi}=1>nh!EEkdtUuY8|Oo2*1y zdgq}Yy?BB5bS%%&A)mPDgl}m^C$)4^R9XVxN(CN*3iZ|__sy3cq{0fZo#;~p_N~AU zGmIZ+i;02|l;B#F%m)o`T--6_UJHud&#|F+Lh*zLPdvP&!&Jejg1PcS(bWxODLQin z>I&37gmX8jE6`M+sX)^MG~J+5j3am^F+G${R%w%!r;(mjfIh2$bxCW8S*Q8>=cz>x zgDUQHXg!Q7JAmZ9J70)$9=(uYgg@1kK{KCLZFlTIV&GZUM%fe=7qFE{Yv<*Fn#>a2 zplz^h3A2Do0CPn^vn-{1wQcFTY_dT+r2J`2SW7UDboc2tEBypot20)fZHW!GEfgJS zs1CczVIy0KEycj(VKeu0*3{EHDfgopbu3wB@iO0%|D3I6Kv8B2n?8AL^8P|eQr~BH zN|I(2q8d~+XkJQ!?0zbpo{N$RzGc*j0BhWflS}lPZ11IA@9s9+68(HP=fig8@_Sle z@9$8)zhU+Tb10a@9m5V~=U8@*4?9QNX=LU;1l8WR>cX=Ty?3_mJibO8VFKI3#%1o5 z)wNMJQ?jG*$!L)xb0a=#r@9yD#=cVhnJ&ZkvKVMs?BcY5IMqKU=PkZ~_`5>aN$8;! s-n&<#w$4<|73N`x a -> b +fi = fromIntegral + +arrangeEvents :: [Event b] -> [[Event b]] +arrangeEvents [] = [] +arrangeEvents (e:es) = addEvent e (arrangeEvents es) + +fits :: Event b -> [Event b] -> Bool +fits (Event _ part' _) events = not $ any (\Event{..} -> isJust $ subArc part' part) events + +addEvent :: Event b -> [[Event b]] -> [[Event b]] +addEvent e [] = [[e]] +addEvent e (level:ls) + | fits e level = (e:level) : ls + | otherwise = level : addEvent e ls + +levels :: Pattern ColourD -> [[Event ColourD]] +levels pat = arrangeEvents $ sortOn' ((\Arc{..} -> stop - start) . part) (queryArc pat (Arc 0 1)) + +sortOn' :: Ord a => (b -> a) -> [b] -> [b] +sortOn' f = map snd . sortOn fst . map (\x -> let y = f x in y `seq` (y, x)) + +-- | Recover depricated functions for 1.0.7 +dirtToColour :: ControlPattern -> Pattern ColourD +dirtToColour = fmap (stringToColour . show) + +stringToColour :: String -> ColourD +stringToColour str = sRGB (r/256) (g/256) (b/256) + where + i = hash str `mod` 16777216 + r = fromIntegral $ (i .&. 0xFF0000) `shiftR` 16 + g = fromIntegral $ (i .&. 0x00FF00) `shiftR` 8 + b = fromIntegral (i .&. 0x0000FF) + +segmentator :: Pattern ColourD -> Pattern [ColourD] +segmentator p@Pattern{..} = Pattern nature + $ \(State arc@Arc{..} _) + -> filter (\(Event _ (Arc start' stop') _) -> start' < stop && stop' > start) + $ groupByTime (segment' (queryArc p arc)) + +segment' :: [Event a] -> [Event a] +segment' es = foldr split es pts + where pts = nub $ points es + +split :: Time -> [Event a] -> [Event a] +split _ [] = [] +split t (ev@(Event whole Arc{..} value):es) + | t > start && t < stop = + Event whole (Arc start t) value : Event whole (Arc t stop) value : (split t es) + | otherwise = ev:split t es + +points :: [Event a] -> [Time] +points [] = [] +points (Event _ Arc{..} _ : es) = start : stop : points es + +groupByTime :: [Event a] -> [Event [a]] +groupByTime es = map merge $ groupBy ((==) `on` part) $ sortOn (stop . part) es + where + merge :: [EventF a b] -> EventF a [b] + merge evs@(Event{whole, part} : _) = Event whole part $ map (\Event{value} -> value) evs + merge _ = error "groupByTime" + +beatNow :: Tempo.Tempo -> IO Double +beatNow t = do + now <- getCurrentTime + at <- case OSC.iso_8601_to_utctime $ OSC.time_pp $ Tempo.atTime t of + Nothing -> pure now + Just at' -> pure at' + let delta = realToFrac $ diffUTCTime now at + let beatDelta = Tempo.cps t * delta + return $ Tempo.nudged t + beatDelta + +remoteLocal :: Config -> OSC.Time -> IO (MVar Tempo.Tempo) +remoteLocal config time = do + let tempoClientPort = cTempoClientPort config + hostname = cTempoAddr config + port = cTempoPort config + (remote_addr:_) <- getAddrInfo Nothing (Just hostname) Nothing + local <- OSC.udpServer "127.0.0.1" tempoClientPort + let (SockAddrInet _ a) = addrAddress remote_addr + remote = SockAddrInet (fromIntegral port) a + newMVar $ Tempo.defaultTempo time local remote + + + diff --git a/src/CycleAnimation.hs b/src/CycleAnimation.hs new file mode 100644 index 0000000..237116b --- /dev/null +++ b/src/CycleAnimation.hs @@ -0,0 +1,315 @@ +module CycleAnimation where + + +import Control.Concurrent +import Control.Monad.Reader +import Control.Monad.State + +import Data.Bits +import Data.Colour.SRGB +import GHC.Int (Int16) + +import Graphics.UI.SDL +import Graphics.UI.SDL.TTF.Management +import Graphics.UI.SDL.TTF.Render +import Graphics.UI.SDL.TTF.Types + +import qualified GHC.Word +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 Sound.OSC.FD (time) + +import Sound.Tidal.Config +import Sound.Tidal.Core +import Sound.Tidal.ParseBP +import Sound.Tidal.Pattern hiding (Event) +import Sound.Tidal.Tempo +import Sound.Tidal.Utils + +import qualified Sound.Tidal.Pattern as Pat + +import Common + + +-- | To run at CLI to see animation. +-- | Cycle animation looks like https://www.youtube.com/watch?v=cCmCSSb4vHs +-- | Rectangle animation looks ... +-- @ +-- stack repl +-- :set -XOverloadedStrings +-- ah <- run +-- swapMVar ah $ degradeBy 0.3 $ every 3 (fast 3) $ Params.s "[red, white, [purple orange green]]" +-- @ +-- | Look at comment for 'loop' function below. +runAnimation :: IO (MVar ControlPattern) +runAnimation = do + mp <- newMVar silence + void $ forkIO $ run' mp + return mp + +run' :: MVar ControlPattern -> IO () +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 + + +runLoop :: AppConfig -> Scene -> IO () +runLoop = evalStateT . runReaderT loop + +-- | Animate pattern looply. Choose form inside 'loop'. +-- | It needs to be optimized. +loop :: AppEnv () +loop = do + quit' <- whileEvents act + screen <- acScreen `liftM` ask + tempoM <- acTempo `liftM` ask + fps <- acFps `liftM` ask + mp <- acPattern `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 + void $ fillRect screen clipRect bgColor + + -- | Use one of + -- + -- | (1) Cicle form of moving patterns + drawPatC (100, fi screenHeight / 2) (dirtToColour pat) screen beat + + -- | (2) Rectangular form of moving patterns + -- | drawPatR (0, fi screenHeight) (dirtToColour 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' + +data Scene = Scene + { mouseXY :: (Float, Float) + , cursor :: (Float, Float) + } + +data AppConfig = AppConfig + { acScreen :: Surface + , acFont :: Font + , acTempo :: MVar Tempo + , acFps :: FR.FPSManager + , acPattern :: MVar Pat.ControlPattern + } + +type AppState = StateT Scene IO + +type AppEnv = ReaderT AppConfig AppState + +screenWidth :: Int +screenWidth = 1024 + +screenHeight :: Int +screenHeight = 768 + +screenBpp :: Int +screenBpp = 32 + +-- A middle of window. +middle :: (Double, Double) +middle = (fromIntegral $ screenWidth `div` 2, fromIntegral $ screenHeight `div` 2) + +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 :: [Modifier] -> Bool +ctrlDown = any (`elem` [KeyModLeftCtrl, KeyModRightCtrl]) + +shiftDown :: [Modifier] -> Bool +shiftDown = any (\x -> elem x + [ KeyModLeftShift + , KeyModRightShift + , KeyModShift + ]) + +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 off + where off = Just Rect { rectX = x, rectY = y, rectW = 0, rectH = 0 } + +initEnv :: MVar ControlPattern -> IO AppConfig +initEnv mp = do + time' <- time + screen <- setVideoMode screenWidth screenHeight screenBpp [SWSurface] + font' <- openFont "futura.ttf" 22 + setCaption "Cycle" [] + tempoMV' <- remoteLocal defaultConfig time' + fps <- FR.new + FR.init fps + return $ AppConfig screen font' tempoMV' fps mp + +-- Draw one cycle pattern. +drawArc + :: Surface + -> ColourD + -> (Double, Double) -- Middle`s coord + -> (Double, Double) -- Torus`s internal and external radiuses. + -> Double -- (pi*2) * fromRational (s - (toRational $ beat / 8)) + -> Double -- ((pi*2) * fromRational (e-s)) + -> Double -- step + -> IO () +drawArc screen c (x,y) (r,r') t o step' + | o <= 0 = return () + | otherwise = do + let pix = colourToPixel c + void $ SDLP.filledPolygon screen coords pix + drawArc screen c (x,y) (r,r') t (o-step') step' + return () + where + a = max t (t + o - step') -- start width + b = t + o -- end width + coords :: [(Int16, Int16)] + coords = map (\(x',y') -> (floor $ x + x', floor $ y + y')) + [ (r * cos a, r * sin a) -- 1 + , (r' * cos a, r' * sin a) -- 2 + , (r' * cos b, r' * sin b) -- 3 + , (r * cos b, r * sin b) -- 4 + ] + +-- Draw cycle patterns continiously. +drawPatC + :: (Double, Double) + -> Pat.Pattern ColourD + -> Surface + -> Double + -> IO () +drawPatC (r,r') pat screen beat = mapM_ drawEvents $ event pos pat + where + pos :: Rational + pos = toRational $ beat / 8 + + drawEvents :: ((Rational, Rational), [ColourD]) -> IO () + drawEvents ((begin,end), cs) = + mapM_ (\(index', color) -> drawEvent (begin,end) color index' (length cs)) + (enumerate $ reverse cs) + + drawEvent :: (Rational, Rational) -> ColourD -> Int -> Int -> IO () + drawEvent (begin, end) color index' len = do + let thickness = (1 / fromIntegral len) * (r' - r) + let thickIndex = r + thickness * fromIntegral index' + + drawArc screen color middle (thickIndex, thickIndex + thickness) + ((pi*2) * fromRational (begin - pos)) ((pi*2) * fromRational (end - begin)) (pi/16) + +-- Draw one cycle patterns +drawRect :: Surface + -> ColourD + -> (Double, Double) -- thickIndex, thickIndex + thickness + -> Double -- ((pi*2) * fromRational (start - pos)) + -> Double -- ((pi*2) * fromRational (end - start)) + -> Double -- step (pi/16) + -> IO () +drawRect screen c (thickStart,thickEnd) t o step + | o <= 0 = return () + | otherwise = do + let pix = colourToPixel c + void $ SDLP.filledPolygon screen coords pix + drawRect screen c (thickStart, thickEnd) t (o - step) step + return () + where + a = max t (t + o - step) -- + b = t + o + + coords = map (\(x',y') -> (floor x', floor y')) + [ (b, thickStart) -- 1 + , (b, thickEnd) -- 2 + , (a, thickEnd) -- 3 + , (a, thickStart) -- 4 + ] + +-- Draw cycle patterns continiously +drawPatR :: (Double, Double) -> Pat.Pattern ColourD -> Surface -> Double -> IO () +drawPatR (x1,x2) p screen beat = mapM_ drawEvents $ event pos p + where + pos :: Rational + pos = toRational $ beat / 8 + + drawEvents :: ((Rational, Rational), [ColourD]) -> IO () + drawEvents ((begin, end), cs) = + mapM_ (\(index', c) -> drawEvent (begin, end) c index' (length cs)) (enumerate $ reverse cs) + + drawEvent :: (Rational, Rational) -> ColourD -> Int -> Int -> IO () + drawEvent (begin, end) color index' len = do + let thickness = (1 / fromIntegral len) * (x2 - x1) + let thickIndex = thickness * fromIntegral index' + let width = fi screenWidth + drawRect screen color (thickIndex, thickIndex + thickness) + (width * fromRational (begin - pos)) (width * fromRational (end - begin)) 1 + +event :: Rational -> Pat.Pattern ColourD -> [((Rational, Rational), [ColourD])] +event pos pat = map (\(Pat.Event _ Arc{..} events) -> + ((max start pos, min stop (pos + 1)), events)) + $ queryArc (segmentator pat) (Arc pos (pos + 1)) + +whileEvents :: MonadIO m => (Event -> m ()) -> m Bool +whileEvents act = do + ev <- liftIO pollEvent + case ev of + Quit -> return True + NoEvent -> return False + _ -> do + act ev + whileEvents act + +textSize :: String -> Font -> IO (Float,Float) +textSize text font' = + do message <- renderTextSolid font' text (Color 0 0 0) + return (fromScreen (surfaceGetWidth message, surfaceGetHeight message)) + +colourToPixel :: Colour Double -> Pixel +colourToPixel c = + -- mapRGB (surfaceGetPixelFormat screen) 255 255 255 + rgbColor (floor $ r*255) (floor $ g*255) (floor $ b *255) + where (RGB r g b) = toSRGB c + +colourToPixelS :: Surface -> Colour Double -> IO Pixel +colourToPixelS s c = + (mapRGB . surfaceGetPixelFormat) s (floor $ r*255) (floor $ g*255) (floor $ b*255) + where (RGB r g b) = toSRGB c + +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 :: Integer) + ) + +pixel :: Surface -> (GHC.Word.Word8,GHC.Word.Word8,GHC.Word.Word8) -> IO Pixel +pixel face (r,g,b) = mapRGB (surfaceGetPixelFormat face) r g b + + + diff --git a/src/Examples.hs b/src/Examples.hs new file mode 100644 index 0000000..32c1554 --- /dev/null +++ b/src/Examples.hs @@ -0,0 +1,108 @@ +module Examples where + +import Data.Colour +import Sound.Tidal.Context + +import Common (dirtToColour) +import Vis +import VisCycle +import VisGradient + + +-- | Examples +-- +-- | For pattern animation look at 'runAnimation' function at 'CycleAnimation.hs' module. +-- | There two forms of moving patterns: cycle and rectangle. +-- +-- | Here is renders of still images only. +main :: IO () +main = do + renderMatBundlePDF "./examples/" [a, b, c, d, e, f, g] + return () + +-- | Make mat rectangle pattern +matRect :: IO () +matRect = renderMatPDF "./examples/matRect" pip + +-- | Make bundle of mat rectangle pattern +matBundleRect :: IO () +matBundleRect = renderMatBundlePDF "./examples/" [foo, pip, pop, bar, buz] + +-- | Make gradient rectangle pattern +gradientRect :: IO () +gradientRect = renderGradientPDF "./examples/gradientRect" pip + +-- | Make gradient rectangle pattern +matCycleWithBorders :: IO () +matCycleWithBorders = renderCyclePDF "./examples/cycle" "background text" pip + +-- | Prepared patterns. +foo :: Pattern ColourD +foo = dirtToColour $ striate 16 $ sound "[bd*3? dr2, ~ casio ~, [bd arpy]]" # n + "2? 3 1 2" + +pip :: Pattern ColourD +pip = dirtToColour $ fast 12 $ sound + "[bd bd bd, <[sd sd] cp>, arpy arpy]>, odx]" + +pop :: Pattern ColourD +pop = dirtToColour $ fast 12 $ loopAt 3 $ sound + "[~ bd bd ~] ~ [bd ~ ~ [sd ~ ~ sd] ~ ~ sd]" + +bar :: Pattern ColourD +bar = dirtToColour $ fast 12 $ sound "{~ ~ ~ ~, arpy bass2 drum notes can}" + +buz :: Pattern ColourD +buz = + dirtToColour $ fast 24 $ sound "arpy*4" # pan (range 0.25 0.75 sine) # gain + (range 1.2 0.5 sine) + +a :: Pattern ColourD +a = density 16 $ every 2 rev $ every 3 (superimpose (iter 4)) $ rev + "[black blue darkblue, grey lightblue]" + +b :: Pattern (Colour Double) +b = flip darken <$> "[black blue orange, red green]*16" <*> sine + +c :: Pattern (Colour Double) +c = + density 10 + $ flip darken + <$> "[black blue, grey ~ navy, cornflowerblue blue]*2" + <*> (slow 5 $ (*) <$> sine <*> (slow 2 tri)) + +d :: Pattern (Colour Double) +d = + every 2 rev + $ density 10 + $ ( blend' + <$> "blue navy" + <*> "orange [red, orange, purple]" + <*> (slow 6 $ sine) + ) + where blend' x y z = blend z x y + +e :: Pattern (Colour Double) +e = + density 32 + $ flip over + <$> "[grey olive, black ~ brown, darkgrey]" + <*> ( withOpacity + <$> "[beige, lightblue white darkgreen, beige]" + <*> ((*) <$> (slow 8 $ slow 4 sine) <*> (slow 3 $ sine)) + ) + +f :: Pattern ColourD +f = + density 2 + $ flip darken + <$> (density 8 $ "[black blue, grey ~ navy, cornflowerblue blue]*2") + <*> sine + +g :: Pattern ColourD +g = density 2 $ do + let x = "[skyblue olive, grey ~ navy, cornflowerblue green]" + coloura <- density 8 x + colourb <- density 4 x + slide' <- slow 2 sine + return $ blend slide' coloura colourb diff --git a/src/Vis.hs b/src/Vis.hs new file mode 100644 index 0000000..a24eb1c --- /dev/null +++ b/src/Vis.hs @@ -0,0 +1,117 @@ +module Vis + ( magicallyMakeEverythingFaster + , renderMatPDF + , renderMatSVG + , renderMatBundlePDF + , renderMatBundleSVG + , svgAsString + , vPDF + , vSVG + ) where + +import Data.Colour.SRGB +import Sound.Tidal.Context hiding (segment) + +import Common + +import qualified Graphics.Rendering.Cairo as C + +-- | Render PDF. +vPDF + :: FilePath -- ^ path/filename without extansion. + -> (Double, Double) -- ^ Image size. + -> Pattern ColourD -- ^ Pattern. See 'Examples.hs' for pattern examples. + -> IO () +vPDF = v C.withPDFSurface + +vSVG :: FilePath -> (Double, Double) -> Pattern ColourD -> IO () +vSVG = v C.withSVGSurface + +-- | Render bundle of patterns to PDF. +renderMatBundlePDF :: FilePath -> [Pattern ColourD] -> IO () +renderMatBundlePDF path xs = mapM_ (\(num, p) + -> vPDF (concat [path, "patternP_", show num, ".pdf"]) (1600,400) p) + $ zip [(0::Int)..] xs + +-- | Render bundle of patterns to SVG. +renderMatBundleSVG :: FilePath -> [Pattern ColourD] -> IO () +renderMatBundleSVG path xs = mapM_ (\(num, p) + -> vSVG (concat [path, "patternS_", show num, ".svg"]) (1600,400) p) + $ zip [(0::Int)..] xs + +-- | First argument is order number for name. +renderMatPDF :: String -> Pattern ColourD -> IO () +renderMatPDF name = vPDF (concat [name, ".pdf"]) (1600, 400) + +-- | First argument is order number for name. +renderMatSVG :: String -> Pattern ColourD -> IO () +renderMatSVG name = vSVG (concat [name, ".svg"]) (1600, 400) + +-- | Show svg code of pattern. +svgAsString :: Pattern ColourD -> IO String +svgAsString pat = do + renderMatSVG "/tmp/vis2-tmp" pat + readFile "/tmp/vis2-tmp.svg" + +magicallyMakeEverythingFaster :: Pattern a -> [Event a] +magicallyMakeEverythingFaster = splitArcs 16 + where + splitArcs num p = concatMap + (\i -> queryArc p $ Arc i $ i+(1/num)) [0, (1/num) .. (1-(1/num))] + +-- | Constant. +ticks :: Ratio Integer +ticks = 1 + +v :: (FilePath -> Double -> Double -> (C.Surface -> IO ()) -> IO ()) + -> FilePath + -> (Double, Double) -- ^ Image output size. + -> Pattern ColourD + -> IO () +v sf fn (x,y) pat = + sf fn x y $ \surf -> + 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 + +-- | Convert time and color to rendered type. +renderEvent :: Event [ColourD] -> C.Render () +renderEvent (Event _ Arc{..} value) = do + C.save + drawBlocks value 0 + C.restore + where + height = 1 / fromIntegral (length value) + drawBlocks :: [ColourD] -> Integer -> C.Render () + drawBlocks [] _ = return () + drawBlocks (c:cs) num = do + let (RGB r g b) = toSRGB c + let x = fromRational start + let y = fromIntegral num * height + let w = fromRational (stop - start) + let h = height + C.setSourceRGBA r g b 1 + C.rectangle x y w h + C.fill + C.stroke + drawBlocks cs (num + 1) + +events :: Pattern ColourD -> [Event [ColourD]] +events pat = map + ( \(Event whole Arc{..} value) + -> Event whole (Arc ((start - tick) / speed') ((stop - tick) / speed')) value + ) + $ queryArc (segmentator pat) (Arc tick (tick + speed')) + where + speed' :: Ratio Integer + speed' = 1 + tick :: Ratio Integer + tick = ticks / 2 + + diff --git a/src/VisCycle.hs b/src/VisCycle.hs new file mode 100644 index 0000000..22f3f78 --- /dev/null +++ b/src/VisCycle.hs @@ -0,0 +1,91 @@ +module VisCycle + ( renderCyclePDF + , renderCycleSVG + ) where + +import Data.Colour.SRGB +import Sound.Tidal.Context +import Sound.Tidal.Utils + +import Common + +import qualified Graphics.Rendering.Cairo as C + + +-- | Constants. +totalWidth :: Double +totalWidth = 500 + +border :: Double +border = 5 + +v :: (String -> Double -> Double -> (C.Surface -> IO ()) -> IO ()) + -> String -- ^ filePath + -> (Double, Double) -- ^ size + -> [[Event ColourD]] + -> String -- ^ label + -> IO () +v sf fn (x,y) colorEvents label = + sf fn x y $ \surf -> C.renderWith surf $ do + C.setAntialias C.AntialiasBest + C.save + C.translate border border + C.scale (totalWidth-(border*2)) (totalWidth-(border*2)) + C.setOperator C.OperatorOver + C.selectFontFace ("Inconsolata" :: String) C.FontSlantNormal C.FontWeightNormal + C.setFontSize 0.2 + (C.TextExtents _ _ _ 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.rectangle 0 0 1 1 + -- C.fill + mapM_ (renderLevel (length colorEvents)) $ enumerate colorEvents + C.restore + +renderLevel :: Int -> (Int, [Event ColourD]) -> C.Render () +renderLevel total (num, level) = do + C.save + mapM_ drawEvent level + C.restore + where + drawEvent :: Event ColourD -> C.Render () + drawEvent (Event _ Arc{..} c) = do + let (RGB r g b) = toSRGB c + let levelHeight = (1 / fi (total+1))/2 + let h = levelHeight * fi (num + 1) + let hPi = pi / 2 + let dPi = pi * 2 + C.save + C.setSourceRGBA r g b 1 + C.arc 0.5 0.5 (h+levelHeight) (fromRational start * dPi - hPi) (fromRational stop * dPi - hPi) + C.arcNegative 0.5 0.5 h (fromRational stop * dPi - hPi) (fromRational start * dPi - hPi) + C.fill + C.setSourceRGBA 0.5 0.5 0.5 1 + C.setLineWidth 0.005 + C.arc 0.5 0.5 (h+levelHeight) (fromRational start * dPi - hPi) (fromRational stop * dPi - hPi) + C.arcNegative 0.5 0.5 h (fromRational stop * dPi - hPi) (fromRational start * dPi - hPi) + C.stroke + C.restore + +-- | Render a cycle pattern to pdf file. +renderCyclePDF + :: String -- ^ File name (and path) + -> String -- ^ Background text + -> Pattern ColourD + -> IO () +renderCyclePDF name label pat = do + v C.withPDFSurface (name ++ ".pdf") (totalWidth, totalWidth) (levels pat) label + return () + + -- | Render a cycle pattern to pdf file. +renderCycleSVG + :: String -- ^ File name (and path) + -> String -- ^ Background text + -> Pattern ColourD + -> IO () +renderCycleSVG name label pat = do + v C.withSVGSurface (name ++ ".svg") (totalWidth, totalWidth) (levels pat) label + return () diff --git a/src/VisGradient.hs b/src/VisGradient.hs new file mode 100644 index 0000000..8790c92 --- /dev/null +++ b/src/VisGradient.hs @@ -0,0 +1,95 @@ +module VisGradient + ( renderGradientSVG + , renderGradientPDF + ) where + +import Data.Colour.SRGB +import Sound.Tidal.Context +import Sound.Tidal.Utils + +import qualified Graphics.Rendering.Cairo as C + +import Common + + +-- | Constans +totalWidth :: Double +totalWidth = 1700 + +ratio :: Double +ratio = 3/40 + +levelHeight :: Double +levelHeight = totalWidth * ratio + +v :: (FilePath -> Double -> Double -> (C.Surface -> IO ()) -> IO ()) + -> FilePath + -> (Double, Double) + -> [[Event ColourD]] + -> IO () +v sf fn (x,y) colorEvents = sf fn x y $ \surf -> + C.renderWith surf $ do + C.save + -- C.scale x (y / (fromIntegral $ length colorEvents)) + C.setOperator C.OperatorOver + -- C.setSourceRGB 0 0 0 + -- C.rectangle 0 0 1 1 + --C.fill + mapM_ (renderLevel (length colorEvents)) $ enumerate colorEvents + C.restore + +renderLevel + :: (Foldable t, Integral a) + => p + -> (a, t (Event ColourD)) + -> C.Render () +renderLevel _ (num, level) = do + C.save + mapM_ drawEvent $ level + C.restore + where + drawEvent (Event (Arc sWhole eWhole) Arc{..} c) = do + let (RGB r g b) = toSRGB c + let x = (fromRational start) * totalWidth + let y = (fromIntegral num) * levelHeight + let xWhole = (fromRational sWhole) * totalWidth + -- let w = levelHeight + let lineW = (fromRational (stop - start) * totalWidth) + let wholeLineW = (fromRational (eWhole-sWhole) * totalWidth) + -- let lineH = 2 + -- let lgap = 3 + -- let rgap = 3 + -- let border = 3 + -- let half = levelHeight / 2 + -- let quarter = levelHeight / 4 + -- C.setSourceRGBA 0.6 0.6 0.6 1 + -- C.rectangle x y lineW levelHeight + C.withLinearPattern xWhole 0 (wholeLineW + xWhole) 0 $ \pat -> do + -- C.patternAddColorStopRGB pat 0 0 0 0 + -- C.patternAddColorStopRGB pat 0.5 1 1 1 + C.save + C.patternAddColorStopRGBA pat 0 r g b 1 + C.patternAddColorStopRGBA pat 1 r g b 0.5 + C.patternSetFilter pat C.FilterFast + C.setSource pat + -- 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 + +renderGradientSVG :: String -> Pattern ColourD -> IO () +renderGradientSVG name pat = do + v C.withSVGSurface (name ++ ".svg") + (totalWidth, levelHeight * (fromIntegral $ length $ levels pat)) $ levels pat + return () + +renderGradientPDF :: String -> Pattern ColourD -> IO () +renderGradientPDF name pat = do + v C.withPDFSurface (name ++ ".pdf") + (totalWidth, levelHeight * (fromIntegral $ length $ levels pat)) $ levels pat + return () + diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..ee4f14e --- /dev/null +++ b/stack.yaml @@ -0,0 +1,14 @@ +resolver: lts-13.8 + +# packages: [] + + +extra-deps: + - SDL-0.6.7.0 + - cairo-0.13.6.0 + - tidal-1.0.7 + - gtk2hs-buildtools-0.13.5.0 + - SDL-gfx-0.7.0.0 + - SDL-image-0.6.2.0 + - SDL-ttf-0.6.3.0 + diff --git a/tidal-vis.cabal b/tidal-vis.cabal index 289319a..4fbaf22 100644 --- a/tidal-vis.cabal +++ b/tidal-vis.cabal @@ -1,25 +1,47 @@ name: tidal-vis -version: 0.9.5 +version: 1.0.7 synopsis: Visual rendering for Tidal patterns --- description: +-- 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 +Copyright: (c) Alex McLean and others, 2019 category: Sound build-type: Simple -cabal-version: >=1.4 +cabal-version: 2.0 --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 + Exposed-modules: Common + CycleAnimation + Examples + Vis + VisCycle + VisGradient - Build-depends: base < 5, tidal>=0.9.5, colour, cairo, process + hs-source-dirs: src + + Build-depends: base < 5 + , tidal>=1.0.7 + , colour + , cairo + , SDL + , mtl + , SDL-gfx + , SDL-image + , SDL-ttf + , hosc + , hashable + , time + , network + + default-language: Haskell2010 + + default-extensions: OverloadedStrings + RecordWildCards