-- Copyright 2021 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 #-} -- | Convert Meter.Meter into a low level marklist. module Ui.Meter.Make ( make_marklist , to_rank_durations -- used by Perform.Lilypond.Meter , big_label , count_from #ifdef TESTING , module Ui.Meter.Make #endif ) where import qualified Data.List as List import qualified Data.Ratio as Ratio import qualified Data.Set as Set import qualified Data.Text as Text import qualified Util.Num as Num import qualified Util.Regex as Regex import qualified Ui.Color as Color import qualified Ui.Meter.Mark as Mark import qualified Ui.Meter.Meter as Meter import Ui.Meter.Meter (AbstractMeter(..), Duration, Label, Measures) import qualified Ui.ScoreTime as ScoreTime import Global import Types -- TODO If I port this to c++, then I can just marshal Config instead of the -- vector. Then, I could only materialize marks that are visible and stop -- paying for the micro divisions I hardly ever see. -- -- On the other hand, paying for them once on ruler creation sounds better -- than paying for them on every zoom change. make_marklist :: Meter.Meter -> Mark.Marklist make_marklist :: Meter -> Marklist make_marklist = [PosMark] -> Marklist Mark.marklist ([PosMark] -> Marklist) -> (Meter -> [PosMark]) -> Meter -> Marklist forall b c a. (b -> c) -> (a -> b) -> a -> c . Meter -> [PosMark] make_measures -- | Repeat each measure for the given count. -- This can't express unaligned beats. If you want a cut-off measure -- like 4/4 - 1/16, you would have to create a special measure for it. -- If I want that, I can make a function on AbstractMeter. make_measures :: Meter.Meter -> [(TrackTime, Mark.Mark)] make_measures :: Meter -> [PosMark] make_measures Meter meter = Duration -> [LabeledMark] -> [PosMark] labeled_marklist Duration 0 ([LabeledMark] -> [PosMark]) -> [LabeledMark] -> [PosMark] forall a b. (a -> b) -> a -> b $ Config -> Int -> [(Rank, Duration)] -> [LabeledMark] label_ranks Config config (Config -> Int Meter.config_start_measure Config config) ([(Rank, Duration)] -> [LabeledMark]) -> [(Rank, Duration)] -> [LabeledMark] forall a b. (a -> b) -> a -> b $ [(Duration, AbstractMeter)] -> [(Rank, Duration)] to_rank_durations ([(Duration, AbstractMeter)] -> [(Rank, Duration)]) -> [(Duration, AbstractMeter)] -> [(Rank, Duration)] forall a b. (a -> b) -> a -> b $ (MSection -> (Duration, AbstractMeter)) -> [MSection] -> [(Duration, AbstractMeter)] forall a b. (a -> b) -> [a] -> [b] map MSection -> (Duration, AbstractMeter) expand (Meter -> [MSection] Meter.meter_sections Meter meter) where config :: Config config = Meter -> Config Meter.meter_config Meter meter expand :: MSection -> (Duration, AbstractMeter) expand (Meter.MSection Int count Duration dur AbstractMeter measure) = (Duration tdur, [AbstractMeter] -> AbstractMeter D (Int -> AbstractMeter -> [AbstractMeter] forall a. Int -> a -> [a] replicate Int count AbstractMeter measure)) where tdur :: Duration tdur = Duration dur Duration -> Duration -> Duration forall a. Fractional a => a -> a -> a / Int -> Duration forall a b. (Integral a, Num b) => a -> b fromIntegral (AbstractMeter -> Int Meter.meter_length AbstractMeter measure) -- | The AbstractMeters are concatenated, and each one defines a rank 0. -- Each T level gets the given Duration. to_rank_durations :: [(Duration, AbstractMeter)] -> [(Meter.Rank, Duration)] to_rank_durations :: [(Duration, AbstractMeter)] -> [(Rank, Duration)] to_rank_durations = [(Rank, Duration)] -> [(Rank, Duration)] forall {b} {a}. (Num b, Ord a, Bounded a, Eq b) => [(a, b)] -> [(a, b)] group0 ([(Rank, Duration)] -> [(Rank, Duration)]) -> ([(Duration, AbstractMeter)] -> [(Rank, Duration)]) -> [(Duration, AbstractMeter)] -> [(Rank, Duration)] forall b c a. (b -> c) -> (a -> b) -> a -> c . ((Duration, AbstractMeter) -> [(Rank, Duration)]) -> [(Duration, AbstractMeter)] -> [(Rank, Duration)] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap ((Duration -> AbstractMeter -> [(Rank, Duration)]) -> (Duration, AbstractMeter) -> [(Rank, Duration)] forall a b c. (a -> b -> c) -> (a, b) -> c uncurry (Rank -> Duration -> AbstractMeter -> [(Rank, Duration)] forall {t}. Num t => Rank -> t -> AbstractMeter -> [(Rank, t)] convert Rank forall a. Bounded a => a minBound)) where -- Convert returns an intermediate format where all the ranks coexist at -- the same time, by giving them 0 dur. group0 :: [(a, b)] -> [(a, b)] group0 [(a, b)] rank_dur = case ((a, b) -> Bool) -> [(a, b)] -> ([(a, b)], [(a, b)]) forall a. (a -> Bool) -> [a] -> ([a], [a]) span ((b -> b -> Bool forall a. Eq a => a -> a -> Bool ==b 0) (b -> Bool) -> ((a, b) -> b) -> (a, b) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . (a, b) -> b forall a b. (a, b) -> b snd) [(a, b)] rank_dur of ([(a, b)] zeros, (a rank, b dur) : [(a, b)] rest) -> ([a] -> a forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a minimum (a rank a -> [a] -> [a] forall a. a -> [a] -> [a] : ((a, b) -> a) -> [(a, b)] -> [a] forall a b. (a -> b) -> [a] -> [b] map (a, b) -> a forall a b. (a, b) -> a fst [(a, b)] zeros), b dur) (a, b) -> [(a, b)] -> [(a, b)] forall a. a -> [a] -> [a] : [(a, b)] -> [(a, b)] group0 [(a, b)] rest ([(a, b)] _, []) -> [(a forall a. Bounded a => a minBound, b 0)] convert :: Rank -> t -> AbstractMeter -> [(Rank, t)] convert Rank rank t dur AbstractMeter meter = case AbstractMeter meter of AbstractMeter T -> [(Rank rank, t dur)] D [AbstractMeter] ms -> (Rank rank, t 0) (Rank, t) -> [(Rank, t)] -> [(Rank, t)] forall a. a -> [a] -> [a] : (AbstractMeter -> [(Rank, t)]) -> [AbstractMeter] -> [(Rank, t)] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap (Rank -> t -> AbstractMeter -> [(Rank, t)] convert (Rank -> Rank next_rank Rank rank) t dur) [AbstractMeter] ms next_rank :: Meter.Rank -> Meter.Rank next_rank :: Rank -> Rank next_rank Rank r | Rank r Rank -> Rank -> Bool forall a. Eq a => a -> a -> Bool == Rank forall a. Bounded a => a maxBound = Rank r | Bool otherwise = Rank -> Rank forall a. Enum a => a -> a succ Rank r data LabeledMark = LabeledMark { LabeledMark -> Rank m_rank :: !Meter.Rank , LabeledMark -> Duration m_duration :: !Duration , LabeledMark -> Label m_label :: !Label } deriving (LabeledMark -> LabeledMark -> Bool (LabeledMark -> LabeledMark -> Bool) -> (LabeledMark -> LabeledMark -> Bool) -> Eq LabeledMark forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: LabeledMark -> LabeledMark -> Bool $c/= :: LabeledMark -> LabeledMark -> Bool == :: LabeledMark -> LabeledMark -> Bool $c== :: LabeledMark -> LabeledMark -> Bool Eq, Int -> LabeledMark -> ShowS [LabeledMark] -> ShowS LabeledMark -> String (Int -> LabeledMark -> ShowS) -> (LabeledMark -> String) -> ([LabeledMark] -> ShowS) -> Show LabeledMark forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [LabeledMark] -> ShowS $cshowList :: [LabeledMark] -> ShowS show :: LabeledMark -> String $cshow :: LabeledMark -> String showsPrec :: Int -> LabeledMark -> ShowS $cshowsPrec :: Int -> LabeledMark -> ShowS Show) type RankNum = Int rank_num :: Meter.Rank -> RankNum rank_num :: Rank -> Int rank_num = Rank -> Int forall a. Enum a => a -> Int fromEnum instance Pretty LabeledMark where pretty :: LabeledMark -> Label pretty (LabeledMark Rank rank Duration dur Label label) = (Rank, Duration, Label) -> Label forall a. Pretty a => a -> Label pretty (Rank rank, Duration dur, Label label) -- | Add Labels to the given ruler ranks. label_ranks :: Meter.Config -> Measures -> [(Meter.Rank, Duration)] -> [LabeledMark] label_ranks :: Config -> Int -> [(Rank, Duration)] -> [LabeledMark] label_ranks Config config Int start_measure [(Rank, Duration)] rank_durs = [ Rank -> Duration -> Label -> LabeledMark LabeledMark Rank rank Duration dur Label label | (Rank rank, Duration dur, Label label) <- [Rank] -> [Duration] -> [Label] -> [(Rank, Duration, Label)] forall a b c. [a] -> [b] -> [c] -> [(a, b, c)] List.zip3 [Rank] ranks [Duration] ps [Label] labels ] where ([Rank] ranks, [Duration] ps) = [(Rank, Duration)] -> ([Rank], [Duration]) forall a b. [(a, b)] -> ([a], [b]) unzip [(Rank, Duration)] rank_durs labels :: [Label] labels = ([Label] -> Label) -> [[Label]] -> [Label] forall a b. (a -> b) -> [a] -> [b] map [Label] -> Label join_label ([[Label]] -> [Label]) -> [[Label]] -> [Label] forall a b. (a -> b) -> a -> b $ Label -> Int -> [[Label]] -> [[Label]] strip_prefixes Label "" (Config -> Int Meter.config_strip_depth Config config) ([[Label]] -> [[Label]]) -> [[Label]] -> [[Label]] forall a b. (a -> b) -> a -> b $ Int -> LabelComponents -> Int -> [Int] -> [[Label]] convert_labels (Config -> Int Meter.config_min_depth Config config) (LabelConfig -> LabelComponents label_components (Config -> LabelConfig Meter.config_label Config config)) Int start_measure ([Rank] -> [Rank] -> [Int] collapse_ranks [Rank] unlabeled [Rank] ranks) unlabeled :: [Rank] unlabeled = Set Rank -> [Rank] labeled_to_unlabeled_ranks (Config -> Set Rank Meter.config_labeled_ranks Config config) labeled_to_unlabeled_ranks :: Set Meter.Rank -> [Meter.Rank] labeled_to_unlabeled_ranks :: Set Rank -> [Rank] labeled_to_unlabeled_ranks Set Rank labeled = [Rank r | Rank r <- [Rank] Meter.all_ranks, Bool -> Bool not (Rank r Rank -> Set Rank -> Bool forall a. Ord a => a -> Set a -> Bool `Set.member` Set Rank labeled)] -- | Create marks from a labeled meter. labeled_marklist :: TrackTime -> [LabeledMark] -> [(TrackTime, Mark.Mark)] labeled_marklist :: Duration -> [LabeledMark] -> [PosMark] labeled_marklist Duration start [LabeledMark] marks = [ (Rational -> Duration forall a b. (Real a, Fractional b) => a -> b realToFrac Rational pos, Duration -> Rank -> Label -> Mark mark Duration dur Rank rank Label label) | (Rank rank, Rational pos, Label label, Duration dur) <- [Rank] -> [Rational] -> [Label] -> [Duration] -> [(Rank, Rational, Label, Duration)] forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)] List.zip4 [Rank] ranks [Rational] starts ((LabeledMark -> Label) -> [LabeledMark] -> [Label] forall a b. (a -> b) -> [a] -> [b] map LabeledMark -> Label m_label [LabeledMark] marks) [Duration] durs ] where starts :: [Rational] starts = (Rational -> Rational -> Rational) -> Rational -> [Rational] -> [Rational] forall b a. (b -> a -> b) -> b -> [a] -> [b] scanl Rational -> Rational -> Rational forall a. Num a => a -> a -> a (+) (Duration -> Rational forall {a}. RealFrac a => a -> Rational to_rational Duration start) ((LabeledMark -> Rational) -> [LabeledMark] -> [Rational] forall a b. (a -> b) -> [a] -> [b] map (Duration -> Rational forall {a}. RealFrac a => a -> Rational to_rational (Duration -> Rational) -> (LabeledMark -> Duration) -> LabeledMark -> Rational forall b c a. (b -> c) -> (a -> b) -> a -> c . LabeledMark -> Duration m_duration) [LabeledMark] marks) -- Avoid accumulating error, as per 'Duration'. to_rational :: a -> Rational to_rational a t = a -> a -> Rational forall a. RealFrac a => a -> a -> Rational Ratio.approxRational a t a 0.0000001 durs :: [Duration] durs = [(Rank, Duration)] -> [Duration] rank_durs ([Rank] -> [Duration] -> [(Rank, Duration)] forall a b. [a] -> [b] -> [(a, b)] zip [Rank] ranks ((LabeledMark -> Duration) -> [LabeledMark] -> [Duration] forall a b. (a -> b) -> [a] -> [b] map LabeledMark -> Duration m_duration [LabeledMark] marks)) ranks :: [Rank] ranks = (LabeledMark -> Rank) -> [LabeledMark] -> [Rank] forall a b. (a -> b) -> [a] -> [b] map LabeledMark -> Rank m_rank [LabeledMark] marks mark :: Duration -> Rank -> Label -> Mark mark Duration rank_dur Rank rank Label name = Mark.Mark { mark_rank :: Rank mark_rank = Rank rank , mark_width :: Int mark_width = Int width , mark_color :: Color mark_color = Color color , mark_name :: Label mark_name = Label name , mark_name_zoom_level :: Double mark_name_zoom_level = Double zoom Double -> Double -> Double forall a. Num a => a -> a -> a * Double 2 , mark_zoom_level :: Double mark_zoom_level = Double zoom } where (Color color, Int width, Int pixels) = [(Color, Int, Int)] meter_ranks [(Color, Int, Int)] -> Int -> (Color, Int, Int) forall a. [a] -> Int -> a !! Int -> Int -> Int forall a. Ord a => a -> a -> a min (Rank -> Int rank_num Rank rank) Int ranks_len zoom :: Double zoom = Duration -> Int -> Double pixels_to_zoom Duration rank_dur Int pixels ranks_len :: Int ranks_len = [(Color, Int, Int)] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [(Color, Int, Int)] meter_ranks -- * labels -- TODO make LabelConfig into a general description, eliminate LabelComponents label_components :: Meter.LabelConfig -> LabelComponents label_components :: LabelConfig -> LabelComponents label_components = \case Meter.BigNumber Int sub_start -> Int -> LabelComponents big_number_components Int sub_start Meter.Cycle [Label] labels -> [[Label]] -> LabelComponents LabelComponents [ [Label] -> [Label] forall a. [a] -> [a] cycle [Label] labels , [Label] numbers -- nadai / gati , [Label] numbers, [Label] numbers, [Label] numbers, [Label] numbers ] where numbers :: [Label] numbers = Int -> [Label] count_from Int 1 -- | This is the prototype for how to draw labels. The outer list is indexed -- by rank, while the inner is has the sequence of labels at that rank. -- 'convert_labels' will take from a given level each time it sees that rank, -- and reset back to the beginning when the rank becomes less than that level. -- The inner list should be infinite to so it won't run out of labels no matter -- how many consecutive ranks are at that level. newtype LabelComponents = LabelComponents [[Label]] instance Show LabelComponents where show :: LabelComponents -> String show (LabelComponents [[Label]] labels) = [[Label]] -> String forall a. Show a => a -> String show ([[Label]] -> String) -> [[Label]] -> String forall a b. (a -> b) -> a -> b $ ([Label] -> [Label]) -> [[Label]] -> [[Label]] forall a b. (a -> b) -> [a] -> [b] map (([Label] -> [Label] -> [Label] forall a. [a] -> [a] -> [a] ++[Label "..."]) ([Label] -> [Label]) -> ([Label] -> [Label]) -> [Label] -> [Label] forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> [Label] -> [Label] forall a. Int -> [a] -> [a] take Int 10) [[Label]] labels instance Pretty LabelComponents where pretty :: LabelComponents -> Label pretty = LabelComponents -> Label forall a. Show a => a -> Label showt -- | Like 'number_components', but the first two are bigger. big_number_components :: Int -> LabelComponents big_number_components :: Int -> LabelComponents big_number_components Int sub_start = [[Label]] -> LabelComponents LabelComponents ([[Label]] -> LabelComponents) -> [[Label]] -> LabelComponents forall a b. (a -> b) -> a -> b $ Int -> [[Label]] -> [[Label]] forall a. Int -> [a] -> [a] take Int max_label_depth ([[Label]] -> [[Label]]) -> [[Label]] -> [[Label]] forall a b. (a -> b) -> a -> b $ (Label -> Label) -> [Label] -> [Label] forall a b. (a -> b) -> [a] -> [b] map Label -> Label big_label (Int -> [Label] count_from Int sub_start) [Label] -> [[Label]] -> [[Label]] forall a. a -> [a] -> [a] : [Label] -> [[Label]] forall a. a -> [a] List.repeat (Int -> [Label] count_from Int sub_start) where -- | Limit label component depth. I'll never take more than this anyway so -- it probably doesn't matter, but let's avoid too many infinite lists. max_label_depth :: Int max_label_depth :: Int max_label_depth = Int 10 big_label :: Label -> Label big_label :: Label -> Label big_label Label t = Label "`+2/" Label -> Label -> Label forall a. Semigroup a => a -> a -> a <> Label t Label -> Label -> Label forall a. Semigroup a => a -> a -> a <> Label "`" biggest_label :: Label -> Label biggest_label :: Label -> Label biggest_label Label t = Label "`+4/" Label -> Label -> Label forall a. Semigroup a => a -> a -> a <> Label t Label -> Label -> Label forall a. Semigroup a => a -> a -> a <> Label "`" strip_markup :: Label -> Label strip_markup :: Label -> Label strip_markup = Regex -> Label -> Label -> Label Regex.substitute (HasCallStack => String -> Regex String -> Regex Regex.compileUnsafe String "`(\\+\\d+/)?") Label "" join_label :: [Label] -> Label join_label :: [Label] -> Label join_label = Label -> [Label] -> Label Text.intercalate Label "." split_label :: Label -> [Label] split_label :: Label -> [Label] split_label = (Char -> Bool) -> Label -> [Label] Text.split (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool ==Char '.') -- | Convert label components to label lists based on the given ranks. convert_labels :: Int -- ^ Labels have at least this many sections. Otherwise, -- trailing sections are omitted. -> LabelComponents -> Measures -> [RankNum] -> [[Label]] convert_labels :: Int -> LabelComponents -> Int -> [Int] -> [[Label]] convert_labels Int min_depth (LabelComponents [[Label]] components) Int start_measure [Int] ranks = [[Label]] -> [[Label]] forall {a}. [[a]] -> [[a]] strip ([[Label]] -> [[Label]]) -> [[Label]] -> [[Label]] forall a b. (a -> b) -> a -> b $ ([Label] -> [Label]) -> [[Label]] -> [[Label]] forall a b. (a -> b) -> [a] -> [b] map ((Label -> Label) -> [Label] -> [Label] forall a b. (a -> b) -> [a] -> [b] map Label -> Label replace) ([[Label]] -> [[Label]]) -> [[Label]] -> [[Label]] forall a b. (a -> b) -> a -> b $ [[Label]] -> [Int] -> [[Label]] apply_labels (Int -> [Label] -> [Label] forall a. Int -> [a] -> [a] drop Int start_measure [Label] measure_labels [Label] -> [[Label]] -> [[Label]] forall a. a -> [a] -> [a] : [[Label]] components) [Int] ranks where strip :: [[a]] -> [[a]] strip = (Int -> [a] -> [a]) -> [Int] -> [[a]] -> [[a]] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith Int -> [a] -> [a] forall a. Int -> [a] -> [a] take ((Int -> Int) -> [Int] -> [Int] forall a b. (a -> b) -> [a] -> [b] map (Int -> Int -> Int forall a. Ord a => a -> a -> a max Int min_depth (Int -> Int) -> (Int -> Int) -> Int -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . (Int -> Int -> Int forall a. Num a => a -> a -> a +Int 1)) [Int] ranks) replace :: Label -> Label replace Label t = if Label -> Bool Text.null Label t then Label "-" else Label t measure_labels :: [Label] measure_labels :: [Label] measure_labels = (Label -> Label) -> [Label] -> [Label] forall a b. (a -> b) -> [a] -> [b] map Label -> Label biggest_label (Int -> [Label] count_from Int 0) count_from :: Int -> [Label] count_from :: Int -> [Label] count_from Int n = (Int -> Label) -> [Int] -> [Label] forall a b. (a -> b) -> [a] -> [b] map Int -> Label forall a. Show a => a -> Label showt [Int n..] -- | The ruler gets cluttered if I label every single rank, so combine the ones -- in the given list with the following rank. collapse_ranks :: [Meter.Rank] -> [Meter.Rank] -> [RankNum] collapse_ranks :: [Rank] -> [Rank] -> [Int] collapse_ranks [Rank] omit = (Rank -> Int) -> [Rank] -> [Int] forall a b. (a -> b) -> [a] -> [b] map (\Rank r -> Rank -> Int rank_num Rank r Int -> Int -> Int forall a. Num a => a -> a -> a - Rank -> Int below Rank r) where below :: Rank -> Int below Rank r = [Rank] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ((Rank -> Bool) -> [Rank] -> [Rank] forall a. (a -> Bool) -> [a] -> [a] takeWhile (Rank -> Rank -> Bool forall a. Ord a => a -> a -> Bool <Rank r) [Rank] omit) -- | When labels are created, many of them have the same components as the -- previous label, e.g. @1.1.1@, @1.1.2@. Replace leading components up to -- a certain depth with a placeholder to make the difference more apparent: -- @1.1.1@, @-.-.2@. -- -- This doesn't actually look that nice on the UI because it does it for all -- labels, not just the visible ones. strip_prefixes :: Text -> Int -> [[Label]] -> [[Label]] strip_prefixes :: Label -> Int -> [[Label]] -> [[Label]] strip_prefixes Label replacement Int depth = ([Label] -> [Label]) -> [[Label]] -> [[Label]] forall a b. (a -> b) -> [a] -> [b] map [Label] -> [Label] strip where strip :: [Label] -> [Label] strip [Label] labels = Int -> Label -> [Label] forall a. Int -> a -> [a] replicate Int prefix Label replacement [Label] -> [Label] -> [Label] forall a. [a] -> [a] -> [a] ++ [Label] post where (Int prefix, [Label] post) = Int -> [Label] -> (Int, [Label]) forall {t} {a} {a}. (Ord t, Num t, Num a) => t -> [a] -> (a, [a]) split1 Int depth [Label] labels -- Like splitAt, but don't take the final one, because then I'd replace -- everything in shorter labels. split1 :: t -> [a] -> (a, [a]) split1 t n [a] xs | t n t -> t -> Bool forall a. Ord a => a -> a -> Bool <= t 0 = (a 0, [a] xs) split1 t _ [] = (a 0, []) split1 t _ [a x] = (a 0, [a x]) split1 t n (a _:[a] xs) = (a -> a) -> (a, [a]) -> (a, [a]) forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first (a -> a -> a forall a. Num a => a -> a -> a +a 1) (t -> [a] -> (a, [a]) split1 (t nt -> t -> t forall a. Num a => a -> a -> a -t 1) [a] xs) -- | Apply the labels according to the ranks. Each Rank input has -- a corresponding @[Label]@ output. Each rank advances the label at the rank's -- index in the labels, and resets all the labels beneath it. If a rank runs -- out of labels, @\"\"@ is emitted. -- -- The first rank doesn't matter since it always emits the initial state of the -- labels. apply_labels :: [[Label]] -> [RankNum] -> [[Label]] apply_labels :: [[Label]] -> [Int] -> [[Label]] apply_labels [[Label]] labels = (([Label] -> Label) -> [[Label]] -> [Label] forall a b. (a -> b) -> [a] -> [b] map [Label] -> Label forall {a}. IsString a => [a] -> a hd [[Label]] labels :) ([[Label]] -> [[Label]]) -> ([Int] -> [[Label]]) -> [Int] -> [[Label]] forall b c a. (b -> c) -> (a -> b) -> a -> c . ([[Label]], [[Label]]) -> [[Label]] forall a b. (a, b) -> b snd (([[Label]], [[Label]]) -> [[Label]]) -> ([Int] -> ([[Label]], [[Label]])) -> [Int] -> [[Label]] forall b c a. (b -> c) -> (a -> b) -> a -> c . ([[Label]] -> Int -> ([[Label]], [Label])) -> [[Label]] -> [Int] -> ([[Label]], [[Label]]) forall (t :: * -> *) s a b. Traversable t => (s -> a -> (s, b)) -> s -> t a -> (s, t b) List.mapAccumL [[Label]] -> Int -> ([[Label]], [Label]) mk [[Label]] labels ([Int] -> ([[Label]], [[Label]])) -> ([Int] -> [Int]) -> [Int] -> ([[Label]], [[Label]]) forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> [Int] -> [Int] forall a. Int -> [a] -> [a] drop Int 1 where mk :: [[Label]] -> Int -> ([[Label]], [Label]) mk [[Label]] state Int rank = ([[Label]] next, ([Label] -> Label) -> [[Label]] -> [Label] forall a b. (a -> b) -> [a] -> [b] map [Label] -> Label forall {a}. IsString a => [a] -> a hd [[Label]] next) where next :: [[Label]] next = Int -> [[Label]] -> [[Label]] split Int rank [[Label]] state split :: Int -> [[Label]] -> [[Label]] split Int rank [[Label]] state = [[Label]] above [[Label]] -> [[Label]] -> [[Label]] forall a. [a] -> [a] -> [a] ++ [Label] cur [Label] -> [[Label]] -> [[Label]] forall a. a -> [a] -> [a] : Int -> [[Label]] -> [[Label]] forall a. Int -> [a] -> [a] drop (Int rank Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1) [[Label]] labels where ([[Label]] above, [[Label]] below) = Int -> [[Label]] -> ([[Label]], [[Label]]) forall a. Int -> [a] -> ([a], [a]) splitAt Int rank [[Label]] state cur :: [Label] cur = case [[Label]] below of (Label _ : cur :: [Label] cur@(Label _:[Label] _)) : [[Label]] _ -> [Label] cur [[Label]] _ -> [Label ""] hd :: [a] -> a hd [] = a "" hd (a x:[a] _) = a x -- ** meter constants -- | The mark color defaults to mostly transparent so it looks nice on overlay -- rulers. color1, color2 :: Double -> Double -> Double -> Color.Color color1 :: Double -> Double -> Double -> Color color1 Double r Double g Double b = Double -> Double -> Double -> Double -> Color Color.rgba Double r Double g Double b Double 0.5 color2 :: Double -> Double -> Double -> Color color2 Double r Double g Double b = Double -> Double -> Double -> Double -> Color Color.rgba Double r Double g Double b Double 0.3 type MarkWidth = Int -- | Configs for marks in order of increasing rank. -- @(color, width, zoom_pixels)@ -- -- @zoom_pixels@ is how many pixels of space a mark at this rank must have -- between its neighbors before it appears. meter_ranks :: [(Color.Color, MarkWidth, Int)] meter_ranks :: [(Color, Int, Int)] meter_ranks = [ (Double -> Double -> Double -> Color a3 Double 0.0 Double 0.0 Double 0.0, Int 3, Int 8) -- section , (Double -> Double -> Double -> Color a3 Double 0.2 Double 0.1 Double 0.0, Int 2, Int 8) -- measure / whole , (Double -> Double -> Double -> Color a3 Double 1.0 Double 0.4 Double 0.2, Int 2, Int 8) -- half , (Double -> Double -> Double -> Color a2 Double 1.0 Double 0.4 Double 0.2, Int 2, Int 8) -- quarter , (Double -> Double -> Double -> Color a3 Double 1.0 Double 0.4 Double 0.9, Int 1, Int 8) -- 8th , (Double -> Double -> Double -> Color a2 Double 1.0 Double 0.4 Double 0.9, Int 1, Int 8) -- 16th , (Double -> Double -> Double -> Color a2 Double 0.1 Double 0.5 Double 0.1, Int 1, Int 8) -- 32nd , (Double -> Double -> Double -> Color a1 Double 0.1 Double 0.5 Double 0.1, Int 1, Int 8) -- 64th , (Double -> Double -> Double -> Color a2 Double 0.0 Double 0.0 Double 0.0, Int 1, Int 8) -- 128th , (Double -> Double -> Double -> Color a1 Double 0.0 Double 0.0 Double 0.0, Int 1, Int 8) -- 256th ] where a1 :: Double -> Double -> Double -> Color a1 = Double -> Double -> Double -> Double -> Color alpha Double 0.2 a2 :: Double -> Double -> Double -> Color a2 = Double -> Double -> Double -> Double -> Color alpha Double 0.4 a3 :: Double -> Double -> Double -> Color a3 = Double -> Double -> Double -> Double -> Color alpha Double 0.55 alpha :: Double -> Double -> Double -> Double -> Color alpha Double a Double r Double g Double b = Double -> Double -> Double -> Double -> Color Color.rgba Double r Double g Double b Double a -- | The rank duration is the duration until the next mark of equal or greater -- (lower) rank. rank_durs :: [(Meter.Rank, Duration)] -> [Duration] rank_durs :: [(Rank, Duration)] -> [Duration] rank_durs = ([(Rank, Duration)] -> Duration) -> [[(Rank, Duration)]] -> [Duration] forall a b. (a -> b) -> [a] -> [b] map [(Rank, Duration)] -> Duration forall {a} {a}. (Num a, Ord a) => [(a, a)] -> a rank_dur ([[(Rank, Duration)]] -> [Duration]) -> ([(Rank, Duration)] -> [[(Rank, Duration)]]) -> [(Rank, Duration)] -> [Duration] forall b c a. (b -> c) -> (a -> b) -> a -> c . [(Rank, Duration)] -> [[(Rank, Duration)]] forall a. [a] -> [[a]] List.tails where rank_dur :: [(a, a)] -> a rank_dur [] = a 0 rank_dur ((a rank, a dur) : [(a, a)] meter) = a total where total :: a total = a dur a -> a -> a forall a. Num a => a -> a -> a + [a] -> a forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a Num.sum (((a, a) -> a) -> [(a, a)] -> [a] forall a b. (a -> b) -> [a] -> [b] map (a, a) -> a forall a b. (a, b) -> b snd (((a, a) -> Bool) -> [(a, a)] -> [(a, a)] forall a. (a -> Bool) -> [a] -> [a] takeWhile ((a -> a -> Bool forall a. Ord a => a -> a -> Bool >a rank) (a -> Bool) -> ((a, a) -> a) -> (a, a) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . (a, a) -> a forall a b. (a, b) -> a fst) [(a, a)] meter)) -- | Given a mark duration and the number of pixels it needs to display, -- return the appropriate zoom factor. pixels_to_zoom :: Duration -> Int -> Double pixels_to_zoom :: Duration -> Int -> Double pixels_to_zoom Duration dur Int pixels | Duration dur Duration -> Duration -> Bool forall a. Eq a => a -> a -> Bool == Duration 0 = Double 0 | Bool otherwise = Int -> Double forall a b. (Integral a, Num b) => a -> b fromIntegral Int pixels Double -> Double -> Double forall a. Fractional a => a -> a -> a / Duration -> Double ScoreTime.to_double Duration dur