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

{- | Work with rulers and meters.  A meter is a marklist on a ruler named
    'Ruler.meter', and is used by "Cmd.TimeStep" to align things.  By
    convention the meter has regular subdivisions, with 'Ruler.Rank's that
    correspond roughly to timestep durations (e.g. whole, half, quarter notes).
    The ruler marks are numbered, and this module, with the support of
    "Cmd.RulerUtil", lets you modify the meter in a higher level way and takes
    care of renumbering the labels so e.g. measure numbers always count up even
    if you double the length of the meter.

    Ultimately this is necessary because I want to manipulate rulers as a high
    level 'Meter.Meter' or 'Meter.LabeledMeter', but 'Ruler.Marklist' has lost
    the meter's structure.  That in turn is because different kinds of meters,
    talams, gong cycles, etc. have different structures and I didn't think
    I could come up with a single high level data structure that fit them all
    and still allowed generic manipulation.

    Many functions emit a 'Modify'.  If defaults to 'RulerUtil.Section' scope,
    but you can change it to work on selected tracks with 'tracks' or all
    rulers in the block with 'block'.  Then, the 'modify' function will
    destructively modify selected rulers, while the 'local' function will
    modify via copy-on-write, so that other blocks or tracks are unaffected.

    Examples:

    - Start at a different measure number:

        > LRuler.modify $ LRuler.set_start_measure 4

    - Bali: 8 gongs with 4 jegogans per gong.  Since counts are on calung, and
    there are 2 calung per jegogan, this is basically an 8 beat cycle:

        > LRuler.modify $ LRuler.gongs 8 4

    - Give the current block 6 sections of standard 4/4 meter, with 4 measures
    per section, where each measure gets 1t:

        > LRuler.modify $ LRuler.measures Meters.m44 6 4

    - TODO make a middle measure 5/4?

    - Set a block to 8 avartanams of adi talam:

        > LRuler.local $ LRuler.ruler $ Tala.adi 8

    - Change the selected tracks to 8 avartanams of tisram:

        > LRuler.local $ LRuler.tracks $ LRuler.ruler $
        >   Tala.simple Tala.adi_tala 3 8

    - Slow and fast rupaka, chatusra nadai:

        > LRuler.local $ LRuler.ruler $ Tala.simple Tala.rupaka_tala 4 8
        > LRuler.local $ LRuler.ruler $ Tala.simple Tala.rupaka_fast 4 8

    - Set a block to 8 avartanams of adi talam, then select tracks and set them
    to chatusram-tisram:

        > LRuler.modify $ LRuler.ruler $ Tala.adi 8
        > LRuler.local $ LRuler.tracks $ LRuler.ruler $ LTala.chatis 8 4
-}
module Cmd.Repl.LRuler where
import           Prelude hiding (concat)
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as Map
import qualified Data.Text as Text

import qualified Util.Lists as Lists
import qualified Cmd.Cmd as Cmd
import qualified Cmd.Create as Create
import qualified Cmd.Ruler.Extract as Extract
import qualified Cmd.Ruler.Gong as Gong
import qualified Cmd.Ruler.RulerUtil as RulerUtil
import qualified Cmd.Selection as Selection

import qualified Ui.Block as Block
import qualified Ui.Color as Color
import qualified Ui.Events as Events
import qualified Ui.Id as Id
import qualified Ui.Meter.Mark as Mark
import qualified Ui.Meter.Meter as Meter
import qualified Ui.Ruler as Ruler
import qualified Ui.Ui as Ui

import           Global
import           Types


-- * general purpose

rename :: RulerId -> RulerId -> Cmd.CmdL ()
rename :: RulerId -> RulerId -> CmdL ()
rename = forall (m :: * -> *). M m => RulerId -> RulerId -> m ()
Create.rename_ruler

-- | List all rulers, along with the number of blocks each one appears in.
listn :: Cmd.CmdL [(RulerId, Int)]
listn :: CmdL [(RulerId, Int)]
listn = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => m [(RulerId, [BlockId])]
list

list :: Ui.M m => m [(RulerId, [BlockId])]
list :: forall (m :: * -> *). M m => m [(RulerId, [BlockId])]
list = do
    [RulerId]
ruler_ids <- forall (m :: * -> *). M m => m [RulerId]
Ui.all_ruler_ids
    [[(BlockId, [(Int, TracklikeId)])]]
block_ids <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
M m =>
RulerId -> m [(BlockId, [(Int, TracklikeId)])]
Ui.blocks_with_ruler_id [RulerId]
ruler_ids
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [RulerId]
ruler_ids (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst) [[(BlockId, [(Int, TracklikeId)])]]
block_ids)

-- | Destroy all unrefereced rulers, and return their now-invalid RulerIds.
gc :: Ui.M m => m [RulerId]
gc :: forall (m :: * -> *). M m => m [RulerId]
gc = do
    [RulerId]
ruler_ids <- forall (m :: * -> *). M m => m [RulerId]
Create.orphan_rulers
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). M m => RulerId -> m ()
Ui.destroy_ruler [RulerId]
ruler_ids
    forall (m :: * -> *) a. Monad m => a -> m a
return [RulerId]
ruler_ids

-- | Group together rulers that are the same, replace all the duplicates with
-- the first ruler in each group, then gc away the duplicates.  Return the
-- duplicates.
unify :: Ui.M m => m [[RulerId]]
unify :: forall (m :: * -> *). M m => m [[RulerId]]
unify = do
    [NonEmpty (RulerId, Ruler)]
