-- 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
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
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", forall a. Pretty a => a -> Doc
Pretty.format Marklists
mlists)
        , (Label
"bg", forall a. Pretty a => a -> Doc
Pretty.format Color
bg)
        , (Label
"show_names", forall a. Pretty a => a -> Doc
Pretty.format Bool
show_names)
        , (Label
"align_to_bottom", 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 seq :: forall a b. a -> b -> b
`seq` ()


-- * ruler

empty :: Ruler
empty :: Ruler
empty = Ruler
    { ruler_marklists :: Marklists
ruler_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 = forall a. a -> Maybe a -> a
fromMaybe Meter
Meter.empty_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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Label
meter_name 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 forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Label
meter_name (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 = forall a. a -> Maybe a -> a
fromMaybe Marklist
Mark.empty 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Label
name 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 (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Label
name (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScoreTime
0 :) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Marklist -> ScoreTime
Mark.end forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems 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 forall a b. (a -> b) -> a -> b
$ [PosMark] -> Marklist
Mark.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) -> [(forall a. Ord a => a -> a -> a
min ScoreTime
s ScoreTime
e, Mark
start_mark), (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 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 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 -> (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
    Just Marklist
mlist -> case Marklist -> [PosMark]
Mark.to_list Marklist
mlist of
        [] -> (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
        [(ScoreTime
p, Mark
m)]
            | Mark -> Label
Mark.mark_name Mark
m forall a. Eq a => a -> a -> Bool
== Mark -> Label
Mark.mark_name Mark
end_mark -> (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just ScoreTime
p)
            | Bool
otherwise -> (forall a. a -> Maybe a
Just ScoreTime
p, forall a. Maybe a
Nothing)
        [PosMark]
_ -> (forall a. a -> Maybe a
Just (Marklist -> ScoreTime
Mark.start Marklist
mlist), 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) -> (forall a. a -> Maybe a -> a
fromMaybe ScoreTime
0 Maybe ScoreTime
start, Maybe ScoreTime
end 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 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.
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Marklist -> ScoreTime
Mark.end forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Label -> Ruler -> Maybe Marklist
lookup_marklist Label
meter_name Ruler
ruler