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 = AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
titleAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
        String -> Widget Name
forall n. String -> Widget n
str String
"┬ ┬┌─┐┌─┐┌─┐┌─┐┬─┐┌┬┐" Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=>
        String -> Widget Name
forall n. String -> Widget n
str String
"├─┤├─┤└─┐│  ├─┤├┬┘ ││" Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=>
        String -> Widget Name
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 =
  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 Widget Name
title 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
<=>
  MMS -> Widget Name
drawList MMS
s

drawList :: MMS -> Widget Name
drawList :: MMS -> Widget Name
drawList MMS
s = Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
4 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
             (Bool -> String -> Widget Name)
-> Bool -> GenericList Name Vector String -> Widget Name
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
sMMS
-> Getting
     (GenericList Name Vector String)
     MMS
     (GenericList Name Vector String)
-> GenericList Name Vector String
forall s a. s -> Getting a s a -> a
^.Getting
  (GenericList Name Vector String)
  MMS
  (GenericList Name Vector String)
Lens' MMS (GenericList Name Vector String)
l)

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

handleEvent :: GlobalState -> MMS -> BrickEvent Name Event -> EventM Name (Next GlobalState)
handleEvent :: GlobalState
-> MMS -> BrickEvent Name Event -> EventM Name (Next GlobalState)
handleEvent GlobalState
gs MMS
s (VtyEvent Event
e) =
  let update :: MMS -> GlobalState
update = GlobalState -> MMS -> GlobalState
updateMMS GlobalState
gs in
    case Event
e of
      V.EvKey Key
V.KEsc [] -> GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
halt GlobalState
gs
      V.EvKey (V.KChar Char
'q') []  -> GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
halt GlobalState
gs
      V.EvKey Key
V.KEnter [] ->
        case GenericList Name Vector String -> Maybe Int
forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
L.listSelected (MMS
sMMS
-> Getting
     (GenericList Name Vector String)
     MMS
     (GenericList Name Vector String)
-> GenericList Name Vector String
forall s a. s -> Getting a s a -> a
^.Getting
  (GenericList Name Vector String)
  MMS
  (GenericList Name Vector String)
Lens' MMS (GenericList Name Vector String)
l) of
          Just Int
0 -> GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM Name (Next GlobalState))
-> EventM Name GlobalState -> EventM Name (Next GlobalState)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (GlobalState
gs GlobalState -> State -> GlobalState
`goToState`) (State -> GlobalState)
-> EventM Name State -> EventM Name GlobalState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO State -> EventM Name State
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO State
cardSelectorState
          Just Int
1 -> GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM Name (Next GlobalState))
-> GlobalState -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ GlobalState
gs GlobalState -> State -> GlobalState
`goToState` State
infoState
          Just Int
2 -> GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM Name (Next GlobalState))
-> EventM Name GlobalState -> EventM Name (Next GlobalState)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (GlobalState
gs GlobalState -> State -> GlobalState
`goToState`) (State -> GlobalState)
-> EventM Name State -> EventM Name GlobalState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO State -> EventM Name State
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO State
settingsState
          Just Int
3 -> GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
halt GlobalState
gs
          Maybe Int
_ -> EventM Name (Next GlobalState)
forall a. HasCallStack => a
undefined

      Event
ev -> GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM Name (Next GlobalState))
-> (GenericList Name Vector String -> GlobalState)
-> GenericList Name Vector String
-> EventM Name (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMS -> GlobalState
update (MMS -> GlobalState)
-> (GenericList Name Vector String -> MMS)
-> GenericList Name Vector String
-> GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericList Name Vector String -> MMS -> MMS)
-> MMS -> GenericList Name Vector String -> MMS
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((GenericList Name Vector String
 -> Identity (GenericList Name Vector String))
-> MMS -> Identity MMS
Lens' MMS (GenericList Name Vector String)
l ((GenericList Name Vector String
  -> Identity (GenericList Name Vector String))
 -> MMS -> Identity MMS)
-> GenericList Name Vector String -> MMS -> MMS
forall s t a b. ASetter s t a b -> b -> s -> t
.~) MMS
s (GenericList Name Vector String -> EventM Name (Next GlobalState))
-> EventM Name (GenericList Name Vector String)
-> EventM Name (Next GlobalState)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Event
 -> GenericList Name Vector String
 -> EventM Name (GenericList Name Vector String))
-> Event
-> GenericList Name Vector String
-> EventM Name (GenericList Name Vector String)
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
(Event -> GenericList n t e -> EventM n (GenericList n t e))
-> Event -> GenericList n t e -> EventM n (GenericList n t e)
L.handleListEventVi Event
-> GenericList Name Vector String
-> EventM Name (GenericList Name Vector String)
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> GenericList n t e -> EventM n (GenericList n t e)
L.handleListEvent Event
ev (MMS
sMMS
-> Getting
     (GenericList Name Vector String)
     MMS
     (GenericList Name Vector String)
-> GenericList Name Vector String
forall s a. s -> Getting a s a -> a
^.Getting
  (GenericList Name Vector String)
  MMS
  (GenericList Name Vector String)
Lens' MMS (GenericList Name Vector String)
l)
handleEvent GlobalState
gs MMS
_ BrickEvent Name Event
_ = GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs