Yvee1/hascard
1
1
Fork 0
mirror of https://github.com/Yvee1/hascard.git synced 2024-11-25 01:42:20 +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
| InfoViewport
| SettingsViewport
| CardViewport Int
| RecentsList
| FileBrowserList
| SBClick T.ClickableScrollbarElement Name

124
src/UI/Cards.hs
View File

@ -23,6 +23,7 @@ import UI.Attributes
import UI.BrickHelpers
import System.FilePath
import Data.List (intercalate)
import qualified Brick.Types as BT
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
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"
MultipleChoiceState {} -> ", ENTER: submit answer / continue"
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"
drawCardBox :: Widget Name -> Widget Name
@ -67,31 +68,38 @@ drawFooter s = if s^.reviewMode
endCard = maybe False (isFinalPopup . view popupState) (s^.popup)
drawCardUI :: CS -> Widget Name
drawCardUI s = let p = 1 in
joinBorders $ drawCardBox $ (<=> drawFooter s) $
case (s ^. shownCards) !! (s ^. index) of
Definition title _ descr -> drawHeader title
<=> B.hBorder
<=> padLeftRight p (drawDef s descr <=> str " ")
drawCardUI s =
let card = (s ^. shownCards) !! (s ^. index)
in
joinBorders $
drawCardBox $
drawHeader card
<=>
B.hBorder
<=>
scrollableViewportPercent 60 (CardViewport (s ^. index))
(drawContent s card)
<=>
str " "
<=>
drawFooter s
MultipleChoice question _ correct others -> drawHeader question
<=> B.hBorder
<=> padLeftRight p (drawChoices s (listMultipleChoice correct others) <=> str " ")
drawHeader :: Card -> Widget Name
drawHeader (Definition title _ _) = drawTitle title
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
<=> B.hBorder
<=> padLeftRight p (atLeastV 1 (drawPerforated s perforated) <=> str " ")
drawContent :: CS -> Card -> Widget Name
drawContent s (Definition _ _ descr) = padLeftRight 1 $ drawDef s descr
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
<=> B.hBorder
<=> 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 $
drawTitle :: String -> Widget n
drawTitle title = withAttr titleAttr $
padLeftRight 1 $
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
where formattedOptions :: [Widget Name]
formattedOptions = [ prefix <+> coloring (drawDescr opt) |
formattedOptions = [ visibility $ prefix <+> coloring (drawDescr opt) |
(j, opt) <- zip [0..] options,
let prefix = if i == j then withAttr highlightedChoiceAttr (str "* ") else str " "
chosen = M.findWithDefault False j kvs
visibility = if i == j && not chosen then visible else id
coloring = case (chosen, j==k) of
(False, _) -> id
(True, False) -> withAttr incorrectChoiceAttr
@ -143,10 +152,11 @@ drawOptions :: CS -> NonEmpty Option -> Widget Name
drawOptions s = case (s ^. cardState, s ^. currentCard) of
(MultipleAnswerState {_highlighted=j, _selected=kvs, _entered=submitted}, _) ->
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 " "
enabled = M.findWithDefault False i kvs
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
(True, True, Correct) -> 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
OpenQuestionState {_gapInput = kvs, _highlighted=j, _entered=submitted, _correctGaps=cgs} ->
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
cursor :: Widget Name -> Widget Name
-- 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
visibility = if i == j && not submitted then visible else id
correct = M.findWithDefault False i cgs
coloring = case (submitted, correct) of
(False, _) -> withAttr gapAttr
(True, False) -> withAttr incorrectGapAttr
(True, True) -> withAttr correctGapAttr
gapWidget = cursor $ coloring (str gap) in
gapWidget = visibility . cursor $ coloring (str gap) in
if n' >= 0
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
_ -> id
visibility = if i == j && not submitted then visible else id
number =
case (submitted, i+1 == k) of
(False, _) -> str (show (i+1) <> ". ")
(True, False) -> withAttr incorrectElementAttr (str (show k <> ". "))
(True, True ) -> withAttr correctElementAttr (str (show k <> ". "))
in
number <+> color (drawDescr text)
in visibility $ number <+> color (drawDescr text)
_ -> error "cardstate mismatch"
@ -247,6 +260,12 @@ halt' :: EventM n GlobalState ()
halt' = removeToModeOrQuit' beforeMoving CardSelector
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 (VtyEvent e) =
-- let update = updateCS gs
@ -268,8 +287,15 @@ handleEvent (VtyEvent e) =
then if not (s^.reviewMode) then next
else cs.popup ?= correctPopup
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 ()
where up = when f $ scroll s (-1)
down = when f $ scroll s 1
(MultipleChoiceState {_highlighted = i, _number = n, _tried = kvs}, MultipleChoice _ _ (CorrectOption j _) _) ->
case ev of
V.EvKey V.KUp [] -> up
@ -286,11 +312,13 @@ handleEvent (VtyEvent e) =
where frozen = M.findWithDefault False j kvs
down = when (i < n-1 && not frozen) $
cs.cardState.highlighted += 1
down = if not frozen
then when (i < n-1) $ cs.cardState.highlighted += 1
else scroll s 1
up = when (i > 0 && not frozen) $
cs.cardState.highlighted -= 1
up = if not frozen
then when (i > 0) $ cs.cardState.highlighted -= 1
else scroll s (-1)
correctlyAnswered = i == j && M.size (M.filter id kvs) == 1
@ -320,18 +348,19 @@ handleEvent (VtyEvent e) =
where frozen = submitted
down = when (i < n-1 && not frozen) $
cs.cardState.highlighted += 1
down = if not frozen
then when (i < n-1) $ cs.cardState.highlighted += 1
else scroll s 1
up = when (i > 0 && not frozen) $
cs.cardState.highlighted -= 1
up = if not frozen
then when (i > 0) $ cs.cardState.highlighted -= 1
else scroll s (-1)
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) ->
let frozen = M.foldr (&&) True cGaps in
case ev of
V.EvKey (V.KFun 1) [] -> zoom (cs.cardState) $ do
V.EvKey (V.KFun 1) [V.MCtrl] -> zoom (cs.cardState) $ do
gapInput .= correctAnswers
entered .= True
failed .= True
@ -357,8 +386,15 @@ handleEvent (VtyEvent e) =
where backword "" = ""
backword xs = unwords . init . words $ xs
V.EvKey V.KUp [] -> up
V.EvKey V.KDown [] -> down
V.EvKey (V.KChar c) [] -> zoom (cs.cardState) $ do
unless frozen $ gapInput.at i.non "" %= (++[c])
case c of
'k' -> up
'j' -> down
_ -> return ()
V.EvKey V.KEnter [] -> case (frozen, fail) of
(False, _) -> zoom cs $ do
@ -385,8 +421,13 @@ handleEvent (VtyEvent e) =
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) ->
case ev of
V.EvKey V.KUp [] -> up
@ -407,7 +448,7 @@ handleEvent (VtyEvent e) =
down = zoom (cs.cardState) $
case (frozen, i < n - 1, dragging) of
(True, _, _) -> return ()
(True, _, _) -> scroll s 1
(_, False, _) -> return ()
(_, _, False) -> highlighted += 1
(_, _, True) -> do highlighted += 1
@ -415,7 +456,7 @@ handleEvent (VtyEvent e) =
up = zoom (cs.cardState) $
case (frozen, i > 0, dragging) of
(True, _, _) -> return ()
(True, _, _) -> scroll s (-1)
(_, False, _) -> return ()
(_, _, False) -> 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]
_ -> error "impossible"
handleEvent (BT.MouseDown (SBClick el (CardViewport i)) _ _ _) = handleClickScroll (scroll' i) el
handleEvent _ = return ()
next :: EventM Name GlobalState ()

6
src/UI/Info.hs
View File

@ -61,14 +61,12 @@ info = unlines
, "Controls:"
, " * 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"
, ""
, " * 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 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"]