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

-- | Cmds to manipulate the ruler.
--
-- This is a subset of the features in "Cmd.Repl.LRuler", specifically the
-- subset I want to bind to keys.  Perhaps I should move the logic from LRuler
-- here and have LRuler use these definitions.
module Cmd.RulerCmd where
import qualified Util.Lists as Lists
import qualified Cmd.Cmd as Cmd
import qualified Cmd.Ruler.RulerUtil as RulerUtil
import qualified Cmd.Selection as Selection

import qualified Ui.Meter.Meter as Meter
import qualified Ui.Meter.Meters as Meters


local_clip :: Cmd.M m => m ()
local_clip :: forall (m :: * -> *). M m => m ()
local_clip = do
    (BlockId
block_id, Measures
_, TrackId
_, Duration
pos) <- forall (m :: * -> *).
M m =>
m (BlockId, Measures, TrackId, Duration)
Selection.get_insert
    forall (m :: * -> *).
M m =>
Scope -> BlockId -> (Meter -> Meter) -> m [RulerId]
RulerUtil.local_meter Scope
RulerUtil.Block BlockId
block_id forall a b. (a -> b) -> a -> b
$
        ([MSection] -> [MSection]) -> Meter -> Meter
Meter.modify_sections (Duration -> [MSection] -> [MSection]
Meter.sections_take Duration
pos)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

local_double :: Cmd.M m => m ()
local_double :: forall (m :: * -> *). M m => m ()
local_double = forall (m :: * -> *). M m => (Meter -> Meter) -> m ()
local forall a b. (a -> b) -> a -> b
$ ([MSection] -> [MSection]) -> Meter -> Meter
Meter.modify_sections forall a b. (a -> b) -> a -> b
$ \[MSection]
sections -> [MSection]
sections forall a. Semigroup a => a -> a -> a
<> [MSection]
sections

local_add_section :: Cmd.M m => m ()
local_add_section :: forall (m :: * -> *). M m => m ()
local_add_section = forall (m :: * -> *). M m => (Meter -> Meter) -> m ()
local forall a b. (a -> b) -> a -> b
$ (MSection -> [MSection]) -> Meter -> Meter
modify_final forall a b. (a -> b) -> a -> b
$ \MSection
section -> [MSection
section, MSection
section]

local_extend :: Cmd.M m => Meter.Measures -> m ()
local_extend :: forall (m :: * -> *). M m => Measures -> m ()
local_extend Measures
n = forall (m :: * -> *). M m => (Meter -> Meter) -> m ()
local (Measures -> Meter -> Meter
extend Measures
n)

extend :: Meter.Measures -> Meter.Meter -> Meter.Meter
extend :: Measures -> Meter -> Meter
extend Measures
n = (MSection -> [MSection]) -> Meter -> Meter
modify_final forall a b. (a -> b) -> a -> b
$ \MSection
section -> (forall a. a -> [a] -> [a]
:[]) forall a b. (a -> b) -> a -> b
$ MSection
section
    { section_measures :: Measures
Meter.section_measures = Measures
n forall a. Num a => a -> a -> a
+ MSection -> Measures
Meter.section_measures MSection
section }

modify_final :: (Meter.MSection -> [Meter.MSection]) -> Meter.Meter
    -> Meter.Meter
modify_final :: (MSection -> [MSection]) -> Meter -> Meter
modify_final MSection -> [MSection]
modify = ([MSection] -> [MSection]) -> Meter -> Meter
Meter.modify_sections forall a b. (a -> b) -> a -> b
$ \[MSection]
ss -> case forall a. [a] -> Maybe ([a], a)
Lists.unsnoc [MSection]
ss of
    Just ([MSection]
ss, MSection
s) -> [MSection]
ss forall a. [a] -> [a] -> [a]
++ MSection -> [MSection]
modify MSection
s
    Maybe ([MSection], MSection)
Nothing -> MSection -> [MSection]
modify MSection
default_section

local :: Cmd.M m => (Meter.Meter -> Meter.Meter) -> m ()
local :: forall (m :: * -> *). M m => (Meter -> Meter) -> m ()
local Meter -> Meter
action = do
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    forall (m :: * -> *).
M m =>
Scope -> BlockId -> (Meter -> Meter) -> m [RulerId]
RulerUtil.local_meter Scope
RulerUtil.Block BlockId
block_id Meter -> Meter
action
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- TODO should it be configurable?
default_section :: Meter.MSection
default_section :: MSection
default_section = Measures -> Duration -> AbstractMeter -> MSection
Meter.MSection Measures
4 Duration
1 AbstractMeter
Meters.m44