groups <- forall key a. Eq key => (a -> key) -> [a] -> [NonEmpty a]
Lists.groupStable forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall (m :: * -> *) a. M m => (State -> a) -> m a
Ui.gets (forall k a. Map k a -> [(k, a)]
Map.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Map RulerId Ruler
Ui.state_rulers)
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {m :: * -> *} {b}. M m => NonEmpty (RulerId, b) -> m ()
merge [NonEmpty (RulerId, Ruler)]
groups
    forall (m :: * -> *). M m => m [RulerId]
gc
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
>Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NonEmpty.toList) [NonEmpty (RulerId, Ruler)]
groups
    where
    merge :: NonEmpty (RulerId, b) -> m ()
merge ((RulerId
rid, b
_) :| [(RulerId, b)]
dups) = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(RulerId, b)]
dups) forall a b. (a -> b) -> a -> b
$ \RulerId
dup_rid ->
        forall (m :: * -> *). M m => RulerId -> RulerId -> m ()
replace_ruler_id RulerId
dup_rid RulerId
rid

-- | After copying blocks around and fiddling with rulers, the RulerIds can
-- wind up with names from other blocks.  Synchronize RulerIds along with their
-- owning BlockIds.  A RulerId only on one BlockId is assumed to be local to
-- that block, and will get its name.
sync_ids :: Ui.M m => m Text
sync_ids :: forall (m :: * -> *). M m => m Name
sync_ids = do
    [[RulerId]]
deleted <- forall (m :: * -> *). M m => m [[RulerId]]
unify
    let unified :: Name
unified = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[RulerId]]
deleted then Name
"" else [Name] -> Name
Text.unlines forall a b. (a -> b) -> a -> b
$
            Name
"Unified:" forall a. a -> [a] -> [a]
: [forall a. Pretty a => a -> Name
pretty RulerId
x forall a. Semigroup a => a -> a -> a
<> Name
" <- " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Name
pretty [RulerId]
xs | RulerId
x : [RulerId]
xs <- [[RulerId]]
deleted]
            forall a. [a] -> [a] -> [a]
++ [Name
""]
    [(RulerId, BlockId)]
misnamed <- forall (m :: * -> *). M m => m [(RulerId, BlockId)]
list_misnamed
    let renames :: [(RulerId, Id)]
renames = [(RulerId
ruler_id, BlockId -> Id
RulerUtil.block_id_to_ruler BlockId
block_id)
            | (RulerId
ruler_id, BlockId
block_id) <- [(RulerId, BlockId)]
misnamed]
    forall (m :: * -> *). M m => [(RulerId, Id)] -> m ()
Create.rename_rulers [(RulerId, Id)]
renames
    let renamed :: Name
renamed = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RulerId, Id)]
renames then Name
"" else [Name] -> Name
Text.unlines forall a b. (a -> b) -> a -> b
$
            Name
"Renamed:" forall a. a -> [a] -> [a]
: [ forall a. Pretty a => a -> Name
pretty RulerId
from forall a. Semigroup a => a -> a -> a
<> Name
" -> "
                forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Name
pretty (Id -> RulerId
Id.RulerId Id
to) | (RulerId
from, Id
to) <- [(RulerId, Id)]
renames]
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Name
unified forall a. Semigroup a => a -> a -> a
<> Name
renamed

list_misnamed :: Ui.M m => m [(RulerId, BlockId)]
list_misnamed :: forall (m :: * -> *). M m => m [(RulerId, BlockId)]
list_misnamed = forall {a}. Ident a => [(a, [BlockId])] -> [(a, BlockId)]
go forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => m [(RulerId, [BlockId])]
list
    where
    go :: [(a, [BlockId])] -> [(a, BlockId)]
go [(a, [BlockId])]
ruler_blocks =
        [ (a
ruler_id, BlockId
block_id)
        | (a
ruler_id, Just BlockId
block_id) <- forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall {a}. [a] -> Maybe a
len1) [(a, [BlockId])]
ruler_blocks
        , BlockId -> Id
RulerUtil.block_id_to_ruler BlockId
block_id forall a. Eq a => a -> a -> Bool
/= forall a. Ident a => a -> Id
Id.unpack_id a
ruler_id
        ]
    len1 :: [a] -> Maybe a
len1 [a
x] = forall a. a -> Maybe a
Just a
x
    len1 [a]
_ = forall a. Maybe a
Nothing

-- | Blocks that contain the given ruler.
blocks_of :: Ui.M m => RulerId -> m [BlockId]
blocks_of :: forall (m :: * -> *). M m => RulerId -> m [BlockId]
blocks_of = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
M m =>
RulerId -> m [(BlockId, [(Int, TracklikeId)])]
Ui.blocks_with_ruler_id

-- | Set the rulers on a block to the given RulerId.
set_ruler_id :: Ui.M m => RulerId -> BlockId -> m ()
set_ruler_id :: forall (m :: * -> *). M m => RulerId -> BlockId -> m ()
set_ruler_id RulerId
ruler_id BlockId
block_id = do
    RulerId
old <- forall (m :: * -> *). M m => BlockId -> m RulerId
Ui.block_ruler BlockId
block_id
    forall (m :: * -> *). M m => BlockId -> RulerId -> RulerId -> m ()
Ui.replace_ruler_id BlockId
block_id RulerId
old RulerId
ruler_id

-- | Copy the ruler of the given block to the current one.
copy :: Cmd.M m => BlockId -> m ()
copy :: forall (m :: * -> *). M m => BlockId -> m ()
copy BlockId
other_block = do
    RulerId
other_ruler <- forall (m :: * -> *). M m => BlockId -> m RulerId
Ui.ruler_of BlockId
other_block
    BlockId
