{-# LANGUAGE DataKinds #-}

-- | Text-field context menu (Cut / Copy / Paste / Select All): opening,
-- picking, painting, spans and cursor.
module NanoUI.Frame.TextEdit.Menu
  ( textEditMenuWidth
  , textEditMenuRectAt
  , openTextEditMenu
  , finalizeTextEditMenuPick
  , closeTextEditMenuOnOutsideClick
  , closeTextEditMenuOnEscape
  , drawTextEditMenuOverlays
  , collectTextEditMenuSpans
  , textEditMenuCursorKind
  , textFieldWidgetAtMouse
  , applyTextFieldMenuAction
  ) where

import Control.Monad (forM, forM_, unless, when)
import Data.IORef (writeIORef)
import qualified Data.IntMap.Strict as IM
import qualified Data.Text as T
import NanoUI.Context
  ( Context (..)
  , TextInputMenu (..)
  , WidgetStore (..)
  , getStore
  , getTextInputMenu
  , intKey
  , isDisabled
  , markDirty
  , markEscapeConsumed
  , setTextInputMenu
  , widgetTheme
  , InteractionState (..)
  , modifyInteraction
  )
import NanoUI.Draw (pushRect, pushText)
import NanoUI.Font
  ( centeredTextY
  , menuItemPadX
  , menuItemRowH
  , menuMinW
  , menuOuterPad
  , menuSepH
  , widgetContentInset
  )
import NanoUI.Frame.Chrome (overlayMenuStyle, paintMenuAccent, paintMenuPanel)
import NanoUI.Frame.Hit (nodeClippedHit, overlayHitAllowed, widgetOverlayAllowed)
import NanoUI.Frame.TextArea.Content (isMouseOnTextAreaScrollBarAt)
import NanoUI.Id (WidgetId)
import NanoUI.Input
  ( Input (..)
  , Key (..)
  , UiCursorKind (..)
  , inputKeys
  , inputKeysElem
  , inputMousePos
  , inputMousePressed
  , inputMouseRightPressed
  , inputWindowSize
  )
import NanoUI.Layout.Arena (NodeType (NodeTextArea, NodeTextInput), findNodeRevM, getNodeType, getRect, getWidgetId)
import NanoUI.Style (Style (..), themeSeparator)
import NanoUI.Types (Color (..), Rect (..), Size (..), V2 (..), lerpColor, rectContains)
import NanoUI.Widgets.TextEditor (EditorMode (..), TextCommand (..), canRedo, canUndo)
import NanoUI.Widgets.TextField (applyTextFieldCommand, textFieldHistory, textFieldMode)

data TextEditMenuRow
  = TextEditMenuSep
  | TextEditMenuItem Int T.Text

-- | The menu's commands, in row order; a row's index is its item number.
textEditMenuCommands :: [TextCommand]
textEditMenuCommands :: [TextCommand]
textEditMenuCommands = [TextCommand
Undo, TextCommand
Redo, TextCommand
Cut, TextCommand
Copy, TextCommand
Paste, TextCommand
SelectAll]

textEditMenuRows :: [TextEditMenuRow]
textEditMenuRows :: [TextEditMenuRow]
textEditMenuRows =
  [ Int -> Text -> TextEditMenuRow
TextEditMenuItem Int
0 Text
"Undo"
  , Int -> Text -> TextEditMenuRow
TextEditMenuItem Int
1 Text
"Redo"
  , TextEditMenuRow
TextEditMenuSep
  , Int -> Text -> TextEditMenuRow
TextEditMenuItem Int
2 Text
"Cut"
  , Int -> Text -> TextEditMenuRow
TextEditMenuItem Int
3 Text
"Copy"
  , Int -> Text -> TextEditMenuRow
TextEditMenuItem Int
4 Text
"Paste"
  , TextEditMenuRow
TextEditMenuSep
  , Int -> Text -> TextEditMenuRow
TextEditMenuItem Int
5 Text
"Select All"
  ]

-- Use the same row metrics as generic popup menus.
textEditMenuRowH :: TextEditMenuRow -> Float
textEditMenuRowH :: TextEditMenuRow -> Float
textEditMenuRowH = \case
  TextEditMenuRow
TextEditMenuSep -> Float
menuSepH
  TextEditMenuItem {} -> Float
menuItemRowH

textEditMenuContentH :: Float
textEditMenuContentH :: Float
textEditMenuContentH = [Float] -> Float
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((TextEditMenuRow -> Float) -> [TextEditMenuRow] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map TextEditMenuRow -> Float
textEditMenuRowH [TextEditMenuRow]
textEditMenuRows)

textEditMenuWidth :: Context -> IO Float
textEditMenuWidth :: Context -> IO Float
textEditMenuWidth Context
ctx = do
  ws <- (Text -> IO Float) -> [Text] -> IO [Float]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (((Float, Float) -> Float) -> IO (Float, Float) -> IO Float
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Float, Float) -> Float
forall a b. (a, b) -> a
fst (IO (Float, Float) -> IO Float)
-> (Text -> IO (Float, Float)) -> Text -> IO Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Text -> IO (Float, Float)
ctxMeasureText Context
ctx) [Text
lbl | TextEditMenuItem Int
_ Text
lbl <- [TextEditMenuRow]
textEditMenuRows]
  pure (max menuMinW (maximum ws + 2 * menuItemPadX + 2 * menuOuterPad))

