Handle mouse click event (#437)

This change adds support for mouse event:
- Change panel focus
- Display world location distance to the center

Fixes #203

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.

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
 

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

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)