this_block <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    RulerId
this_ruler <- forall (m :: * -> *). M m => BlockId -> m RulerId
Ui.block_ruler BlockId
this_block
    forall (m :: * -> *). M m => BlockId -> RulerId -> RulerId -> m ()
Ui.replace_ruler_id BlockId
this_block RulerId
this_ruler RulerId
other_ruler

-- | Set the ruler of the tracks in the given scope.
set :: Ui.M m => RulerId -> BlockId -> RulerUtil.Scope -> m ()
set :: forall (m :: * -> *). M m => RulerId -> BlockId -> Scope -> m ()
set RulerId
ruler_id BlockId
block_id Scope
scope = do
    [Maybe RulerId]
ruler_ids <- case Scope
scope of
        Scope
RulerUtil.Block -> do
            Int
count <- forall (m :: * -> *). M m => BlockId -> m Int
Ui.track_count BlockId
block_id
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
count (forall a. a -> Maybe a
Just RulerId
ruler_id)
        RulerUtil.Section Int
tracknum -> forall {m :: * -> *} {a} {t :: * -> *}.
(M m, Num a, Enum a, Foldable t, Eq a) =>
t a -> m [Maybe RulerId]
replace_tracknums
            forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
M m =>
BlockId -> Int -> m [(Int, TracklikeId)]
RulerUtil.get_section BlockId
block_id Int
tracknum
        RulerUtil.Tracks [Int]
tracknums -> forall {m :: * -> *} {a} {t :: * -> *}.
(M m, Num a, Enum a, Foldable t, Eq a) =>
t a -> m [Maybe RulerId]
replace_tracknums [Int]
tracknums
    forall (m :: * -> *). M m => BlockId -> [Maybe RulerId] -> m ()
Ui.set_ruler_ids BlockId
block_id [Maybe RulerId]
ruler_ids
    where
    replace_tracknums :: t a -> m [Maybe RulerId]
replace_tracknums t a
tracknums = do
        [Maybe RulerId]
old <- forall a b. (a -> b) -> [a] -> [b]
map TracklikeId -> Maybe RulerId
Block.ruler_id_of forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [TracklikeId]
Block.block_tracklike_ids forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                forall (m :: * -> *). M m => BlockId -> m Block
Ui.get_block BlockId
block_id
        let replace :: a -> Maybe RulerId -> Maybe RulerId
replace a
tracknum Maybe RulerId
old_ruler
                | a
tracknum forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
tracknums = forall a. a -> Maybe a
Just RulerId
ruler_id
                | Bool
otherwise = Maybe RulerId
old_ruler
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> Maybe RulerId -> Maybe RulerId
replace [a
0..] [Maybe RulerId]
old

-- | Replace the ruler.
ruler :: Cmd.M m => Meter.Meter -> m Modify
ruler :: forall (m :: * -> *). M m => Meter -> m Modify
ruler Meter
meter = do
    (BlockId
block_id, Int
tracknum) <- forall (m :: * -> *). M m => m (BlockId, Int)
get_block_track
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BlockId -> Int -> ModifyRuler -> Modify
make_modify BlockId
block_id Int
tracknum forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
        Meter -> Ruler
Ruler.meter_ruler Meter
meter

lruler :: Cmd.M m => Meter.Meter -> m [RulerId]
lruler :: forall (m :: * -> *). M m => Meter -> m [RulerId]
lruler = forall (m :: * -> *). M m => m Modify -> m [RulerId]
local forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). M m => Meter -> m Modify
ruler

-- | Modify all rulers.
modify_rulers :: Cmd.M m => (Ruler.Ruler -> Ruler.Ruler) -> m ()
modify_rulers :: forall (m :: * -> *). M m => (Ruler -> Ruler) -> m ()
modify_rulers Ruler -> Ruler
modify = do
    [RulerId]
ruler_ids <- forall (m :: * -> *). M m => m [RulerId]
Ui.all_ruler_ids
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [RulerId]
ruler_ids forall a b. (a -> b) -> a -> b
$ \RulerId
ruler_id ->
        forall (m :: * -> *). M m => RulerId -> ModifyRuler -> m ()
Ui.modify_ruler RulerId
ruler_id (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ruler -> Ruler
modify)

-- | Replace all occurrences of one RulerId with another.
replace_ruler_id :: Ui.M m => RulerId -> RulerId -> m ()
replace_ruler_id :: forall (m :: * -> *). M m => RulerId -> RulerId -> m ()
replace_ruler_id RulerId
old RulerId
new = do
    [(BlockId, [(Int, TracklikeId)])]
blocks <- forall (m :: * -> *).
M m =>
RulerId -> m [(BlockId, [(Int, TracklikeId)])]
Ui.blocks_with_ruler_id RulerId
old
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(BlockId, [(Int, TracklikeId)])]
blocks) forall a b. (a -> b) -> a -> b
$ \BlockId
block_id ->
        forall (m :: * -> *). M m => BlockId -> RulerId -> RulerId -> m ()
Ui.replace_ruler_id BlockId
block_id RulerId
old RulerId
new

-- * query

get_meter :: Ui.M m => BlockId -> m Meter.Meter
get_meter :: forall (m :: * -> *). M m => BlockId -> m Meter
get_meter BlockId
block_id = Ruler -> Meter
Ruler.get_meter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *). M m => RulerId -> m Ruler
Ui.get_ruler forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => BlockId -> m RulerId
Ui.ruler_of BlockId
block_id)

