From b27331c7f722b69467da1b97d9a7dd04916af462 Mon Sep 17 00:00:00 2001
From: alex <alex@slab.org>
Date: Thu, 22 Aug 2019 11:12:49 +0100
Subject: [PATCH] updates to tidal 1.4.x

---
 src/Common.hs      | 30 +++++++++++++++++++++++-------
 src/VisGradient.hs |  3 ++-
 src/VisPart.hs     |  3 ++-
 tidal-vis.cabal    |  4 ++--
 4 files changed, 29 insertions(+), 11 deletions(-)

diff --git a/src/Common.hs b/src/Common.hs
index b25c6a6..8839a9b 100644
--- a/src/Common.hs
+++ b/src/Common.hs
@@ -6,6 +6,7 @@ module Common
        , dirtToColour
        , fi
        , levels
+       , levelsWhole
        , remoteLocal
        , segmentator
        , toPattern
@@ -30,8 +31,21 @@ import qualified Sound.Tidal.Tempo as Tempo
 fi :: (Integral a, Num b) => a -> b
 fi = fromIntegral
 
-arrangeEvents :: [Event b] -> [[Event b]]
-arrangeEvents = foldr addEvent []
+fitsWhole :: Event b -> [Event b] -> Bool
+fitsWhole event events = not $ any (\event' -> isJust $ subArc (wholeOrPart event) (wholeOrPart event')) events
+
+addEventWhole :: Event b -> [[Event b]] -> [[Event b]]
+addEventWhole e [] = [[e]]
+addEventWhole e (level:ls)
+    | isAnalog e = level:ls
+    | fitsWhole e level = (e:level) : ls
+    | otherwise = level : addEventWhole e ls
+
+arrangeEventsWhole :: [Event b] -> [[Event b]]
+arrangeEventsWhole = foldr addEventWhole []
+
+levelsWhole :: Pattern a -> [[Event a]]
+levelsWhole pat = arrangeEventsWhole $ sortOn' ((\Arc{..} -> stop - start) . part) (queryArc pat (Arc 0 1))
 
 fits :: Event b -> [Event b] -> Bool
 fits (Event _ part' _) events = not $ any (\Event{..} -> isJust $ subArc part' part) events
@@ -42,13 +56,16 @@ addEvent e (level:ls)
     | fits e level = (e:level) : ls
     | otherwise = level : addEvent e ls
 
-levels :: Pattern ColourD -> [[Event ColourD]]
+arrangeEvents :: [Event b] -> [[Event b]]
+arrangeEvents = foldr addEvent []
+
+levels :: Pattern a -> [[Event a]]
 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.13
+-- | Recover deprecated functions for 1.0.13
 dirtToColour :: ControlPattern -> Pattern ColourD
 dirtToColour = fmap (stringToColour . show)
 
@@ -61,8 +78,7 @@ stringToColour str = sRGB (r/256) (g/256) (b/256)
     b = fromIntegral (i .&. 0x0000FF)
 
 segmentator :: Pattern ColourD -> Pattern [ColourD]
-segmentator p@Pattern{..} = Pattern nature
-    $ \(State arc@Arc{..} _)
+segmentator p@Pattern{..} = Pattern $ \(State arc@Arc{..} _)
     -> filter (\(Event _ (Arc start' stop') _) -> start' < stop && stop' > start)
     $ groupByTime (segment' (queryArc p arc))
 
@@ -112,5 +128,5 @@ remoteLocal config time = do
     _ -> error "wrong Socket"
 
 toPattern :: [Event ControlMap] -> ControlPattern
-toPattern evs = Pattern Digital $ const evs
+toPattern evs = Pattern $ const evs
 
diff --git a/src/VisGradient.hs b/src/VisGradient.hs
index 8790c92..bad7d67 100644
--- a/src/VisGradient.hs
+++ b/src/VisGradient.hs
@@ -48,7 +48,8 @@ renderLevel _ (num, level) = do
     mapM_ drawEvent $ level
     C.restore
   where
-    drawEvent (Event (Arc sWhole eWhole) Arc{..} c) = do
+    drawEvent e@(Event _ Arc{..} c) = do
+        let (Arc sWhole eWhole) = wholeOrPart e
         let (RGB r g b) = toSRGB c
         let x = (fromRational start) * totalWidth
         let y = (fromIntegral num) * levelHeight
diff --git a/src/VisPart.hs b/src/VisPart.hs
index 8fc3000..ca6fc7b 100644
--- a/src/VisPart.hs
+++ b/src/VisPart.hs
@@ -49,7 +49,8 @@ renderLevel _ (num, level) = do
     mapM_ drawEvent $ level
     C.restore
   where
-    drawEvent (Event (Arc sWhole eWhole) (Arc sPart ePart) v) = do
+    drawEvent e@(Event _ (Arc sPart ePart) v) = do
+        let (Arc sWhole eWhole) = wholeOrPart e
         let (r, g, b) = (0,0,0)
         let px = (fromRational sPart) * totalWidth
         let wx = (fromRational sWhole) * totalWidth
diff --git a/tidal-vis.cabal b/tidal-vis.cabal
index ed70a1c..bd70bf3 100644
--- a/tidal-vis.cabal
+++ b/tidal-vis.cabal
@@ -1,5 +1,5 @@
 name:                tidal-vis
-version:             1.0.14
+version:             1.0.15
 synopsis:            Visual rendering for Tidal patterns and osc messages
 homepage:            http://yaxu.org/tidal/
 license:             GPL-3
@@ -65,7 +65,7 @@ library
                   , SDL-ttf
                   , mtl
                   , network
-                  , tidal >= 1.0.15
+                  , tidal >= 1.0.15 && < 1.5
                   , time
                   , unagi-chan