content: -- 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
  
  -- | Cmds for track level operations.
  module Cmd.Repl.LTrack where
  import qualified Data.List as List
  import qualified Data.Set as Set
  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.ModifyEvents as ModifyEvents
  import qualified Cmd.Selection as Selection
  
  import qualified Derive.ParseTitle as ParseTitle
  import qualified Derive.ScoreT as ScoreT
  import qualified Ui.Block as Block
  import qualified Ui.Event as Event
  import qualified Ui.Events as Events
  import qualified Ui.Track as Track
  import qualified Ui.TrackTree as TrackTree
  import qualified Ui.Types as Types
  import qualified Ui.Ui as Ui
  
  import           Global
  import           Types
  
  
  -- | List all tracks, along with the number of blocks each one appears in.
  list :: Cmd.CmdL [(TrackId, Int)]
  list = do
      track_ids <- Ui.all_track_ids
      counts <- map length <$> mapM Ui.blocks_with_track_id track_ids
      return $ zip track_ids counts
  
  gc :: Cmd.CmdL [TrackId]
  gc = do
      tids <- orphans
      mapM_ Ui.destroy_track tids
      return tids
  
  -- | Tracks that don't appear in any block.
  orphans :: Cmd.CmdL [TrackId]
  orphans = Set.elems <$> Create.orphan_tracks
  
  -- | Remove tracks with no events from the given block.
  remove_empty :: BlockId -> Cmd.CmdL ()
  remove_empty block_id = do
      track_ids <- Block.block_track_ids <$> Ui.get_block block_id
      mapM_ Ui.destroy_track
          =<< filterM (fmap Events.null . Ui.get_events) track_ids
  
  remove_all_empty :: Cmd.CmdL ()
  remove_all_empty = mapM_ remove_empty =<< Ui.all_block_ids
  
  map_widths :: (Text -> Bool) -> (Types.Width -> Types.Width) -> Cmd.CmdL ()
  map_widths wanted f = do
      block_ids <- Ui.all_block_ids
      forM_ block_ids $ \block_id -> do
          tracknums <- map Ui.track_tracknum
              . filter (wanted . Ui.track_title) <$>
                  TrackTree.tracks_of block_id
          widths <- map Block.track_width <$>
              mapM (Ui.get_block_track_at block_id) tracknums
          zipWithM_ (Ui.set_track_width block_id)
              tracknums (map f widths)
  
  -- | Transform all track titles.
  map_titles :: (Text -> Text) -> Cmd.CmdL ()
  map_titles f = do
      tids <- Ui.all_track_ids
      mapM_ (flip Ui.modify_track_title f) tids
  
  rename_instruments :: [(Text, Text)] -> Cmd.CmdL ()
  rename_instruments renames = map_titles $ \t -> fromMaybe t $ lookup t renames
  
  replace :: Text -> Text -> Cmd.CmdL ()
  replace from to = map_titles $ Text.replace from to
  
  -- | Find all tracks with the given string in their title.  You can use
  -- 'Ui.blocks_with_track_id' to find the blocks with the tracks, and
  -- 'map_titles' or 'replace' to change the titles.
  find :: Cmd.M m => Text -> m [(TrackId, Text)]
  find search = find_f (search `Text.isInfixOf`)
  
  find_f :: Cmd.M m => (Text -> Bool) -> m [(TrackId, Text)]
  find_f matches = do
      tids <- Ui.all_track_ids
      titles <- mapM Ui.get_track_title tids
      return [(tid, title) | (tid, title) <- zip tids titles, matches title]
  
  -- * manipulation
  
  -- | Duplicate a track from one block to another.  The underlying track is
  -- the same, so edits in one of its occurrances will be reflected in all of its
  -- blocks.
  duplicate :: Ui.M m => BlockId -> TrackNum -> BlockId -> TrackNum -> m ()
  duplicate source_block source_tracknum dest_block dest_tracknum = do
      track <- Ui.get_block_track_at source_block source_tracknum
      Ui.insert_track dest_block dest_tracknum track
  
  -- * events
  
  events :: Ui.M m => TrackId -> m [Event.Event]
  events = fmap Events.ascending . Ui.get_events
  
  selected :: Cmd.M m => m [Event.Event]
  selected = do
      (_, _, track_ids, range) <- Selection.tracks
      track_id <- Cmd.require "selected track" (Lists.head track_ids)
      Events.ascending . Events.in_range range <$> Ui.get_events track_id
  
  events_range :: TrackId -> ScoreTime -> ScoreTime -> Cmd.CmdL [Event.Event]
  events_range track_id start end =
      Events.ascending . Events.in_range (Events.Range start end) <$>
          Ui.get_events track_id
  
  selected_notation :: Cmd.M m => TrackTime -> m Text
  selected_notation step = do
      events <- selected
      (start, end) <- Events.range_times <$> Selection.range
      return $ to_notation start step end events
  
  -- | Reduce event text to notation at a fixed time increment.  It only works
  -- out if each event only has a single letter.
  to_notation :: TrackTime -> TrackTime -> TrackTime -> [Event.Event] -> Text
  to_notation start step end = mconcat . go (Lists.range' start end step)
      where
      go _ [] = []
      go [] ts = replicate (length ts) " "
      go (t:ts) (e:es)
          | Event.start e > t = " " : go ts (e:es)
          | Event.start e == t = Event.text e : go ts es
          | otherwise = " " : go (t:ts) es
  
  -- | 4 measures per line, 16 time steps per measure.
  format_measures :: String -> [String]
  format_measures =
      map (List.intercalate "|") . Lists.chunked 4 . Lists.chunked 16
  
  
  -- * strip controls
  
  drop_dups :: Cmd.CmdL ()
  drop_dups = ModifyEvents.selection $ ModifyEvents.events $
      return . Lists.dropDups Event.text
  
  -- * waveform
  
  waveform :: Cmd.CmdT IO ()
  waveform = do
      mapM_ toggle_waveform =<< Selection.track_ids
      -- Invalidate to force it to add or remove waveforms.  It's a big hammer
      -- but it works and it should be uncommon to toggle this.
      Cmd.invalidate_performances
  
  toggle_waveform :: TrackId -> Cmd.CmdT IO ()
  toggle_waveform track_id = Ui.modify_waveform track_id not
  
  
  -- * signal render
  
  filled :: Cmd.CmdL ()
  filled = mapM_ (Ui.set_render_style (Track.Filled Nothing))
      =<< Selection.track_ids
  
  line :: Cmd.CmdL ()
  line = mapM_ (Ui.set_render_style (Track.Line Nothing))
      =<< Selection.track_ids
  
  note_pitch :: Cmd.CmdL ()
  note_pitch = nline "#"
  
  -- | Pass \"#\" for the pitch track.
  nline :: Text -> Cmd.CmdL ()
  nline = note_render Track.Line
  
  nfilled :: Text -> Cmd.CmdL ()
  nfilled = note_render Track.Filled
  
  note_render :: Cmd.M m => (Maybe Track.RenderSource -> Track.RenderStyle)
      -> Text -- ^ Either a control name, or a #-prefixed pitch name.
      -> m ()
  note_render mode control_name = do
      control <- Cmd.require_right id $ ScoreT.parse_generic_control control_name
      track_ids <- Selection.track_ids
      track_ids <- filterM is_note track_ids
      mapM_ (Ui.set_render_style
          (mode (Just (either Track.Control Track.Pitch control)))) track_ids
      where
      is_note = fmap ParseTitle.is_note_track . Ui.get_track_title
  
  no_render :: Cmd.CmdL ()
  no_render = mapM_ (Ui.set_render_style Track.NoRender) =<< Selection.track_ids
  