get_sections :: Ui.M m => BlockId -> m [Meter.MSection]
get_sections :: forall (m :: * -> *). M m => BlockId -> m [MSection]
get_sections = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Meter -> [MSection]
Meter.meter_sections forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). M m => BlockId -> m Meter
get_meter

get_marks :: Ui.M m => BlockId -> m [(TrackTime, Mark.Mark)]
get_marks :: forall (m :: * -> *). M m => BlockId -> m [(TrackTime, Mark)]
get_marks BlockId
block_id =
    TrackTime -> Marklist -> [(TrackTime, Mark)]
Mark.ascending TrackTime
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Ruler -> Marklist
Ruler.get_marklist Name
Ruler.meter_name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (forall (m :: * -> *). M m => RulerId -> m Ruler
Ui.get_ruler forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => BlockId -> m RulerId
Ui.ruler_of BlockId
block_id)

-- | Ruler under the selection having at least the given rank.
selected_marks :: Cmd.M m => Meter.Rank -> m [(TrackTime, Mark.Mark)]
selected_marks :: forall (m :: * -> *). M m => Rank -> m [(TrackTime, Mark)]
selected_marks Rank
rank = do
    Ruler
ruler <- forall (m :: * -> *). M m => RulerId -> m Ruler
Ui.get_ruler forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m RulerId
selected
    (TrackTime
start, TrackTime
end) <- forall (m :: * -> *). M m => m (TrackTime, TrackTime)
selection_range
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
<=Rank
rank) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mark -> Rank
Mark.mark_rank forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
        forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((forall a. Ord a => a -> a -> Bool
<=TrackTime
end) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ TrackTime -> Marklist -> [(TrackTime, Mark)]
Mark.ascending TrackTime
start forall a b. (a -> b) -> a -> b
$
        Name -> Ruler -> Marklist
Ruler.get_marklist Name
Ruler.meter_name Ruler
ruler

-- | Ruler of the track under the selection.
selected :: Cmd.M m => m RulerId
selected :: forall (m :: * -> *). M m => m RulerId
selected = do
    (BlockId
block_id, Int
tracknum, TrackId
_, TrackTime
_) <- forall (m :: * -> *). M m => m (BlockId, Int, TrackId, TrackTime)
Selection.get_insert
    forall (m :: * -> *) a. (Stack, M m) => Name -> Maybe a -> m a
Cmd.require Name
"no ruler" forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => BlockId -> Int -> m (Maybe RulerId)
Ui.ruler_track_at BlockId
block_id Int
tracknum

-- * upgrade to Meter.Meter

upgrade_infer :: Meter.AbstractMeter -> Upgrade
upgrade_infer :: AbstractMeter -> Upgrade
upgrade_infer AbstractMeter
meter Marklist
mlist =
    ( AbstractMeter -> TrackTime -> Int -> TrackTime -> Meter
RulerUtil.meter_until AbstractMeter
meter TrackTime
dur Int
4 TrackTime
end
    , String
"measure " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TrackTime
dur forall a. Semigroup a => a -> a -> a
<> String
" end: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TrackTime
end
    )
    where (TrackTime
dur, TrackTime
end) = (Marklist -> TrackTime
infer_measure_dur Marklist
mlist, Marklist -> TrackTime
Mark.end Marklist
mlist)

infer_measure_dur :: Mark.Marklist -> TrackTime
infer_measure_dur :: Marklist -> TrackTime
infer_measure_dur Marklist
mlist =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe TrackTime
0 forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> k) -> [a] -> Maybe a
Lists.maximumOn forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall a b. (a -> b) -> a -> b
$
        forall key a. Ord key => (a -> key) -> [a] -> [(key, [a])]
Lists.keyedGroupSort forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
subtract NonNull TrackTime
starts (forall a. Int -> [a] -> [a]
drop Int
1 NonNull TrackTime
starts)
    where
    starts :: NonNull TrackTime
starts = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
<= Rank
Meter.W) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mark -> Rank
Mark.mark_rank 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
. Marklist -> [(TrackTime, Mark)]
Mark.to_list forall a b. (a -> b) -> a -> b
$ Marklist
mlist

upgrade_gong :: Upgrade
upgrade_gong :: Upgrade
upgrade_gong Marklist
mlist = (TrackTime -> Meter
Gong.until (Marklist -> TrackTime
Mark.end Marklist
mlist), String
"")

type Upgrade = Mark.Marklist -> (Meter.Meter, String)

-- |
-- > LRuler.replace_meters LRuler.upgrade_gong
-- > LRuler.replace_meters (LRuler.upgrade_infer Meters.m44)
replace_meters :: Ui.M m => Bool -> Upgrade -> m String
replace_meters :: forall (m :: * -> *). M m => Bool -> Upgrade -> m String
replace_meters Bool
force Upgrade
upgrade = do
    [RulerId]
