packages feed

thock-0.2.0.0: src/UI/Offline.hs

-- | This module has deals with UI specific to the offline game and for transitioning to online.
module UI.Offline where

import Brick
  ( BrickEvent (VtyEvent),
    EventM,
    Next,
    Padding (Max),
    Widget,
    fill,
    hLimit,
    hLimitPercent,
    padBottom,
    showFirstCursor,
    txt,
    txtWrap,
    vLimit,
    withAttr,
    (<+>),
    (<=>),
  )
import Brick.Forms
  ( Form (formState),
    editTextField,
    handleFormEvent,
    newForm,
    renderForm,
    (@@=),
  )
import qualified Brick.Main as M
import qualified Brick.Widgets.Center as C
import qualified Brick.Widgets.List as L
import Client (runClient)
import Control.Lens ((&), (+~), (^.))
import Control.Monad.IO.Class (MonadIO (liftIO))
import qualified Data.Text as T
import qualified Graphics.Vty as V
import Quotes (generateQuote)
import Thock
  ( Game (..),
    GameState,
    HasRoomId (roomId),
    HasUsername (username),
    MenuList,
    ResourceName (RoomIdField, UsernameField),
    RoomForm,
    RoomFormData (RoomFormData),
    Username (Username),
    generateRoomId,
    initialGame,
    isDone,
    onlineSelectState,
    quote,
    startPracticeGame,
    strokes,
    value,
  )
import UI.Attributes (attributeMap, redAttr, secondaryAttr)
import UI.Common
  ( addBorder,
    drawFinished,
    drawInput,
    drawProgressBarGameState,
    drawPrompt,
    listDrawElement,
    titleWidget,
    updateGameState,
  )

-- | Brick app for handling an offline 'Game'
localApp :: M.App Game () ResourceName
localApp =
  M.App
    { M.appDraw = drawGame,
      M.appChooseCursor = showFirstCursor,
      M.appHandleEvent = handleKeyGame,
      M.appStartEvent = return,
      M.appAttrMap = const attributeMap
    }

-- | Draws the given 'Game' based on its current state
drawGame :: Game -> [Widget ResourceName]
drawGame g = case g of
  MainMenu l -> drawList l
  OnlineSelect l -> drawList l
  CreateRoomMenu form -> drawForm form
  JoinRoomMenu form -> drawForm form
  Practice gs -> drawPractice gs
  ErrorOverlay prev t -> drawError prev t

-- | Renders a list widget under the logo
drawList :: MenuList -> [Widget ResourceName]
drawList l = [drawMenu listWidget]
  where
    listWidget = L.renderList listDrawElement True l

-- | Renders a form widget under the logo
drawForm :: RoomForm a -> [Widget ResourceName]
drawForm form = [drawMenu formWidget]
  where
    formWidget = vLimit 6 $ hLimitPercent 80 (renderForm form)

-- | Draws the title over another widget w
drawMenu :: Widget ResourceName -> Widget ResourceName
drawMenu w = addBorder "" (C.center titleWidget <=> padBottom Max (C.hCenter w))

-- | Draw a practice game based on its 'GameState'
drawPractice :: GameState -> [Widget ResourceName]
drawPractice g =
  [ drawFinished g "Back: Esc | Retry: ^r | Next: ^n",
    drawProgressBarGameState g <=> drawPrompt g <=> drawInput g
  ]

-- | Draws an error popup over the 'Game'
drawError :: Game -> T.Text -> [Widget ResourceName]
drawError g t = errorPopup : drawGame g
  where
    errorPopup = C.centerLayer . hLimitPercent 80 . addBorder "error" $ withAttr redAttr (txtWrap t)

-- | Handles events based on the current state of the 'Game'
handleKeyGame :: Game -> BrickEvent ResourceName () -> EventM ResourceName (Next Game)
handleKeyGame gs ev = case gs of
  MainMenu l -> handleKeyMainMenu l ev
  OnlineSelect l -> handleKeyOnlineSelect l ev
  CreateRoomMenu form -> handleKeyForm CreateRoomMenu (\u -> generateRoomId >>= runClient True . RoomFormData u) (^. value) form ev
  JoinRoomMenu form -> handleKeyForm JoinRoomMenu (runClient False) (^. (username . value)) form ev
  Practice g -> handleKeyPractice g ev
  ErrorOverlay prev _ -> M.continue prev -- after receiving any event, remove the error overlay

