compat with latest tidal
parent
c7ae35b81a
commit
b30f711c67
|
|
@ -50,7 +50,7 @@ levelsWhole pat = arrangeEventsWhole $ sortOn' ((\Arc{..} -> 0 - (stop - start))
|
||||||
-- levelsWhole pat = arrangeEventsWhole $ defragParts $ queryArc pat (Arc 0 1)
|
-- levelsWhole pat = arrangeEventsWhole $ defragParts $ queryArc pat (Arc 0 1)
|
||||||
|
|
||||||
fits :: Event b -> [Event b] -> Bool
|
fits :: Event b -> [Event b] -> Bool
|
||||||
fits (Event _ part' _) events = not $ any (\Event{..} -> isJust $ subArc part' part) events
|
fits (Event _ _ part' _) events = not $ any (\Event{..} -> isJust $ subArc part' part) events
|
||||||
|
|
||||||
addEvent :: Event b -> [[Event b]] -> [[Event b]]
|
addEvent :: Event b -> [[Event b]] -> [[Event b]]
|
||||||
addEvent e [] = [[e]]
|
addEvent e [] = [[e]]
|
||||||
|
|
@ -82,7 +82,7 @@ stringToColour str = sRGB (r/256) (g/256) (b/256)
|
||||||
|
|
||||||
segmentator :: Pattern ColourD -> Pattern [ColourD]
|
segmentator :: Pattern ColourD -> Pattern [ColourD]
|
||||||
segmentator p@Pattern{..} = Pattern $ \(State arc@Arc{..} _)
|
segmentator p@Pattern{..} = Pattern $ \(State arc@Arc{..} _)
|
||||||
-> filter (\(Event _ (Arc start' stop') _) -> start' < stop && stop' > start)
|
-> filter (\(Event _ _ (Arc start' stop') _) -> start' < stop && stop' > start)
|
||||||
$ groupByTime (segment' (defragParts $ queryArc p arc))
|
$ groupByTime (segment' (defragParts $ queryArc p arc))
|
||||||
|
|
||||||
segment' :: [Event a] -> [Event a]
|
segment' :: [Event a] -> [Event a]
|
||||||
|
|
@ -91,20 +91,20 @@ segment' es = foldr split es pts
|
||||||
|
|
||||||
split :: Time -> [Event a] -> [Event a]
|
split :: Time -> [Event a] -> [Event a]
|
||||||
split _ [] = []
|
split _ [] = []
|
||||||
split t (ev@(Event whole Arc{..} value):es)
|
split t (ev@(Event c whole Arc{..} value):es)
|
||||||
| t > start && t < stop =
|
| t > start && t < stop =
|
||||||
Event whole (Arc start t) value : Event whole (Arc t stop) value : split t es
|
Event c whole (Arc start t) value : Event c whole (Arc t stop) value : split t es
|
||||||
| otherwise = ev:split t es
|
| otherwise = ev:split t es
|
||||||
|
|
||||||
points :: [Event a] -> [Time]
|
points :: [Event a] -> [Time]
|
||||||
points [] = []
|
points [] = []
|
||||||
points (Event _ Arc{..} _ : es) = start : stop : points es
|
points (Event _ _ Arc{..} _ : es) = start : stop : points es
|
||||||
|
|
||||||
groupByTime :: [Event a] -> [Event [a]]
|
groupByTime :: [Event a] -> [Event [a]]
|
||||||
groupByTime es = map merge $ groupBy ((==) `on` part) $ sortOn (stop . part) es
|
groupByTime es = map merge $ groupBy ((==) `on` part) $ sortOn (stop . part) es
|
||||||
where
|
where
|
||||||
merge :: [EventF a b] -> EventF a [b]
|
merge :: [EventF a b] -> EventF a [b]
|
||||||
merge evs@(Event{whole, part} : _) = Event whole part $ map (\Event{value} -> value) evs
|
merge evs@(Event{context, whole, part} : _) = Event context whole part $ map (\Event{value} -> value) evs
|
||||||
merge _ = error "groupByTime"
|
merge _ = error "groupByTime"
|
||||||
|
|
||||||
beatNow :: Tempo.Tempo -> IO Double
|
beatNow :: Tempo.Tempo -> IO Double
|
||||||
|
|
|
||||||
|
|
@ -196,7 +196,7 @@ drawPatR (x1,x2) p screen beat = mapM_ drawEvents $ event (pos beat) p
|
||||||
(width * fromRational (b - pos beat)) (width * fromRational (e - b)) 1
|
(width * fromRational (b - pos beat)) (width * fromRational (e - b)) 1
|
||||||
|
|
||||||
event :: Rational -> Pat.Pattern ColourD -> [((Rational, Rational), [ColourD])]
|
event :: Rational -> Pat.Pattern ColourD -> [((Rational, Rational), [ColourD])]
|
||||||
event position pat = map (\(Pat.Event _ Arc{..} events) ->
|
event position pat = map (\(Pat.Event _ _ Arc{..} events) ->
|
||||||
((max start position, min stop (position + 1)), events))
|
((max start position, min stop (position + 1)), events))
|
||||||
$ queryArc (segmentator pat) (Arc position (position + 1))
|
$ queryArc (segmentator pat) (Arc position (position + 1))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -82,7 +82,7 @@ v sf fn (x,y) pat =
|
||||||
|
|
||||||
-- | Convert time and color to rendered type.
|
-- | Convert time and color to rendered type.
|
||||||
renderEvent :: Event [ColourD] -> C.Render ()
|
renderEvent :: Event [ColourD] -> C.Render ()
|
||||||
renderEvent (Event _ Arc{..} value) = do
|
renderEvent (Event _ _ Arc{..} value) = do
|
||||||
C.save
|
C.save
|
||||||
drawBlocks value 0
|
drawBlocks value 0
|
||||||
C.restore
|
C.restore
|
||||||
|
|
@ -104,8 +104,8 @@ renderEvent (Event _ Arc{..} value) = do
|
||||||
|
|
||||||
events :: Pattern ColourD -> [Event [ColourD]]
|
events :: Pattern ColourD -> [Event [ColourD]]
|
||||||
events pat = map
|
events pat = map
|
||||||
( \(Event whole Arc{..} value)
|
( \(Event context whole Arc{..} value)
|
||||||
-> Event whole (Arc ((start - tick) / speed') ((stop - tick) / speed')) value
|
-> Event context whole (Arc ((start - tick) / speed') ((stop - tick) / speed')) value
|
||||||
)
|
)
|
||||||
$ queryArc (segmentator pat) (Arc tick (tick + speed'))
|
$ queryArc (segmentator pat) (Arc tick (tick + speed'))
|
||||||
where
|
where
|
||||||
|
|
|
||||||
|
|
@ -52,7 +52,7 @@ renderLevel total (num, level) = do
|
||||||
C.restore
|
C.restore
|
||||||
where
|
where
|
||||||
drawEvent :: Event ColourD -> C.Render ()
|
drawEvent :: Event ColourD -> C.Render ()
|
||||||
drawEvent (Event _ Arc{..} c) = do
|
drawEvent (Event _ _ Arc{..} c) = do
|
||||||
let (RGB r g b) = toSRGB c
|
let (RGB r g b) = toSRGB c
|
||||||
let levelHeight = (1 / fi (total+1))/2
|
let levelHeight = (1 / fi (total+1))/2
|
||||||
let h = levelHeight * fi (num + 1)
|
let h = levelHeight * fi (num + 1)
|
||||||
|
|
|
||||||
|
|
@ -48,7 +48,7 @@ renderLevel _ (num, level) = do
|
||||||
mapM_ drawEvent $ level
|
mapM_ drawEvent $ level
|
||||||
C.restore
|
C.restore
|
||||||
where
|
where
|
||||||
drawEvent e@(Event _ Arc{..} c) = do
|
drawEvent e@(Event _ _ Arc{..} c) = do
|
||||||
let (Arc sWhole eWhole) = wholeOrPart e
|
let (Arc sWhole eWhole) = wholeOrPart e
|
||||||
let (RGB r g b) = toSRGB c
|
let (RGB r g b) = toSRGB c
|
||||||
let x = (fromRational start) * totalWidth
|
let x = (fromRational start) * totalWidth
|
||||||
|
|
|
||||||
|
|
@ -59,7 +59,7 @@ renderLevel _ (num, level) = do
|
||||||
mapM_ drawEvent $ level
|
mapM_ drawEvent $ level
|
||||||
C.restore
|
C.restore
|
||||||
where
|
where
|
||||||
drawEvent e@(Event _ (Arc sPart ePart) v) = do
|
drawEvent e@(Event _ _ (Arc sPart ePart) v) = do
|
||||||
let (Arc sWhole eWhole) = wholeOrPart e
|
let (Arc sWhole eWhole) = wholeOrPart e
|
||||||
let (r, g, b) = (0,0,0)
|
let (r, g, b) = (0,0,0)
|
||||||
let px = (fromRational sPart) * totalWidth
|
let px = (fromRational sPart) * totalWidth
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue