{-# LANGUAGE CPP #-}
module Ui.Meter.Make (
make_marklist
, to_rank_durations
, 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
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
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)
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
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)
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)]
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)
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
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
, [Label]
numbers, [Label]
numbers, [Label]
numbers, [Label]
numbers
]
where numbers :: [Label]
numbers = Int -> [Label]
count_from Int
1
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
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
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_labels :: Int
-> 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..]
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)
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
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_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
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
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)
, (Double -> Double -> Double -> Color
a3 Double
0.2 Double
0.1 Double
0.0, Int
2, Int
8)
, (Double -> Double -> Double -> Color
a3 Double
1.0 Double
0.4 Double
0.2, Int
2, Int
8)
, (Double -> Double -> Double -> Color
a2 Double
1.0 Double
0.4 Double
0.2, Int
2, Int
8)
, (Double -> Double -> Double -> Color
a3 Double
1.0 Double
0.4 Double
0.9, Int
1, Int
8)
, (Double -> Double -> Double -> Color
a2 Double
1.0 Double
0.4 Double
0.9, Int
1, Int
8)
, (Double -> Double -> Double -> Color
a2 Double
0.1 Double
0.5 Double
0.1, Int
1, Int
8)
, (Double -> Double -> Double -> Color
a1 Double
0.1 Double
0.5 Double
0.1, Int
1, Int
8)
, (Double -> Double -> Double -> Color
a2 Double
0.0 Double
0.0 Double
0.0, Int
1, Int
8)
, (Double -> Double -> Double -> Color
a1 Double
0.0 Double
0.0 Double
0.0, Int
1, Int
8)
]
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
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))
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