-- | Handles key events for navigating the 'MainMenu'
handleKeyMainMenu :: MenuList -> BrickEvent ResourceName e -> EventM ResourceName (Next Game)
handleKeyMainMenu l (VtyEvent e) = case e of
  V.EvKey V.KEsc [] -> M.halt (MainMenu l)
  V.EvKey V.KEnter []
    | Just i <- L.listSelected l ->
      if i == 0
        then liftIO generateQuote >>= M.continue . startPracticeGame
        else M.continue onlineSelectState
  ev -> L.handleListEvent ev l >>= M.continue . MainMenu
handleKeyMainMenu l _ = M.continue (MainMenu l)

-- | Handles key events for creating or joining an online room
handleKeyOnlineSelect :: MenuList -> BrickEvent ResourceName e -> EventM ResourceName (Next Game)
handleKeyOnlineSelect l (VtyEvent e) = case e of
  V.EvKey V.KEsc [] -> M.continue initialGame
  V.EvKey V.KEnter []
    | Just i <- L.listSelected l ->
      M.continue
        ( if i == 0
            then CreateRoomMenu (makeCreateRoomForm emptyUsername)
            else JoinRoomMenu (makeJoinRoomForm emptyRoomFormData)
        )
    where
      emptyUsername = Username ""
      emptyRoomFormData = RoomFormData emptyUsername ""
  ev -> L.handleListEvent ev l >>= M.continue . OnlineSelect
handleKeyOnlineSelect l _ = M.continue (OnlineSelect l)

-- | Handles a key event for a form and its validation
handleKeyForm ::
  -- | Function to construct a Game from the given form
  (RoomForm a -> Game) ->
  -- | Action to run when the form is submitted, returns a possible error
  (a -> IO (Maybe T.Text)) ->
  -- | Function to get the username from the given form
  (a -> T.Text) ->
  RoomForm a ->
  BrickEvent ResourceName () ->
  EventM ResourceName (Next Game)
handleKeyForm ctr onEnter getUser form ev@(VtyEvent e) = case e of
  V.EvKey V.KEsc [] -> M.continue initialGame
  V.EvKey V.KEnter [] ->
    if not . T.null $ getUser (formState form)
      then
        M.suspendAndResume
          (maybe initialGame (ErrorOverlay (ctr form)) <$> onEnter (formState form))
      else M.continue (ErrorOverlay (ctr form) "username cannot be empty")
  _ -> handleFormEvent ev form >>= M.continue . ctr
handleKeyForm ctr _ _ form _ = M.continue (ctr form)

-- | Construct a 'RoomForm' with the given 'Username' as the initial state
makeCreateRoomForm :: Username -> RoomForm Username
makeCreateRoomForm =
  newForm
    [ formLabel "Username"
        @@= addBorder ""
        @@= editTextField value UsernameField (Just 1)
    ]

-- | Construct a 'RoomForm' with the given 'RoomFormData' as the initial state
makeJoinRoomForm :: RoomFormData -> RoomForm RoomFormData
makeJoinRoomForm =
  newForm
    [ formLabel "Username"
        @@= addBorder ""
        @@= editTextField (username . value) UsernameField (Just 1),
      formLabel "Room ID"
        @@= addBorder ""
        @@= editTextField roomId RoomIdField (Just 1)
    ]

-- | Label a widget using the given text in the style of a form
formLabel :: T.Text -> Widget n -> Widget n
formLabel t w = C.vCenter label <+> C.vCenter w
  where
    label = vLimit 1 (hLimit 15 $ withAttr secondaryAttr $ txt t <+> fill ' ')

-- | Handles key events for updating the 'GameState' in a 'Practice' game
handleKeyPractice :: GameState -> BrickEvent ResourceName e -> EventM ResourceName (Next Game)
handleKeyPractice g (VtyEvent ev) =
  case ev of
    V.EvKey V.KEsc [] -> M.continue initialGame
    V.EvKey (V.KChar 'r') [V.MCtrl] -> M.continue (startPracticeGame (g ^. quote))
    V.EvKey (V.KChar 'n') [V.MCtrl] -> liftIO generateQuote >>= M.continue . startPracticeGame
    V.EvKey (V.KChar _) [] -> nextState (g & strokes +~ 1)
    _ -> nextState g
  where
    nextState g' =
      if isDone g'
        then M.continue (Practice g')
        else updateGameState g' ev >>= M.continue . Practice
handleKeyPractice g _ = M.continue (Practice g)