module UI.Info (State, drawUI, handleEvent, theMap) where

import Brick
import Brick.Widgets.Border
import Brick.Widgets.Border.Style
import Brick.Widgets.Center
import States
import StateManagement
import qualified Brick.Types as T
import qualified Graphics.Vty as V
import UI.BrickHelpers

drawUI :: IS -> [Widget Name]
drawUI :: IS -> [Widget Name]
drawUI = (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const Widget Name
ui

ui :: Widget Name
ui :: Widget Name
ui =
  forall n. Widget n -> Widget n
joinBorders forall a b. (a -> b) -> a -> b
$
  forall n. Widget n -> Widget n
center forall a b. (a -> b) -> a -> b
$
  forall n. BorderStyle -> Widget n -> Widget n
withBorderStyle BorderStyle
unicodeRounded forall a b. (a -> b) -> a -> b
$
  forall n. Widget n -> Widget n
border forall a b. (a -> b) -> a -> b
$
  forall n. Int -> Widget n -> Widget n
hLimit Int
40 forall a b. (a -> b) -> a -> b
$
  forall n. Widget n -> Widget n
hCenter (forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
titleAttr (forall n. String -> Widget n
str String
"Info")) forall n. Widget n -> Widget n -> Widget n
<=>
  forall n. Widget n
hBorder forall n. Widget n -> Widget n -> Widget n
<=>
  Widget Name
drawInfo

scroll :: Int -> EventM Name s ()
scroll :: forall s. Int -> EventM Name s IS
scroll = forall n. ViewportScroll n -> forall s. Int -> EventM n s IS
vScrollBy (forall n. n -> ViewportScroll n
viewportScroll Name
InfoViewport)

handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()
handleEvent :: BrickEvent Name IS -> EventM Name GlobalState IS
handleEvent (VtyEvent Event
e) = do
  case Event
e of
    V.EvKey Key
V.KEsc [] -> forall (m :: * -> *). MonadState GlobalState m => m IS
popState
    V.EvKey (V.KChar Char
'q') [] -> forall (m :: * -> *). MonadState GlobalState m => m IS
popState
    V.EvKey Key
V.KEnter [] -> forall (m :: * -> *). MonadState GlobalState m => m IS
popState
    V.EvKey Key
V.KDown [] -> forall s. Int -> EventM Name s IS
scroll Int
1
    V.EvKey (V.KChar Char
'j') [] -> forall s. Int -> EventM Name s IS
scroll Int
1
    V.EvKey Key
V.KUp [] -> forall s. Int -> EventM Name s IS
scroll (-Int
1)
    V.EvKey (V.KChar Char
'k') [] -> forall s. Int -> EventM Name s IS
scroll (-Int
1)
    Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleEvent (T.MouseDown (SBClick ClickableScrollbarElement
el Name
InfoViewport) Button
_ [Modifier]
_ Location
_) = forall n s.
(Int -> EventM n s IS)
-> ClickableScrollbarElement -> EventM n s IS
handleClickScroll forall s. Int -> EventM Name s IS
scroll ClickableScrollbarElement
el
handleEvent BrickEvent Name IS
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

titleAttr :: AttrName
titleAttr :: AttrName
titleAttr = String -> AttrName
attrName String
"title"

theMap :: AttrMap
theMap :: AttrMap
theMap = Attr -> [(AttrName, Attr)] -> AttrMap
attrMap Attr
V.defAttr
    [ (AttrName
titleAttr, Color -> Attr
fg Color
V.yellow) ]

drawInfo :: Widget Name
drawInfo :: Widget Name
drawInfo =
  forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$
  Int -> Name -> Widget Name -> Widget Name
scrollableViewportPercent Int
60 Name
InfoViewport forall a b. (a -> b) -> a -> b
$
  forall n. String -> Widget n
strWrap String
info

info :: String
info :: String
info = [String] -> String
unlines
  [ String
"Hascard is a text-based user interface for reviewing notes using 'flashcards'. Cards are written in markdown-like syntax; for more info see the README file. Use the --help flag for information on the command line options."
  , String
""
  , String
"Controls:"
  , String
" * Use arrows or the j and k keys for menu navigation"
  , String
""
  , String
" * Enter confirms a selection, flips a card or continues to the next card"
  , String
""
  , String
" * Use Tab or the arrow keys for navigating gaps in open questions"
  , String
""
  , String
" * Use the c key for confirming reorder questions or multiple choice questions with more than 1 possible answer"
  , String
""
  , String
" * Use Shift+Tab to show the answers of a open question"
  , String
""
  , String
" * Use Ctrl+Left and Ctrl+Right to move to previous and next cards without having to answer them; this is disabled in review mode"]