-- | Menu rect at the pointer, kept inside the window.
textEditMenuRectAt :: Float -> Float -> Float -> Size -> Rect
textEditMenuRectAt :: Float -> Float -> Float -> Size -> Rect
textEditMenuRectAt Float
x Float
y Float
menuW (Size Float
ww Float
wh) =
  let h :: Float
h = Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
menuOuterPad Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
textEditMenuContentH
   in Float -> Float -> Float -> Float -> Rect
Rect (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
x (Float
ww Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
menuW))) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
y (Float
wh Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
h))) Float
menuW Float
h

textEditMenuContentRect :: Rect -> Rect
textEditMenuContentRect :: Rect -> Rect
textEditMenuContentRect (Rect Float
x Float
y Float
w Float
_) =
  Float -> Float -> Float -> Float -> Rect
Rect (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
menuOuterPad) (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
menuOuterPad) (Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
menuOuterPad) Float
textEditMenuContentH

-- | Every row with its band spanning the full menu width.
textEditMenuLayout :: Rect -> [(TextEditMenuRow, Rect)]
textEditMenuLayout :: Rect -> [(TextEditMenuRow, Rect)]
textEditMenuLayout menuRect :: Rect
menuRect@(Rect Float
mx Float
_ Float
mw Float
_) =
  let Rect Float
_ Float
top Float
_ Float
_ = Rect -> Rect
textEditMenuContentRect Rect
menuRect
      go :: Float -> [TextEditMenuRow] -> [(TextEditMenuRow, Rect)]
go Float
_ [] = []
      go Float
relY (TextEditMenuRow
entry : [TextEditMenuRow]
rest) =
        let h :: Float
h = TextEditMenuRow -> Float
textEditMenuRowH TextEditMenuRow
entry
         in (TextEditMenuRow
entry, Float -> Float -> Float -> Float -> Rect
Rect Float
mx (Float
top Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
relY) Float
mw Float
h) (TextEditMenuRow, Rect)
-> [(TextEditMenuRow, Rect)] -> [(TextEditMenuRow, Rect)]
forall a. a -> [a] -> [a]
: Float -> [TextEditMenuRow] -> [(TextEditMenuRow, Rect)]
go (Float
relY Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h) [TextEditMenuRow]
rest
   in Float -> [TextEditMenuRow] -> [(TextEditMenuRow, Rect)]
go Float
0 [TextEditMenuRow]
textEditMenuRows

textEditMenuPickAction :: Rect -> V2 -> Maybe Int
textEditMenuPickAction :: Rect -> V2 -> Maybe Int
textEditMenuPickAction Rect
menuRect mouse :: V2
mouse@(V2 Float
_ Float
my) =
  let Rect Float
_ Float
top Float
_ Float
_ = Rect -> Rect
textEditMenuContentRect Rect
menuRect
   in if Float
my Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
top Bool -> Bool -> Bool
|| Float
my Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
top Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
textEditMenuContentH
        then Maybe Int
forall a. Maybe a
Nothing
        else
          case [TextEditMenuRow
entry | (TextEditMenuRow
entry, Rect
row) <- Rect -> [(TextEditMenuRow, Rect)]
textEditMenuLayout Rect
menuRect, Rect -> Bool
rectContainsY Rect
row] of
            TextEditMenuItem Int
action Text
_ : [TextEditMenuRow]
_ -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
action
            [TextEditMenuRow]
_ -> Maybe Int
forall a. Maybe a
Nothing
  where
    rectContainsY :: Rect -> Bool
rectContainsY (Rect Float
_ Float
ry Float
_ Float
rh) = let V2 Float
_ Float
py = V2
mouse in Float
py Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
ry Bool -> Bool -> Bool
&& Float
py Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
ry Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rh

textEditMenuItemFg :: Style -> Bool -> Color
textEditMenuItemFg :: Style -> Bool -> Color
textEditMenuItemFg Style
style Bool
enabled =
  if Bool
enabled
    then Style -> Color
styleFg Style
style
    else Color -> Color -> Float -> Color
lerpColor (Style -> Color
styleFg Style
style) (Style -> Color
styleBg Style
style) Float
0.55

openTextEditMenu :: Context -> Input -> IO ()
openTextEditMenu :: Context -> Input -> IO ()
openTextEditMenu Context
ctx Input
inp =
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Input -> Bool
inputMouseRightPressed Input
inp) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let mouse :: V2
mouse@(V2 Float
mx Float
my) = Input -> V2
inputMousePos Input
inp
    mWid <- Context -> V2 -> IO (Maybe WidgetId)
textFieldWidgetAtMouse Context
ctx V2
mouse
    case mWid of
      Maybe WidgetId
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just WidgetId
wid -> do
        IORef WidgetId -> WidgetId -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Context -> IORef WidgetId
ctxFocusId Context
ctx) WidgetId
wid
        menuW <- Context -> IO Float
textEditMenuWidth Context
ctx
        let menuRect = Float -> Float -> Float -> Size -> Rect
textEditMenuRectAt Float
mx Float
my Float
menuW (Input -> Size
inputWindowSize Input
inp)
        setTextInputMenu ctx (Just (TextInputMenu wid menuRect))
        markDirty ctx

textFieldWidgetAtMouse :: Context -> V2 -> IO (Maybe WidgetId)
textFieldWidgetAtMouse :: Context -> V2 -> IO (Maybe WidgetId)
textFieldWidgetAtMouse Context
ctx V2
mouse = do
  let na :: NodeArena
na = Context -> NodeArena
ctxNodeArena Context
ctx
  mIdx <-
    NodeArena -> (Int -> IO Bool) -> IO (Maybe Int)
findNodeRevM NodeArena
na ((Int -> IO Bool) -> IO (Maybe Int))
-> (Int -> IO Bool) -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ \Int
idx -> do
      nt <- NodeArena -> Int -> IO NodeType
getNodeType NodeArena
na Int
idx
      if nt /= NodeTextInput && nt /= NodeTextArea
        then pure False
        else do
          wid <- getWidgetId na idx
          disabled <- isDisabled ctx wid
          if disabled
            then pure False
            else do
              (x, y, w, h) <- getRect na idx
              hit <- nodeClippedHit ctx idx (Rect x y w h) mouse
              if not hit
                then pure False
                else do
                  allowed <- overlayHitAllowed ctx idx mouse
                  if not allowed
                    then pure False
                    else
                      if nt == NodeTextArea
                        then not <$> isMouseOnTextAreaScrollBarAt ctx idx mouse
                        else pure True
  traverse (getWidgetId na) mIdx

finalizeTextEditMenuPick :: Context -> Input -> IO ()
finalizeTextEditMenuPick :: Context -> Input -> IO ()
finalizeTextEditMenuPick Context
ctx Input
inp =
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Input -> Bool
inputMousePressed Input
inp) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    mMenu <- Context -> IO (Maybe TextInputMenu)
getTextInputMenu Context
ctx
    case mMenu of
      Just TextInputMenu
