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 Graphics.Vty as V

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

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

handleEvent :: GlobalState -> IS -> BrickEvent Name Event -> EventM Name (Next GlobalState)
handleEvent :: GlobalState
-> IS -> BrickEvent Name IS -> EventM Name (Next GlobalState)
handleEvent GlobalState
gs IS
s (VtyEvent Event
e) =
  let update :: IS -> GlobalState
update = GlobalState -> IS -> GlobalState
updateIS GlobalState
gs
      continue' :: IS -> EventM n (Next GlobalState)
continue' = GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM n (Next GlobalState))
-> (IS -> GlobalState) -> IS -> EventM n (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IS -> GlobalState
update
      halt' :: GlobalState -> EventM n (Next GlobalState)
halt' = GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM n (Next GlobalState))
-> (GlobalState -> GlobalState)
-> GlobalState
-> EventM n (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalState -> GlobalState
popState in
    case Event
e of
      V.EvKey Key
V.KEsc [] -> GlobalState -> EventM Name (Next GlobalState)
forall n. GlobalState -> EventM n (Next GlobalState)
halt' GlobalState
gs
      V.EvKey (V.KChar Char
'q') [] -> GlobalState -> EventM Name (Next GlobalState)
forall n. GlobalState -> EventM n (Next GlobalState)
halt' GlobalState
gs
      V.EvKey Key
V.KEnter [] -> GlobalState -> EventM Name (Next GlobalState)
forall n. GlobalState -> EventM n (Next GlobalState)
halt' GlobalState
gs
      V.EvKey Key
V.KDown [] -> ViewportScroll Name -> Int -> EventM Name IS
forall n. ViewportScroll n -> Int -> EventM n IS
vScrollBy (Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
Ordinary) Int
1 EventM Name IS
-> EventM Name (Next GlobalState) -> EventM Name (Next GlobalState)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IS -> EventM Name (Next GlobalState)
forall n. IS -> EventM n (Next GlobalState)
continue' IS
s
      V.EvKey (V.KChar Char
'j') [] -> ViewportScroll Name -> Int -> EventM Name IS
forall n. ViewportScroll n -> Int -> EventM n IS
vScrollBy (Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
Ordinary) Int
1 EventM Name IS
-> EventM Name (Next GlobalState) -> EventM Name (Next GlobalState)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IS -> EventM Name (Next GlobalState)
forall n. IS -> EventM n (Next GlobalState)
continue' IS
s
      V.EvKey Key
V.KUp [] -> ViewportScroll Name -> Int -> EventM Name IS
forall n. ViewportScroll n -> Int -> EventM n IS
vScrollBy (Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
Ordinary) (-Int
1) EventM Name IS
-> EventM Name (Next GlobalState) -> EventM Name (Next GlobalState)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IS -> EventM Name (Next GlobalState)
forall n. IS -> EventM n (Next GlobalState)
continue' IS
s
      V.EvKey (V.KChar Char
'k') [] -> ViewportScroll Name -> Int -> EventM Name IS
forall n. ViewportScroll n -> Int -> EventM n IS
vScrollBy (Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
Ordinary) (-Int
1) EventM Name IS
-> EventM Name (Next GlobalState) -> EventM Name (Next GlobalState)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IS -> EventM Name (Next GlobalState)
forall n. IS -> EventM n (Next GlobalState)
continue' IS
s
      Event
_ -> IS -> EventM Name (Next GlobalState)
forall n. IS -> EventM n (Next GlobalState)
continue' IS
s
handleEvent GlobalState
gs IS
_ BrickEvent Name IS
_ = GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs

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 =
  Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
  Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimitPercent Int
60 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
  Name -> ViewportType -> Widget Name -> Widget Name
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport Name
Ordinary ViewportType
Vertical (String -> Widget Name
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
" * Press the s key to toggle shuffling inside the deck selector menu"
  , 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 F1 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"]