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