ruler_ids <- forall (m :: * -> *). M m => m [RulerId]
Ui.all_ruler_ids
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [RulerId]
ruler_ids forall a b. (a -> b) -> a -> b
$ \RulerId
ruler_id ->
        ((forall a. Show a => a -> String
show RulerId
ruler_id forall a. Semigroup a => a -> a -> a
<> String
": ") <>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => Bool -> Upgrade -> RulerId -> m String
replace_meter Bool
force Upgrade
upgrade RulerId
ruler_id

-- | Add a Meter for the ruler if not already present.
replace_meter :: Ui.M m => Bool -> Upgrade -> RulerId -> m String
replace_meter :: forall (m :: * -> *). M m => Bool -> Upgrade -> RulerId -> m String
replace_meter Bool
force Upgrade
upgrade RulerId
ruler_id = do
    Ruler
ruler <- forall (m :: * -> *). M m => RulerId -> m Ruler
Ui.get_ruler RulerId
ruler_id
    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
Ruler.meter_name (Ruler -> Marklists
Ruler.ruler_marklists Ruler
ruler) of
        Just (Maybe Meter
old_meter, Marklist
mlist)
            | Bool
force Bool -> Bool -> Bool
|| Maybe Meter
old_meter forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing -> do
                let (Meter
meter, String
msg) = Upgrade
upgrade Marklist
mlist
                forall (m :: * -> *). M m => RulerId -> Meter -> m ()
RulerUtil.set_meter RulerId
ruler_id Meter
meter
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"replaced: " forall a. Semigroup a => a -> a -> a
<> String
msg
            | Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"already has meter"
        Maybe (Maybe Meter, Marklist)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"no meter?"

-- * Modify

-- | Copy the meter under the selection and append it to the end of the ruler.
append :: Cmd.M m => m Modify
append :: forall (m :: * -> *). M m => m Modify
append = do
    (TrackTime
start, TrackTime
end) <- forall (m :: * -> *). M m => m (TrackTime, TrackTime)
selection_range
    forall (m :: * -> *). M m => (Meter -> Meter) -> m Modify
modify_selected forall a b. (a -> b) -> a -> b
$ ([MSection] -> [MSection]) -> Meter -> Meter
Meter.modify_sections forall a b. (a -> b) -> a -> b
$ \[MSection]
ss ->
        [MSection]
ss forall a. Semigroup a => a -> a -> a
<> TrackTime -> TrackTime -> [MSection] -> [MSection]
RulerUtil.extract TrackTime
start TrackTime
end [MSection]
ss

-- | Append another ruler to this one.
append_ruler_id :: Cmd.M m => RulerId -> m Modify
append_ruler_id :: forall (m :: * -> *). M m => RulerId -> m Modify
append_ruler_id RulerId
ruler_id = do
    Meter
other <- forall (m :: * -> *). M m => RulerId -> m Meter
RulerUtil.get_meter RulerId
ruler_id
    forall (m :: * -> *). M m => (Meter -> Meter) -> m Modify
modify_selected forall a b. (a -> b) -> a -> b
$ (forall a. Semigroup a => a -> a -> a
<> Meter
other)

-- | Remove the selected range of the ruler and shift the rest up.
delete :: Cmd.M m => m Modify
delete :: forall (m :: * -> *). M m => m Modify
delete = do
    (TrackTime
start, TrackTime
end) <- forall (m :: * -> *). M m => m (TrackTime, TrackTime)
selection_range
    forall (m :: * -> *). M m => (Meter -> Meter) -> m Modify
modify_selected forall a b. (a -> b) -> a -> b
$ ([MSection] -> [MSection]) -> Meter -> Meter
Meter.modify_sections forall a b. (a -> b) -> a -> b
$ TrackTime -> TrackTime -> [MSection] -> [MSection]
RulerUtil.delete TrackTime
start TrackTime
end

-- | Insert the selected meter range at the given time.
insert :: Cmd.M m => TrackTime -> m Modify
insert :: forall (m :: * -> *). M m => TrackTime -> m Modify
insert TrackTime
at = do
    (TrackTime
start, TrackTime
end) <- forall (m :: * -> *). M m => m (TrackTime, TrackTime)
selection_range
    [MSection]
sections <- forall (m :: * -> *). M m => BlockId -> m [MSection]
get_sections forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    forall (m :: * -> *). M m => (Meter -> Meter) -> m Modify
modify_selected forall a b. (a -> b) -> a -> b
$ [MSection] -> Meter -> Meter
Meter.set_sections forall a b. (a -> b) -> a -> b
$
        TrackTime -> [MSection] -> [MSection]
Meter.sections_take TrackTime
at [MSection]
sections
        forall a. Semigroup a => a -> a -> a
<> TrackTime -> TrackTime -> [MSection] -> [MSection]
RulerUtil.extract TrackTime
start TrackTime
end [MSection]
sections
        forall a. Semigroup a => a -> a -> a
<> TrackTime -> [MSection] -> [MSection]
Meter.sections_drop TrackTime
at [MSection]
sections

replace_range :: TrackTime -> TrackTime -> [Meter.MSection] -> Meter.Meter
    -> Meter.Meter
replace_range :: TrackTime -> TrackTime -> [MSection] -> Meter -> Meter
replace_range TrackTime
start TrackTime
end [MSection]
insert = ([MSection] -> [MSection]) -> Meter -> Meter
Meter.modify_sections forall a b. (a -> b) -> a -> b
$ \[MSection]
ss ->
    let pre :: [MSection]
pre = TrackTime -> [MSection] -> [MSection]
Meter.sections_take TrackTime
start [MSection]
ss
        post :: [MSection]
post = TrackTime -> [MSection] -> [MSection]
Meter.sections_drop TrackTime
end [MSection]
ss
    in [MSection]
pre forall a. Semigroup a => a -> a -> a
<> [MSection]
insert forall a. Semigroup a => a -> a -> a
<> [MSection]
post

-- -- | Replace the selected region with another marklist.
-- replace_range :: TrackTime -> TrackTime -> Meter.LabeledMeter
--     -> Meter.LabeledMeter -> Meter.LabeledMeter
-- replace_range start end insert meter =
--     before <> Meter.take_before (end - start) insert <> after
--     where
--     before = Meter.take_before start meter
--     after = Meter.drop_until end meter

-- TODO This is no longer possible since that's now hardcoded at the Meter.Make
-- level.  Having to do it at all is no good though, I should not have to pay
-- for marks which are not visible.
-- strip_ranks :: Cmd.M m => Meter.Rank -> m Modify
-- strip_ranks max_rank =
--     modify_selected $ Meter.strip_ranks (Meter.name_to_rank max_rank)

type Sections = Int
type Measures = Int

-- | Set the ruler to a number of measures of the given meter, where each
-- measure gets 1t:
--
-- > LRuler.local $ LRuler.measures Meters.m44 4 4
-- > LRuler.modify $ LRuler.measures Meters.m34 4 8
measures :: Cmd.M m => Meter.AbstractMeter -> Sections -> Measures -> m Modify
measures :: forall (m :: * -> *).
M m =>
AbstractMeter -> Int -> Int -> m Modify
measures AbstractMeter
meter Int
sections Int
measures = forall (m :: * -> *). M m => ([MSection] -> [MSection]) -> m Modify
modify_sections forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$
    forall a. Int -> a -> [a]
replicate Int
sections forall a b. (a -> b) -> a -> b
$ Int -> TrackTime -> AbstractMeter -> MSection
Meter.MSection Int
measures TrackTime
1 AbstractMeter
meter

-- | Create gongs with 'Gong.gongs'.
gongs :: Cmd.M m => Gong.Gongs -> Gong.Jegogans -> m Modify
gongs :: forall (m :: * -> *). M m => Int -> Int -> m Modify
gongs Int
sections Int
jegog = forall (m :: * -> *). M m => Meter -> m Modify
ruler forall a b. (a -> b) -> a -> b
$ Int -> Int -> Meter
Gong.regular Int
sections Int
jegog

java :: Cmd.M m => Int -> m Modify
java :: forall (m :: * -> *). M m => Int -> m Modify
java Int
lines = forall (m :: * -> *). M m => Meter -> m Modify
ruler forall a b. (a -> b) -> a -> b
$ Int -> Meter
Gong.java Int
lines

-- | Replace the meter with the concatenation of the rulers of the given
-- blocks.  This is like 'extract' except it doesn't infer the blocks from the
-- calls and doesn't scale the extracted rulers.
concat :: Cmd.M m => [BlockId] -> m Modify
concat :: forall (m :: * -> *). M m => [BlockId] -> m Modify
concat [BlockId]
block_ids = do
    [MSection]
sections <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). M m => BlockId -> m [MSection]
get_sections [BlockId]
block_ids
    forall (m :: * -> *). M m => ([MSection] -> [MSection]) -> m Modify