menu
        | Rect -> V2 -> Bool
rectContains (TextInputMenu -> Rect
textInputMenuRect TextInputMenu
menu) (Input -> V2
inputMousePos Input
inp) ->
            case Rect -> V2 -> Maybe Int
textEditMenuPickAction (TextInputMenu -> Rect
textInputMenuRect TextInputMenu
menu) (Input -> V2
inputMousePos Input
inp) of
              Maybe Int
Nothing -> Context -> Maybe TextInputMenu -> IO ()
setTextInputMenu Context
ctx Maybe TextInputMenu
forall a. Maybe a
Nothing
              Just Int
action -> do
                enabled <- Context -> WidgetId -> Int -> IO Bool
textFieldMenuActionEnabled Context
ctx (TextInputMenu -> WidgetId
textInputMenuWidget TextInputMenu
menu) Int
action
                if enabled
                  then applyTextFieldMenuAction ctx (textInputMenuWidget menu) action
                  else do
                    setTextInputMenu ctx Nothing
                    markDirty ctx
      Maybe TextInputMenu
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

closeTextEditMenuOnOutsideClick :: Context -> Input -> IO ()
closeTextEditMenuOnOutsideClick :: Context -> Input -> IO ()
closeTextEditMenuOnOutsideClick Context
ctx Input
inp =
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Input -> Bool
inputMousePressed Input
inp Bool -> Bool -> Bool
|| Input -> Bool
inputMouseRightPressed Input
inp) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    mMenu <- Context -> IO (Maybe TextInputMenu)
getTextInputMenu Context
ctx
    case mMenu of
      Just TextInputMenu
menu
        | Bool -> Bool
not (Rect -> V2 -> Bool
rectContains (TextInputMenu -> Rect
textInputMenuRect TextInputMenu
menu) (Input -> V2
inputMousePos Input
inp)) ->
            Context -> Maybe TextInputMenu -> IO ()
setTextInputMenu Context
ctx Maybe TextInputMenu
forall a. Maybe a
Nothing
      Maybe TextInputMenu
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

closeTextEditMenuOnEscape :: Context -> Input -> IO ()
closeTextEditMenuOnEscape :: Context -> Input -> IO ()
closeTextEditMenuOnEscape Context
ctx Input
inp =
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key -> SmallArray Key -> Bool
inputKeysElem Key
KeyEscape (Input -> SmallArray Key
inputKeys Input
inp)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Context -> IO (Maybe TextInputMenu)
getTextInputMenu Context
ctx IO (Maybe TextInputMenu) -> (Maybe TextInputMenu -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe TextInputMenu
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just TextInputMenu
_ -> do
        Context -> Maybe TextInputMenu -> IO ()
setTextInputMenu Context
ctx Maybe TextInputMenu
forall a. Maybe a
Nothing
        Context -> IO ()
markEscapeConsumed Context
ctx
        Context -> IO ()
markDirty Context
ctx

textEditMenuCursorKind :: Context -> Input -> IO (Maybe UiCursorKind)
textEditMenuCursorKind :: Context -> Input -> IO (Maybe UiCursorKind)
textEditMenuCursorKind Context
ctx Input
inp = do
  mMenu <- Context -> IO (Maybe TextInputMenu)
getTextInputMenu Context
ctx
  let mouse = Input -> V2
inputMousePos Input
inp
  case mMenu of
    Just TextInputMenu
menu
      | Rect -> V2 -> Bool
rectContains (TextInputMenu -> Rect
textInputMenuRect TextInputMenu
menu) V2
mouse
      , Just Int
action <- Rect -> V2 -> Maybe Int
textEditMenuPickAction (TextInputMenu -> Rect
textInputMenuRect TextInputMenu
menu) V2
mouse -> do
          enabled <- Context -> WidgetId -> Int -> IO Bool
textFieldMenuActionEnabled Context
ctx (TextInputMenu -> WidgetId
textInputMenuWidget TextInputMenu
menu) Int
action
          pure (Just (if enabled then UiCursorPointer else UiCursorDefault))
    Maybe TextInputMenu
_ -> Maybe UiCursorKind -> IO (Maybe UiCursorKind)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe UiCursorKind
forall a. Maybe a
Nothing

drawTextEditMenuOverlays :: Context -> Input -> IO ()
drawTextEditMenuOverlays :: Context -> Input -> IO ()
drawTextEditMenuOverlays Context
ctx Input
inp = do
  mMenu <- Context -> IO (Maybe TextInputMenu)
getTextInputMenu Context
ctx
  forM_ mMenu $ \TextInputMenu
menu -> do
    let wid :: WidgetId
wid = TextInputMenu -> WidgetId
textInputMenuWidget TextInputMenu
menu
    allow <- Context -> WidgetId -> IO Bool
widgetOverlayAllowed Context
ctx WidgetId
wid
    when allow $ do
      theme <- widgetTheme ctx wid
      let da = Context -> DrawArena
ctxDrawArena Context
ctx
          fm = Context -> FontMetrics
ctxFontMetrics Context
ctx
          menuRect = TextInputMenu -> Rect
textInputMenuRect TextInputMenu
menu
          style = Theme -> Style
overlayMenuStyle Theme
theme
          Rect contentX _ _ _ = textEditMenuContentRect menuRect
          labelX = Float
contentX Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
menuItemPadX Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float, Float) -> Float
forall a b. (a, b) -> a
fst (FontMetrics -> (Float, Float)
widgetContentInset FontMetrics
fm)
      paintMenuPanel da theme style menuRect
      forM_ (textEditMenuLayout menuRect) $ \case
        (TextEditMenuRow
TextEditMenuSep, Rect Float
rx Float
ry Float
rw Float
rh) ->
          DrawArena -> Rect -> Color -> IO ()
