1
1
mirror of https://github.com/Yvee1/hascard.git synced 2024-11-25 20:33:34 +03:00

replaced custom manual UI with basic brick UI

This commit is contained in:
Yvee1 2020-01-21 22:12:36 +01:00
parent 561bb70ba7
commit 71fd9168ac
3 changed files with 62 additions and 52 deletions

View File

@ -9,5 +9,5 @@ main = do
case args of case args of
[input] -> do [input] -> do
file <- handleFilePath input file <- handleFilePath input
runFlashcards file runBrickFlashcards file
_ -> putStrLn "error: input filepath to a flashcard" _ -> putStrLn "error: input filepath to a flashcard"

View File

@ -24,6 +24,8 @@ dependencies:
- split - split
- brick - brick
- word-wrap - word-wrap
- vty
- microlens-platform
library: library:
source-dirs: src source-dirs: src

View File

@ -1,23 +1,72 @@
{-# LANGUAGE TemplateHaskell #-}
module Lib where module Lib where
import Data.List.Split import Data.List.Split
import System.IO (stdin, hReady, hSetEcho, hSetBuffering, BufferMode(NoBuffering)) import System.IO (stdin, hReady, hSetEcho, hSetBuffering, BufferMode(NoBuffering))
import Data.Char import Data.Char
import Brick
import qualified Brick.Widgets.Border as B
import qualified Brick.Widgets.Border.Style as BS
import qualified Brick.Widgets.Center as C
import qualified Graphics.Vty as V
handleFilePath :: FilePath -> IO String import Lens.Micro.Platform
handleFilePath = readFile
-- Word Description -- Word Description
data Card = Definition String String data Card = Definition String String
deriving Show deriving Show
runFlashcards :: String -> IO () data State = State
runFlashcards input = do { _cards :: [Card] -- list of flashcards
hSetBuffering stdin NoBuffering , _index :: Int -- current card index
hSetEcho stdin False , _correct :: Int -- not implemented, but for score keeping
}
makeLenses ''State
type Event = ()
type Name = ()
app :: App State Event Name
app = App
{ appDraw = drawUI
, appChooseCursor = neverShowCursor
, appHandleEvent = handleEvent
, appStartEvent = return
, appAttrMap = const theMap
}
drawUI :: State -> [Widget Name]
drawUI s = [drawCardUI s]
drawCardUI :: State -> Widget Name
drawCardUI s = C.center $
B.border $
hLimitPercent 60 $
vLimitPercent 40 $
padTopBottom 1 $
padLeftRight 5 $
C.hCenter (str title) <=> str descr
where Definition title descr = (s ^. cards) !! (s ^. index)
handleEvent :: State -> BrickEvent Name Event -> EventM Name (Next State)
handleEvent s (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt s
handleEvent s (VtyEvent (V.EvKey V.KEsc [])) = halt s
handleEvent s (VtyEvent (V.EvKey V.KEnter [])) = continue $ next s
handleEvent s _ = continue s
theMap :: AttrMap
theMap = attrMap V.defAttr []
handleFilePath :: FilePath -> IO String
handleFilePath = readFile
runBrickFlashcards :: String -> IO ()
runBrickFlashcards input = do
let cards = stringToCards input let cards = stringToCards input
drawCards cards let initialState = State cards 0 0
quit finalState <- defaultMain app initialState
pure ()
stringToCards :: String -> [Card] stringToCards :: String -> [Card]
stringToCards = map stringToCard . splitString stringToCards = map stringToCard . splitString
@ -31,46 +80,5 @@ stringToCard s = let (firstLine : rest) = dropWhile (`elem` ["\n", "\r\n", "\r",
splitString :: String -> [String] splitString :: String -> [String]
splitString = splitOn "---" splitString = splitOn "---"
drawCard :: Card -> IO () next :: State -> State
drawCard (Definition word def) = do next s = s & index %~ (+1)
cls
goto (1, 1)
putStr "\ESC[1;4m"
putStrLn word
putStr "\ESC[0m"
putStrLn def
drawCards :: [Card] -> IO ()
drawCards [] = pure ()
drawCards (c : cs) = do
drawCard c
next cs
next :: [Card] -> IO ()
next cs = do cmd <- getKey
case cmd of
"q" -> quit
"\ESC" -> quit
"\n" -> drawCards cs
_ -> next cs
cls :: IO ()
cls = putStr "\ESC[2J"
type Pos = (Int, Int)
goto :: Pos -> IO ()
goto (x, y) = putStr ("\ESC[" ++ show y ++ ";" ++ show x ++ "H")
-- from https://stackoverflow.com/a/38553473/11931091
getKey :: IO String
getKey = reverse <$> getKey' ""
where getKey' chars = do
char <- getChar
more <- hReady stdin
(if more then getKey' else return) (char:chars)
quit :: IO ()
quit = do
cls
goto (1, 1)