don't scroll past top of page
This commit is contained in:
parent
a91ed5afb3
commit
363d0cb2d3
|
@ -38,6 +38,8 @@ module Mtlstats.Actions
|
||||||
, resetGoalData
|
, resetGoalData
|
||||||
, assignPMins
|
, assignPMins
|
||||||
, backHome
|
, backHome
|
||||||
|
, scrollUp
|
||||||
|
, scrollDown
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Trans.State (modify)
|
import Control.Monad.Trans.State (modify)
|
||||||
|
@ -237,3 +239,11 @@ backHome
|
||||||
= (progMode .~ MainMenu)
|
= (progMode .~ MainMenu)
|
||||||
. (inputBuffer .~ "")
|
. (inputBuffer .~ "")
|
||||||
. (scrollOffset .~ 0)
|
. (scrollOffset .~ 0)
|
||||||
|
|
||||||
|
-- | Scrolls the display up
|
||||||
|
scrollUp :: ProgState -> ProgState
|
||||||
|
scrollUp = scrollOffset %~ max 0 . pred
|
||||||
|
|
||||||
|
-- | Scrolls the display down
|
||||||
|
scrollDown :: ProgState -> ProgState
|
||||||
|
scrollDown = scrollOffset %~ succ
|
||||||
|
|
|
@ -278,8 +278,8 @@ reportC = Controller
|
||||||
return C.CursorInvisible
|
return C.CursorInvisible
|
||||||
, handleController = \e -> do
|
, handleController = \e -> do
|
||||||
case e of
|
case e of
|
||||||
C.EventSpecialKey C.KeyUpArrow -> modify $ scrollOffset %~ pred
|
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
|
||||||
C.EventSpecialKey C.KeyDownArrow -> modify $ scrollOffset %~ succ
|
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
|
||||||
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
|
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
|
||||||
C.EventSpecialKey _ -> modify backHome
|
C.EventSpecialKey _ -> modify backHome
|
||||||
C.EventCharacter _ -> modify backHome
|
C.EventCharacter _ -> modify backHome
|
||||||
|
|
|
@ -61,6 +61,8 @@ spec = describe "Mtlstats.Actions" $ do
|
||||||
resetGoalDataSpec
|
resetGoalDataSpec
|
||||||
assignPMinsSpec
|
assignPMinsSpec
|
||||||
backHomeSpec
|
backHomeSpec
|
||||||
|
scrollUpSpec
|
||||||
|
scrollDownSpec
|
||||||
|
|
||||||
startNewSeasonSpec :: Spec
|
startNewSeasonSpec :: Spec
|
||||||
startNewSeasonSpec = describe "startNewSeason" $ do
|
startNewSeasonSpec = describe "startNewSeason" $ do
|
||||||
|
@ -672,3 +674,29 @@ backHomeSpec = describe "backHome" $ do
|
||||||
|
|
||||||
it "should reset the scroll offset" $
|
it "should reset the scroll offset" $
|
||||||
result^.scrollOffset `shouldBe` 0
|
result^.scrollOffset `shouldBe` 0
|
||||||
|
|
||||||
|
scrollUpSpec :: Spec
|
||||||
|
scrollUpSpec = describe "scrollUp" $ do
|
||||||
|
|
||||||
|
context "scrolled down" $
|
||||||
|
it "should decrease the scroll offset by one" $ let
|
||||||
|
ps = newProgState & scrollOffset .~ 10
|
||||||
|
ps' = scrollUp ps
|
||||||
|
in ps'^.scrollOffset `shouldBe` 9
|
||||||
|
|
||||||
|
context "at top" $
|
||||||
|
it "should keep the scroll offset at zero" $ let
|
||||||
|
ps = scrollUp newProgState
|
||||||
|
in ps^.scrollOffset `shouldBe` 0
|
||||||
|
|
||||||
|
context "above top" $
|
||||||
|
it "should return the scroll offset to zero" $ let
|
||||||
|
ps = newProgState & scrollOffset .~ (-10)
|
||||||
|
ps' = scrollUp ps
|
||||||
|
in ps'^.scrollOffset `shouldBe` 0
|
||||||
|
|
||||||
|
scrollDownSpec = describe "scrollDown" $
|
||||||
|
it "should increase the scroll offset" $ let
|
||||||
|
ps = newProgState & scrollOffset .~ 10
|
||||||
|
ps' = scrollDown ps
|
||||||
|
in ps'^.scrollOffset `shouldBe` 11
|
||||||
|
|
Loading…
Reference in New Issue
Block a user