-
Notifications
You must be signed in to change notification settings - Fork 52
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Extract utils from Controller and View
- Loading branch information
Showing
5 changed files
with
131 additions
and
102 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,24 @@ | ||
| {-# LANGUAGE PatternSynonyms #-} | ||
|
|
||
| module Swarm.TUI.Controller.ControllerUtils where | ||
|
|
||
| import Brick hiding (Direction) | ||
| import Graphics.Vty qualified as V | ||
|
|
||
| -- | Pattern synonyms to simplify brick event handler | ||
| pattern Key :: V.Key -> BrickEvent n e | ||
| pattern Key k = VtyEvent (V.EvKey k []) | ||
|
|
||
| pattern CharKey, ControlChar, MetaChar :: Char -> BrickEvent n e | ||
| pattern CharKey c = VtyEvent (V.EvKey (V.KChar c) []) | ||
| pattern ControlChar c = VtyEvent (V.EvKey (V.KChar c) [V.MCtrl]) | ||
| pattern MetaChar c = VtyEvent (V.EvKey (V.KChar c) [V.MMeta]) | ||
|
|
||
| pattern ShiftKey :: V.Key -> BrickEvent n e | ||
| pattern ShiftKey k = VtyEvent (V.EvKey k [V.MShift]) | ||
|
|
||
| pattern EscapeKey :: BrickEvent n e | ||
| pattern EscapeKey = VtyEvent (V.EvKey V.KEsc []) | ||
|
|
||
| pattern FKey :: Int -> BrickEvent n e | ||
| pattern FKey c = VtyEvent (V.EvKey (V.KFun c) []) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,103 @@ | ||
| {-# LANGUAGE OverloadedStrings #-} | ||
|
|
||
| module Swarm.TUI.View.ViewUtils where | ||
|
|
||
| import Brick hiding (Direction) | ||
| import Brick.Widgets.Dialog | ||
| import Brick.Widgets.List qualified as BL | ||
| import Control.Lens hiding (Const, from) | ||
| import Data.List.NonEmpty (NonEmpty (..)) | ||
| import Data.Maybe (catMaybes, fromMaybe) | ||
| import Data.Text (Text) | ||
| import Data.Text qualified as T | ||
| import Swarm.Game.Entity as E | ||
| import Swarm.Game.Scenario (scenarioName) | ||
| import Swarm.Game.ScenarioInfo (scenarioItemName) | ||
| import Swarm.Game.State | ||
| import Swarm.Language.Pretty (prettyText) | ||
| import Swarm.Language.Types (Polytype) | ||
| import Swarm.TUI.Attr | ||
| import Swarm.TUI.Model | ||
| import Witch (from, into) | ||
|
|
||
| -- | Generate a fresh modal window of the requested type. | ||
| generateModal :: AppState -> ModalType -> Modal | ||
| generateModal s mt = Modal mt (dialog (Just title) buttons (maxModalWindowWidth `min` requiredWidth)) | ||
| where | ||
| currentScenario = s ^. uiState . scenarioRef | ||
| currentSeed = s ^. gameState . seed | ||
| haltingMessage = case s ^. uiState . uiMenu of | ||
| NoMenu -> Just "Quit" | ||
| _ -> Nothing | ||
| descriptionWidth = 100 | ||
| helpWidth = 80 | ||
| (title, buttons, requiredWidth) = | ||
| case mt of | ||
| HelpModal -> (" Help ", Nothing, helpWidth) | ||
| RobotsModal -> ("Robots", Nothing, descriptionWidth) | ||
| RecipesModal -> ("Available Recipes", Nothing, descriptionWidth) | ||
| CommandsModal -> ("Available Commands", Nothing, descriptionWidth) | ||
| MessagesModal -> ("Messages", Nothing, descriptionWidth) | ||
| WinModal -> | ||
| let nextMsg = "Next challenge!" | ||
| stopMsg = fromMaybe "Return to the menu" haltingMessage | ||
| continueMsg = "Keep playing" | ||
| in ( "" | ||
| , Just | ||
| ( 0 | ||
| , [ (nextMsg, NextButton scene) | ||
| | Just scene <- [nextScenario (s ^. uiState . uiMenu)] | ||
| ] | ||
| ++ [ (stopMsg, QuitButton) | ||
| , (continueMsg, KeepPlayingButton) | ||
| ] | ||
| ) | ||
| , sum (map length [nextMsg, stopMsg, continueMsg]) + 32 | ||
| ) | ||
| DescriptionModal e -> (descriptionTitle e, Nothing, descriptionWidth) | ||
| QuitModal -> | ||
| let stopMsg = fromMaybe ("Quit to" ++ maybe "" (" " ++) (into @String <$> curMenuName s) ++ " menu") haltingMessage | ||
| maybeStartOver = sequenceA ("Start over", StartOverButton currentSeed <$> currentScenario) | ||
| in ( "" | ||
| , Just | ||
| ( 0 | ||
| , catMaybes | ||
| [ Just ("Keep playing", CancelButton) | ||
| , maybeStartOver | ||
| , Just (stopMsg, QuitButton) | ||
| ] | ||
| ) | ||
| , T.length (quitMsg (s ^. uiState . uiMenu)) + 4 | ||
| ) | ||
| GoalModal _ -> | ||
| let goalModalTitle = case currentScenario of | ||
| Nothing -> "Goal" | ||
| Just (scenario, _) -> scenario ^. scenarioName | ||
| in (" " <> T.unpack goalModalTitle <> " ", Nothing, 80) | ||
| KeepPlayingModal -> ("", Just (0, [("OK", CancelButton)]), 80) | ||
|
|
||
| -- | Render the type of the current REPL input to be shown to the user. | ||
| drawType :: Polytype -> Widget Name | ||
| drawType = withAttr infoAttr . padLeftRight 1 . txt . prettyText | ||
|
|
||
| descriptionTitle :: Entity -> String | ||
| descriptionTitle e = " " ++ from @Text (e ^. entityName) ++ " " | ||
|
|
||
| -- | Width cap for modal and error message windows | ||
| maxModalWindowWidth :: Int | ||
| maxModalWindowWidth = 500 | ||
|
|
||
| -- | Get the name of the current New Game menu. | ||
| curMenuName :: AppState -> Maybe Text | ||
| curMenuName s = case s ^. uiState . uiMenu of | ||
| NewGameMenu (_ :| (parentMenu : _)) -> | ||
| Just (parentMenu ^. BL.listSelectedElementL . to scenarioItemName) | ||
| NewGameMenu _ -> Just "Scenarios" | ||
| _ -> Nothing | ||
|
|
||
| quitMsg :: Menu -> Text | ||
| quitMsg m = "Are you sure you want to " <> quitAction <> "? All progress on this scenario will be lost!" | ||
| where | ||
| quitAction = case m of | ||
| NoMenu -> "quit" | ||
| _ -> "return to the menu" |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters