-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE CPP #-}
-- | Support for rhythmic spelling in different meters.
module Perform.Lilypond.Meter (
    Meter, meter_nums, meter_denom
    , time_num
    , default_meter
    , measure_time
    , unparse_meter, parse_meter
    , is_binary
    -- * tie breaking
    , allowed_duration
#ifdef TESTING
    , module Perform.Lilypond.Meter
#endif
) where
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Vector.Unboxed as Vector
import           Data.Vector.Unboxed ((!))

import qualified Util.Num as Num
import qualified Util.P as P
import qualified Util.Parse as Parse
import qualified Util.Seq as Seq

import qualified Perform.Lilypond.Types as Types
import           Perform.Lilypond.Types (Duration(..), NoteDuration(..), Time)
import qualified Ui.Meter.Make as Meter.Make
import qualified Ui.Meter.Meter as Meter
import           Ui.Meter.Meter (AbstractMeter(..))

import           Global


data Meter = Meter {
    -- | NonEmpty list of numerators.  E.g. [2, 3] indicates 2+3.
    Meter -> [Int]
meter_nums :: ![Int]
    , Meter -> Duration
meter_denom :: !Duration
    , Meter -> Ranks
meter_ranks :: !Ranks
    } deriving (Meter -> Meter -> Bool
(Meter -> Meter -> Bool) -> (Meter -> Meter -> Bool) -> Eq Meter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Meter -> Meter -> Bool
$c/= :: Meter -> Meter -> Bool
== :: Meter -> Meter -> Bool
$c== :: Meter -> Meter -> Bool
Eq, Int -> Meter -> ShowS
[Meter] -> ShowS
Meter -> String
(Int -> Meter -> ShowS)
-> (Meter -> String) -> ([Meter] -> ShowS) -> Show Meter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Meter] -> ShowS
$cshowList :: [Meter] -> ShowS
show :: Meter -> String
$cshow :: Meter -> String
showsPrec :: Int -> Meter -> ShowS
$cshowsPrec :: Int -> Meter -> ShowS
Show)

-- | Meter rank, indexed by 128th note.
type Ranks = Vector.Vector Rank
type Rank = Int

time_num :: Meter -> Int
time_num :: Meter -> Int
time_num = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum ([Int] -> Int) -> (Meter -> [Int]) -> Meter -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meter -> [Int]
meter_nums

rank_at :: Meter -> Time -> Int
rank_at :: Meter -> Time -> Int
rank_at Meter
meter Time
t = Ranks
v Ranks -> Int -> Int
forall a. Unbox a => Vector a -> Int -> a
! (Time -> Int
time_index Time
t Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Ranks -> Int
forall a. Unbox a => Vector a -> Int
Vector.length Ranks
v)
    where v :: Ranks
v = Meter -> Ranks
meter_ranks Meter
meter

time_index :: Time -> Int
time_index :: Time -> Int
time_index = Time -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

index_time :: Int -> Time
index_time :: Int -> Time
index_time = Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Pretty Meter where pretty :: Meter -> Text
pretty = Meter -> Text
unparse_meter

instance Types.ToLily Meter where
    to_lily :: Meter -> Text
to_lily (Meter [Int]
nums Duration
denom Ranks
_) =
        Int -> Text
forall a. Show a => a -> Text
showt ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum [Int]
nums) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Duration -> Text
forall a. ToLily a => a -> Text
Types.to_lily Duration
denom

is_binary :: Meter -> Bool
is_binary :: Meter -> Bool
is_binary Meter
meter = case Meter -> [Int]
meter_nums Meter
meter of
    [Int
num] -> (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==Double
0) (Double -> Bool) -> Double -> Bool
forall a b. (a -> b) -> a -> b
$ (Integer, Double) -> Double
forall a b. (a, b) -> b
snd ((Integer, Double) -> Double) -> (Integer, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Double -> (Integer, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Double -> (Integer, Double)) -> Double -> (Integer, Double)
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
num)
    [Int]
_ -> Bool
False

-- | Duration of a measure, in Time.
measure_time :: Meter -> Time
measure_time :: Meter -> Time
measure_time Meter
meter =
    Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Meter -> Int
time_num Meter
meter) Time -> Time -> Time
forall a. Num a => a -> a -> a
* Duration -> Time
Types.dur_to_time (Meter -> Duration
meter_denom Meter
meter)

unparse_meter :: Meter -> Text
unparse_meter :: Meter -> Text
unparse_meter Meter
meter = Text -> [Text] -> Text
Text.intercalate Text
"+" ((Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
forall a. Show a => a -> Text
showt (Meter -> [Int]
meter_nums Meter
meter))
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Duration -> Text
forall a. ToLily a => a -> Text
Types.to_lily (Meter -> Duration
meter_denom Meter
meter)

default_meter :: Meter
Right Meter
default_meter = Text -> Either Text Meter
parse_meter Text
"4/4"

parse_meter :: Text -> Either Text Meter
parse_meter :: Text -> Either Text Meter
parse_meter Text
text = do
    ([Int]
nums, Int
denom) <- (Text -> Text)
-> Either Text ([Int], Int) -> Either Text ([Int], Int)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text
"parsing meter: "<>) (Either Text ([Int], Int) -> Either Text ([Int], Int))
-> Either Text ([Int], Int) -> Either Text ([Int], Int)
forall a b. (a -> b) -> a -> b
$ Parser ([Int], Int) -> Text -> Either Text ([Int], Int)
forall a. Parser a -> Text -> Either Text a
Parse.parse Parser ([Int], Int)
p_meter Text
text
    Duration
denom <- Text -> Maybe Duration -> Either Text Duration
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
tryJust (Text
"denominator not a valid duration: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt Int
denom) (Maybe Duration -> Either Text Duration)
-> Maybe Duration -> Either Text Duration
forall a b. (a -> b) -> a -> b
$
        Int -> Maybe Duration
Types.int_dur Int
denom
    [Int] -> Duration -> [AbstractMeter] -> Either Text Meter
make_meter [Int]
nums Duration
denom ([Int] -> Duration -> [AbstractMeter]
abstract_meter [Int]
nums Duration
denom)

abstract_meter :: [Int] -> Duration -> [AbstractMeter]
abstract_meter :: [Int] -> Duration -> [AbstractMeter]
abstract_meter [Int]
nums Duration
denom = case ([Int], Duration)
-> Map ([Int], Duration) AbstractMeter -> Maybe AbstractMeter
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ([Int]
nums, Duration
denom) Map ([Int], Duration) AbstractMeter
default_meters of
    Just AbstractMeter
m -> [AbstractMeter
m]
    Maybe AbstractMeter
Nothing -> case [Int] -> Duration -> [Int]
default_divisions [Int]
nums Duration
denom of
        [Int
num] -> [[AbstractMeter] -> AbstractMeter
D (Int -> AbstractMeter -> [AbstractMeter]
forall a. Int -> a -> [a]
replicate Int
num AbstractMeter
T)]
        [Int]
nums -> [[AbstractMeter] -> AbstractMeter
D [[AbstractMeter] -> AbstractMeter
D (Int -> AbstractMeter -> [AbstractMeter]
forall a. Int -> a -> [a]
replicate Int
n AbstractMeter
T) | Int
n <- [Int]
nums]]
    where
    -- Certain simple duple meters get a simpler division.  This has the effect
    -- of allowing notes to cross beat divisions, e.g. 4 2 4 in 4/4.
    default_meters :: Map ([Int], Duration) AbstractMeter
default_meters = [(([Int], Duration), AbstractMeter)]
-> Map ([Int], Duration) AbstractMeter
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (([Int
1], Duration
D4), AbstractMeter
T)
        , (([Int
2], Duration
D4), AbstractMeter
T)
        , (([Int
4], Duration
D4), AbstractMeter
T)
        ]

default_divisions :: [Int] -> Duration -> [Int]
default_divisions :: [Int] -> Duration -> [Int]
default_divisions [Int
num] Duration
denom = [Int] -> (Int, Duration) -> Map (Int, Duration) [Int] -> [Int]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [Int
num] (Int
num, Duration
denom) Map (Int, Duration) [Int]
defaults
    where
    defaults :: Map (Int, Duration) [Int]
