BrickHelper.hs

{-# LANGUAGE RankNTypes #-}

module TextUI.ItemField.BrickHelper
       ( getEventWidgetLocation
       , BChan, newBChan, writeBChan, readBChan
       , defaultConfig
       )
       where

import Brick.Main (lookupViewport, lookupExtent, clickedExtent)
import Brick.Types (EventM, Location(..), locationRowL, locationColumnL,
                    Extent(..), Viewport(..))
import Brick.Widgets.Core (Named(..))
import Data.Monoid ((<>))
import Lens.Micro ((^.))
import Control.Concurrent
import Data.Default
import Graphics.Vty

-- Vty 5.15 introduces defaultConfig instead of using Data.Default.def

defaultConfig :: Graphics.Vty.Config
defaultConfig = def

-- Brick 0.16 introduces the BChan to abstract over the underlying
-- Chan implementation.

type BChan a = Chan a

newBChan :: forall a. Int -> IO (BChan a)
newBChan _ = newChan

writeBChan :: forall a. Chan a -> a -> IO ()
writeBChan = writeChan

readBChan :: forall a. Chan a -> IO a
readBChan = readChan


-- | When processing a global EvMouseDown VtyEvent, the coordinates of
-- the mouse event on the screen must be mapped to a specific location
-- in a Widget.  The `lookupExtent` function will return the "extent"
-- of the Widget (i.e. where it was drawn and how big it is) but this
-- only indicates that the widget was clocked and does not identify
-- the actual location within the widget where the click occurred.
--
-- The `getEventWidgetLocation` function translates the mouse event
-- coordinates to a specific location within the widget in the
-- widget's local reference frame, taking into account any scrolling
-- that has occurred within a viewport that wraps that widget.
--
--    drawUI st = reportExtent (getName st) $
--                viewport (getName st) Vertical $
--                Widget Fixed Fixed $ ...
--
--    handleEvent event st =
--      case event of
--        EvMouseDown col row button _mods ->
--          do wcoords <- getEventWidgetLocation fieldw col row
--             case wcoords of
--               Nothing -> return fieldw
--               Just l -> ...
--
getEventWidgetLocation :: (Named a n, Ord n)
                          => a -> Int -> Int -> EventM n (Maybe Location)
getEventWidgetLocation widget screenCol screenRow =
    do mExtent <- Brick.Main.lookupExtent (getName widget)
       case mExtent of
         Nothing -> return Nothing
         Just e@(Extent _ upperLeft _ _) ->
             if Brick.Main.clickedExtent (screenCol, screenRow) e
             then let widgetRow = screenRow - upperLeft^.locationRowL
                      widgetCol = screenCol - upperLeft^.locationColumnL
                      widgetLoc = Location (widgetCol, widgetRow)
                  in do mView <- Brick.Main.lookupViewport (getName widget)
                        case mView of
                          Nothing -> return $ Just widgetLoc
                          Just (VP left top _) ->
                            return $ Just $ widgetLoc <> Location (left, top)
             else return Nothing