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

Merge pull request #13 from g-w1/master

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/UI/CardSelector.hs
View File

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

106
src/UI/Cards.hs
View File

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

2
src/UI/FileBrowser.hs
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" vBox [ hCenter $ txt "Up/Down: select, h: toggle show hidden files"
, hCenter $ txt "/: search, Ctrl-C or Esc: cancel search" , hCenter $ txt "/: search, Ctrl-C or Esc: cancel search"
, hCenter $ txt "Enter: change directory or select file" , 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) handleEvent :: GlobalState -> FBS -> BrickEvent Name Event -> EventM Name (Next GlobalState)

7
src/UI/Info.hs
View File

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

11
src/UI/MainMenu.hs
View File

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

9
src/UI/Parameter.hs
View File

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

5
src/UI/Settings.hs
View File

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