defaults = [((Int, Duration), [Int])] -> Map (Int, Duration) [Int]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ ((Int
5, Duration
D8), [Int
3, Int
2])
        , ((Int
6, Duration
D8), [Int
3, Int
3])
        , ((Int
7, Duration
D8), [Int
3, Int
4])
        , ((Int
9, Duration
D8), [Int
3, Int
3, Int
3])
        , ((Int
12, Duration
D8), [Int
3, Int
3, Int
3, Int
3])
        ]
default_divisions [Int]
nums Duration
_ = [Int]
nums

p_meter :: Parse.Parser ([Int], Int)
p_meter :: Parser ([Int], Int)
p_meter = (,) ([Int] -> Int -> ([Int], Int))
-> ParsecT Void Text Identity [Int]
-> ParsecT Void Text Identity (Int -> ([Int], Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Int
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Int]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
P.sepBy1 ParsecT Void Text Identity Int
forall (m :: * -> *). ParserT m Int
Parse.p_positive (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'+')
    ParsecT Void Text Identity (Int -> ([Int], Int))
-> ParsecT Void Text Identity Int -> Parser ([Int], Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'/' ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Int
forall (m :: * -> *). ParserT m Int
Parse.p_positive)

make_meter :: [Int] -> Duration -> [AbstractMeter] -> Either Text Meter
make_meter :: [Int] -> Duration -> [AbstractMeter] -> Either Text Meter
make_meter [Int]
nums Duration
denom [AbstractMeter]
meters = [Int] -> Duration -> Ranks -> Meter
Meter [Int]
nums Duration
denom (Ranks -> Meter) -> Either Text Ranks -> Either Text Meter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text Ranks
vector
    where
    vector :: Either Text Ranks
vector
        | Double
frac Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
0 = Text -> Either Text Ranks
forall a b. a -> Either a b
Left (Text -> Either Text Ranks) -> Text -> Either Text Ranks
forall a b. (a -> b) -> a -> b
$ Text
"can't fit " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt Int
ranks Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" into "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt Int
expected Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" by doubling"
        | Bool
otherwise = Ranks -> Either Text Ranks
forall a b. b -> Either a b
Right (Ranks -> Either Text Ranks) -> Ranks -> Either Text Ranks
forall a b. (a -> b) -> a -> b
$ [AbstractMeter] -> Ranks
to_vector ([AbstractMeter] -> Ranks) -> [AbstractMeter] -> Ranks
forall a b. (a -> b) -> a -> b
$ [Int] -> [AbstractMeter] -> [AbstractMeter]
subdivides (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
exp Int
2) [AbstractMeter]
meters
    (Int
exp, Double
frac) = Double -> (Int, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Double -> (Int, Double)) -> Double -> (Int, Double)
forall a b. (a -> b) -> a -> b
$
        Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
expected Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ranks)
    expected :: Int
expected = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum [Int]
nums Int -> Int -> Int
forall a. Num a => a -> a -> a
* Time -> Int
time_index (Duration -> Time
Types.dur_to_time Duration
denom)
    ranks :: Int
ranks = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (AbstractMeter -> Int) -> [AbstractMeter] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map AbstractMeter -> Int
abstract_length [AbstractMeter]
meters
    to_vector :: [AbstractMeter] -> Ranks
to_vector = [Int] -> Ranks
forall a. Unbox a => [a] -> Vector a
Vector.fromList ([Int] -> Ranks)
-> ([AbstractMeter] -> [Int]) -> [AbstractMeter] -> Ranks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rank, Duration) -> Int) -> [(Rank, Duration)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Rank -> Int
forall a. Enum a => a -> Int
fromEnum (Rank -> Int)
-> ((Rank, Duration) -> Rank) -> (Rank, Duration) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rank, Duration) -> Rank
forall a b. (a, b) -> a
fst)
        ([(Rank, Duration)] -> [Int])
-> ([AbstractMeter] -> [(Rank, Duration)])
-> [AbstractMeter]
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Duration, AbstractMeter)] -> [(Rank, Duration)]
Meter.Make.to_rank_durations ([(Duration, AbstractMeter)] -> [(Rank, Duration)])
-> ([AbstractMeter] -> [(Duration, AbstractMeter)])
-> [AbstractMeter]
-> [(Rank, Duration)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbstractMeter -> (Duration, AbstractMeter))
-> [AbstractMeter] -> [(Duration, AbstractMeter)]
forall a b. (a -> b) -> [a] -> [b]
map (Duration
1,)