pushRect DrawArena
da (Float -> Float -> Float -> Float -> Rect
Rect (Float
rx Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
menuItemPadX) (Float
ry Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rh Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2) (Float
rw Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
menuItemPadX) Float
1) (Theme -> Color
themeSeparator Theme
theme)
        (TextEditMenuItem Int
action Text
lbl, row :: Rect
row@(Rect Float
_ Float
ry Float
_ Float
rh)) -> do
          enabled <- Context -> WidgetId -> Int -> IO Bool
textFieldMenuActionEnabled Context
ctx WidgetId
wid Int
action
          when (enabled && rectContains row (inputMousePos inp)) $ do
            pushRect da row (styleHoverBg style)
            paintMenuAccent da theme row
          unless (T.null lbl) $ do
            (_, th) <- ctxMeasureText ctx lbl
            pushText da fm labelX (centeredTextY fm ry rh th) lbl (textEditMenuItemFg style enabled)

collectTextEditMenuSpans :: Context -> Input -> IO [(Rect, T.Text, Color, Color, Rect)]
collectTextEditMenuSpans :: Context -> Input -> IO [(Rect, Text, Color, Color, Rect)]
collectTextEditMenuSpans Context
ctx Input
inp = do
  mMenu <- Context -> IO (Maybe TextInputMenu)
getTextInputMenu Context
ctx
  case mMenu of
    Maybe TextInputMenu
