1
1
mirror of https://github.com/Yvee1/hascard.git synced 2024-11-22 12:51:58 +03:00

Merge pull request #13 from g-w1/master

Add quit with q
This commit is contained in:
Steven van den Broek 2020-09-13 19:34:28 +02:00 committed by GitHub
commit efc5a24bd2
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
7 changed files with 79 additions and 74 deletions

View File

@ -1,4 +1,4 @@
module UI.CardSelector
module UI.CardSelector
( State
, drawUI
, handleEvent
@ -27,16 +27,16 @@ import qualified Stack as S
import qualified UI.Attributes as A
drawUI :: GlobalState -> CSS -> [Widget Name]
drawUI gs s =
drawUI gs s =
[ drawException (s ^. exception), drawMenu gs s ]
title :: Widget Name
title = withAttr titleAttr $ str "Select a deck of flashcards "
drawMenu :: GlobalState -> CSS -> Widget Name
drawMenu gs s =
drawMenu gs s =
joinBorders $
center $
center $
withBorderStyle unicodeRounded $
border $
hLimitPercent 60 $
@ -73,6 +73,7 @@ handleEvent gs s@CSS{_list=l, _exception=exc} (VtyEvent ev) =
(Just _, _) -> continue' $ s & exception .~ Nothing
(_, e) -> case e of
V.EvKey V.KEsc [] -> halt' gs
V.EvKey (V.KChar 'q') [] -> halt' gs
_ -> do l' <- L.handleListEventVi L.handleListEvent e l
let s' = (s & list .~ l') in
@ -80,7 +81,7 @@ handleEvent gs s@CSS{_list=l, _exception=exc} (VtyEvent ev) =
V.EvKey V.KEnter [] ->
case L.listSelectedElement l' of
Nothing -> continue' s'
Just (_, "Select file from system") ->
Just (_, "Select file from system") ->
let gs' = update s' in continue =<< (gs' `goToState`) <$> liftIO fileBrowserState
Just (i, _) -> do
let fp = (s' ^. recents) `S.unsafeElemAt` i
@ -100,4 +101,4 @@ handleEvent gs _ _ = continue gs
addRecentInternal :: CSS -> FilePath -> IO CSS
addRecentInternal s fp = do
addRecent fp
refreshRecents s
refreshRecents s

View File

@ -33,7 +33,7 @@ drawUI s = [maybe emptyWidget (`drawPopup` s) (s^.popup), drawCardUI s <=> draw
drawInfo :: CS -> Widget Name
drawInfo s = if not (s ^. showControls) then emptyWidget else
strWrap . ("ESC: quit" <>) $ case s ^. cardState of
strWrap . ("ESC or q: quit" <>) $ case s ^. cardState of
DefinitionState {} -> ", ENTER: flip card / continue"
MultipleChoiceState {} -> ", ENTER: submit answer / continue"
MultipleAnswerState {} -> ", ENTER: select / continue, c: submit selection"
@ -48,12 +48,12 @@ drawCardBox w = C.center $
hLimitPercent 60 w
drawFooter :: CS -> Widget Name
drawFooter s = if s^.reviewMode
drawFooter s = if s^.reviewMode
then padLeftRight 1 $ wrong <+> progress <+> correct
else progress
-- not guaranteed that progress is horizontally centered i think
where progress = C.hCenter $ str (show (s^.index + 1) ++ "/" ++ show (s^.nCards))
wrong = withAttr wrongAttr (str ("" <> show nWrong))
wrong = withAttr wrongAttr (str ("" <> show nWrong))
correct = withAttr correctAttr (str ("" <> show nCorrect))
nCorrect = length (s^.correctCards)
nWrong = s^.index - nCorrect + (if endCard then 1 else 0)
@ -66,9 +66,9 @@ drawCardUI s = let p = 1 in
Definition title descr -> drawHeader title
<=> B.hBorder
<=> padLeftRight p (drawDef s descr <=> str " ")
MultipleChoice question correct others -> drawHeader question
<=> B.hBorder
MultipleChoice question correct others -> drawHeader question
<=> B.hBorder
<=> padLeftRight p (drawChoices s (listMultipleChoice correct others) <=> str " ")
OpenQuestion title perforated -> drawHeader title
@ -100,7 +100,7 @@ drawDef s def = if s ^. showHints then drawHintedDef s def else drawNormalDef s
drawHintedDef :: CS -> String -> Widget Name
drawHintedDef s def = case s ^. cardState of
DefinitionState {_flipped=f} -> if f then drawDescr def else drawDescr [if isSpace' char then char else '_' | char <- def]
_ -> error "impossible: "
_ -> error "impossible: "
isSpace' :: Char -> Bool
isSpace' '\r' = True
@ -114,17 +114,17 @@ drawNormalDef s def = case s ^. cardState of
c <- getContext
let w = c^.availWidthL
render . vBox $ [str " " | _ <- wrapTextToLines wrapSettings w (pack def)]
_ -> error "impossible: "
_ -> error "impossible: "
drawChoices :: CS -> [String] -> Widget Name
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) |
(j, opt) <- zip [0..] options,
let prefix = if i == j then withAttr highlightedChoiceAttr (str "* ") else str " "
chosen = M.findWithDefault False j kvs
chosen = M.findWithDefault False j kvs
coloring = case (chosen, j==k) of
(False, _) -> id
(True, False) -> withAttr incorrectChoiceAttr
@ -134,7 +134,7 @@ drawChoices s options = case (s ^. cardState, s ^. currentCard) of
drawOptions :: CS -> NonEmpty Option -> Widget Name
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..])
where drawOption (Option kind text, i) = coloring (str "[") <+> coloring (highlighting (str symbol)) <+> coloring (str "] ") <+> drawDescr text
where symbol = if (i == j && not submitted) || enabled then "*" else " "
@ -163,12 +163,12 @@ makeSentenceWidget :: Int -> CS -> Sentence -> Widget Name
makeSentenceWidget w state = vBox . fst . makeSentenceWidget' 0 0
where
makeSentenceWidget' :: Int -> Int -> Sentence -> ([Widget Name], Bool)
makeSentenceWidget' padding _ (Normal s) = let (ws, _, fit) = wrapStringWithPadding padding w s in (ws, fit)
makeSentenceWidget' padding _ (Normal s) = let (ws, _, fit) = wrapStringWithPadding padding w s in (ws, fit)
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
n' = w - n - textWidth gap
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
@ -179,10 +179,10 @@ makeSentenceWidget w state = vBox . fst . makeSentenceWidget' 0 0
(False, _) -> withAttr gapAttr
(True, False) -> withAttr incorrectGapAttr
(True, True) -> withAttr correctGapAttr
gapWidget = cursor $ coloring (str gap) in
if n' >= 0
if n' >= 0
then let (ws1@(w':ws'), fit) = makeSentenceWidget' (w-n') (i+1) post in
if fit then ((ws & _last %~ (<+> (gapWidget <+> w'))) ++ ws', fit')
else ((ws & _last %~ (<+> gapWidget)) ++ ws1, fit')
@ -195,7 +195,7 @@ wrapStringWithPadding :: Int -> Int -> String -> ([Widget Name], Int, Bool)
wrapStringWithPadding padding w s
| null (words s) = ([str ""], padding, True)
| otherwise = if textWidth (head (words s)) < w - padding then
let startsWithSpace = head s == ' '
let startsWithSpace = head s == ' '
s' = if startsWithSpace then " " <> replicate padding 'X' <> tail s else replicate padding 'X' ++ s
lastLetter = last s
postfix = if lastLetter == ' ' then T.pack [lastLetter] else T.empty
@ -214,7 +214,7 @@ wrapStringWithPadding padding w s
drawReorder :: CS -> Widget Name
drawReorder s = case (s ^. cardState, s ^. currentCard) of
(ReorderState {_highlighted=j, _grabbed=g, _order=kvs, _number=n, _entered=submitted}, Reorder _ _) ->
(ReorderState {_highlighted=j, _grabbed=g, _order=kvs, _number=n, _entered=submitted}, Reorder _ _) ->
vBox . flip map (map (\i -> (i, kvs M.! i)) [0..n-1]) $
\(i, (k, text)) ->
let color = case (i == j, g) of
@ -222,7 +222,7 @@ drawReorder s = case (s ^. cardState, s ^. currentCard) of
(True, False) -> withAttr highlightedElementAttr
_ -> id
number =
number =
case (submitted, i+1 == k) of
(False, _) -> str (show (i+1) <> ". ")
(True, False) -> withAttr incorrectElementAttr (str (show k <> ". "))
@ -252,9 +252,9 @@ handleEvent gs s (VtyEvent e) =
case (s ^. cardState, s ^. currentCard) of
(DefinitionState{_flipped = f}, _) ->
case ev of
V.EvKey V.KEnter [] ->
V.EvKey V.KEnter [] ->
if f
then if not (s^.reviewMode) then next gs s
then if not (s^.reviewMode) then next gs s
else continue' (s & popup ?~ correctPopup)
else continue' $ s & cardState.flipped %~ not
_ -> continue' s
@ -263,19 +263,19 @@ handleEvent gs s (VtyEvent e) =
case ev of
V.EvKey V.KUp [] -> continue' up
V.EvKey (V.KChar 'k') [] -> continue' up
V.EvKey V.KDown [] -> continue' down
V.EvKey V.KDown [] -> continue' down
V.EvKey (V.KChar 'j') [] -> continue' down
V.EvKey V.KEnter [] ->
if frozen
then next gs $ s & if correctlyAnswered then correctCards %~ (s^.index:) else id
else continue' $ s & cardState.tried %~ M.insert i True
_ -> continue' s
where frozen = M.findWithDefault False j kvs
down = if i < n-1 && not frozen
then s & (cardState.highlighted) +~ 1
else s
@ -285,12 +285,12 @@ handleEvent gs s (VtyEvent e) =
else s
correctlyAnswered = i == j && M.size (M.filter (==True) kvs) == 1
(MultipleAnswerState {_highlighted = i, _number = n, _entered = submitted, _selected = kvs}, MultipleAnswer _ opts) ->
case ev of
V.EvKey V.KUp [] -> continue' up
V.EvKey (V.KChar 'k') [] -> continue' up
V.EvKey V.KDown [] -> continue' down
V.EvKey V.KDown [] -> continue' down
V.EvKey (V.KChar 'j') [] -> continue' down
V.EvKey (V.KChar 'c') [] -> continue' $ s & (cardState.entered) .~ True
@ -304,7 +304,7 @@ handleEvent gs s (VtyEvent e) =
where frozen = submitted
down = if i < n-1 && not frozen
then s & (cardState.highlighted) +~ 1
else s
@ -325,17 +325,17 @@ handleEvent gs s (VtyEvent e) =
& cardState.correctGaps .~ M.fromAscList [(i, True) | i <- [0..n-1]]
where correctAnswers = M.fromAscList $ zip [0..] $ map NE.head (sentenceToGaps (perforatedToSentence perforated))
V.EvKey (V.KChar '\t') [] -> continue' $
V.EvKey (V.KChar '\t') [] -> continue' $
if i < n - 1 && not frozen
then s & (cardState.highlighted) +~ 1
else s & (cardState.highlighted) .~ 0
V.EvKey V.KRight [] -> continue' $
V.EvKey V.KRight [] -> continue' $
if i < n - 1 && not frozen
then s & (cardState.highlighted) +~ 1
else s
V.EvKey V.KLeft [] -> continue' $
V.EvKey V.KLeft [] -> continue' $
if i > 0 && not frozen
then s & (cardState.highlighted) -~ 1
else s
@ -346,7 +346,7 @@ handleEvent gs s (VtyEvent e) =
V.EvKey V.KEnter [] -> if frozen
then if fail
then next gs s
else next gs (s & correctCards %~ (s^.index:))
else next gs (s & correctCards %~ (s^.index:))
else continue' s'
where sentence = perforatedToSentence perforated
gaps = sentenceToGaps sentence
@ -358,17 +358,17 @@ handleEvent gs s (VtyEvent e) =
then s'
else s' & cardState.failed .~ True
V.EvKey V.KBS [] -> continue' $
V.EvKey V.KBS [] -> continue' $
if frozen then s else s & cardState.gapInput.ix i %~ backspace
where backspace "" = ""
backspace xs = init xs
_ -> continue' s
(ReorderState {_highlighted = i, _entered = submitted, _grabbed=dragging, _number = n, _order = kvs }, Reorder _ elts) ->
case ev of
V.EvKey V.KUp [] -> continue' up
V.EvKey (V.KChar 'k') [] -> continue' up
V.EvKey V.KDown [] -> continue' down
V.EvKey V.KDown [] -> continue' down
V.EvKey (V.KChar 'j') [] -> continue' down
V.EvKey (V.KChar 'c') [] -> continue' $ s & (cardState.entered) .~ True
@ -382,8 +382,8 @@ handleEvent gs s (VtyEvent e) =
where frozen = submitted
down =
down =
case (frozen, i < n - 1, dragging) of
(True, _, _) -> s
(_, False, _) -> s
@ -398,7 +398,7 @@ handleEvent gs s (VtyEvent e) =
(_, _, False) -> s & (cardState.highlighted) -~ 1
(_, _, True) -> s & (cardState.highlighted) -~ 1
& (cardState.order) %~ interchange i (i-1)
correct = all (uncurry (==) . (\i -> (i+1, fst (kvs M.! i)))) [0..n-1]
_ -> error "impossible"
@ -407,8 +407,8 @@ handleEvent gs _ _ = continue gs
next :: GlobalState -> CS -> EventM Name (Next GlobalState)
next gs s
| s ^. index + 1 < length (s ^. cards) = continue . updateCS gs . straightenState $ s & index +~ 1
| s ^. reviewMode =
let thePopup =
| s ^. reviewMode =
let thePopup =
if null (s^.correctCards) || length (s^. correctCards) == length (s^.cards)
then finalPopup
else deckMakerPopup
@ -424,7 +424,7 @@ straightenState s =
let card = (s ^. cards) !! (s ^. index) in s
& currentCard .~ card
& cardState .~ defaultCardState card
interchange :: (Ord a) => a -> a -> Map a b -> Map a b
interchange i j kvs =
let vali = kvs M.! i
@ -448,7 +448,7 @@ correctPopup = Popup drawer eventHandler initialState
colorYes = if selected == 1 then selectedYesButtonAttr else yesButtonAttr
no = withAttr colorNo $ str "No"
yes = withAttr colorYes $ str "Yes" in
centerPopup $
centerPopup $
B.borderWithLabel (str "Correct?") $
hLimit 20 $
str " " <=>
@ -457,7 +457,7 @@ correctPopup = Popup drawer eventHandler initialState
initialState = CorrectPopup 0
eventHandler gs s ev =
eventHandler gs s ev =
let update = updateCS gs
continue' = continue . update
p = fromJust (s ^. popup)
@ -471,12 +471,12 @@ correctPopup = Popup drawer eventHandler initialState
finalPopup :: Popup CS
finalPopup = Popup drawer eventHandler initialState
where drawer s =
let wrong = withAttr wrongAttr (str (" Incorrect: " <> show nWrong) <+> hFill ' ')
where drawer s =
let wrong = withAttr wrongAttr (str (" Incorrect: " <> show nWrong) <+> hFill ' ')
correct = withAttr correctAttr (str (" Correct: " <> show nCorrect) <+> hFill ' ')
nCorrect = length (s^.correctCards)
nWrong = s^.index + 1 - nCorrect in
centerPopup $
centerPopup $
B.borderWithLabel (str "Finished") $
hLimit 20 $
str " " <=>
@ -498,19 +498,19 @@ deckMakerPopup = Popup drawer eventHandler initialState
(_, True) -> withAttr highlightedOptAttr $ str "*"
(True, _) -> withAttr selectedOptAttr $ str "*"
_ -> withAttr selectedOptAttr $ str " "
makeBox lens i =
makeBox lens i =
(if state ^?! lens then withAttr selectedOptAttr else id) $
str "[" <+> makeSym lens i <+> str "]"
wBox = makeBox makeDeckIncorrect 0
cBox = makeBox makeDeckCorrect 1
wrong = wBox <+> withAttr wrongAttr (str (" Incorrect: " <> show nWrong) <+> hFill ' ')
wrong = wBox <+> withAttr wrongAttr (str (" Incorrect: " <> show nWrong) <+> hFill ' ')
correct = cBox <+> withAttr correctAttr (str (" Correct: " <> show nCorrect) <+> hFill ' ')
nCorrect = length (s^.correctCards)
nWrong = s^.index + 1 - nCorrect in
centerPopup $
centerPopup $
B.borderWithLabel (str "Generate decks") $
hLimit 20 $
str " " <=>
@ -547,8 +547,8 @@ deckMakerPopup = Popup drawer eventHandler initialState
_ -> continue' s
generateDecks :: FilePath -> [Card] -> [Int] -> Bool -> Bool -> IO ()
generateDecks fp cards corrects makeCorrect makeIncorrect =
when (makeCorrect || makeIncorrect) $
generateDecks fp cards corrects makeCorrect makeIncorrect =
when (makeCorrect || makeIncorrect) $
do let (correct, incorrect) = splitCorrectIncorrect cards corrects
when makeCorrect $ writeFile (replaceBaseName fp (takeBaseName fp <> "+")) (cardsToString correct)
when makeIncorrect $ writeFile (replaceBaseName fp (takeBaseName fp <> "-")) (cardsToString incorrect)
@ -558,7 +558,7 @@ splitCorrectIncorrect :: [Card] -> [Int] -> ([Card], [Card])
splitCorrectIncorrect cards indices = doSplit [] [] (zip [0..] cards) (reverse indices)
where doSplit cs ws [] _ = (reverse cs, reverse ws)
doSplit cs ws ((_, x):xs) [] = doSplit cs (x:ws) xs []
doSplit cs ws ((j, x):xs) (i:is) =
doSplit cs ws ((j, x):xs) (i:is) =
if i == j
then doSplit (x:cs) ws xs is
else doSplit cs (x:ws) xs (i:is)
else doSplit cs (x:ws) xs (i:is)

View File

@ -46,7 +46,7 @@ drawUI FBS{_fb=b, _exception'=exc} = [drawException exc, center $ ui <=> help]
vBox [ hCenter $ txt "Up/Down: select, h: toggle show hidden files"
, hCenter $ txt "/: search, Ctrl-C or Esc: cancel search"
, hCenter $ txt "Enter: change directory or select file"
, hCenter $ txt "Esc: quit"
, hCenter $ txt "Esc or q: quit"
]
handleEvent :: GlobalState -> FBS -> BrickEvent Name Event -> EventM Name (Next GlobalState)

View File

@ -14,7 +14,7 @@ drawUI = (:[]) . const ui
ui :: Widget Name
ui =
joinBorders $
center $
center $
withBorderStyle unicodeRounded $
border $
hLimit 40 $
@ -29,6 +29,7 @@ handleEvent gs s (VtyEvent e) =
halt' = continue . popState in
case e of
V.EvKey V.KEsc [] -> halt' gs
V.EvKey (V.KChar 'q') [] -> halt' gs
V.EvKey V.KEnter [] -> halt' gs
V.EvKey V.KDown [] -> vScrollBy (viewportScroll Ordinary) 1 >> continue' s
V.EvKey (V.KChar 'j') [] -> vScrollBy (viewportScroll Ordinary) 1 >> continue' s
@ -45,7 +46,7 @@ theMap = attrMap V.defAttr
[ (titleAttr, fg V.yellow) ]
drawInfo :: Widget Name
drawInfo =
drawInfo =
padLeftRight 1 $
vLimitPercent 60 $
viewport Ordinary Vertical (strWrap info)
@ -67,4 +68,4 @@ info = unlines
, ""
, " * Use 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"]

View File

@ -19,16 +19,16 @@ title :: Widget Name
title = withAttr titleAttr $
str "┬ ┬┌─┐┌─┐┌─┐┌─┐┬─┐┌┬┐" <=>
str "├─┤├─┤└─┐│ ├─┤├┬┘ ││" <=>
str "┴ ┴┴ ┴└─┘└─┘┴ ┴┴└──┴┘"
str "┴ ┴┴ ┴└─┘└─┘┴ ┴┴└──┴┘"
drawUI :: MMS -> [Widget Name]
drawUI s =
drawUI s =
[ drawMenu s ]
drawMenu :: MMS -> Widget Name
drawMenu s =
drawMenu s =
joinBorders $
center $
center $
withBorderStyle unicodeRounded $
border $
hLimit 40 $
@ -49,11 +49,12 @@ handleEvent gs s (VtyEvent e) =
let update = updateMMS gs in
case e of
V.EvKey V.KEsc [] -> halt gs
V.EvKey (V.KChar 'q') [] -> halt gs
V.EvKey V.KEnter [] ->
case L.listSelected (s^.l) of
Just 0 -> continue =<< (gs `goToState`) <$> liftIO cardSelectorState
Just 1 -> continue $ gs `goToState` infoState
Just 2 -> continue =<< (gs `goToState`) <$> liftIO settingsState
Just 2 -> continue =<< (gs `goToState`) <$> liftIO settingsState
Just 3 -> halt gs
_ -> undefined

View File

@ -20,14 +20,14 @@ drawUI = (:[]) . ui
ui :: PS -> Widget Name
ui s =
joinBorders $
center $
center $
withBorderStyle unicodeRounded $
border $
hLimitPercent 60 $
hLimit 40 $
hCenter (withAttr titleAttr (str "Select parameters")) <=>
hBorder <=>
padLeftRight 1
padLeftRight 1
(renderForm (s ^. psForm))
handleEvent :: GlobalState -> PS -> BrickEvent Name Event -> EventM Name (Next GlobalState)
@ -50,6 +50,7 @@ handleEvent gs s ev@(VtyEvent e) =
in case e of
-- continue gs
V.EvKey V.KEsc [] -> halt' gs
V.EvKey (V.KChar 'q') [] -> halt' gs
V.EvKey V.KDown [] -> down
V.EvKey (V.KChar 'j') [] -> down
V.EvKey V.KUp [] -> up
@ -58,8 +59,8 @@ handleEvent gs s ev@(VtyEvent e) =
V.EvKey V.KBackTab [] -> continue gs
_ -> do f <- handleFormEvent ev form
if formState f ^. pOk
then continue =<< (gs `goToState`)
<$> liftIO (cardsWithOptionsState
then continue =<< (gs `goToState`)
<$> liftIO (cardsWithOptionsState
(gs & parameters .~ formState f)
(s ^. psFp)
(s ^. psCards))

View File

@ -19,7 +19,7 @@ drawUI = (:[]) . ui
ui :: SS -> Widget Name
ui f =
joinBorders $
center $
center $
withBorderStyle unicodeRounded $
border $
hLimitPercent 60 $
@ -34,7 +34,7 @@ handleEvent gs form ev@(VtyEvent e) =
let update = updateSS gs
continue' = continue . update
halt' global = continue (popState global) <* liftIO (setSettings (formState form))
focus = formFocus form
(Just n) = focusGetCurrent focus
down = if n == MaxRecentsField then continue gs
@ -45,6 +45,7 @@ handleEvent gs form ev@(VtyEvent e) =
in
case e of
V.EvKey V.KEsc [] -> halt' gs
V.EvKey (V.KChar 'q') [] -> halt' gs
V.EvKey V.KDown [] -> down
V.EvKey (V.KChar 'j') [] -> down
V.EvKey V.KUp [] -> up