diff --git a/src/Sound/Tidal/Pattern.hs b/src/Sound/Tidal/Pattern.hs index 498e8360..ef7d89cc 100644 --- a/src/Sound/Tidal/Pattern.hs +++ b/src/Sound/Tidal/Pattern.hs @@ -915,14 +915,10 @@ eventHasOnset e | isAnalog e = False -- | Given any event, return it as if it was queried between the given arc encloseEvent :: Arc -> Event a -> Maybe (Event a) encloseEvent _ (Event _ Nothing _ _) = Nothing -- TODO how to handle analogs -encloseEvent (Arc as ae) ev@(Event _ (Just (Arc ws we)) _ _) - | we <= as = Nothing - | ws >= ae = Nothing - | ws >= as && we <= ae = Just ev -- fully within - | ws >= as && we > ae = Just ev { part = Arc ws ae } -- starts within, ends outside - | ws < as && we > ae = Just ev { part = Arc as ae } -- starts outside, ends outside - | ws < as && we <= ae = Just ev { part = Arc as we } -- starts outside, ends within - | otherwise = Nothing +encloseEvent a@(Arc as ae) ev@(Event ctx (Just w@(Arc ws we)) part val) + | we <= as || ws >= ae = Nothing -- outside + | ws >= as && we <= ae = Just ev -- fully within + | otherwise = Just ev { part = sect w a } -- intersects -- | If an event ends before it starts, switch starts with ends unflipEvent :: Event a -> Event a diff --git a/src/Sound/Tidal/UI.hs b/src/Sound/Tidal/UI.hs index e5e3fc0b..107896b7 100644 --- a/src/Sound/Tidal/UI.hs +++ b/src/Sound/Tidal/UI.hs @@ -37,6 +37,8 @@ module Sound.Tidal.UI where import Prelude hiding ((*>), (<*)) +import Control.Applicative (liftA2) + import Data.Bits (Bits, shiftL, shiftR, testBit, xor) import Data.Char (digitToInt, isDigit, ord) @@ -2060,10 +2062,16 @@ fill p' p = struct (splitQueries $ p {query = q, pureValue = Nothing}) p' _quant :: Time -> Pattern a -> Pattern a _quant 0 pat = pat _quant k pat = - withEventOnArc (quantEvent k) (timeToCycleArc . start) pat + withEventOnArc (quantEvent k) (surround) pat where + surround qa@(Arc qs qe) = Arc (qs - lookahead) (qe + lookahead) + lookahead = 1/k quantEvent k ev = ev { whole = (fmap rounding <$> whole ev) } - rounding n = toTime $ ((/ k) $ fromIntegral $ round $ (* k) n) + rounding n = (roundNumerator n) % k' + roundNumerator n = (nn * k' + (nd `div` 2)) `div` nd + where nn = numerator n + nd = denominator n + k' = numerator k quant :: Pattern Time -> Pattern a -> Pattern a quant = patternify _quant @@ -2090,14 +2098,13 @@ fill' = patternify2 _fill alterT :: (Time -> Time) -> Pattern a -> Pattern a alterT f pat = withEventOnArc (unflipEvent . alterEvent) (timeToCycleArc . start) pat - where alterEvent ev = ev { whole = (fmap alterTime <$> whole ev) } - alterTime w = (sam $ w) + (f $ cyclePos $ w) + where alterEvent ev = ev { whole = (fmap (mapCycle f) $ whole ev) } alterF :: (Double -> Double) -> Pattern a -> Pattern a alterF f pat = withEventOnArc (unflipEvent . alterEvent) (timeToCycleArc . start) pat - where alterEvent ev = ev { whole = (fmap alterTime <$> whole ev) } - alterTime t = (sam $ t) + (toRational $ f $ fromRational $ cyclePos $ t) + where alterEvent ev = ev { whole = (fmap (mapCycle f') $ whole ev) } + f' = toRational . f . fromRational {- | @ply n@ repeats each event @n@ times within its arc.