subdivides :: [Int] -> [AbstractMeter] -> [AbstractMeter]
subdivides :: [Int] -> [AbstractMeter] -> [AbstractMeter]
subdivides [Int]
divs [AbstractMeter]
meter = (Int -> [AbstractMeter] -> [AbstractMeter])
-> [AbstractMeter] -> [Int] -> [AbstractMeter]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> [AbstractMeter] -> [AbstractMeter]
subdivide [AbstractMeter]
meter ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
divs)

subdivide :: Int -> [AbstractMeter] -> [AbstractMeter]
subdivide :: Int -> [AbstractMeter] -> [AbstractMeter]
subdivide Int
n = (AbstractMeter -> AbstractMeter)
-> [AbstractMeter] -> [AbstractMeter]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> AbstractMeter -> AbstractMeter
Meter.subdivide Int
n)

abstract_length :: AbstractMeter -> Int
abstract_length :: AbstractMeter -> Int
abstract_length (D [AbstractMeter]
ds) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (AbstractMeter -> Int) -> [AbstractMeter] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map AbstractMeter -> Int
abstract_length [AbstractMeter]
ds
abstract_length AbstractMeter
T = Int
1

-- * allowed time

{- | Figure out how much time a note at the given position should be allowed
    before it must tie.

    The heuristic is:

    - A binary meter is one whose numerator is a power of 2.

    - First, restrict the maximum 'allowed_time'.  For binary meters, this is
    up to the rank of the start point - 2, which means that if you start on
    an 8th note, you can span until the next half note.  Compound meters are
    different because the rank divisions don't correspond to binary note
    divisions (e.g. 3/4 goes dotted half, quarter, 8th, etc., instead of 4/4's
    whole, half, quarter, etc.).  So they only go up to the rank-1.  This is
    winds up being too restrictive though, because it means that e.g. you could
    never span a quarter note if you start on an eighth, but 8 4 8 4 is
    a perfectly readable 3/4 bar.  So the allowed duration is extended to
    twice the duration to the next rank-1 crossing, which allows 8 8~8 to
    become 8 4.

    - Next, if the allowed duration corresponds exactly to possible note
    duration, take that.  This expresses that it's preferable to spell without
    a tie if you can.  If it doesn't correspond to a note duration, then it
    has to be tied, and break on the place where it crosses the lowest rank.

    - Complex meters like 2+3/4 are treated as binary if you are in the binary
    part.  TODO not yet

    See NOTE [tie-breaking heuristic]
-}
allowed_duration :: Bool -> Meter -> Time -> Time -> NoteDuration
allowed_duration :: Bool -> Meter -> Time -> Time -> NoteDuration
allowed_duration Bool
use_dot Meter
meter Time
start_ Time
dur =
    Time -> NoteDuration
best_duration (Time -> NoteDuration) -> (Time -> Time) -> Time -> NoteDuration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Time -> Time
forall a. Ord a => a -> a -> a
min (Time
start Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
dur) (Time -> NoteDuration) -> Time -> NoteDuration
forall a b. (a -> b) -> a -> b
$ Meter -> Time -> Time
allowed_time Meter
meter Time
start
    where
    best_duration :: Time -> NoteDuration
best_duration Time
end
        | Just NoteDuration
ndur <- (NoteDuration -> Bool) -> [NoteDuration] -> Maybe NoteDuration
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
startTime -> Time -> Time
forall a. Num a => a -> a -> a
+Time
dur) (Time -> Bool) -> (NoteDuration -> Time) -> NoteDuration -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoteDuration -> Time
to_time) [NoteDuration]
candidates = NoteDuration
ndur
        | Bool
otherwise = NoteDuration -> Maybe NoteDuration -> NoteDuration
forall a. a -> Maybe a -> a
fromMaybe (Duration -> Bool -> NoteDuration
Types.NoteDuration Duration
Types.D128 Bool
False) (Maybe NoteDuration -> NoteDuration)
-> Maybe NoteDuration -> NoteDuration
forall a b. (a -> b) -> a -> b
$
            (NoteDuration -> Int) -> [NoteDuration] -> Maybe NoteDuration
