-- 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

module Ui.Ruler (
    -- * Ruler
    Ruler(..), Marklists, Name
    , meter_ruler, meter_name
    , empty
    , get_meter, lookup_meter, set_meter, modify_meter
    , lookup_marklist, get_marklist, set_marklist, remove_marklist
    , modify_marklist, modify_marklists
    , time_end
    -- ** bounds
    , bounds_name, set_bounds, get_bounds, bounds_of
) where
import qualified Control.DeepSeq as DeepSeq
import qualified Data.Map as Map

import qualified Util.Pretty as Pretty
import qualified App.Config as Config
import qualified Ui.Color as Color
import qualified Ui.Meter.Make as Make
import qualified Ui.Meter.Mark as Mark
import           Ui.Meter.Mark (Marklist)
import qualified Ui.Meter.Meter as Meter

import           Global
import           Types


-- * Ruler

-- | A Ruler contains all the data to display a ruler.
data Ruler = Ruler {
    Ruler -> Marklists
ruler_marklists :: !Marklists
    , Ruler -> Color
ruler_bg :: !Color.Color
    -- | Show the names if this is on an event track.  Ruler tracks always show
    -- the names.
    , Ruler -> Bool
ruler_show_names :: !Bool
    -- | Align bottoms of marks to beats, instead of the top.  Looks good used
    -- with negative duration events (arrival beats).
    , Ruler -> Bool
ruler_align_to_bottom :: !Bool
    } deriving (Ruler -> Ruler -> Bool
(Ruler -> Ruler -> Bool) -> (Ruler -> Ruler -> Bool) -> Eq Ruler
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ruler -> Ruler -> Bool
$c/= :: Ruler -> Ruler -> Bool
== :: Ruler -> Ruler -> Bool
$c== :: Ruler -> Ruler -> Bool
Eq, Int -> Ruler -> ShowS
[Ruler] -> ShowS
Ruler -> String
(Int -> Ruler -> ShowS)
-> (Ruler -> String) -> ([Ruler] -> ShowS) -> Show Ruler
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ruler] -> ShowS
$cshowList :: [Ruler] -> ShowS
show :: Ruler -> String
$cshow :: Ruler -> String
showsPrec :: Int -> Ruler -> ShowS
$cshowsPrec :: Int -> Ruler -> ShowS
Show)

-- | Each ruler can have multiple named marklists.  This means a ruler can
-- have multiple simultaneous meters, or a separate list of ad-hoc cue points.
-- All marks are flattened before display, and are drawn in the sort order of
-- their Names.
--
-- However, multiple meters are liable to be cluttered, and multiple cue lists
-- also seem gratuitous.
type Marklists = Map Name (Maybe Meter.Meter, Marklist)
type Name = Text

instance Pretty Ruler where
    format :: Ruler -> Doc
format (Ruler Marklists
mlists Color
bg Bool
show_names Bool
align_to_bottom) = Doc -> [(Label, Doc)] -> Doc
Pretty.record Doc
"Ruler"
        [ (Label
"marklists", Marklists -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Marklists
mlists)
        , (Label
"bg", Color -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Color
bg)
        , (Label
"show_names", Bool -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Bool
show_names)
        , (Label
"align_to_bottom", Bool -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Bool
align_to_bottom)
        ]

instance DeepSeq.NFData Ruler where rnf :: Ruler -> ()
rnf (Ruler Marklists
mlists Color
_ Bool
_ Bool
_) = Marklists
mlists Marklists -> () -> ()
`seq` ()


-- * ruler

empty :: Ruler
empty :: Ruler
empty = Ruler
    { ruler_marklists :: Marklists
ruler_marklists = Marklists
forall a. Monoid a => a
mempty
    , ruler_bg :: Color
ruler_bg = Color
Config.ruler_bg
    , ruler_show_names :: Bool
ruler_show_names = Bool
False
    , ruler_align_to_bottom :: Bool
ruler_align_to_bottom = Bool
False
    }

-- | Create a ruler with just a 'meter' marklist.
meter_ruler :: Meter.Meter -> Ruler
meter_ruler :: Meter -> Ruler
meter_ruler Meter
meter = Meter -> Ruler -> Ruler
set_meter Meter
meter Ruler
empty

-- | The meter marklist by convention has marks corresponding to the meter of
-- the piece.  Other commands may use this to find out where beats are.
meter_name :: Name
meter_name :: Label
meter_name = Label
"meter"

