Yvee1/hascard
1
1
Fork 0
mirror of https://github.com/Yvee1/hascard.git synced 2024-11-22 04:33:06 +03:00
Code Issues Projects Releases Wiki Activity

Add scrolling functionality to cards & change F1 to Ctrl+F1

Browse Source
This commit is contained in:
Yvee1 2023-12-17 18:46:58 +01:00
parent 3132f7a44b
commit 0b877aa855
4 changed files with 224 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
cards/long.txt Normal file
View File

@ -0,0 +1,94 @@
# Very long definition of Haskell
Haskell (/ˈhæskəl/) is a general-purpose, statically-typed, purely functional programming language with type inference and lazy evaluation.
Designed for teaching, research, and industrial applications, Haskell has pioneered a number of programming language features such as type classes, which enable type-safe operator overloading, and monadic input/output (IO).
It is named after logician Haskell Curry. Haskell's main implementation is the Glasgow Haskell Compiler (GHC).
Haskell's semantics are historically based on those of the Miranda programming language, which served to focus the efforts of the initial Haskell working group.
The last formal specification of the language was made in July 2010, while the development of GHC continues to expand Haskell via language extensions.
Haskell is used in academia and industry.
As of May 2021, Haskell was the 28th most popular programming language by Google searches for tutorials, and made up less than 1% of active users on the GitHub source code repository.
After the release of Miranda by Research Software Ltd. in 1985, interest in lazy functional languages grew. By 1987, more than a dozen non-strict, purely functional programming languages existed.
Miranda was the most widely used, but it was proprietary software.
At the conference on Functional Programming Languages and Computer Architecture (FPCA '87) in Portland, Oregon, there was a strong consensus that a committee be formed to define an open standard for such languages.
The committee's purpose was to consolidate existing functional languages into a common one to serve as a basis for future research in functional-language design.
Haskell was developed by a committee, attempting to bring together off the shelf solutions where possible.
Type classes, which enable type-safe operator overloading, were first proposed by Philip Wadler and Stephen Blott to address the ad-hoc handling of equality types and arithmetic overloading in languages at the time.
In early versions of Haskell up until and including version 1.2, user interaction and IO (input and output) were handled by both streams based and continuation based mechanisms which were widely considered unsatisfactory.
In version 1.3, monadic IO was introduced, along with the generalisation of type classes to higher kinds (type constructors).
Along with "do notation", which provides syntactic sugar for the Monad type class, this gave Haskell an effect system that maintained referential transparency and was convenient.
Other notable changes in early versions were the approach to the 'seq' function, which creates a data dependency between values, and is used in lazy languages to avoid excessive memory consumption; with it moving from a type class to a standard function to make refactoring more practical.
The first version of Haskell ("Haskell 1.0") was defined in 1990.
The committee's efforts resulted in a series of language definitions (1.0, 1.1, 1.2, 1.3, 1.4).
---
# Very many options
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
* Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten
---
# Very many options
[ ] 1
[ ] 2
[ ] 3
[ ] 4
[*] Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five Five
[ ] 6
[ ] 7
[ ] 8
[ ] 9
[*] Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten Ten
---
# Very long open question of Haskell
Haskell (/ˈhæskəl/) is a general-purpose, statically-typed, purely functional programming language with type inference and lazy evaluation.
Designed for teaching, research, and industrial applications, Haskell has pioneered a number of programming language features such as type classes, which enable type-safe operator overloading, and monadic input/output (IO).
It is named after logician _Haskell Curry_. Haskell's main implementation is the Glasgow Haskell Compiler (GHC).
Haskell's semantics are historically based on those of the Miranda programming language, which served to focus the efforts of the initial Haskell working group.
The last formal specification of the language was made in July 2010, while the development of GHC continues to expand Haskell via language extensions.
Haskell is used in academia and industry.
As of May 2021, Haskell was the _28_th most popular programming language by Google searches for tutorials, and made up less than 1% of active users on the GitHub source code repository.
After the release of Miranda by Research Software Ltd. in 1985, interest in lazy functional languages grew. By 1987, more than a dozen non-strict, purely functional programming languages existed.
Miranda was the most widely used, but it was proprietary software. At the conference on Functional Programming Languages and Computer Architecture (FPCA '87) in Portland, Oregon, there was a strong consensus that a committee be formed to define an open standard for such languages.
The committee's purpose was to consolidate existing functional languages into a common one to serve as a basis for future research in functional-language design.
Haskell was developed by a committee, attempting to bring together off the shelf solutions where possible.
Type classes, which enable type-safe operator overloading, were first proposed by Philip Wadler and Stephen Blott to address the ad-hoc handling of equality types and arithmetic overloading in languages at the time.
In early versions of Haskell up until and including version 1.2, user interaction and IO (input and output) were handled by both streams based and continuation based mechanisms which were widely considered unsatisfactory.
In version 1.3, monadic IO was introduced, along with the generalisation of type classes to higher kinds (type constructors).
Along with "do notation", which provides syntactic sugar for the Monad type class, this gave Haskell an effect system that maintained referential transparency and was convenient.
Other notable changes in early versions were the approach to the '_seq_' function, which creates a data dependency between values, and is used in lazy languages to avoid excessive memory consumption; with it moving from a type class to a standard function to make refactoring more practical.
The first version of Haskell ("Haskell 1.0") was defined in 1990.
The committee's efforts resulted in a series of language definitions (1.0, 1.1, 1.2, 1.3, 1.4).
---
# Very long reorder
1. a
2. b
3. c
4. d
5. e
7. g
6. f
8. h
9. i
10. j

1
src/States.hs
View File

@ -37,6 +37,7 @@ data Name =
| MainMenuList | MainMenuList
| InfoViewport | InfoViewport
| SettingsViewport | SettingsViewport
| CardViewport Int
| RecentsList | RecentsList
| FileBrowserList | FileBrowserList
| SBClick T.ClickableScrollbarElement Name | SBClick T.ClickableScrollbarElement Name

212
src/UI/Cards.hs
View File

@ -23,6 +23,7 @@ import UI.Attributes
import UI.BrickHelpers import UI.BrickHelpers
import System.FilePath import System.FilePath
import Data.List (intercalate) import Data.List (intercalate)
import qualified Brick.Types as BT
import qualified Data.List.NonEmpty as NE import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
@ -44,7 +45,7 @@ drawInfo s = if not (s ^. showControls) then emptyWidget else
DefinitionState {} -> ", ENTER: flip card / continue" DefinitionState {} -> ", ENTER: flip card / continue"
MultipleChoiceState {} -> ", ENTER: submit answer / continue" MultipleChoiceState {} -> ", ENTER: submit answer / continue"
MultipleAnswerState {} -> ", ENTER: select / continue, c: submit selection" MultipleAnswerState {} -> ", ENTER: select / continue, c: submit selection"
OpenQuestionState {} -> ", LEFT/RIGHT/TAB: navigate gaps, ENTER: submit answer / continue, F1: show answer" OpenQuestionState {} -> ", LEFT/RIGHT/TAB: navigate gaps, ENTER: submit answer / continue, Ctrl+F1: show answer"
ReorderState {} -> ", ENTER: grab, c: submit answer" ReorderState {} -> ", ENTER: grab, c: submit answer"
drawCardBox :: Widget Name -> Widget Name drawCardBox :: Widget Name -> Widget Name
@ -67,31 +68,38 @@ drawFooter s = if s^.reviewMode
endCard = maybe False (isFinalPopup . view popupState) (s^.popup) endCard = maybe False (isFinalPopup . view popupState) (s^.popup)
drawCardUI :: CS -> Widget Name drawCardUI :: CS -> Widget Name
drawCardUI s = let p = 1 in drawCardUI s =
joinBorders $ drawCardBox $ (<=> drawFooter s) $ let card = (s ^. shownCards) !! (s ^. index)
case (s ^. shownCards) !! (s ^. index) of in
Definition title _ descr -> drawHeader title joinBorders $
<=> B.hBorder drawCardBox $
<=> padLeftRight p (drawDef s descr <=> str " ") drawHeader card
<=>
B.hBorder
<=>
scrollableViewportPercent 60 (CardViewport (s ^. index))
(drawContent s card)
<=>
str " "
<=>
drawFooter s
MultipleChoice question _ correct others -> drawHeader question drawHeader :: Card -> Widget Name
<=> B.hBorder drawHeader (Definition title _ _) = drawTitle title
<=> padLeftRight p (drawChoices s (listMultipleChoice correct others) <=> str " ") drawHeader (MultipleChoice question _ _ _) = drawTitle question
drawHeader (OpenQuestion question _ _) = drawTitle question
drawHeader (MultipleAnswer question _ _) = drawTitle question
drawHeader (Reorder question _ _) = drawTitle question
OpenQuestion title _ perforated -> drawHeader title drawContent :: CS -> Card -> Widget Name
<=> B.hBorder drawContent s (Definition _ _ descr) = padLeftRight 1 $ drawDef s descr
<=> padLeftRight p (atLeastV 1 (drawPerforated s perforated) <=> str " ") drawContent s (MultipleChoice _ _ correct others) = padLeftRight 1 $ drawChoices s (listMultipleChoice correct others)
drawContent s (OpenQuestion _ _ perforated) = padLeftRight 1 $ drawPerforated s perforated
drawContent s (MultipleAnswer _ _ options) = padRight (Pad 1) $ drawOptions s options
drawContent s (Reorder{}) = padLeftRight 1 $ drawReorder s
MultipleAnswer question _ options -> drawHeader question drawTitle :: String -> Widget n
<=> B.hBorder drawTitle title = withAttr titleAttr $
<=> padRight (Pad p) (drawOptions s options <=> str " ")
Reorder question _ _ -> drawHeader question
<=> B.hBorder
<=> padLeftRight p (drawReorder s <=> str " ")
drawHeader :: String -> Widget Name
drawHeader title = withAttr titleAttr $
padLeftRight 1 $ padLeftRight 1 $
hCenteredStrWrap title hCenteredStrWrap title
@ -128,10 +136,11 @@ drawChoices s options = case (s ^. cardState, s ^. currentCard) of
(MultipleChoiceState {_highlighted=i, _tried=kvs}, MultipleChoice _ _ (CorrectOption k _) _) -> vBox formattedOptions (MultipleChoiceState {_highlighted=i, _tried=kvs}, MultipleChoice _ _ (CorrectOption k _) _) -> vBox formattedOptions
where formattedOptions :: [Widget Name] where formattedOptions :: [Widget Name]
formattedOptions = [ prefix <+> coloring (drawDescr opt) | formattedOptions = [ visibility $ prefix <+> coloring (drawDescr opt) |
(j, opt) <- zip [0..] options, (j, opt) <- zip [0..] options,
let prefix = if i == j then withAttr highlightedChoiceAttr (str "* ") else str " " let prefix = if i == j then withAttr highlightedChoiceAttr (str "* ") else str " "
chosen = M.findWithDefault False j kvs chosen = M.findWithDefault False j kvs
visibility = if i == j && not chosen then visible else id
coloring = case (chosen, j==k) of coloring = case (chosen, j==k) of
(False, _) -> id (False, _) -> id
(True, False) -> withAttr incorrectChoiceAttr (True, False) -> withAttr incorrectChoiceAttr
@ -143,10 +152,11 @@ drawOptions :: CS -> NonEmpty Option -> Widget Name
drawOptions s = case (s ^. cardState, s ^. currentCard) of drawOptions s = case (s ^. cardState, s ^. currentCard) of
(MultipleAnswerState {_highlighted=j, _selected=kvs, _entered=submitted}, _) -> (MultipleAnswerState {_highlighted=j, _selected=kvs, _entered=submitted}, _) ->
vBox . NE.toList . NE.map drawOption . (`NE.zip` NE.fromList [0..]) vBox . NE.toList . NE.map drawOption . (`NE.zip` NE.fromList [0..])
where drawOption (Option kind text, i) = coloring (str "[") <+> coloring (highlighting (str symbol)) <+> coloring (str "] ") <+> drawDescr text where drawOption (Option kind text, i) = visibility $ coloring (str "[") <+> coloring (highlighting (str symbol)) <+> coloring (str "] ") <+> drawDescr text
where symbol = if (i == j && not submitted) || enabled then "*" else " " where symbol = if (i == j && not submitted) || enabled then "*" else " "
enabled = M.findWithDefault False i kvs enabled = M.findWithDefault False i kvs
highlighting = if i == j && not submitted then withAttr highlightedOptAttr else id highlighting = if i == j && not submitted then withAttr highlightedOptAttr else id
visibility = if i == j && not submitted then visible else id
coloring = case (submitted, enabled, kind) of coloring = case (submitted, enabled, kind) of
(True, True, Correct) -> withAttr correctOptAttr (True, True, Correct) -> withAttr correctOptAttr
(True, False, Incorrect) -> withAttr correctOptAttr (True, False, Incorrect) -> withAttr correctOptAttr
@ -174,20 +184,22 @@ makeSentenceWidget w state = vBox . fst . makeSentenceWidget' 0 0
makeSentenceWidget' padding i (Perforated pre _ post) = case state ^. cardState of makeSentenceWidget' padding i (Perforated pre _ post) = case state ^. cardState of
OpenQuestionState {_gapInput = kvs, _highlighted=j, _entered=submitted, _correctGaps=cgs} -> OpenQuestionState {_gapInput = kvs, _highlighted=j, _entered=submitted, _correctGaps=cgs} ->
let (ws, n, fit') = wrapStringWithPadding padding w pre let (ws, n, fit') = wrapStringWithPadding padding w pre
gap = M.findWithDefault "" i kvs stored = M.findWithDefault "" i kvs
gap = if stored == "" then "░" else stored
n' = w - n - textWidth gap n' = w - n - textWidth gap
cursor :: Widget Name -> Widget Name cursor :: Widget Name -> Widget Name
-- i is the index of the gap that we are drawing; j is the gap that is currently selected -- i is the index of the gap that we are drawing; j is the gap that is currently selected
cursor = if i == j then showCursor Ordinary (Location (textWidth gap, 0)) else id cursor = if i == j then showCursor Ordinary (Location (textWidth gap, 0)) else id
visibility = if i == j && not submitted then visible else id
correct = M.findWithDefault False i cgs correct = M.findWithDefault False i cgs
coloring = case (submitted, correct) of coloring = case (submitted, correct) of
(False, _) -> withAttr gapAttr (False, _) -> withAttr gapAttr
(True, False) -> withAttr incorrectGapAttr (True, False) -> withAttr incorrectGapAttr
(True, True) -> withAttr correctGapAttr (True, True) -> withAttr correctGapAttr
gapWidget = cursor $ coloring (str gap) in gapWidget = visibility . cursor $ coloring (str gap) in
if n' >= 0 if n' >= 0
then let (ws1@(w':ws'), fit) = makeSentenceWidget' (w-n') (i+1) post in then let (ws1@(w':ws'), fit) = makeSentenceWidget' (w-n') (i+1) post in
@ -230,13 +242,14 @@ drawReorder s = case (s ^. cardState, s ^. currentCard) of
(True, False) -> withAttr highlightedElementAttr (True, False) -> withAttr highlightedElementAttr
_ -> id _ -> id
visibility = if i == j && not submitted then visible else id
number = number =
case (submitted, i+1 == k) of case (submitted, i+1 == k) of
(False, _) -> str (show (i+1) <> ". ") (False, _) -> str (show (i+1) <> ". ")
(True, False) -> withAttr incorrectElementAttr (str (show k <> ". ")) (True, False) -> withAttr incorrectElementAttr (str (show k <> ". "))
(True, True ) -> withAttr correctElementAttr (str (show k <> ". ")) (True, True ) -> withAttr correctElementAttr (str (show k <> ". "))
in in visibility $ number <+> color (drawDescr text)
number <+> color (drawDescr text)
_ -> error "cardstate mismatch" _ -> error "cardstate mismatch"
@ -247,6 +260,12 @@ halt' :: EventM n GlobalState ()
halt' = removeToModeOrQuit' beforeMoving CardSelector halt' = removeToModeOrQuit' beforeMoving CardSelector
where beforeMoving = zoom css refreshRecents where beforeMoving = zoom css refreshRecents
scroll :: CS -> Int -> EventM Name s ()
scroll s = scroll' $ s ^. index
scroll' :: Int -> Int -> EventM Name s ()
scroll' i = vScrollBy $ viewportScroll $ CardViewport i
handleEvent :: BrickEvent Name Event -> EventM Name GlobalState () handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()
handleEvent (VtyEvent e) = handleEvent (VtyEvent e) =
-- let update = updateCS gs -- let update = updateCS gs
@ -268,8 +287,15 @@ handleEvent (VtyEvent e) =
then if not (s^.reviewMode) then next then if not (s^.reviewMode) then next
else cs.popup ?= correctPopup else cs.popup ?= correctPopup
else cs.cardState.flipped %= not else cs.cardState.flipped %= not
V.EvKey V.KUp [] -> up
V.EvKey (V.KChar 'k') [] -> up
V.EvKey V.KDown [] -> down
V.EvKey (V.KChar 'j') [] -> down
_ -> return () _ -> return ()
where up = when f $ scroll s (-1)
down = when f $ scroll s 1
(MultipleChoiceState {_highlighted = i, _number = n, _tried = kvs}, MultipleChoice _ _ (CorrectOption j _) _) -> (MultipleChoiceState {_highlighted = i, _number = n, _tried = kvs}, MultipleChoice _ _ (CorrectOption j _) _) ->
case ev of case ev of
V.EvKey V.KUp [] -> up V.EvKey V.KUp [] -> up
@ -286,11 +312,13 @@ handleEvent (VtyEvent e) =
where frozen = M.findWithDefault False j kvs where frozen = M.findWithDefault False j kvs
down = when (i < n-1 && not frozen) $ down = if not frozen
cs.cardState.highlighted += 1 then when (i < n-1) $ cs.cardState.highlighted += 1
else scroll s 1
up = when (i > 0 && not frozen) $ up = if not frozen
cs.cardState.highlighted -= 1 then when (i > 0) $ cs.cardState.highlighted -= 1
else scroll s (-1)
correctlyAnswered = i == j && M.size (M.filter id kvs) == 1 correctlyAnswered = i == j && M.size (M.filter id kvs) == 1
@ -320,72 +348,85 @@ handleEvent (VtyEvent e) =
where frozen = submitted where frozen = submitted
down = when (i < n-1 && not frozen) $ down = if not frozen
cs.cardState.highlighted += 1 then when (i < n-1) $ cs.cardState.highlighted += 1
else scroll s 1
up = when (i > 0 && not frozen) $ up = if not frozen
cs.cardState.highlighted -= 1 then when (i > 0) $ cs.cardState.highlighted -= 1
else scroll s (-1)
correctlyAnswered = NE.toList (NE.map isOptionCorrect opts) == map snd (M.toAscList kvs) correctlyAnswered = NE.toList (NE.map isOptionCorrect opts) == map snd (M.toAscList kvs)
(OpenQuestionState {_highlighted = i, _number = n, _gapInput = kvs, _correctGaps = cGaps, _failed=fail}, OpenQuestion _ _ perforated) -> (OpenQuestionState {_highlighted = i, _number = n, _gapInput = kvs, _correctGaps = cGaps, _failed=fail}, OpenQuestion _ _ perforated) ->
let frozen = M.foldr (&&) True cGaps in case ev of
case ev of V.EvKey (V.KFun 1) [V.MCtrl] -> zoom (cs.cardState) $ do
V.EvKey (V.KFun 1) [] -> zoom (cs.cardState) $ do gapInput .= correctAnswers
gapInput .= correctAnswers entered .= True
entered .= True failed .= True
failed .= True correctGaps .= M.fromAscList [(i, True) | i <- [0..n-1]]
correctGaps .= M.fromAscList [(i, True) | i <- [0..n-1]] where correctAnswers = M.fromAscList $ zip [0..] $ map NE.head (sentenceToGaps (perforatedToSentence perforated))
where correctAnswers = M.fromAscList $ zip [0..] $ map NE.head (sentenceToGaps (perforatedToSentence perforated))
V.EvKey (V.KChar '\t') [] -> zoom (cs.cardState) $ do V.EvKey (V.KChar '\t') [] -> zoom (cs.cardState) $ do
if i < n - 1 && not frozen if i < n - 1 && not frozen
then highlighted += 1 then highlighted += 1
else highlighted .= 0 else highlighted .= 0
V.EvKey V.KRight [] -> V.EvKey V.KRight [] ->
when (i < n - 1 && not frozen) $ when (i < n - 1 && not frozen) $
cs.cardState.highlighted += 1 cs.cardState.highlighted += 1
V.EvKey V.KLeft [] -> V.EvKey V.KLeft [] ->
when (i > 0 && not frozen) $ when (i > 0 && not frozen) $
cs.cardState.highlighted -= 1 cs.cardState.highlighted -= 1
-- C-w deletes a word back (eg. "test test" -> "test") -- C-w deletes a word back (eg. "test test" -> "test")
V.EvKey (V.KChar 'w') [V.MCtrl] -> zoom (cs.cardState) $ do V.EvKey (V.KChar 'w') [V.MCtrl] -> zoom (cs.cardState) $ do
unless frozen $ gapInput.ix i %= backword unless frozen $ gapInput.ix i %= backword
where backword "" = "" where backword "" = ""
backword xs = unwords . init . words $ xs backword xs = unwords . init . words $ xs
V.EvKey (V.KChar c) [] -> zoom (cs.cardState) $ do V.EvKey V.KUp [] -> up
unless frozen $ gapInput.at i.non "" %= (++[c]) V.EvKey V.KDown [] -> down
V.EvKey V.KEnter [] -> case (frozen, fail) of V.EvKey (V.KChar c) [] -> zoom (cs.cardState) $ do
(False, _) -> zoom cs $ do unless frozen $ gapInput.at i.non "" %= (++[c])
let sentence = perforatedToSentence perforated case c of
gaps = sentenceToGaps sentence 'k' -> up
'j' -> down
_ -> return ()
wordIsCorrect :: String -> NonEmpty String -> Bool V.EvKey V.KEnter [] -> case (frozen, fail) of
wordIsCorrect = if s^.isCaseSensitive (False, _) -> zoom cs $ do
then elem let sentence = perforatedToSentence perforated
else (\word possibilites -> map toLower word `elem` NE.map (map toLower) possibilites) gaps = sentenceToGaps sentence
cardState.correctGaps %= M.mapWithKey (\j _ -> M.findWithDefault "" j kvs `wordIsCorrect` (gaps !! j)) wordIsCorrect :: String -> NonEmpty String -> Bool
cardState.entered .= True wordIsCorrect = if s^.isCaseSensitive
then elem
else (\word possibilites -> map toLower word `elem` NE.map (map toLower) possibilites)
unlessM (M.foldr (&&) True <$> use (cardState.correctGaps)) $ cardState.correctGaps %= M.mapWithKey (\j _ -> M.findWithDefault "" j kvs `wordIsCorrect` (gaps !! j))
cardState.failed .= True cardState.entered .= True
(_, True) -> next unlessM (M.foldr (&&) True <$> use (cardState.correctGaps)) $
(_, False) -> do cardState.failed .= True
cs.correctCards %= (s^.index:)
next
V.EvKey V.KBS [] -> unless frozen $ (_, True) -> next
cs.cardState.gapInput.ix i %= backspace (_, False) -> do
where backspace "" = "" cs.correctCards %= (s^.index:)
backspace xs = init xs next
_ -> return ()
V.EvKey V.KBS [] -> unless frozen $
cs.cardState.gapInput.ix i %= backspace
where backspace "" = ""
backspace xs = init xs
_ -> return ()
where frozen = M.foldr (&&) True cGaps
down = when frozen $ scroll s 1
up = when frozen $ scroll s (-1)
(ReorderState {_highlighted = i, _entered = submitted, _grabbed=dragging, _number = n, _order = kvs }, Reorder _ _ elts) -> (ReorderState {_highlighted = i, _entered = submitted, _grabbed=dragging, _number = n, _order = kvs }, Reorder _ _ elts) ->
case ev of case ev of
@ -407,7 +448,7 @@ handleEvent (VtyEvent e) =
down = zoom (cs.cardState) $ down = zoom (cs.cardState) $
case (frozen, i < n - 1, dragging) of case (frozen, i < n - 1, dragging) of
(True, _, _) -> return () (True, _, _) -> scroll s 1
(_, False, _) -> return () (_, False, _) -> return ()
(_, _, False) -> highlighted += 1 (_, _, False) -> highlighted += 1
(_, _, True) -> do highlighted += 1 (_, _, True) -> do highlighted += 1
@ -415,7 +456,7 @@ handleEvent (VtyEvent e) =
up = zoom (cs.cardState) $ up = zoom (cs.cardState) $
case (frozen, i > 0, dragging) of case (frozen, i > 0, dragging) of
(True, _, _) -> return () (True, _, _) -> scroll s (-1)
(_, False, _) -> return () (_, False, _) -> return ()
(_, _, False) -> highlighted -= 1 (_, _, False) -> highlighted -= 1
(_, _, True) -> do highlighted -= 1 (_, _, True) -> do highlighted -= 1
@ -424,6 +465,7 @@ handleEvent (VtyEvent e) =
correct = all (uncurry (==) . (\i -> (i+1, fst (kvs M.! i)))) [0..n-1] correct = all (uncurry (==) . (\i -> (i+1, fst (kvs M.! i)))) [0..n-1]
_ -> error "impossible" _ -> error "impossible"
handleEvent (BT.MouseDown (SBClick el (CardViewport i)) _ _ _) = handleClickScroll (scroll' i) el
handleEvent _ = return () handleEvent _ = return ()
next :: EventM Name GlobalState () next :: EventM Name GlobalState ()

6
src/UI/Info.hs
View File

@ -61,14 +61,12 @@ info = unlines
, "Controls:" , "Controls:"
, " * Use arrows or the j and k keys for menu navigation" , " * Use arrows or the j and k keys for menu navigation"
, "" , ""
, " * Press the s key to toggle shuffling inside the deck selector menu"
, ""
, " * Enter confirms a selection, flips a card or continues to the next card" , " * Enter confirms a selection, flips a card or continues to the next card"
, "" , ""
, " * Use TAB or the arrow keys for navigating gaps in open questions" , " * Use TAB or the arrow keys for navigating gaps in open questions"
, "" , ""
, " * Use the c key for confirming reorder questions or multiple choice questions with more than 1 possible answer" , " * Use the c key for confirming reorder questions or multiple choice questions with more than 1 possible answer"
, "" , ""
, " * Use F1 to show the answers of a open question" , " * Use Ctrl+F1 to show the answers of a open question"
, "" , ""
, " * Use CTRL+Left and CTRL+Right to move to previous and next cards without having to answer them; this is disabled in review mode"] , " * Use Ctrl+Left and Ctrl+Right to move to previous and next cards without having to answer them; this is disabled in review mode"]