\begin{code}
module Music.Analysis.Abstract.Rhythm where
import Music.Analysis.PF ((><), swap, p2, split, p1, grd, (-|-), assocl,
mapL, cataL, e2m, hyloL)
import Music.Analysis.Abstract.Settings (Settings, getNumber, changeText,
fromList, number, priority)
import Music.Analysis.Abstract.Motive (Motive, fromMotive, toMotive,
mapMotive, cataMotive)
import Music.Analysis.Base (Number, Delta, Text,
IntegerNumber, RatioNumber, toRatio, toInteger)
import Data.Maybe (maybe)
import Data.Function (id, const, (.))
import Data.Ord (Ord(..))
import Data.Eq (Eq(..))
import Data.Tuple (uncurry)
import Data.List ((++), zip, tail, init, unzip)
import Prelude (Num(..), (/), Show(..),(^), read)
\end{code}
RhythmNode is defined as pair of Delta, variation on durations, and number of
dots.
Mandatory settings are:
\begin{description}
\item[TempoPitch] by default is number 4,
\item[TempoNumber] by default is number 60,
\item[CompassUp] by default is number 4
\item[CompassDown] by default is number 4.
\end{description}
\begin{code}
type RhythmNode = (Delta, Dots)
type RhythmAbsolute = (RatioNumber, Dots)
type RhythmRelative = (RatioNumber, Dots)
type Dots = IntegerNumber
type Duration = Number
data DurationClass = Whole
| Half
| Quarter
| Eighth
| Th16
| Th32
| Th64
| UnkownDuration Text
deriving (Eq, Show)
settings :: Settings
settings = fromList [
("TempoPitch", number 4 priority),
("TempoNumber", number 60 priority),
("CompassUp", number 4 priority),
("CompassDown", number 4 priority)]
\end{code}
\begin{code}
durationNode :: RhythmNode -> Number
durationNode =
hyloL
(maybe 0 (uncurry (+)))
(e2m . (const () -|- split p1 ((/2) >< pred)) . grd ((<=0).p2)) .
(id >< succ)
where pred x = x 1
succ x = x + 1
compass :: (Number,Number) -> Number
compass (x,y) = x/y
\end{code}
These functions are combinators over Rhythm.
\begin{code}
tempo :: RatioNumber -> Motive RhythmAbsolute -> Motive RhythmAbsolute
tempo n = mapMotive (const ((*n) >< id))
duration :: Motive RhythmNode -> Number
duration = p2 .
cataMotive 0 (const (uncurry (+) . (durationNode >< id)))
reverse :: Motive RhythmNode -> Motive RhythmNode
reverse = toMotive .
cataMotive [] (const (uncurry (++) . swap . ( (:[]) >< id)))
symmetric :: RatioNumber -> Motive RhythmAbsolute -> Motive RhythmAbsolute
symmetric n = mapMotive (const ((n +) . (/n) >< id))
\end{code}
Relative function assume that Motive have Absolute Type, and change it into
Relative Type.
Absolute function is computed using Point-Free approach. Actually, it built
initial lists from nodes and reverse reversed result, summing it.
Attention: Relative and absolute functions use wrong initial number from
settings.
\begin{code}
relative :: Motive RhythmAbsolute -> Motive RhythmRelative
relative = toMotive .
split (changeText "Type" "Relative" . p1)
(mapL (split (uncurry (/) . (p1 >< p1)) (p2 . p1)) .
uncurry zip . (p2 >< uncurry (:) . (initial >< id)) .
split id id .
(maybe (toRatio 4) (toRatio . toInteger) .
getNumber "CompassDown" >< id))
. fromMotive
where initial :: RatioNumber -> RhythmAbsolute
initial = split id (const 0)
absolute :: Motive RhythmRelative -> Motive RhythmAbsolute
absolute = toMotive .
split (changeText "Type" "Absolute" . p1)
(uncurry zip . (tail .
(mapL (cataL (maybe (toRatio 1) (uncurry (*))))) .
(hyloL (maybe [] (uncurry (++) . swap . ((:[]) >< id)))
(e2m . ( const () -|- split id init) . grd (==[]))) .
(uncurry (:))
>< id) .
(assocl . (id >< unzip)) .
(maybe (toRatio 4) (toRatio.toInteger) . getNumber "CompassDown" >< id))
. fromMotive
\end{code}
\begin{code}
durationNumber :: DurationClass -> Duration
durationNumber Whole = 4
durationNumber Half = 2
durationNumber Quarter = 1
durationNumber Eighth = 0.5
durationNumber Th16 = 0.25
durationNumber Th32 = 0.125
durationNumber Th64 = 0.0625
durationNumber (UnkownDuration _) = 1
\end{code}
\begin{code}
durationTotalNumber :: (DurationClass, Dots) -> Duration
durationTotalNumber =
hyloL
(maybe 0 (uncurry (+)))
(e2m . (const () -|- split p1 ((/2) >< pred)) . grd ((<=0).p2)) .
(durationNumber >< succ)
where pred x = x 1
succ x = x + 1
getDurationClass :: (Duration,Dots) -> DurationClass
getDurationClass (4,_) = Whole
getDurationClass (2,_) = Half
getDurationClass (1,_) = Quarter
getDurationClass (0.5,_) = Eighth
getDurationClass (0.25,_) = Th16
getDurationClass (0.125,_) = Th32
getDurationClass (0.0625,_) = Th64
getDurationClass (b,0) = UnkownDuration (show b)
getDurationClass (t,i) = getDurationClass (((2^i) / ((2^(i+1)) 1)) * t, 0)
getDuration :: (DurationClass, Dots) -> Duration
getDuration =
hyloL
(maybe 0 (uncurry (+)))
(e2m . (const () -|- split p1 ((/2) >< pred)) . grd ((<=0).p2)) .
(durationNumber >< succ)
where pred x = x 1
succ x = x + 1
getDuration_aux1 :: DurationClass -> Duration
getDuration_aux1 Whole = 4
getDuration_aux1 Half = 2
getDuration_aux1 Quarter = 1
getDuration_aux1 Eighth = 0.5
getDuration_aux1 Th16 = 0.25
getDuration_aux1 Th32 = 0.125
getDuration_aux1 Th64 = 0.0625
getDuration_aux1 (UnkownDuration x) = read x
\end{code}