slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ui: mouse scrolls accounts, register screens

Browse Source
This commit is contained in:
Simon Michael 2021-11-17 18:23:50 -10:00
parent 96a80fca70
commit 6d69ea9c29
2 changed files with 47 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -2,6 +2,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
module Hledger.UI.AccountsScreen
(accountsScreen
@ -12,7 +13,7 @@ where
import Brick
import Brick.Widgets.List
(handleListEvent, list, listElementsL, listMoveDown, listMoveTo, listNameL, listSelectedElement, listSelectedL, renderList, listElements)
(handleListEvent, list, listElementsL, listMoveDown, listMoveTo, listNameL, listSelectedElement, listSelectedL, renderList, listElements, listSelected, listMoveUp)
import Brick.Widgets.Edit
import Control.Monad
import Control.Monad.IO.Class (liftIO)
@ -21,7 +22,7 @@ import Data.Maybe
import qualified Data.Text as T
import Data.Time.Calendar (Day)
import qualified Data.Vector as V
import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft))
import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft, BScrollDown, BScrollUp))
import Lens.Micro.Platform
import Safe
import System.Console.ANSI
@ -331,10 +332,39 @@ asHandle ui0@UIState{
-- prevent moving down over blank padding items;
-- instead scroll down by one, until maximally scrolled - shows the end has been reached
VtyEvent (EvKey (KDown) []) | isBlankElement mnextelement -> do
vScrollBy (viewportScroll $ _asList^.listNameL) 1
continue ui
where
mnextelement = listSelectedElement $ listMoveDown _asList
vScrollBy (viewportScroll $ _asList^.listNameL) 1 >> continue ui
where mnextelement = listSelectedElement $ listMoveDown _asList
-- mouse scroll wheel scrolls the viewport up or down to its maximum extent.
-- The selection will be moved when necessary to keep it visible and allow the scroll.
MouseDown name BScrollDown _mods _loc -> do
mvp <- lookupViewport name
let mselidx = listSelected _asList
case (mvp, mselidx) of
(Just VP{_vpTop}, Just selidx) -> do
let
listheight = asListSize _asList
pushsel | selidx <= _vpTop && selidx < (listheight-1) = listMoveDown
| otherwise = id
ui' = ui{aScreen=scr{_asList=pushsel _asList}}
viewportScroll name `vScrollBy` 1
continue ui'
_ -> continue ui
MouseDown name BScrollUp _mods _loc -> do
mvp <- lookupViewport name
let mselidx = listSelected _asList
case (mvp, mselidx) of
(Just VP{_vpTop, _vpSize=(_,vpheight)}, Just selidx) -> do
let
pushsel | selidx >= _vpTop + vpheight - 1 && selidx > 0 = listMoveUp
| otherwise = id
ui' = ui{aScreen=scr{_asList=pushsel _asList}}
viewportScroll name `vScrollBy` (-1)
continue ui'
_ -> continue ui
-- if page down or end leads to a blank padding item, stop at last non-blank
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do
@ -382,3 +412,5 @@ isBlankElement mel = ((asItemAccountName . snd) <$> mel) == Just ""
asCenterAndContinue ui = do
scrollSelectionToMiddle $ _asList $ aScreen ui
continue ui
asListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements

16
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -19,7 +19,7 @@ import Data.Maybe
import qualified Data.Text as T
import Data.Time.Calendar
import qualified Data.Vector as V
import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft))
import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft, BScrollDown, BScrollUp))
import Brick
import Brick.Widgets.List
(handleListEvent, list, listElementsL, listMoveDown, listMoveTo, listNameL, listSelectedElement, listSelectedL, renderList, listElements)
@ -367,13 +367,15 @@ rsHandle ui@UIState{
where
clickeddate = maybe "" rsItemDate $ listElements rsList !? y
-- prevent moving down over blank padding items;
-- instead scroll down by one, until maximally scrolled - shows the end has been reached
-- when at the last item, instead of moving down, scroll down by one, until maximally scrolled
VtyEvent e | e `elem` moveDownEvents, isBlankElement mnextelement -> do
vScrollBy (viewportScroll $ rsList^.listNameL) 1
continue ui
where
mnextelement = listSelectedElement $ listMoveDown rsList
vScrollBy (viewportScroll $ rsList ^. listNameL) 1 >> continue ui
where mnextelement = listSelectedElement $ listMoveDown rsList
-- mouse scroll wheel scrolls the viewport up or down to its maximum extent,
-- TODO moving the selection when necessary to allow the scroll.
MouseDown _n BScrollDown _mods _loc -> vScrollBy (viewportScroll $ rsList ^. listNameL) 1 >> continue ui
MouseDown _n BScrollUp _mods _loc -> vScrollBy (viewportScroll $ rsList ^. listNameL) (-1) >> continue ui
-- if page down or end leads to a blank padding item, stop at last non-blank
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do