Nothing -> [(Rect, Text, Color, Color, Rect)]
-> IO [(Rect, Text, Color, Color, Rect)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just TextInputMenu
menu -> do
      let wid :: WidgetId
wid = TextInputMenu -> WidgetId
textInputMenuWidget TextInputMenu
menu
      allow <- Context -> WidgetId -> IO Bool
widgetOverlayAllowed Context
ctx WidgetId
wid
      if not allow
        then pure []
        else do
          theme <- widgetTheme ctx wid
          let fm = Context -> FontMetrics
ctxFontMetrics Context
ctx
              menuRect = TextInputMenu -> Rect
textInputMenuRect TextInputMenu
menu
              style = Theme -> Style
overlayMenuStyle Theme
theme
              Rect contentX _ _ _ = textEditMenuContentRect menuRect
              labelX = Float
contentX Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
menuItemPadX Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float, Float) -> Float
forall a b. (a, b) -> a
fst (FontMetrics -> (Float, Float)
widgetContentInset FontMetrics
fm)
          fmap concat . forM (textEditMenuLayout menuRect) $ \case
            (TextEditMenuRow
TextEditMenuSep, Rect
_) -> [(Rect, Text, Color, Color, Rect)]
-> IO [(Rect, Text, Color, Color, Rect)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            (TextEditMenuItem Int
action Text
lbl, row :: Rect
row@(Rect Float
_ Float
ry Float
_ Float
rh)) -> do
              enabled <- Context -> WidgetId -> Int -> IO Bool
textFieldMenuActionEnabled Context
ctx WidgetId
wid Int
action
              (tw, th) <- ctxMeasureText ctx lbl
              let bg
                    | Bool
enabled Bool -> Bool -> Bool
&& Rect -> V2 -> Bool
rectContains Rect
row (Input -> V2
inputMousePos Input
inp) = Style -> Color
styleHoverBg Style
style
                    | Bool
otherwise = Style -> Color
styleBg Style
style
              pure [(Rect labelX (centeredTextY fm ry rh th) tw th, lbl, textEditMenuItemFg style enabled, bg, menuRect)]

applyTextFieldMenuAction :: Context -> WidgetId -> Int -> IO ()
applyTextFieldMenuAction :: Context -> WidgetId -> Int -> IO ()
applyTextFieldMenuAction Context
ctx WidgetId
wid Int
item =
  [TextCommand] -> (TextCommand -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Int -> [TextCommand] -> [TextCommand]
forall a. Int -> [a] -> [a]
take Int
1 (Int -> [TextCommand] -> [TextCommand]
forall a. Int -> [a] -> [a]
drop Int
item [TextCommand]
textEditMenuCommands)) ((TextCommand -> IO ()) -> IO ())
-> (TextCommand -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TextCommand
cmd -> do
    Context -> (InteractionState -> InteractionState) -> IO ()
modifyInteraction Context
ctx (\InteractionState
s -> InteractionState
s {isTextEditLastAction = Just (wid, cmd)})
    Context -> WidgetId -> TextCommand -> IO ()
applyTextFieldCommand Context
ctx WidgetId
wid TextCommand
cmd

textFieldMenuActionEnabled :: Context -> WidgetId -> Int -> IO Bool
textFieldMenuActionEnabled :: Context -> WidgetId -> Int -> IO Bool
textFieldMenuActionEnabled Context
ctx WidgetId
wid Int
item = do
  store <- Context -> IO WidgetStore
getStore Context
ctx
  mMode <- textFieldMode ctx wid
  history <- textFieldHistory ctx wid
  let hasText = Bool -> Bool
not (Text -> Bool
T.null (Text -> Int -> IntMap Text -> Text
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Text
"" (WidgetId -> Int
intKey WidgetId
wid) (WidgetStore -> IntMap Text
storeText WidgetStore
store)))
  case (mMode, drop item textEditMenuCommands) of
    (Just EditorMode
mode, TextCommand
cmd : [TextCommand]
_) -> case TextCommand
cmd of
      TextCommand
Undo -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EditorMode -> Bool
modeEditable EditorMode
mode Bool -> Bool -> Bool
&& EditHistory -> Bool
canUndo EditHistory
history)
      TextCommand
Redo -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EditorMode -> Bool
modeEditable EditorMode
mode Bool -> Bool -> Bool
&& EditHistory -> Bool
canRedo EditHistory
history)
      TextCommand
Cut -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EditorMode -> Bool
modeEditable EditorMode
mode Bool -> Bool -> Bool
&& EditorMode -> Bool
modeCopyable EditorMode
mode Bool -> Bool -> Bool
&& Bool
hasText)
      TextCommand
Copy -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EditorMode -> Bool
modeCopyable EditorMode
mode Bool -> Bool -> Bool
&& Bool
hasText)
      TextCommand
Paste
        | EditorMode -> Bool
modeEditable EditorMode
mode -> Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) (Maybe Text -> Bool) -> IO (Maybe Text) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> IO (Maybe Text)
ctxClipboardGet Context
ctx
        | Bool
otherwise -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      TextCommand
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
hasText
    (Maybe EditorMode, [TextCommand])
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False