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

-- | Lower level 'Block.View' utilities.  Specifically, this has support for
-- "Cmd.ViewConfig" and "Cmd.Create", so they don't have to import each other.
module Cmd.Views where
import qualified Util.Num as Num
import qualified Util.Rect as Rect
import qualified App.Config as Config
import qualified Cmd.Cmd as Cmd
import qualified Ui.Block as Block
import qualified Ui.ScoreTime as ScoreTime
import qualified Ui.Ui as Ui
import qualified Ui.Zoom as Zoom

import           Global
import           Types


maximize_and_zoom :: Cmd.M m => ViewId -> m ()
maximize_and_zoom :: forall (m :: * -> *). M m => ViewId -> m ()
maximize_and_zoom ViewId
view_id = do
    forall (m :: * -> *). M m => Bool -> ViewId -> m ()
resize_to_fit Bool
True ViewId
view_id
    forall (m :: * -> *). M m => ViewId -> m ()
zoom_to_ruler ViewId
view_id

-- * zoom

-- | Set zoom on the given view to make the entire block visible.
zoom_to_ruler :: Cmd.M m => ViewId -> m ()
zoom_to_ruler :: forall (m :: * -> *). M m => ViewId -> m ()
zoom_to_ruler ViewId
view_id = do
    TrackTime
block_end <- forall (m :: * -> *). M m => ViewId -> m TrackTime
block_end ViewId
view_id
    Double
factor <- forall (m :: * -> *). M m => ViewId -> TrackTime -> m Double
zoom_factor ViewId
view_id TrackTime
block_end
    forall (m :: * -> *). M m => ViewId -> Zoom -> m ()
set_zoom ViewId
view_id forall a b. (a -> b) -> a -> b
$ Zoom.Zoom { offset :: TrackTime
offset = TrackTime
0, factor :: Double
factor = Double
factor }

-- | Figure out the zoom factor to display the given amount of TrackTime.
zoom_factor :: Ui.M m => ViewId -> TrackTime -> m Double
zoom_factor :: forall (m :: * -> *). M m => ViewId -> TrackTime -> m Double
zoom_factor ViewId
view_id TrackTime
dur
    | TrackTime
dur forall a. Eq a => a -> a -> Bool
== TrackTime
0 = forall (m :: * -> *) a. Monad m => a -> m a
return Double
1
    | Bool
otherwise = do
        View
view <- forall (m :: * -> *). M m => ViewId -> m View
Ui.get_view ViewId
view_id
        let pixels :: Int
pixels = View -> Int
Block.view_visible_time View
view
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pixels forall a. Fractional a => a -> a -> a
/ TrackTime -> Double
ScoreTime.to_double TrackTime
dur

set_zoom :: Cmd.M m => ViewId -> Zoom.Zoom -> m ()
set_zoom :: forall (m :: * -> *). M m => ViewId -> Zoom -> m ()
set_zoom ViewId
view_id = forall (m :: * -> *). M m => ViewId -> (Zoom -> Zoom) -> m ()
modify_zoom ViewId
view_id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

-- | Set time scroll, clipping so it doesn't scroll past 'Block.block_end'.
set_time_offset :: Cmd.M m => ViewId -> TrackTime -> m ()
set_time_offset :: forall (m :: * -> *). M m => ViewId -> TrackTime -> m ()
set_time_offset ViewId
view_id TrackTime
offset = do
    View
view <- forall (m :: * -> *). M m => ViewId -> m View
Ui.get_view ViewId
view_id
    let visible :: TrackTime
visible = View -> TrackTime
Block.visible_time View
view
    TrackTime
end <- forall (m :: * -> *). M m => BlockId -> m TrackTime
Ui.block_end forall a b. (a -> b) -> a -> b
$ View -> BlockId
Block.view_block View
view
    forall (m :: * -> *). M m => ViewId -> (Zoom -> Zoom) -> m ()
modify_zoom ViewId
view_id forall a b. (a -> b) -> a -> b
$ \Zoom
zoom -> Zoom
zoom
        { offset :: TrackTime
Zoom.offset = forall a. Ord a => a -> a -> a -> a
Num.clamp TrackTime
0 (TrackTime
end forall a. Num a => a -> a -> a
- TrackTime
visible) TrackTime
offset }

modify_zoom :: Cmd.M m => ViewId -> (Zoom.Zoom -> Zoom.Zoom) -> m ()
modify_zoom :: forall (m :: * -> *). M m => ViewId -> (Zoom -> Zoom) -> m ()
modify_zoom ViewId
view_id Zoom -> Zoom
modify = do
    forall (m :: * -> *). M m => ViewId -> (Zoom -> Zoom) -> m ()
Ui.modify_zoom ViewId
view_id Zoom -> Zoom
modify
    -- it's a no-op and Internal adds many deps
    -- Internal.sync_zoom_status view_id