forall k a. Ord k => (a -> k) -> [a] -> Maybe a
Seq.minimum_on (Meter -> Time -> Int
rank_at Meter
meter (Time -> Int) -> (NoteDuration -> Time) -> NoteDuration -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoteDuration -> Time
to_time) [NoteDuration]
candidates
        where
        candidates :: [NoteDuration]
candidates = (NoteDuration -> Bool) -> [NoteDuration] -> [NoteDuration]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<=Time
end) (Time -> Bool) -> (NoteDuration -> Time) -> NoteDuration -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoteDuration -> Time
to_time) ([NoteDuration] -> [NoteDuration])
-> [NoteDuration] -> [NoteDuration]
forall a b. (a -> b) -> a -> b
$
            if Bool
use_dot then [NoteDuration]
dotted_durs else [NoteDuration]
durs
    durs :: [NoteDuration]
durs = [NoteDuration] -> [NoteDuration]
forall a. [a] -> [a]
reverse ([NoteDuration] -> [NoteDuration])
-> [NoteDuration] -> [NoteDuration]
forall a b. (a -> b) -> a -> b
$ (Duration -> NoteDuration) -> [Duration] -> [NoteDuration]
forall a b. (a -> b) -> [a] -> [b]
map ((Duration -> Bool -> NoteDuration)
-> Bool -> Duration -> NoteDuration
forall a b c. (a -> b -> c) -> b -> a -> c
flip Duration -> Bool -> NoteDuration
NoteDuration Bool
False) [Duration
D1 .. Duration
D128]
    dotted_durs :: [NoteDuration]
dotted_durs = [NoteDuration] -> [NoteDuration]
forall a. [a] -> [a]
reverse
        [Duration -> Bool -> NoteDuration
NoteDuration Duration
d Bool
dot | Duration
d <- [Duration
D1 .. Duration
D64], Bool
dot <- [Bool
True, Bool
False]]
    start :: Time
start = Time
start_ Time -> Time -> Time
forall a. Integral a => a -> a -> a
`mod` Meter -> Time
measure_time Meter
meter
    to_time :: NoteDuration -> Time
to_time NoteDuration
dur = Time
start Time -> Time -> Time
forall a. Num a => a -> a -> a
+ NoteDuration -> Time
Types.note_dur_to_time NoteDuration
dur

-- | See 'allowed_duration'.
allowed_time :: Meter -> Time -> Time
allowed_time :: Meter -> Time -> Time
allowed_time Meter
meter Time
start = Time -> Maybe Time -> Time
forall a. a -> Maybe a -> a
fromMaybe (Meter -> Time
measure_time Meter
meter) (Maybe Time -> Time) -> Maybe Time -> Time
forall a b. (a -> b) -> a -> b
$ if Meter -> Bool
is_binary Meter
meter
    -- TODO is_binary in this part of the meter
    then Int -> Maybe Time
at_rank (Int
start_rank Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
    else case Int -> Maybe Time
at_rank (Int
start_rank Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) of
        Maybe Time
Nothing -> Maybe Time
forall a. Maybe a
Nothing
        Just Time
end -> Time -> Time -> Time
forall a. Ord a => a -> a -> a
min (Time
start Time -> Time -> Time
forall a. Num a => a -> a -> a
+ (Time
end Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
start) Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
2) (Time -> Time) -> Maybe Time -> Maybe Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Time
at_rank (Int
start_rank Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
    where
    at_rank :: Int -> Maybe Time
at_rank Int
n = Time -> Int -> Meter -> Maybe Time
find_rank Time
start Int
n Meter
meter
    start_rank :: Int
start_rank = Meter -> Time -> Int
rank_at Meter
meter Time
start

-- | Find the time of the rank <= the given one.  Rank 0 can never be spanned,
-- so always stop at a rank 0.
find_rank :: Time -> Rank -> Meter -> Maybe Time
find_rank :: Time -> Int -> Meter -> Maybe Time
find_rank Time
start Int
rank = (Int -> Time) -> Maybe Int -> Maybe Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Time -> Time -> Time
forall a. Num a => a -> a -> a
+ (Time
start Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
1)) (Time -> Time) -> (Int -> Time) -> Int -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Time
index_time)
    (Maybe Int -> Maybe Time)
