diff --git a/src/VisPart.hs b/src/VisPart.hs new file mode 100644 index 0000000..8fc3000 --- /dev/null +++ b/src/VisPart.hs @@ -0,0 +1,136 @@ +module VisPart + ( renderPartSVG + , renderPartPDF + ) 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 :: Show a => (FilePath -> Double -> Double -> (C.Surface -> IO ()) -> IO ()) + -> FilePath + -> (Double, Double) + -> [[Event a]] + -> IO () +v sf fn (x,y) es = 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 + C.setAntialias C.AntialiasBest + mapM_ (renderLevel (length es)) $ enumerate es + C.restore + +renderLevel + :: (Foldable t, Integral a, Show b) + => p + -> (a, t (Event b)) + -> C.Render () +renderLevel _ (num, level) = do + C.save + mapM_ drawEvent $ level + C.restore + where + drawEvent (Event (Arc sWhole eWhole) (Arc sPart ePart) v) = do + let (r, g, b) = (0,0,0) + let px = (fromRational sPart) * totalWidth + let wx = (fromRational sWhole) * totalWidth + let y = (fromIntegral num) * levelHeight + let pw = (fromRational (ePart - sPart) * totalWidth) + let ww = (fromRational (eWhole - sWhole) * totalWidth) + let gap = 12 + let lw = 2 + halfLw = lw /2 + halfGap = gap / 2 + + C.withLinearPattern wx 0 (ww + wx) 0 $ \pat -> do + C.save + C.patternAddColorStopRGBA pat 0 0.8 0.8 0.8 1 + C.patternAddColorStopRGBA pat 1 0 0 0 0.5 + C.patternSetFilter pat C.FilterFast + C.setSource pat + let leftGap = if px == wx then halfGap else 0 + rightGap = if px+pw == wx+ww then halfGap else 0 + C.rectangle (px+leftGap) (y+halfGap) ((pw-(leftGap+rightGap))) (levelHeight-gap) + C.fill + C.restore + C.save + C.setSourceRGBA 0 0 0 1 + C.setLineWidth lw + C.moveTo (px+leftGap) (y+halfGap) + C.lineTo (px+pw-(rightGap)) (y+halfGap) + C.moveTo (px+leftGap) (y+levelHeight-halfGap) + C.lineTo (px+pw-(rightGap)) (y+levelHeight-halfGap) + C.stroke + if px == wx + then do C.moveTo (px+halfGap) (y+levelHeight-halfGap) + C.lineTo (px+halfGap) (y+halfGap) + C.stroke + else (do C.setDash [6,4] 6 + C.moveTo (px) (y+halfGap) + C.lineTo (wx+halfGap) (y+halfGap) + C.lineTo (wx+halfGap) (y+levelHeight-halfGap) + C.lineTo (px) (y+levelHeight-halfGap) + C.stroke + C.setDash [] 0 + return () + ) + if (px+pw) == (wx+ww) + then do C.moveTo (px+pw-halfGap) (y+levelHeight-halfGap) + C.lineTo (px+pw-halfGap) (y+halfGap) + C.stroke + return () + else (do C.setDash [6,4] 0 + C.moveTo (px+pw) (y+halfGap) + C.lineTo (wx+ww-halfGap) (y+halfGap) + C.lineTo (wx+ww-halfGap) (y+levelHeight-halfGap) + C.lineTo (px+pw) (y+levelHeight-halfGap) + C.stroke + C.setDash [] 0 + return () + ) + C.restore + C.selectFontFace ("Inconsolata" :: String) C.FontSlantNormal C.FontWeightNormal + C.setFontSize 35 + (C.TextExtents _ _ textW textH _ _) <- C.textExtents (show v) + C.moveTo (wx + 12) (y + textH + 16) + C.textPath (show v) + C.setSourceRGB 0 0 0 + C.fill +-- C.save +-- C.translate border border +-- C.scale (totalWidth-(border*2)) (totalWidth-(border*2)) +-- C.setOperator C.OperatorOver + -- C.fill + -- C.stroke + +renderPartSVG :: Show a => String -> Pattern a -> IO () +renderPartSVG name pat = do + v C.withSVGSurface (name ++ ".svg") + (totalWidth, levelHeight * (fromIntegral $ length $ levelsWhole pat)) $ levelsWhole pat + return () + +renderPartPDF :: Show a => String -> Pattern a -> IO () +renderPartPDF name pat = do + v C.withPDFSurface (name ++ ".pdf") + (totalWidth, levelHeight * (fromIntegral $ length $ levelsWhole pat)) $ levelsWhole pat + return () + diff --git a/tidal-vis.cabal b/tidal-vis.cabal index 922a394..ed70a1c 100644 --- a/tidal-vis.cabal +++ b/tidal-vis.cabal @@ -1,5 +1,5 @@ name: tidal-vis -version: 1.0.13 +version: 1.0.14 synopsis: Visual rendering for Tidal patterns and osc messages homepage: http://yaxu.org/tidal/ license: GPL-3 @@ -47,6 +47,7 @@ library Vis VisCycle VisGradient + VisPart hs-source-dirs: src @@ -64,7 +65,7 @@ library , SDL-ttf , mtl , network - , tidal>=1.0.13 + , tidal >= 1.0.15 , time , unagi-chan