\subsubsection{Duration}
\seclabel{duration}
\begin{haskelllisting}
> module Haskore.Basic.Duration where
> import qualified Medium.Temporal as TemporalMedium
> import Data.Ratio((%))
> import qualified Haskore.General.Utility as Utility
> import Haskore.General.Map (Map)
> import qualified Haskore.General.Map as Map
> import qualified Numeric.NonNegative.Wrapper as NonNeg
\end{haskelllisting}
\begin{haskelllisting}
> type T = TemporalMedium.Dur
> type Ratio = T
> type Offset = Rational
> infixl 7 %+
> (%+) :: Integer -> Integer -> T
> (%+) x y = fromRatio (x%y)
> fromRatio :: Rational -> T
> fromRatio = NonNeg.fromNumberMsg "Duration.fromRatio"
> toRatio :: T -> Rational
> toRatio = NonNeg.toNumber
> toNumber :: Fractional a => T -> a
> toNumber = fromRational . NonNeg.toNumber
> scale :: Ratio -> T -> T
> scale = (*)
> add :: Offset -> T -> T
> add d = NonNeg.fromNumberMsg "Duration.add" . (d+) . toRatio
\end{haskelllisting}
\function{add} may have undefined result.
\begin{haskelllisting}
> divide :: T -> T -> Integer
> divide r1 r2 = Utility.divide (toRatio r1) (toRatio r2)
> divisible :: T -> T -> Bool
> divisible r1 r2 = Utility.divisible (toRatio r1) (toRatio r2)
> gcd :: T -> T -> T
> gcd r1 r2 = fromRatio (Utility.gcdDur (toRatio r1) (toRatio r2))
\end{haskelllisting}
\begin{haskelllisting}
> dotted, doubleDotted :: T -> T
> dotted = ((3%+2) *)
> doubleDotted = ((7%+4) *)
>
> bn, wn, hn, qn, en, sn, tn, sfn :: T
> dwn, dhn, dqn, den, dsn, dtn :: T
> ddhn, ddqn, dden :: T
>
> bn = 2
> wn = 1
> hn = 1%+ 2
> qn = 1%+ 4
> en = 1%+ 8
> sn = 1%+16
> tn = 1%+32
> sfn = 1%+64
>
> dwn = dotted wn
> dhn = dotted hn
> dqn = dotted qn
> den = dotted en
> dsn = dotted sn
> dtn = dotted tn
>
> ddhn = doubleDotted hn
> ddqn = doubleDotted qn
> dden = doubleDotted en
\end{haskelllisting}
\begin{haskelllisting}
> nameDictionary :: Map T String
> nameDictionary =
> let names = "b" : "w" : "h" : "q" : "e" : "s" : "t" : "sf" : []
> durs = zip (iterate (/2) 2) names
> ddurs = map (\(d,s) -> (dotted d, "d" ++s)) durs
> dddurs = map (\(d,s) -> (doubleDotted d, "dd"++s)) durs
> in Map.fromList $
> durs ++
> take 6 (drop 1 ddurs) ++
> take 3 (drop 2 dddurs)
>
> toString :: T -> String
> toString dur =
> maybe
> ("(" ++ show dur ++ ")")
> (++"n")
> (Map.lookup nameDictionary dur)
\end{haskelllisting}
Check proper formatting.
\begin{haskelllisting}
> propToString :: Bool
> propToString =
> all (\(dur,name) -> toString dur == name) $
> (bn, "bn") : (wn, "wn") : (hn, "hn") : (qn, "qn") :
> (en, "en") : (sn, "sn") : (tn, "tn") : (sfn, "sfn") :
> (dwn, "dwn") : (dhn, "dhn") : (dqn, "dqn") :
> (den, "den") : (dsn, "dsn") : (dtn, "dtn") :
> (ddhn, "ddhn") : (ddqn, "ddqn") : (dden, "dden") : []
\end{haskelllisting}