-> (Meter -> Maybe Int) -> Meter -> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> Ranks -> Maybe Int
forall a. Unbox a => (a -> Bool) -> Vector a -> Maybe Int
Vector.findIndex (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
rank)
    (Ranks -> Maybe Int) -> (Meter -> Ranks) -> Meter -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Ranks -> Ranks
forall a. Unbox a => Int -> Vector a -> Vector a
Vector.drop (Time -> Int
time_index Time
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Ranks -> Ranks) -> (Meter -> Ranks) -> Meter -> Ranks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meter -> Ranks
meter_ranks

{-
    NOTE [tie-breaking heuristic]

    Because it's 3/4, h is not a valid rank, because it doesn't divide at
    natural points.  Actually ranks are not note durations, they are metric
    divisions.

    But this should be ok:
    0 w                       | 3/4
    1 q       q       q       |
    2 e   e   e   e   e   e   |
          4------>4------>8-->|

    But if it's longer than 4, then switch to tieing on the low rank:
    0 w                       | 3/4
    1 q       q       q       |
    2 e   e   e   e   e   e   |
          8-->                |
          4------>            |
          8-->4------>        | 4., but 4. is too complicated
          8-->4.--------->    | 2, seems like jumping 2 ranks, 8,4,2.
          8-->2-------------->|

    0 w                       | 3/4
    1 q       q       q       |
    2 e   e   e   e   e   e   |
    3 s s s s s s s s s s s s |
        s>
        8-->
        s>8-->
        s>8-->s>
        s>4------>
        s>4------>s>
        s>8-->4------>

    So maybe what I want is not spanning ranks, but the duration spanning
    ranks.  E.g. I started on an 8th note rank, so I can have up to 4 duration,
    but not beyond.  Or maybe I could go up to rank-1, but add a candidate at
    distance * 2?

    0 w                                       | 5/4
    1 h               h                       |
    2 q       q       q       q       q       |
    3 e   e   e   e   e   e   e   e   e   e   |
    4 s s s s s s s s s s s s s s s s s s s s |

    I think this is like 4/4, if I don't cross rank 1 I should be ok.
    Or treat it as one 2/4, one 3/4?  In that case, I shouldn't do complicated
    things in the second part.

    0 w                       | 6/8
    1 q           q           |
    2 e   e   e   e   e   e   |
          8-->
          4------>
          4------>8-->

    1 q           q           |
    2 e   e   e   e   e   e   |
              8-->8-->

    0 w                       | 6/8
    1 q           q           |
    2 e   e   e   e   e   e   |
    3 s s s s s s s s s s s s |
        s>
        8-->
        s>8-->

    0 w                               | 4/4
    1 h               h               |
    2 q       q       q       q       |
    3 e   e   e   e   e   e   e   e   |
          8-->
          4------>
          8-->8.-->
          4.--------->
          4.--------->8-->            | could be 2, but crosses h
          4.--------->4------>        | so 3 to 1

    But

    1 h               h               | 16
    2 q       q       q       q       | 8
    3 e   e   e   e   e   e   e   e   | 4
          4------>4------>4------>
          4------>8-->8-->4------>
              2-------------->

    So for binary, go up to rank-2.  For compound, go up to rank-1, but allow
    a complete note as long as its duration is rank-1.
    Or maybe I could say I don't like 8~8

    2 q       q       q       q       | 8
    3 e   e   e   e   e   e   e   e   | 4
    4 s s s s s s s s s s s s s s s s | 2
        s>
        8-->
        8.--->
        8.--->s>
        8.--->8-->
        8.--->8.--->
        8.--->4------>

    4/4
    0 w                               | 32
    1 h               h               | 16
    2 q       q       q       q       | 8
    3 e   e   e   e   e   e   e   e   | 4
    4 s s s s s s s s s s s s s s s s | 2
    5 33333333333333333333333333333333| 1
          |------>
          |-------------------------->

    3/4
    0 w                       |
    1 h               h       |
    2 q       q       q       |
    3 e   e   e   e   e   e   |
    4 s s s s s s s s s s s s |
    5 333333333333333333333333|
      2.--------------------->  0->0
          8->                   3->2
             2--------------->  2->0
                 8-->           3->2
                     4------->  2->0
                         8--->  3->end
-}