modify_sections (forall a b. a -> b -> a
const [MSection]
sections)

-- * pull_up, push_down

-- | Extract the meter marklists from the sub-blocks called on the given
-- track, concatenate them, and replace the current meter with it.
pull_up :: Cmd.M m => m Modify
pull_up :: forall (m :: * -> *). M m => m Modify
pull_up = do
    (BlockId
block_id, Int
tracknum, TrackId
track_id, TrackTime
_) <- forall (m :: * -> *). M m => m (BlockId, Int, TrackId, TrackTime)
Selection.get_insert
    Meter
meter <- forall (m :: * -> *). M m => BlockId -> TrackId -> m Meter
Extract.pull_up BlockId
block_id TrackId
track_id
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BlockId -> Int -> ModifyRuler -> Modify
make_modify BlockId
block_id Int
tracknum forall a b. (a -> b) -> a -> b
$
        forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Meter -> Ruler
Ruler.meter_ruler Meter
meter

push_down :: Cmd.M m => Bool -> m ()
push_down :: forall (m :: * -> *). M m => Bool -> m ()
push_down Bool
recursive = do
    (BlockId
block_id, Int
_, TrackId
track_id, TrackTime
_) <- forall (m :: * -> *). M m => m (BlockId, Int, TrackId, TrackTime)
Selection.get_insert
    if Bool
recursive
        then forall (m :: * -> *). M m => Bool -> BlockId -> TrackId -> m ()
Extract.push_down_recursive Bool
False BlockId
block_id TrackId
track_id
        else forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
M m =>
Bool -> BlockId -> TrackId -> m [BlockId]
Extract.push_down Bool
False BlockId
block_id TrackId
track_id

-- * modify

-- | Change a Modify so it modifies only the selected tracks.
tracks :: Cmd.M m => m Modify -> m Modify
tracks :: forall (m :: * -> *). M m => m Modify -> m Modify
tracks m Modify
modify = do
    Modify
modify <- m Modify
modify
    (BlockId
_, [Int]
tracknums, [TrackId]
_, Range
_) <- forall (m :: * -> *). M m => m (BlockId, [Int], [TrackId], Range)
Selection.tracks
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Modify
modify { m_scope :: Scope
m_scope = [Int] -> Scope
RulerUtil.Tracks [Int]
tracknums }

-- | Change a Modify so it modifies all rulers on the block.
block :: Cmd.M m => m Modify -> m Modify
block :: forall (m :: * -> *). M m => m Modify -> m Modify
block m Modify
modify = do
    Modify
modify <- m Modify
modify
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Modify
modify { m_scope :: Scope
m_scope = Scope
RulerUtil.Block }

-- | Enough information to modify a ruler.
--
-- TODO I could also include entire block, and then add_cue etc. could use it,
-- in addition to being able to clip the entire block.
data Modify = Modify {
    Modify -> BlockId
m_block_id :: !BlockId
    , Modify -> Scope
m_scope :: !RulerUtil.Scope
    , Modify -> ModifyRuler
m_modify :: !RulerUtil.ModifyRuler
    }