-- * size

-- | Resize a window to fit its tracks.
resize_to_fit :: Cmd.M m => Bool -- ^ maximize the window vertically
    -> ViewId -> m ()
resize_to_fit :: forall (m :: * -> *). M m => Bool -> ViewId -> m ()
resize_to_fit Bool
maximize ViewId
view_id = do
    View
view <- forall (m :: * -> *). M m => ViewId -> m View
Ui.get_view ViewId
view_id
    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 (Rect -> (Int, Int)
Rect.upper_left (View -> Rect
Block.view_rect View
view))
    Rect
rect <- forall (m :: * -> *). M m => View -> m Rect
contents_rect View
view
    forall (m :: * -> *). M m => ViewId -> Rect -> m ()
Ui.set_view_rect ViewId
view_id forall a b. (a -> b) -> a -> b
$ Rect -> Rect -> Rect
Rect.intersection Rect
screen forall a b. (a -> b) -> a -> b
$ Rect -> Rect -> Rect
scootch Rect
screen forall a b. (a -> b) -> a -> b
$
        if Bool
maximize then Rect -> Rect -> Rect
max_height Rect
screen Rect
rect else Rect
rect
    where
    -- Move the rect over so it fits on the screen.
    scootch :: Rect -> Rect -> Rect
scootch Rect
screen Rect
r = Int -> Int -> Rect -> Rect
Rect.place
        (forall a. Ord a => a -> a -> a -> a
Num.clamp (Rect -> Int
Rect.x Rect
screen) (Rect -> Int
Rect.r Rect
screen forall a. Num a => a -> a -> a
- Rect -> Int
Rect.w Rect
r) (Rect -> Int
Rect.x Rect
r))
        (forall a. Ord a => a -> a -> a -> a
Num.clamp (Rect -> Int
Rect.y Rect
screen) (Rect -> Int
Rect.b Rect
screen forall a. Num a => a -> a -> a
- Rect -> Int
Rect.h Rect
r) (Rect -> Int
Rect.y Rect
r))
        Rect
r
    max_height :: Rect -> Rect -> Rect
max_height Rect
screen Rect
r = Int -> Int -> Int -> Int -> Rect
Rect.xywh
        (Rect -> Int
Rect.x Rect
r) (Rect -> Int
Rect.y Rect
screen)
        (Rect -> Int
Rect.w Rect
r) (Rect -> Int
Rect.h Rect
screen forall a. Num a => a -> a -> a
- Int
Config.window_decoration_h)

-- | Get the View's Rect, resized to fit its contents at its current zoom.  Its
-- position is unchanged.
contents_rect :: Ui.M m => Block.View -> m Rect.Rect
contents_rect :: forall (m :: * -> *). M m => View -> m Rect
contents_rect View
view = do
    TrackTime
block_end <- forall (m :: * -> *). M m => BlockId -> m TrackTime
Ui.block_end (View -> BlockId
Block.view_block View
view)
    Block
block <- forall (m :: * -> *). M m => BlockId -> m Block
Ui.get_block (View -> BlockId
Block.view_block View
view)
    let (Int
x, Int
y) = Rect -> (Int, Int)
Rect.upper_left (View -> Rect
Block.track_rect View
view)
        w :: Int
w = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Track -> Int
Block.display_track_width (Block -> [Track]
Block.block_tracks Block
block)
        h :: Int
h = Zoom -> TrackTime -> Int
Zoom.to_pixels (View -> Zoom
Block.view_zoom View
view) TrackTime
block_end
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ View -> Rect -> Rect
Block.set_track_rect View
view forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Rect
Rect.xywh Int
x Int
y (forall a. Ord a => a -> a -> a
max Int
w Int
40) (forall a. Ord a => a -> a -> a
max Int
h Int
40)

set_track_rect :: Ui.M m => ViewId -> Rect.Rect -> m ()
set_track_rect :: forall (m :: * -> *). M m => ViewId -> Rect -> m ()
set_track_rect ViewId
view_id Rect
rect = do
    View
view <- forall (m :: * -> *). M m => ViewId -> m View
Ui.get_view ViewId
view_id
    forall (m :: * -> *). M m => ViewId -> Rect -> m ()
Ui.set_view_rect ViewId
view_id forall a b. (a -> b) -> a -> b
$ View -> Rect -> Rect
Block.set_track_rect View
view Rect
rect

-- * util

block_end :: Ui.M m => ViewId -> m TrackTime
block_end :: forall (m :: * -> *). M m => ViewId -> m TrackTime
block_end = forall (m :: * -> *). M m => BlockId -> m TrackTime
Ui.block_end forall b c a. (b -> c) -> (a -> b) -> a -> c
. View -> BlockId
Block.view_block forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *). M m => ViewId -> m View
Ui.get_view