mirror of
https://github.com/swarm-game/swarm.git
synced 2024-08-17 10:30:31 +03:00
Handle mouse click event (#437)
This change adds support for mouse event: - Change panel focus - Display world location distance to the center Fixes #203
This commit is contained in:
parent
9fdfeb7554
commit
88933d82fb
@ -66,6 +66,7 @@ appMain seed scenario toRun cheat = do
|
||||
|
||||
let buildVty = V.mkVty V.defaultConfig
|
||||
initialVty <- buildVty
|
||||
V.setMode (V.outputIface initialVty) V.Mouse True
|
||||
void $ customMain initialVty buildVty (Just chan) app s
|
||||
|
||||
-- | If available for the terminal emulator, enable bracketed paste mode.
|
||||
|
@ -214,6 +214,24 @@ handleMainEvent s = \case
|
||||
ControlKey 'k'
|
||||
| s ^. uiState . uiCheatMode -> continue (s & gameState . creativeMode %~ not)
|
||||
FKey 1 -> toggleModal s HelpModal >>= continue
|
||||
MouseDown n _ _ mouseLoc ->
|
||||
case n of
|
||||
WorldPanel -> do
|
||||
mouseCoordsM <- mouseLocToWorldCoords (s ^. gameState) mouseLoc
|
||||
continue (s & uiState . uiWorldCursor .~ mouseCoordsM)
|
||||
REPLPanel ->
|
||||
-- Do not clear the world cursor when going back to the REPL
|
||||
continueWithoutRedraw s
|
||||
_ -> continueWithoutRedraw (s & uiState . uiWorldCursor .~ Nothing)
|
||||
MouseUp n _ _mouseLoc -> do
|
||||
setFocus s $ case n of
|
||||
-- Adapt click event origin to their right panel.
|
||||
-- For the REPL and the World view, using 'Brick.Widgets.Core.clickable' correctly set the origin.
|
||||
-- However this does not seems to work for the robot and info panel.
|
||||
-- Thus we force the destination focus here.
|
||||
InventoryList -> RobotPanel
|
||||
InfoViewport -> InfoPanel
|
||||
_ -> n
|
||||
-- dispatch any other events to the focused panel handler
|
||||
ev ->
|
||||
case focusGetCurrent (s ^. uiState . uiFocusRing) of
|
||||
@ -223,6 +241,19 @@ handleMainEvent s = \case
|
||||
Just InfoPanel -> handleInfoPanelEvent s ev
|
||||
_ -> continueWithoutRedraw s
|
||||
|
||||
mouseLocToWorldCoords :: GameState -> Brick.Location -> EventM Name (Maybe W.Coords)
|
||||
mouseLocToWorldCoords gs (Brick.Location mouseLoc) = do
|
||||
mext <- lookupExtent WorldExtent
|
||||
pure $ case mext of
|
||||
Nothing -> Nothing
|
||||
Just ext ->
|
||||
let region = viewingRegion gs (bimap fromIntegral fromIntegral (extentSize ext))
|
||||
regionStart = W.unCoords (fst region)
|
||||
mouseLoc' = bimap fromIntegral fromIntegral mouseLoc
|
||||
mx = snd mouseLoc' + fst regionStart
|
||||
my = fst mouseLoc' + snd regionStart
|
||||
in Just $ W.Coords (mx, my)
|
||||
|
||||
setFocus :: AppState -> Name -> EventM Name (Next AppState)
|
||||
setFocus s name = continue $ s & uiState . uiFocusRing %~ focusSetCurrent name
|
||||
|
||||
|
@ -60,6 +60,7 @@ module Swarm.TUI.Model (
|
||||
uiPrevMenu,
|
||||
uiCheatMode,
|
||||
uiFocusRing,
|
||||
uiWorldCursor,
|
||||
uiReplForm,
|
||||
uiReplType,
|
||||
uiReplHistory,
|
||||
@ -137,6 +138,7 @@ import Swarm.Game.Entity as E
|
||||
import Swarm.Game.Robot
|
||||
import Swarm.Game.Scenario (ScenarioItem)
|
||||
import Swarm.Game.State
|
||||
import qualified Swarm.Game.World as W
|
||||
import Swarm.Language.Types
|
||||
import Swarm.Util
|
||||
|
||||
@ -363,6 +365,7 @@ data UIState = UIState
|
||||
, _uiPrevMenu :: Menu
|
||||
, _uiCheatMode :: Bool
|
||||
, _uiFocusRing :: FocusRing Name
|
||||
, _uiWorldCursor :: Maybe W.Coords
|
||||
, _uiReplForm :: Form Text AppEvent Name
|
||||
, _uiReplType :: Maybe Polytype
|
||||
, _uiReplLast :: Text
|
||||
@ -419,6 +422,9 @@ uiCheatMode :: Lens' UIState Bool
|
||||
-- the Tab key.
|
||||
uiFocusRing :: Lens' UIState (FocusRing Name)
|
||||
|
||||
-- | The last clicked position on the world view.
|
||||
uiWorldCursor :: Lens' UIState (Maybe W.Coords)
|
||||
|
||||
-- | The form where the user can type input at the REPL.
|
||||
uiReplForm :: Lens' UIState (Form Text AppEvent Name)
|
||||
|
||||
@ -587,6 +593,7 @@ initUIState showMainMenu cheatMode = liftIO $ do
|
||||
, _uiPrevMenu = NoMenu
|
||||
, _uiCheatMode = cheatMode
|
||||
, _uiFocusRing = initFocusRing
|
||||
, _uiWorldCursor = Nothing
|
||||
, _uiReplForm = initReplForm
|
||||
, _uiReplType = Nothing
|
||||
, _uiReplHistory = newREPLHistory history
|
||||
|
@ -205,29 +205,39 @@ drawGameUI s =
|
||||
highlightAttr
|
||||
fr
|
||||
WorldPanel
|
||||
(plainBorder & bottomLabels . rightLabel ?~ padLeftRight 1 (drawTPS s))
|
||||
(plainBorder & bottomLabels . rightLabel ?~ padLeftRight 1 (drawTPS s) & addCursorPos)
|
||||
(drawWorld $ s ^. gameState)
|
||||
, drawKeyMenu s
|
||||
, panel
|
||||
highlightAttr
|
||||
fr
|
||||
REPLPanel
|
||||
( plainBorder
|
||||
& topLabels . rightLabel .~ (drawType <$> (s ^. uiState . uiReplType))
|
||||
)
|
||||
( vLimit replHeight $
|
||||
padBottom Max $
|
||||
padLeftRight 1 $
|
||||
drawREPL s
|
||||
)
|
||||
, clickable REPLPanel $
|
||||
panel
|
||||
highlightAttr
|
||||
fr
|
||||
REPLPanel
|
||||
( plainBorder
|
||||
& topLabels . rightLabel .~ (drawType <$> (s ^. uiState . uiReplType))
|
||||
)
|
||||
( vLimit replHeight
|
||||
. padBottom Max
|
||||
. padLeftRight 1
|
||||
$ drawREPL s
|
||||
)
|
||||
]
|
||||
]
|
||||
]
|
||||
where
|
||||
addCursorPos = case s ^. uiState . uiWorldCursor of
|
||||
Just coord -> topLabels . rightLabel ?~ padLeftRight 1 (drawWorldCursorInfo (s ^. gameState) coord)
|
||||
Nothing -> id
|
||||
fr = s ^. uiState . uiFocusRing
|
||||
moreTop = s ^. uiState . uiMoreInfoTop
|
||||
moreBot = s ^. uiState . uiMoreInfoBot
|
||||
|
||||
drawWorldCursorInfo :: GameState -> W.Coords -> Widget Name
|
||||
drawWorldCursorInfo g i@(W.Coords (y, x)) =
|
||||
hBox [entity, txt $ " at " <> from (show x) <> " " <> from (show (y * (-1)))]
|
||||
where
|
||||
entity = snd $ drawCell (hiding g) (g ^. world) i
|
||||
|
||||
-- | 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
|
||||
@ -419,15 +429,18 @@ drawKeyCmd (key, cmd) = txt $ T.concat ["[", key, "] ", cmd]
|
||||
-- | Draw the current world view.
|
||||
drawWorld :: GameState -> Widget Name
|
||||
drawWorld g =
|
||||
center $
|
||||
cached WorldCache $
|
||||
reportExtent WorldExtent $
|
||||
Widget Fixed Fixed $ do
|
||||
ctx <- getContext
|
||||
let w = ctx ^. availWidthL
|
||||
h = ctx ^. availHeightL
|
||||
ixs = range (viewingRegion g (fromIntegral w, fromIntegral h))
|
||||
render . vBox . map hBox . chunksOf w . map drawLoc $ ixs
|
||||
center
|
||||
. cached WorldCache
|
||||
. reportExtent WorldExtent
|
||||
-- Set the clickable request after the extent to play nice with the cache
|
||||
. clickable WorldPanel
|
||||
. Widget Fixed Fixed
|
||||
$ do
|
||||
ctx <- getContext
|
||||
let w = ctx ^. availWidthL
|
||||
h = ctx ^. availHeightL
|
||||
ixs = range (viewingRegion g (fromIntegral w, fromIntegral h))
|
||||
render . vBox . map hBox . chunksOf w . map drawLoc $ ixs
|
||||
where
|
||||
-- XXX update how this works! Gather all displays, all
|
||||
-- entities... Should make a Display remember which is the
|
||||
@ -443,11 +456,7 @@ drawWorld g =
|
||||
|
||||
drawLoc :: W.Coords -> Widget Name
|
||||
drawLoc coords =
|
||||
let (ePrio, eWidget) = drawCell hiding (g ^. world) coords
|
||||
hiding =
|
||||
if g ^. creativeMode
|
||||
then HideNoEntity
|
||||
else maybe HideAllEntities HideEntityUnknownTo $ focusedRobot g
|
||||
let (ePrio, eWidget) = drawCell (hiding g) (g ^. world) coords
|
||||
in case M.lookup (W.coordsToLoc coords) robotsByLoc of
|
||||
Just r
|
||||
| ePrio > (r ^. robotDisplay . displayPriority) -> eWidget
|
||||
@ -458,6 +467,11 @@ drawWorld g =
|
||||
|
||||
data HideEntity = HideAllEntities | HideNoEntity | HideEntityUnknownTo Robot
|
||||
|
||||
hiding :: GameState -> HideEntity
|
||||
hiding g
|
||||
| g ^. creativeMode = HideNoEntity
|
||||
| otherwise = maybe HideAllEntities HideEntityUnknownTo $ focusedRobot g
|
||||
|
||||
-- | Draw a single cell of the world, either hiding entities that current robot does not know,
|
||||
-- or hiding all/none depending on Left value (True/False).
|
||||
drawCell :: HideEntity -> W.World Int Entity -> W.Coords -> (Int, Widget Name)
|
||||
|
Loading…
Reference in New Issue
Block a user