modify_sections :: Cmd.M m => ([Meter.MSection] -> [Meter.MSection]) -> m Modify
modify_sections :: forall (m :: * -> *). M m => ([MSection] -> [MSection]) -> m Modify
modify_sections = forall (m :: * -> *). M m => (Meter -> Meter) -> m Modify
modify_selected forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([MSection] -> [MSection]) -> Meter -> Meter
Meter.modify_sections

set_start_measure :: Cmd.M m => Meter.Measures -> m Modify
set_start_measure :: forall (m :: * -> *). M m => Int -> m Modify
set_start_measure Int
n = forall (m :: * -> *). M m => (Meter -> Meter) -> m Modify
modify_selected forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Meter -> Meter
Meter.modify_config forall a b. (a -> b) -> a -> b
$ \Config
c ->
    Config
c { config_start_measure :: Int
Meter.config_start_measure = Int
n }

modify_selected :: Cmd.M m => (Meter.Meter -> Meter.Meter) -> m Modify
modify_selected :: forall (m :: * -> *). M m => (Meter -> Meter) -> m Modify
modify_selected Meter -> Meter
modify = do
    (BlockId
block_id, Int
tracknum) <- forall (m :: * -> *). M m => m (BlockId, Int)
get_block_track
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BlockId -> Int -> ModifyRuler -> Modify
make_modify BlockId
block_id Int
tracknum (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Meter -> Meter) -> Ruler -> Ruler
Ruler.modify_meter Meter -> Meter
modify)

make_modify :: BlockId -> TrackNum -> RulerUtil.ModifyRuler -> Modify
make_modify :: BlockId -> Int -> ModifyRuler -> Modify
make_modify BlockId
block_id Int
tracknum = BlockId -> Scope -> ModifyRuler -> Modify
Modify BlockId
block_id (Int -> Scope
RulerUtil.Section Int
tracknum)

get_block_track :: Cmd.M m => m (BlockId, TrackNum)
get_block_track :: forall (m :: * -> *). M m => m (BlockId, Int)
get_block_track = do
    (BlockId
block_id, Int
tracknum, TrackId
_, TrackTime
_) <- forall (m :: * -> *). M m => m (BlockId, Int, TrackId, TrackTime)
Selection.get_insert
    forall (m :: * -> *) a. Monad m => a -> m a
return (BlockId
block_id, Int
tracknum)

local :: Cmd.M m => m Modify -> m [RulerId]
local :: forall (m :: * -> *). M m => m Modify -> m [RulerId]
local = (forall (m :: * -> *). M m => Modify -> m [RulerId]
local_m =<<)

modify :: Cmd.M m => m Modify -> m ()
modify :: forall (m :: * -> *). M m => m Modify -> m ()
modify = (forall (m :: * -> *). M m => Modify -> m ()
modify_m =<<)

-- | Modify a ruler or rulers, making a copy if they're shared with another
-- block.
local_m :: Cmd.M m => Modify -> m [RulerId]
local_m :: forall (m :: * -> *). M m => Modify -> m [RulerId]
local_m (Modify BlockId
block_id Scope
scope ModifyRuler
modify) = forall (m :: * -> *).
M m =>
Scope -> BlockId -> ModifyRuler -> m [RulerId]
RulerUtil.local Scope
scope BlockId
block_id ModifyRuler
modify

-- | Modify the ruler on the focused block.  Other blocks with the same ruler
-- will also be modified.
modify_m :: Cmd.M m => Modify -> m ()
modify_m :: forall (m :: * -> *). M m => Modify -> m ()
modify_m (Modify BlockId
block_id Scope
scope ModifyRuler
modify) = forall (m :: * -> *).
M m =>
Scope -> BlockId -> ModifyRuler -> m ()
RulerUtil.modify Scope
scope BlockId
block_id ModifyRuler
modify

-- | Modify a local copy of the main block ruler.
local_ruler :: Ui.M m => BlockId -> (Ruler.Ruler -> Ruler.Ruler) -> m RulerId
local_ruler :: forall (m :: * -> *).
M m =>
BlockId -> (Ruler -> Ruler) -> m RulerId
local_ruler BlockId
block_id Ruler -> Ruler
modify =
    forall (m :: * -> *).
M m =>
BlockId -> Int -> ModifyRuler -> m RulerId
RulerUtil.local_section BlockId
block_id Int
0 forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ruler -> Ruler
modify

-- * bounds

-- | Set the block's logical start time to the selection.  Notes before this
-- will play before the start of the calling event.
set_start :: Cmd.M m => m RulerId
set_start :: forall (m :: * -> *). M m => m RulerId
set_start = do
    (BlockId
block_id, Int
_, TrackId
_, TrackTime
pos) <- forall (m :: * -> *). M m => m (BlockId, Int, TrackId, TrackTime)
Selection.get_insert
    forall (m :: * -> *).
M m =>
BlockId -> (Ruler -> Ruler) -> m RulerId
local_ruler BlockId
block_id forall a b. (a -> b) -> a -> b
$ \Ruler
ruler ->
        let (Maybe TrackTime
_, Maybe TrackTime
e) = Ruler -> (Maybe TrackTime, Maybe TrackTime)
Ruler.get_bounds Ruler
ruler
        in Maybe TrackTime -> Maybe TrackTime -> Ruler -> Ruler
Ruler.set_bounds (forall a. a -> Maybe a
Just TrackTime
pos) Maybe TrackTime
e Ruler
ruler

