diff --git a/src/Swarm/App.hs b/src/Swarm/App.hs index eddf6521..87615a1a 100644 --- a/src/Swarm/App.hs +++ b/src/Swarm/App.hs @@ -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. diff --git a/src/Swarm/TUI/Controller.hs b/src/Swarm/TUI/Controller.hs index c921bacd..9add43d8 100644 --- a/src/Swarm/TUI/Controller.hs +++ b/src/Swarm/TUI/Controller.hs @@ -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 diff --git a/src/Swarm/TUI/Model.hs b/src/Swarm/TUI/Model.hs index faaffd80..9a66fd5d 100644 --- a/src/Swarm/TUI/Model.hs +++ b/src/Swarm/TUI/Model.hs @@ -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 diff --git a/src/Swarm/TUI/View.hs b/src/Swarm/TUI/View.hs index c0a5f6c7..a22b17c7 100644 --- a/src/Swarm/TUI/View.hs +++ b/src/Swarm/TUI/View.hs @@ -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)