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

import Brick
import Brick.Widgets.Border
import Brick.Widgets.Border.Style
import Brick.Widgets.Center
import Control.Monad.IO.Class
import Lens.Micro.Platform
import Runners
import Settings
import States
import StateManagement
import UI.Attributes
import UI.BrickHelpers
import qualified Graphics.Vty as V
import qualified Brick.Widgets.List as L

title :: Widget Name
title :: Widget Name
title = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
titleAttr forall a b. (a -> b) -> a -> b
$
        forall n. String -> Widget n
str String
"┬ ┬┌─┐┌─┐┌─┐┌─┐┬─┐┌┬┐" forall n. Widget n -> Widget n -> Widget n
<=>
        forall n. String -> Widget n
str String
"├─┤├─┤└─┐│  ├─┤├┬┘ ││" forall n. Widget n -> Widget n -> Widget n
<=>
        forall n. String -> Widget n
str String
"┴ ┴┴ ┴└─┘└─┘┴ ┴┴└──┴┘"

drawUI :: MMS -> [Widget Name]
drawUI :: MMS -> [Widget Name]
drawUI MMS
s =
  [ MMS -> Widget Name
drawMenu MMS
s ]

drawMenu :: MMS -> Widget Name
drawMenu :: MMS -> Widget Name
drawMenu MMS
s =
  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 Widget Name
title forall n. Widget n -> Widget n -> Widget n
<=>
  forall n. Widget n
hBorder forall n. Widget n -> Widget n -> Widget n
<=>
  MMS -> Widget Name
drawList MMS
s

drawList :: MMS -> Widget Name
drawList :: MMS -> Widget Name
drawList MMS
s = forall n. Int -> Widget n -> Widget n
vLimit Int
4 forall a b. (a -> b) -> a -> b
$
             forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
L.renderList Bool -> String -> Widget Name
drawListElement Bool
True (MMS
sforall s a. s -> Getting a s a -> a
^.Lens' MMS (List Name String)
l)

drawListElement :: Bool -> String -> Widget Name
drawListElement :: Bool -> String -> Widget Name
drawListElement Bool
selected = forall n. (Widget n -> Widget n) -> String -> Widget n
hCenteredStrWrapWithAttr forall n. Widget n -> Widget n
attr
  where attr :: Widget n -> Widget n
attr = if Bool
selected then forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
selectedAttr else forall a. a -> a
id

handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()
handleEvent :: BrickEvent Name () -> EventM Name GlobalState ()
handleEvent (VtyEvent Event
e) = case Event
e of
  V.EvKey Key
V.KEsc [] -> forall n s. EventM n s ()
halt
  V.EvKey (V.KChar Char
'q') []  -> forall n s. EventM n s ()
halt
  V.EvKey Key
V.KEnter [] -> do
    List Name String
list <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' GlobalState MMS
mmsforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' MMS (List Name String)
l)
    case forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
L.listSelected List Name String
list of
      Just Int
0 -> forall (m :: * -> *). MonadState GlobalState m => State -> m ()
goToState forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO State
cardSelectorState
      Just Int
1 -> forall (m :: * -> *). MonadState GlobalState m => State -> m ()
goToState State
infoState
      Just Int
2 -> forall (m :: * -> *). MonadState GlobalState m => State -> m ()
goToState forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO State
settingsState
      Just Int
3 -> forall n s. EventM n s ()
halt
      Maybe Int
_ -> forall a. HasCallStack => a
undefined

  Event
ev -> forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (Lens' GlobalState MMS
mmsforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' MMS (List Name String)
l) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
(Event -> EventM n (GenericList n t e) ())
-> Event -> EventM n (GenericList n t e) ()
L.handleListEventVi forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
L.handleListEvent Event
ev
handleEvent BrickEvent Name ()
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()