get_meter :: Ruler -> Meter.Meter
get_meter :: Ruler -> Meter
get_meter = Meter -> Maybe Meter -> Meter
forall a. a -> Maybe a -> a
fromMaybe Meter
Meter.empty_meter (Maybe Meter -> Meter) -> (Ruler -> Maybe Meter) -> Ruler -> Meter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ruler -> Maybe Meter
lookup_meter

lookup_meter :: Ruler -> Maybe Meter.Meter
lookup_meter :: Ruler -> Maybe Meter
lookup_meter = Maybe Meter
-> ((Maybe Meter, Marklist) -> Maybe Meter)
-> Maybe (Maybe Meter, Marklist)
-> Maybe Meter
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Meter
forall a. Maybe a
Nothing (Maybe Meter, Marklist) -> Maybe Meter
forall a b. (a, b) -> a
fst (Maybe (Maybe Meter, Marklist) -> Maybe Meter)
-> (Ruler -> Maybe (Maybe Meter, Marklist)) -> Ruler -> Maybe Meter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> Marklists -> Maybe (Maybe Meter, Marklist)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Label
meter_name (Marklists -> Maybe (Maybe Meter, Marklist))
-> (Ruler -> Marklists) -> Ruler -> Maybe (Maybe Meter, Marklist)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ruler -> Marklists
ruler_marklists

set_meter :: Meter.Meter -> Ruler -> Ruler
set_meter :: Meter -> Ruler -> Ruler
set_meter Meter
meter = (Marklists -> Marklists) -> Ruler -> Ruler
modify_marklists ((Marklists -> Marklists) -> Ruler -> Ruler)
-> (Marklists -> Marklists) -> Ruler -> Ruler
forall a b. (a -> b) -> a -> b
$
    Label -> (Maybe Meter, Marklist) -> Marklists -> Marklists
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Label
meter_name (Meter -> Maybe Meter
forall a. a -> Maybe a
Just Meter
meter, Meter -> Marklist
Make.make_marklist Meter
meter)

modify_meter :: (Meter.Meter -> Meter.Meter) -> Ruler -> Ruler
modify_meter :: (Meter -> Meter) -> Ruler -> Ruler
modify_meter Meter -> Meter
modify Ruler
ruler = Meter -> Ruler -> Ruler
set_meter (Meter -> Meter
modify (Ruler -> Meter
get_meter Ruler
ruler)) Ruler
ruler

get_marklist :: Name -> Ruler -> Marklist
get_marklist :: Label -> Ruler -> Marklist
get_marklist Label
name = Marklist -> Maybe Marklist -> Marklist
forall a. a -> Maybe a -> a
fromMaybe Marklist
Mark.empty (Maybe Marklist -> Marklist)
-> (Ruler -> Maybe Marklist) -> Ruler -> Marklist
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> Ruler -> Maybe Marklist
lookup_marklist Label
name

lookup_marklist :: Name -> Ruler -> Maybe Marklist
lookup_marklist :: Label -> Ruler -> Maybe Marklist
lookup_marklist Label
name = ((Maybe Meter, Marklist) -> Marklist)
-> Maybe (Maybe Meter, Marklist) -> Maybe Marklist
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Meter, Marklist) -> Marklist
forall a b. (a, b) -> b
snd (Maybe (Maybe Meter, Marklist) -> Maybe Marklist)
-> (Ruler -> Maybe (Maybe Meter, Marklist))
-> Ruler
-> Maybe Marklist
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> Marklists -> Maybe (Maybe Meter, Marklist)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Label
name (Marklists -> Maybe (Maybe Meter, Marklist))
-> (Ruler -> Marklists) -> Ruler -> Maybe (Maybe Meter, Marklist)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ruler -> Marklists
ruler_marklists

set_marklist :: Name -> Marklist -> Ruler -> Ruler
set_marklist :: Label -> Marklist -> Ruler -> Ruler
set_marklist Label
name Marklist
mlist = (Marklists -> Marklists) -> Ruler -> Ruler
modify_marklists (Label -> (Maybe Meter, Marklist) -> Marklists -> Marklists
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Label
name (Maybe Meter
forall a. Maybe a
Nothing, Marklist
mlist))

remove_marklist :: Name -> Ruler -> Ruler
remove_marklist :: Label -> Ruler -> Ruler
remove_marklist = (Marklists -> Marklists) -> Ruler -> Ruler
modify_marklists ((Marklists -> Marklists) -> Ruler -> Ruler)
-> (Label -> Marklists -> Marklists) -> Label -> Ruler -> Ruler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> Marklists -> Marklists
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete

