-- 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 Cmd.Repl.LView where
import qualified Data.List as List
import qualified Data.Map as Map

import qualified Util.Pretty as Pretty
import qualified Util.Rect as Rect
import qualified Util.Lists as Lists

import qualified Cmd.Cmd as Cmd
import qualified Cmd.Create as Create
import qualified Cmd.NoteTrackParse as NoteTrackParse
import qualified Cmd.ViewConfig as ViewConfig
import qualified Cmd.Views as Views

import qualified Ui.Block as Block
import qualified Ui.Ui as Ui
import qualified Ui.UiConfig as UiConfig
import qualified Ui.Zoom as Zoom

import           Global
import           Types


list :: Cmd.CmdL [ViewId]
list :: CmdL [ViewId]
list = forall (m :: * -> *). M m => m [ViewId]
Ui.all_view_ids

-- * create

create :: BlockId -> Cmd.CmdL ViewId
create :: BlockId -> CmdL ViewId
create = forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view

-- | Create a view from a BlockId inferred like a block call would, from the
-- selected block.
create_infer :: Text -> Cmd.CmdL ViewId
create_infer :: Text -> CmdL ViewId
create_infer Text
name = do
    Map BlockId Block
blocks <- forall (m :: * -> *) a. M m => (State -> a) -> m a
Ui.gets State -> Map BlockId Block
Ui.state_blocks
    Namespace
ns <- forall (m :: * -> *). M m => m Namespace
Ui.get_namespace
    Maybe BlockId
caller <- forall (m :: * -> *). M m => m (Maybe BlockId)
Cmd.lookup_focused_block
    case forall a.
Map BlockId a
-> Namespace -> Maybe BlockId -> Text -> Maybe BlockId
NoteTrackParse.to_block_id Map BlockId Block
blocks Namespace
ns Maybe BlockId
caller Text
name of
        Just BlockId
block_id -> forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view BlockId
block_id
        Maybe BlockId
Nothing -> forall (m :: * -> *) a. (Stack, M m) => Text -> m a
Cmd.throw Text
"blah"

-- | For the current window, open enough views at the current zoom to see the
-- score from the current time until the end of the block.
cover :: Cmd.M m => m [ViewId]
cover :: forall (m :: * -> *). M m => m [ViewId]
cover = forall (m :: * -> *). M m => ViewId -> m [ViewId]
ViewConfig.views_covering forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m ViewId
Cmd.get_focused_view

-- * arrange

-- | Crunch all the views up against each other.
arrange :: Cmd.CmdL ()
arrange :: CmdL ()
arrange = do
    [Rect]
screens <- forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets State -> [Rect]
Cmd.state_screens
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int, Int) -> CmdL ()
arrange_screen [(Rect -> Int
Rect.x Rect
r, Rect -> Int
Rect.y Rect
r) | Rect
r <- [Rect]
screens]

arrange_screen :: (Int, Int) -> Cmd.CmdL ()
arrange_screen :: (Int, Int) -> CmdL ()
arrange_screen (Int, Int)
point = do
    Rect
screen <- forall (m :: * -> *). M m => Maybe (Int, Int) -> m Rect
Cmd.get_screen forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int, Int)
point
    [(ViewId, Rect)]
view_rects <- forall a. (a -> Bool) -> [a] -> [a]
filter (Rect -> Rect -> Bool
Rect.overlaps Rect
screen 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 a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second View -> Rect
Block.view_rect) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Map ViewId View
Ui.state_views
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => m State
Ui.get
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *). M m => ViewId -> Rect -> m ()
Ui.set_view_rect) forall a b. (a -> b) -> a -> b
$
        forall a. Rect -> [(a, Rect)] -> [(a, Rect)]
compact Rect
screen (forall k a. Ord k => (a -> k) -> [a] -> [a]
Lists.sortOn forall a b. (a, b) -> b
snd [(ViewId, Rect)]
view_rects)

compact :: Rect.Rect -> [(a, Rect.Rect)] -> [(a, Rect.Rect)]
compact :: forall a. Rect -> [(a, Rect)] -> [(a, Rect)]
compact Rect
screen =
    forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL forall {a}.