-- | Set the block's logical end time to the selection.  Notes after this will
-- play after the end of the calling event.
set_end :: Cmd.M m => m RulerId
set_end :: forall (m :: * -> *). M m => m RulerId
set_end = do
    (BlockId
block_id, Int
_, TrackId
_, TrackTime
pos) <- forall (m :: * -> *). M m => m (BlockId, Int, TrackId, TrackTime)
Selection.get_insert
    forall (m :: * -> *).
M m =>
BlockId -> (Ruler -> Ruler) -> m RulerId
local_ruler BlockId
block_id forall a b. (a -> b) -> a -> b
$ \Ruler
ruler ->
        let (Maybe TrackTime
s, Maybe TrackTime
_) = Ruler -> (Maybe TrackTime, Maybe TrackTime)
Ruler.get_bounds Ruler
ruler
        in Maybe TrackTime -> Maybe TrackTime -> Ruler -> Ruler
Ruler.set_bounds Maybe TrackTime
s (forall a. a -> Maybe a
Just TrackTime
pos) Ruler
ruler

-- * cue

-- | Drop a mark at the selected point in the \"cue\" ruler.
add_cue :: Text -> Cmd.CmdL RulerId
add_cue :: Name -> CmdL RulerId
add_cue Name
label = do
    (BlockId
block_id, Int
tracknum, TrackId
_, TrackTime
pos) <- forall (m :: * -> *). M m => m (BlockId, Int, TrackId, TrackTime)
Selection.get_insert
    BlockId -> Int -> TrackTime -> Name -> CmdL RulerId
add_cue_at BlockId
block_id Int
tracknum TrackTime
pos Name
label

remove_cues :: Cmd.CmdL ()
remove_cues :: CmdL ()
remove_cues = do
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    forall (m :: * -> *). M m => BlockId -> ModifyRuler -> m ()
RulerUtil.modify_block BlockId
block_id forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Ruler -> Ruler
Ruler.remove_marklist Name
cue_name

add_cue_at :: BlockId -> TrackNum -> ScoreTime -> Text -> Cmd.CmdL RulerId
add_cue_at :: BlockId -> Int -> TrackTime -> Name -> CmdL RulerId
add_cue_at BlockId
block_id Int
tracknum TrackTime
pos Name
label =
    forall (m :: * -> *).
M m =>
BlockId -> Int -> ModifyRuler -> m RulerId
RulerUtil.local_section BlockId
block_id Int
tracknum forall a b. (a -> b) -> a -> b
$
        forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> (Marklist -> Marklist) -> Ruler -> Ruler
Ruler.modify_marklist Name
cue_name
            (TrackTime -> Mark -> Marklist -> Marklist
Mark.insert_mark TrackTime
pos (Name -> Mark
cue_mark Name
label))

cue_mark :: Text -> Mark.Mark
cue_mark :: Name -> Mark
cue_mark Name
label = Mark.Mark
    { mark_rank :: Rank
mark_rank = forall a. Bounded a => a
minBound
    , mark_width :: Int
mark_width = Int
2
    , mark_color :: Color
mark_color = Color
Color.black
    , mark_name :: Name
mark_name = Name
label
    , mark_name_zoom_level :: Double
mark_name_zoom_level = Double
0
    , mark_zoom_level :: Double
mark_zoom_level = Double
0
    }

cue_name :: Ruler.Name
cue_name :: Name
cue_name = Name
"cue"


{-
TODO I can't restore this unless I expose Make config

-- * colors

-- | Used to adjust mark colors interactively.
reset_colors :: Cmd.CmdL ()
reset_colors = do
    block_id <- Cmd.get_focused_block
    ruler_id <- Ui.ruler_of block_id
    Ui.modify_ruler ruler_id (Right . set_colors meter_ranks)

set_colors :: [(Color.Color, Make.MarkWidth, Int)] -> Ruler.Ruler
    -> Ruler.Ruler
set_colors ranks ruler =
    Ruler.set_meter config
        (Ruler.marklist $ map (second set) $ Mark.ascending 0 mlist)
        ruler
    where
    (config, mlist) = Ruler.get_meter ruler
    set mark = case Lists.at ranks (Mark.mark_rank mark) of
        Nothing -> error $ "no color for rank: " <> show (Mark.mark_rank mark)
        Just (color, width, _) -> mark
            { Mark.mark_color = color
            , Mark.mark_width = width
            }

meter_ranks :: [(Color.Color, Make.MarkWidth, Int)]
meter_ranks =
    [ (a3 0.0 0.0 0.0, 3, 8)    -- section
    , (a3 0.2 0.1 0.0, 2, 8)    -- measure / whole

    , (a3 1.0 0.4 0.2, 2, 8)    -- half
    , (a2 1.0 0.4 0.2, 2, 8)    -- quarter

    , (a3 1.0 0.4 0.9, 1, 8)    -- 8th
    , (a2 1.0 0.4 0.9, 1, 8)    -- 16th

    , (a2 0.1 0.5 0.1, 1, 8)    -- 32nd
    , (a1 0.1 0.5 0.1, 1, 8)    -- 64th

    , (a2 0.0 0.0 0.0, 1, 8)    -- 128th
    , (a1 0.0 0.0 0.0, 1, 8)    -- 256th
    ]
    where
    a1 = alpha 0.2
    a2 = alpha 0.4
    a3 = alpha 0.55
    alpha a r g b = Color.rgba r g b a
-}

-- * util

-- | Ruler operations don't care about selection orientation.
selection_range :: Cmd.M m => m (TrackTime, TrackTime)
selection_range :: forall (m :: * -> *). M m => m (TrackTime, TrackTime)
selection_range = Range -> (TrackTime, TrackTime)
Events.range_times forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => m Range
Selection.range