-- | If the marklist isn't set, modify will be given an empty one.
modify_marklist :: Name -> (Marklist -> Marklist) -> Ruler -> Ruler
modify_marklist :: Label -> (Marklist -> Marklist) -> Ruler -> Ruler
modify_marklist Label
name Marklist -> Marklist
modify Ruler
ruler =
    Label -> Marklist -> Ruler -> Ruler
set_marklist Label
name (Marklist -> Marklist
modify (Label -> Ruler -> Marklist
get_marklist Label
name Ruler
ruler)) Ruler
ruler

modify_marklists
    :: (Map Name (Maybe Meter.Meter, Marklist)
        -> Map Name (Maybe Meter.Meter, Marklist))
    -> Ruler -> Ruler
modify_marklists :: (Marklists -> Marklists) -> Ruler -> Ruler
modify_marklists Marklists -> Marklists
modify Ruler
ruler =
    Ruler
ruler { ruler_marklists :: Marklists
ruler_marklists = Marklists -> Marklists
modify (Ruler -> Marklists
ruler_marklists Ruler
ruler) }

-- | Get the position of the last mark of the ruler.
time_end :: Ruler -> ScoreTime
time_end :: Ruler -> ScoreTime
time_end = [ScoreTime] -> ScoreTime
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([ScoreTime] -> ScoreTime)
-> (Ruler -> [ScoreTime]) -> Ruler -> ScoreTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScoreTime
0 :) ([ScoreTime] -> [ScoreTime])
-> (Ruler -> [ScoreTime]) -> Ruler -> [ScoreTime]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe Meter, Marklist) -> ScoreTime)
-> [(Maybe Meter, Marklist)] -> [ScoreTime]
forall a b. (a -> b) -> [a] -> [b]
map (Marklist -> ScoreTime
Mark.end (Marklist -> ScoreTime)
-> ((Maybe Meter, Marklist) -> Marklist)
-> (Maybe Meter, Marklist)
-> ScoreTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Meter, Marklist) -> Marklist
forall a b. (a, b) -> b
snd) ([(Maybe Meter, Marklist)] -> [ScoreTime])
-> (Ruler -> [(Maybe Meter, Marklist)]) -> Ruler -> [ScoreTime]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Marklists -> [(Maybe Meter, Marklist)]
forall k a. Map k a -> [a]
Map.elems (Marklists -> [(Maybe Meter, Marklist)])
-> (Ruler -> Marklists) -> Ruler -> [(Maybe Meter, Marklist)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ruler -> Marklists
ruler_marklists

-- ** bounds

-- | Marks on this marklist given the logical block bounds.  If there is one
-- mark, it denotes the logical block end.  Two morks mean the first one is the
-- logical block start.  The mark text doesn't matter, but @s@ and @e@ are
-- customary.
bounds_name :: Name
bounds_name :: Label
bounds_name = Label
"bounds"

set_bounds :: Maybe ScoreTime -> Maybe ScoreTime -> Ruler -> Ruler
set_bounds :: Maybe ScoreTime -> Maybe ScoreTime -> Ruler -> Ruler
set_bounds Maybe ScoreTime
start Maybe ScoreTime
end =
    Label -> Marklist -> Ruler -> Ruler
set_marklist Label
bounds_name (Marklist -> Ruler -> Ruler) -> Marklist -> Ruler -> Ruler
forall a b. (a -> b) -> a -> b
$ [PosMark] -> Marklist
Mark.marklist ([PosMark] -> Marklist) -> [PosMark] -> Marklist
forall a b. (a -> b) -> a -> b
$ case (Maybe ScoreTime
start, Maybe ScoreTime
end) of
        -- Ensure that start <= end.
        (Just ScoreTime
s, Just ScoreTime
e) -> [(ScoreTime -> ScoreTime -> ScoreTime
forall a. Ord a => a -> a -> a
min ScoreTime
s ScoreTime
e, Mark
start_mark), (ScoreTime -> ScoreTime -> ScoreTime
forall a. Ord a => a -> a -> a
max ScoreTime
s ScoreTime
e, Mark
end_mark)]
        (Just ScoreTime
s, Maybe ScoreTime
Nothing) -> [(ScoreTime
s, Mark
start_mark)]
        (Maybe ScoreTime
Nothing, Just ScoreTime
e) -> [(ScoreTime
e, Mark
end_mark)]
        (Maybe ScoreTime
Nothing, Maybe ScoreTime
Nothing) -> []

start_mark, end_mark :: Mark.Mark
start_mark :: Mark
start_mark = Rank -> Int -> Color -> Label -> Double -> Double -> Mark
Mark.Mark Rank
forall a. Bounded a => a
minBound Int
2 (Double -> Double -> Double -> Color
Color.rgb Double
0 Double
0.75 Double
0) Label
"s" Double
0 Double
0
end_mark :: Mark
end_mark = Rank -> Int -> Color -> Label -> Double -> Double -> Mark
Mark.Mark Rank
forall a. Bounded a => a
minBound Int
2 (Double -> Double -> Double -> Color
Color.rgb Double
0 Double
0.75 Double
0) Label
"e" Double
0 Double
0

get_bounds :: Ruler -> (Maybe ScoreTime, Maybe ScoreTime)
get_bounds :: Ruler -> (Maybe ScoreTime, Maybe ScoreTime)
get_bounds Ruler
ruler = case Label -> Ruler -> Maybe Marklist
lookup_marklist Label
bounds_name Ruler
ruler of
    Maybe Marklist
Nothing -> (Maybe ScoreTime
forall a. Maybe a
Nothing, Maybe ScoreTime
forall a. Maybe a
Nothing)
    Just Marklist
mlist -> case Marklist -> [PosMark]
Mark.to_list Marklist
mlist of
        [] -> (Maybe ScoreTime
forall a. Maybe a
Nothing, Maybe ScoreTime
forall a. Maybe a
Nothing)
        [(ScoreTime
p, Mark
m)]
            | Mark -> Label
Mark.mark_name Mark
m Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
== Mark -> Label
Mark.mark_name Mark
end_mark -> (Maybe ScoreTime
forall a. Maybe a
Nothing, ScoreTime -> Maybe ScoreTime
forall a. a -> Maybe a
Just ScoreTime
p)
            | Bool
otherwise -> (ScoreTime -> Maybe ScoreTime
forall a. a -> Maybe a
Just ScoreTime
p, Maybe ScoreTime
forall a. Maybe a
Nothing)
        [PosMark]
_ -> (ScoreTime -> Maybe ScoreTime
forall a. a -> Maybe a
Just (Marklist -> ScoreTime
Mark.start Marklist
mlist), ScoreTime -> Maybe ScoreTime
forall a. a -> Maybe a
Just (Marklist -> ScoreTime
Mark.end Marklist
mlist))

-- | Get block bounds as defined by the ruler.  This uses explicit
-- 'bounds_name' if there are any, otherwise it uses the 'meter'.  Otherwise,
-- the start time can default to 0, but the end time defaults to Nothing so the
-- caller can use the end of the last event.
bounds_of :: Ruler -> (ScoreTime, Maybe ScoreTime)
bounds_of :: Ruler -> (ScoreTime, Maybe ScoreTime)
bounds_of Ruler
ruler = case Ruler -> (Maybe ScoreTime, Maybe ScoreTime)
get_bounds Ruler
ruler of
    (Maybe ScoreTime
Nothing, Maybe ScoreTime
Nothing) -> (ScoreTime
0, Maybe ScoreTime
meter_end)
    (Maybe ScoreTime
start, Maybe ScoreTime
end) -> (ScoreTime -> Maybe ScoreTime -> ScoreTime
forall a. a -> Maybe a -> a
fromMaybe ScoreTime
0 Maybe ScoreTime
start, Maybe ScoreTime
end Maybe ScoreTime -> Maybe ScoreTime -> Maybe ScoreTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe ScoreTime
meter_end)
    where
    meter_end :: Maybe ScoreTime
meter_end = Meter -> ScoreTime
Meter.meter_end (Meter -> ScoreTime) -> Maybe Meter -> Maybe ScoreTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ruler -> Maybe Meter
lookup_meter Ruler
ruler
        -- Fall back on marklist end, old scores won't have a Meter.Meter.
        Maybe ScoreTime -> Maybe ScoreTime -> Maybe ScoreTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Marklist -> ScoreTime
Mark.end (Marklist -> ScoreTime) -> Maybe Marklist -> Maybe ScoreTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Label -> Ruler -> Maybe Marklist
lookup_marklist Label
meter_name Ruler
ruler