(Int, Int, Int) -> (a, Rect) -> ((Int, Int, Int), (a, Rect))
go (Rect -> Int
Rect.x Rect
screen, Rect -> Int
Rect.y Rect
screen, Rect -> Int
Rect.h Rect
screen)
    where
    go :: (Int, Int, Int) -> (a, Rect) -> ((Int, Int, Int), (a, Rect))
go (Int
x, Int
y, Int
min_h) (a
view_id, Rect
rect) = ((Int, Int, Int)
next, (a
view_id, Int -> Int -> Rect -> Rect
Rect.place Int
x Int
y Rect
rect))
        where
        next :: (Int, Int, Int)
next
            | Int
x forall a. Num a => a -> a -> a
+ Rect -> Int
Rect.w Rect
rect forall a. Ord a => a -> a -> Bool
< Rect -> Int
Rect.r Rect
screen =
                (Int
x forall a. Num a => a -> a -> a
+ Rect -> Int
Rect.w Rect
rect, Int
y, forall a. Ord a => a -> a -> a
min Int
min_h (Rect -> Int
Rect.h Rect
rect))
            | Bool
otherwise = (Rect -> Int
Rect.x Rect
screen, Int
y forall a. Num a => a -> a -> a
+ Int
min_h, Rect -> Int
Rect.h Rect
screen)

-- * save and load

-- | Show the list of saved views, with a star on the focused one.
saved :: Cmd.CmdL Text
saved :: CmdL Text
saved = do
    SavedViews
saved <- Lens State Config
Ui.configforall a b c. Lens a b -> Lens b c -> Lens a c
#Config :-> SavedViews
UiConfig.saved_views forall (f :: * -> *) a b. Functor f => Lens a b -> f a -> f b
<#> forall (m :: * -> *). M m => m State
Ui.get
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Text
Pretty.formatted forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall {a} {a}. (Eq a, Show a) => (Map a a, Maybe a) -> [Doc]
pretty SavedViews
saved
    where
    pretty :: (Map a a, Maybe a) -> [Doc]
pretty (Map a a
views, Maybe a
focused) =
        forall a b. (a -> b) -> [a] -> [b]
map (\a
view_id -> Text -> Doc
Pretty.text forall a b. (a -> b) -> a -> b
$
                (if forall a. a -> Maybe a
Just a
view_id forall a. Eq a => a -> a -> Bool
== Maybe a
focused then Text
"*" else Text
"") forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt a
view_id)
            (forall k a. Map k a -> [k]
Map.keys Map a a
views)

-- | Save the current view layout.
save :: Text -> Cmd.CmdL ()
save :: Text -> CmdL ()
save = forall (m :: * -> *). M m => Text -> m ()
ViewConfig.save_views

load :: Text -> Cmd.CmdL ()
load :: Text -> CmdL ()
load = forall (m :: * -> *). M m => Text -> m ()
ViewConfig.restore_views

remove :: Ui.M m => Text -> m ()
remove :: forall (m :: * -> *). M m => Text -> m ()
remove = forall (m :: * -> *). M m => Text -> m ()
ViewConfig.remove_views

prev :: Cmd.CmdL ()
prev :: CmdL ()
prev = Text -> CmdL ()
load Text
"prev"

-- * zoom

-- | Copy the zoom factor from the given view to the selected one.  This is
-- useful when lining up parts.
zoom_from :: Cmd.M m => ViewId -> m ()
zoom_from :: forall (m :: * -> *). M m => ViewId -> m ()
zoom_from ViewId
from = do
    Double
from_factor <- Zoom -> Double
Zoom.factor forall b c a. (b -> c) -> (a -> b) -> a -> c
. View -> Zoom
Block.view_zoom forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => ViewId -> m View
Ui.get_view ViewId
from
    ViewId
to <- forall (m :: * -> *). M m => m ViewId
Cmd.get_focused_view
    forall (m :: * -> *). M m => ViewId -> (Zoom -> Zoom) -> m ()
Views.modify_zoom ViewId
to (\Zoom
z -> Zoom
z { factor :: Double
Zoom.factor = Double
from_factor })