module Vgrep.Widget.HorizontalSplit (
hSplitWidget
, HSplitWidget
, HSplit ()
, Focus (..)
, leftOnly
, rightOnly
, splitView
, switchFocus
, leftWidget
, rightWidget
, currentWidget
, leftWidgetFocused
, rightWidgetFocused
) where
import Control.Applicative (liftA2)
import Control.Lens.Compat
import Graphics.Vty.Image
import Vgrep.Environment
import Vgrep.Event
import Vgrep.Type
import Vgrep.Widget.HorizontalSplit.Internal
import Vgrep.Widget.Type
type HSplitWidget s t = Widget (HSplit s t)
hSplitWidget
:: Widget s
-> Widget t
-> HSplitWidget s t
hSplitWidget :: Widget s -> Widget t -> HSplitWidget s t
hSplitWidget Widget s
left Widget t
right = Widget :: forall s.
s
-> (forall (m :: * -> *). Monad m => VgrepT s m Image) -> Widget s
Widget
{ initialize :: HSplit s t
initialize = Widget s -> Widget t -> HSplit s t
forall s t. Widget s -> Widget t -> HSplit s t
initHSplit Widget s
left Widget t
right
, draw :: forall (m :: * -> *). Monad m => VgrepT (HSplit s t) m Image
draw = Widget s -> Widget t -> VgrepT (HSplit s t) m Image
forall (m :: * -> *) s t.
Monad m =>
Widget s -> Widget t -> VgrepT (HSplit s t) m Image
drawWidgets Widget s
left Widget t
right }
initHSplit :: Widget s -> Widget t -> HSplit s t
initHSplit :: Widget s -> Widget t -> HSplit s t
initHSplit Widget s
left Widget t
right = HSplit :: forall s t. s -> t -> Layout -> HSplit s t
HSplit
{ _leftWidget :: s
_leftWidget = Widget s -> s
forall s. Widget s -> s
initialize Widget s
left
, _rightWidget :: t
_rightWidget = Widget t -> t
forall s. Widget s -> s
initialize Widget t
right
, _layout :: Layout
_layout = Layout
LeftOnly }
leftOnly :: Monad m => VgrepT (HSplit s t) m Redraw
leftOnly :: VgrepT (HSplit s t) m Redraw
leftOnly = Getting Layout (HSplit s t) Layout -> VgrepT (HSplit s t) m Layout
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Layout (HSplit s t) Layout
forall s t. Lens' (HSplit s t) Layout
layout VgrepT (HSplit s t) m Layout
-> (Layout -> VgrepT (HSplit s t) m Redraw)
-> VgrepT (HSplit s t) m Redraw
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Layout
LeftOnly -> Redraw -> VgrepT (HSplit s t) m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Unchanged
Layout
_other -> ASetter (HSplit s t) (HSplit s t) Layout Layout
-> Layout -> VgrepT (HSplit s t) m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter (HSplit s t) (HSplit s t) Layout Layout
forall s t. Lens' (HSplit s t) Layout
layout Layout
LeftOnly VgrepT (HSplit s t) m ()
-> VgrepT (HSplit s t) m Redraw -> VgrepT (HSplit s t) m Redraw
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Redraw -> VgrepT (HSplit s t) m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Redraw
rightOnly :: Monad m => VgrepT (HSplit s t) m Redraw
rightOnly :: VgrepT (HSplit s t) m Redraw
rightOnly = Getting Layout (HSplit s t) Layout -> VgrepT (HSplit s t) m Layout
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Layout (HSplit s t) Layout
forall s t. Lens' (HSplit s t) Layout
layout VgrepT (HSplit s t) m Layout
-> (Layout -> VgrepT (HSplit s t) m Redraw)
-> VgrepT (HSplit s t) m Redraw
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Layout
RightOnly -> Redraw -> VgrepT (HSplit s t) m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Unchanged
Layout
_other -> ASetter (HSplit s t) (HSplit s t) Layout Layout
-> Layout -> VgrepT (HSplit s t) m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter (HSplit s t) (HSplit s t) Layout Layout
forall s t. Lens' (HSplit s t) Layout
layout Layout
RightOnly VgrepT (HSplit s t) m ()
-> VgrepT (HSplit s t) m Redraw -> VgrepT (HSplit s t) m Redraw
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Redraw -> VgrepT (HSplit s t) m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Redraw
splitView
:: Monad m
=> Focus
-> Rational
-> VgrepT (HSplit s t) m Redraw
splitView :: Focus -> Rational -> VgrepT (HSplit s t) m Redraw
splitView Focus
focus Rational
ratio = ASetter (HSplit s t) (HSplit s t) Layout Layout
-> Layout -> VgrepT (HSplit s t) m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter (HSplit s t) (HSplit s t) Layout Layout
forall s t. Lens' (HSplit s t) Layout
layout (Focus -> Rational -> Layout
Split Focus
focus Rational
ratio) VgrepT (HSplit s t) m ()
-> VgrepT (HSplit s t) m Redraw -> VgrepT (HSplit s t) m Redraw
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Redraw -> VgrepT (HSplit s t) m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Redraw
switchFocus :: Monad m => VgrepT (HSplit s t) m Redraw
switchFocus :: VgrepT (HSplit s t) m Redraw
switchFocus = Getting Layout (HSplit s t) Layout -> VgrepT (HSplit s t) m Layout
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Layout (HSplit s t) Layout
forall s t. Lens' (HSplit s t) Layout
layout VgrepT (HSplit s t) m Layout
-> (Layout -> VgrepT (HSplit s t) m Redraw)
-> VgrepT (HSplit s t) m Redraw
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Split Focus
focus Rational
ratio -> ASetter (HSplit s t) (HSplit s t) Layout Layout
-> Layout -> VgrepT (HSplit s t) m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter (HSplit s t) (HSplit s t) Layout Layout
forall s t. Lens' (HSplit s t) Layout
layout (Focus -> Rational -> Layout
switch Focus
focus Rational
ratio) VgrepT (HSplit s t) m ()
-> VgrepT (HSplit s t) m Redraw -> VgrepT (HSplit s t) m Redraw
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Redraw -> VgrepT (HSplit s t) m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Redraw
Layout
_otherwise -> Redraw -> VgrepT (HSplit s t) m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Unchanged
where
switch :: Focus -> Rational -> Layout
switch Focus
FocusLeft Rational
ratio = Focus -> Rational -> Layout
Split Focus
FocusRight (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
ratio)
switch Focus
FocusRight Rational
ratio = Focus -> Rational -> Layout
Split Focus
FocusLeft (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
ratio)
drawWidgets
:: Monad m
=> Widget s
-> Widget t
-> VgrepT (HSplit s t) m Image
drawWidgets :: Widget s -> Widget t -> VgrepT (HSplit s t) m Image
drawWidgets Widget s
left Widget t
right = Getting Layout (HSplit s t) Layout -> VgrepT (HSplit s t) m Layout
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Layout (HSplit s t) Layout
forall s t. Lens' (HSplit s t) Layout
layout VgrepT (HSplit s t) m Layout
-> (Layout -> VgrepT (HSplit s t) m Image)
-> VgrepT (HSplit s t) m Image
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Layout
LeftOnly -> LensLike' (Zoomed (VgrepT s m) Image) (HSplit s t) s
-> VgrepT s m Image -> VgrepT (HSplit s t) m Image
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (VgrepT s m) Image) (HSplit s t) s
forall s t s2. Lens (HSplit s t) (HSplit s2 t) s s2
leftWidget (Widget s -> forall (m :: * -> *). Monad m => VgrepT s m Image
forall s.
Widget s -> forall (m :: * -> *). Monad m => VgrepT s m Image
draw Widget s
left)
Layout
RightOnly -> LensLike' (Zoomed (VgrepT t m) Image) (HSplit s t) t
-> VgrepT t m Image -> VgrepT (HSplit s t) m Image
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (VgrepT t m) Image) (HSplit s t) t
forall s t t2. Lens (HSplit s t) (HSplit s t2) t t2
rightWidget (Widget t -> forall (m :: * -> *). Monad m => VgrepT t m Image
forall s.
Widget s -> forall (m :: * -> *). Monad m => VgrepT s m Image
draw Widget t
right)
Split Focus
_ Rational
ratio -> (Image -> Image -> Image)
-> VgrepT (HSplit s t) m Image
-> VgrepT (HSplit s t) m Image
-> VgrepT (HSplit s t) m Image
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Image -> Image -> Image
(<|>)
(Rational -> VgrepT s m Image -> VgrepT (HSplit s t) m Image
forall (m :: * -> *) s t.
Monad m =>
Rational -> VgrepT s m Image -> VgrepT (HSplit s t) m Image
runInLeftWidget Rational
ratio (Widget s -> forall (m :: * -> *). Monad m => VgrepT s m Image
forall s.
Widget s -> forall (m :: * -> *). Monad m => VgrepT s m Image
draw Widget s
left))
(Rational -> VgrepT t m Image -> VgrepT (HSplit s t) m Image
forall (m :: * -> *) t s.
Monad m =>
Rational -> VgrepT t m Image -> VgrepT (HSplit s t) m Image
runInRightWidget Rational
ratio (Widget t -> forall (m :: * -> *). Monad m => VgrepT t m Image
forall s.
Widget s -> forall (m :: * -> *). Monad m => VgrepT s m Image
draw Widget t
right))
runInLeftWidget
:: Monad m
=> Rational
-> VgrepT s m Image
-> VgrepT (HSplit s t) m Image
runInLeftWidget :: Rational -> VgrepT s m Image -> VgrepT (HSplit s t) m Image
runInLeftWidget Rational
ratio VgrepT s m Image
action =
let leftRegion :: Environment -> Environment
leftRegion = ASetter Environment Environment Int Int
-> (Int -> Int) -> Environment -> Environment
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Environment Environment Int Int
Lens' Environment Int
viewportWidth ((Int -> Int) -> Environment -> Environment)
-> (Int -> Int) -> Environment -> Environment
forall a b. (a -> b) -> a -> b
$ \Int
w ->
Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Rational
ratio Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)
in LensLike' (Zoomed (VgrepT s m) Image) (HSplit s t) s
-> VgrepT s m Image -> VgrepT (HSplit s t) m Image
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (VgrepT s m) Image) (HSplit s t) s
forall s t s2. Lens (HSplit s t) (HSplit s2 t) s s2
leftWidget ((Environment -> Environment)
-> VgrepT s m Image -> VgrepT s m Image
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Environment -> Environment
leftRegion VgrepT s m Image
action)
runInRightWidget
:: Monad m
=> Rational
-> VgrepT t m Image
-> VgrepT (HSplit s t) m Image
runInRightWidget :: Rational -> VgrepT t m Image -> VgrepT (HSplit s t) m Image
runInRightWidget Rational
ratio VgrepT t m Image
action =
let rightRegion :: Environment -> Environment
rightRegion = ASetter Environment Environment Int Int
-> (Int -> Int) -> Environment -> Environment
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Environment Environment Int Int
Lens' Environment Int
viewportWidth ((Int -> Int) -> Environment -> Environment)
-> (Int -> Int) -> Environment -> Environment
forall a b. (a -> b) -> a -> b
$ \Int
w ->
Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Rational
1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
ratio) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)
in LensLike' (Zoomed (VgrepT t m) Image) (HSplit s t) t
-> VgrepT t m Image -> VgrepT (HSplit s t) m Image
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (VgrepT t m) Image) (HSplit s t) t
forall s t t2. Lens (HSplit s t) (HSplit s t2) t t2
rightWidget ((Environment -> Environment)
-> VgrepT t m Image -> VgrepT t m Image
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Environment -> Environment
rightRegion VgrepT t m Image
action)