{-# LANGUAGE OverloadedStrings #-}

-- | Combo box: a search field with a filtered, scrollable suggestion dropdown.
-- The per-frame logic is the pure 'comboStep' over a persisted 'ComboState'.
module NanoUI.Widgets.Combo
  ( comboBox
  , comboBox'
  , ComboState (..)
  , ComboInput (..)
  , ComboStep (..)
  , comboStep
  )
where

import Control.Monad (foldM, when, (<$!>))
import Data.IORef (writeIORef)
import Data.IntMap.Strict qualified as IM
import Data.Maybe (fromMaybe, isJust)
import Data.Text (Text)
import Data.Text qualified as T
import Effectful (Eff, type (:>))
import NanoUI.Context
  ( Context (..)
  , getStore
  , intKey
  , markDirty
  , markEscapeConsumed
  , modifyStore
  , recordStoreText
  )
import NanoUI.Font (FontMetrics, menuItemRowH)
import NanoUI.Frame.Hit (findNodeByWidgetId)
import NanoUI.Frame.Select (comboDropPickIndex, comboDropRect, comboScrollGeom)
import NanoUI.Id (WidgetId (..))
import NanoUI.Input (Key (..), inputKeys, inputMouseDown, inputMousePos, inputMousePressed, inputScroll)
import NanoUI.Layout.Arena (setOptions)
import NanoUI.Monad (Ui, askContext, askInput, uiIO)
import NanoUI.Store
  ( WidgetStore (..)
  , boolInt
  , Slot (..)
  , slotKey
  )
import NanoUI.Types (Rect (..), V2 (..), clamp, rectContains, rectNonEmpty, v2X, v2Y)
import NanoUI.WidgetText (textInputFlagSearch)
import NanoUI.Widgets.Behavior (keyboardFocused)
import NanoUI.Widgets.Node (Response (..), setChanged)
import NanoUI.Widgets.TextInput (buildTextInput, searchFieldLayout)

-- | Maximum suggestion rows the combo dropdown shows at once; Up/Down walk
-- the highlight and the wheel scrolls the list through a sliding window.
comboBoxMaxVisible :: Int
comboBoxMaxVisible :: Int
comboBoxMaxVisible = Int
8

-- | Rows scrolled per wheel notch.
comboBoxRowsPerNotch :: Float
comboBoxRowsPerNotch :: Float
comboBoxRowsPerNotch = Float
3

-- | Case-insensitive substring filter behind the combo's suggestion list.
comboFiltered :: Foldable f => f Text -> Text -> [Text]
comboFiltered :: forall (f :: * -> *). Foldable f => f Text -> Text -> [Text]
comboFiltered f Text
options Text
q
  | Text -> Bool
T.null Text
q = [Text]
opts
  | Bool
otherwise =
      let needle :: Text
needle = Text -> Text
T.toLower Text
q
        in (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
T.isInfixOf Text
needle (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower) [Text]
opts
  where
    opts :: [Text]
opts = (Text -> [Text] -> [Text]) -> [Text] -> f Text -> [Text]
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] f Text
options

-- | A combo's state between frames.
data ComboState = ComboState
  { ComboState -> Int
csHighlight :: !Int
    -- ^ Highlighted row of the filtered list; -1 for none.
  , ComboState -> Int
csWindow :: !Int
    -- ^ First visible row.
  , ComboState -> Float
csScrollX :: !Float
  , ComboState -> Float
csContentW :: !Float
    -- ^ Widest matching row, measured while focused.
  , ComboState -> Int
csDrag :: !Int
    -- ^ Scrollbar thumb drag: 0 none, 1 vertical, 2 horizontal.
  , ComboState -> Float
csDragOff :: !Float
    -- ^ Pointer offset into the dragged thumb.
  , ComboState -> Text
csCommitted :: !Text
    -- ^ Last committed value.
  , ComboState -> Text
csLive :: !Text
    -- ^ Field text the combo last produced.
  , ComboState -> Bool
csFocused :: !Bool
  }
  deriving (ComboState -> ComboState -> Bool
(ComboState -> ComboState -> Bool)
-> (ComboState -> ComboState -> Bool) -> Eq ComboState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ComboState -> ComboState -> Bool
== :: ComboState -> ComboState -> Bool
$c/= :: ComboState -> ComboState -> Bool
/= :: ComboState -> ComboState -> Bool
Eq, Int -> ComboState -> ShowS
[ComboState] -> ShowS
ComboState -> String
(Int -> ComboState -> ShowS)
-> (ComboState -> String)
-> ([ComboState] -> ShowS)
-> Show ComboState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComboState -> ShowS
showsPrec :: Int -> ComboState -> ShowS
$cshow :: ComboState -> String
show :: ComboState -> String
$cshowList :: [ComboState] -> ShowS
showList :: [ComboState] -> ShowS
Show)

-- | One frame's inputs to 'comboStep'.
data ComboInput = ComboInput
  { ComboInput -> Bool
ciFocused :: !Bool
  , ComboInput -> Bool
ciEdited :: !Bool
    -- ^ Typing changed the field text this frame.
  , ComboInput -> Text
ciText :: !Text
    -- ^ Field text after this frame's editing.
  , ComboInput -> [Text]
ciRows :: ![Text]
    -- ^ Options matching the field text.
  , ComboInput -> Float
ciContentW :: !Float
    -- ^ Width of the widest matching row.
  , ComboInput -> Rect
ciField :: !Rect
    -- ^ The field's rect; empty before its first layout.
  , ComboInput -> FontMetrics
ciMetrics :: !FontMetrics
  , ComboInput -> V2
ciMouse :: !V2
  , ComboInput -> Bool
ciPressed :: !Bool
  , ComboInput -> Bool
ciDown :: !Bool
  , ComboInput -> V2
ciScroll :: !V2
  , ComboInput -> Bool
ciKeyUp :: !Bool
  , ComboInput -> Bool
ciKeyDown :: !Bool
  , ComboInput -> Bool
ciEnter :: !Bool
  , ComboInput -> Bool
ciEscape :: !Bool
  }

-- | What one frame of the combo decided.
data ComboStep = ComboStep
  { ComboStep -> ComboState
stepState :: !ComboState
  , ComboStep -> Maybe Text
stepCommit :: !(Maybe Text)
    -- ^ The newly committed value, on the frame the committed value changes.
  , ComboStep -> Bool
stepPicked :: !Bool
    -- ^ Enter picked the highlighted row; the caret moves to the text's end.
  , ComboStep -> Bool
stepDismissed :: !Bool
    -- ^ Escape reverted the field to the committed value and releases focus.
  , ComboStep -> Bool
stepRedraw :: !Bool
    -- ^ Something visible moved.
  }

-- | One frame of the combo: highlight, scrolling, thumb drags, and commits.
--
-- Typing edits the live text but never commits it: the committed value only
-- changes on Enter (which commits the highlighted row only), on a row click
-- (a field text the combo did not produce), or when the field loses focus.
-- Escape reverts the live text to the last committed value. Hover
-- highlights a row and makes it the Enter target; Up/Down move the highlight.
comboStep :: ComboInput -> ComboState -> ComboStep
comboStep :: ComboInput -> ComboState -> ComboStep
comboStep ComboInput
ci ComboState
cs0 =
  ComboStep
    { stepState :: ComboState
stepState =
        ComboState
          { csHighlight :: Int
csHighlight = Int
hi'
          , csWindow :: Int
csWindow = Int
win
          , csScrollX :: Float
csScrollX = Float
xOff
          , csContentW :: Float
csContentW = Float
contentW
          , csDrag :: Int
csDrag = Int
dragKind'
          , csDragOff :: Float
csDragOff = Float
dragOff'
          , csCommitted :: Text
csCommitted = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
committed0 Maybe Text
commitText
          , csLive :: Text
csLive = Text
finalText
          , csFocused :: Bool
csFocused = Bool
isFocus
          }
    , stepCommit :: Maybe Text
stepCommit = if Bool
commitPulse then Maybe Text
commitText else Maybe Text
forall a. Maybe a
Nothing
    , stepPicked :: Bool
stepPicked = Bool
picked
    , stepDismissed :: Bool
stepDismissed = Bool
escDismiss
    , stepRedraw :: Bool
stepRedraw =
        Bool
picked Bool -> Bool -> Bool
|| Int
nav Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
|| Bool
escDismiss Bool -> Bool -> Bool
|| Int
wheelDelta Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
|| Float
xWheel Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0
          Bool -> Bool -> Bool
|| Int
win Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
storedWin Bool -> Bool -> Bool
|| Float
xOff Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
storedX Bool -> Bool -> Bool
|| Int
hi' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
storedHi
          Bool -> Bool -> Bool
|| Int
dragKind' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
drag0 Bool -> Bool -> Bool
|| Bool
commitPulse Bool -> Bool -> Bool
|| ComboState -> Bool
csFocused ComboState
cs0 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
isFocus
    }
  where
    isFocus :: Bool
isFocus = ComboInput -> Bool
ciFocused ComboInput
ci
    text :: Text
text = ComboInput -> Text
ciText ComboInput
ci
    displayed :: [Text]
displayed = ComboInput -> [Text]
ciRows ComboInput
ci
    contentW :: Float
contentW = ComboInput -> Float
ciContentW ComboInput
ci
    n :: Int
n = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
displayed
    vis :: Int
vis = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
comboBoxMaxVisible
    storedHi :: Int
storedHi = ComboState -> Int
csHighlight ComboState
cs0
    storedWin :: Int
storedWin = ComboState -> Int
csWindow ComboState
cs0
    storedX :: Float
storedX = ComboState -> Float
csScrollX ComboState
cs0
    drag0 :: Int
drag0 = ComboState -> Int
csDrag ComboState
cs0
    dragOff0 :: Float
dragOff0 = ComboState -> Float
csDragOff ComboState
cs0
    committed0 :: Text
committed0 = ComboState -> Text
csCommitted ComboState
cs0
    -- Typing clears the highlight (-1): it never pre-selects a row.
    hi0 :: Int
hi0 = if ComboInput -> Bool
ciEdited ComboInput
ci then -Int
1 else Int
storedHi
    win0 :: Int
win0 = if ComboInput -> Bool
ciEdited ComboInput
ci then Int
0 else Int
storedWin
    nav :: Int
nav
      | Bool -> Bool
not Bool
isFocus Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int
0 :: Int
      | ComboInput -> Bool
ciKeyDown ComboInput
ci = Int
1
      | ComboInput -> Bool
ciKeyUp ComboInput
ci = -Int
1
      | Bool
otherwise = Int
0
    hi :: Int
hi
      | Int
nav Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int
hi0
      | Int
hi0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = if Int
nav Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int
0 else Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      | Bool
otherwise = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
hi0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nav)
    clampWin :: Int -> Int
clampWin = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
vis))
    -- Keep the highlighted row inside the window after keyboard navigation.
    alignWin :: Int -> Int
alignWin Int
v
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
vis = Int
0
      | Int
hi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
v = Int
hi
      | Int
hi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vis = Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
vis Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      | Bool
otherwise = Int -> Int
clampWin Int
v
    Rect Float
rx Float
ry Float
rw Float
rh = ComboInput -> Rect
ciField ComboInput
ci
    mouse :: V2
mouse = ComboInput -> V2
ciMouse ComboInput
ci
    dropRect :: Rect
dropRect = Float -> Float -> Float -> Float -> Int -> Int -> Float -> Rect
comboDropRect Float
rx Float
ry Float
rw Float
rh (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
vis Int
n) Int
n Float
contentW
    overDrop :: Bool
overDrop = Bool
isFocus Bool -> Bool -> Bool
&& Rect -> Bool
rectNonEmpty (ComboInput -> Rect
ciField ComboInput
ci) Bool -> Bool -> Bool
&& Rect -> V2 -> Bool
rectContains Rect
dropRect V2
mouse
    itemH :: Float
itemH = Float
menuItemRowH
    -- Hover highlights the row under the pointer (and makes it the Enter
    -- target); it never commits by itself. Rows on screen belong to the
    -- previous frame's window, so the hit test maps through storedWin.
    hoverIdx :: Maybe Int
hoverIdx
      | Bool
overDrop = (Int
storedWin Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rect -> Float -> Int -> Float -> Maybe Int
comboDropPickIndex Rect
dropRect Float
itemH (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
vis Int
n) (V2 -> Float
v2Y V2
mouse)
      | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
    hiRaw :: Int
hiRaw = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
hi Maybe Int
hoverIdx
    -- A hover mapped through a stale window can point past a shrunken list:
    -- highlight nothing then.
    hi' :: Int
hi' = if Int
hiRaw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n then Int
hiRaw else -Int
1
    -- Scrollbar geometry from the pre-frame scroll state (the thumb the user
    -- is looking at when a drag starts).
    (Rect
_, Maybe (Rect, Rect)
vSb, Maybe (Rect, Rect)
hSb, Float
usableW) = Rect
-> Int
-> Int
-> Int
-> Float
-> Float
-> (Rect, Maybe (Rect, Rect), Maybe (Rect, Rect), Float)
comboScrollGeom Rect
dropRect Int
n Int
vis Int
storedWin Float
storedX Float
contentW
    maxOffX :: Float
maxOffX = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
contentW Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
usableW)
    onVThumb :: Bool
onVThumb = Bool -> ((Rect, Rect) -> Bool) -> Maybe (Rect, Rect) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(Rect
_, Rect
th) -> Rect -> V2 -> Bool
rectContains Rect
th V2
mouse) Maybe (Rect, Rect)
vSb
    onVTrack :: Bool
onVTrack = Bool -> ((Rect, Rect) -> Bool) -> Maybe (Rect, Rect) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(Rect
t, Rect
_) -> Rect -> V2 -> Bool
rectContains Rect
t V2
mouse) Maybe (Rect, Rect)
vSb
    onHThumb :: Bool
onHThumb = Bool -> ((Rect, Rect) -> Bool) -> Maybe (Rect, Rect) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(Rect
_, Rect
th) -> Rect -> V2 -> Bool
rectContains Rect
th V2
mouse) Maybe (Rect, Rect)
hSb
    onHTrack :: Bool
onHTrack = Bool -> ((Rect, Rect) -> Bool) -> Maybe (Rect, Rect) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(Rect
t, Rect
_) -> Rect -> V2 -> Bool
rectContains Rect
t V2
mouse) Maybe (Rect, Rect)
hSb
    pressed :: Bool
pressed = Bool
isFocus Bool -> Bool -> Bool
&& ComboInput -> Bool
ciPressed ComboInput
ci
    down :: Bool
down = Bool
isFocus Bool -> Bool -> Bool
&& ComboInput -> Bool
ciDown ComboInput
ci
    startV :: Bool
startV = Bool
pressed Bool -> Bool -> Bool
&& Bool
overDrop Bool -> Bool -> Bool
&& Bool
onVTrack
    startH :: Bool
startH = Bool
pressed Bool -> Bool -> Bool
&& Bool
overDrop Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
startV Bool -> Bool -> Bool
&& Bool
onHTrack
    vThumbR :: Rect
vThumbR = Rect -> ((Rect, Rect) -> Rect) -> Maybe (Rect, Rect) -> Rect
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Float -> Float -> Float -> Float -> Rect
Rect Float
0 Float
0 Float
0 Float
0) (Rect, Rect) -> Rect
forall a b. (a, b) -> b
snd Maybe (Rect, Rect)
vSb
    vTrackR :: Rect
vTrackR = Rect -> ((Rect, Rect) -> Rect) -> Maybe (Rect, Rect) -> Rect
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Float -> Float -> Float -> Float -> Rect
Rect Float
0 Float
0 Float
0 Float
0) (Rect, Rect) -> Rect
forall a b. (a, b) -> a
fst Maybe (Rect, Rect)
vSb
    hThumbR :: Rect
hThumbR = Rect -> ((Rect, Rect) -> Rect) -> Maybe (Rect, Rect) -> Rect
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Float -> Float -> Float -> Float -> Rect
Rect Float
0 Float
0 Float
0 Float
0) (Rect, Rect) -> Rect
forall a b. (a, b) -> b
snd Maybe (Rect, Rect)
hSb
    hTrackR :: Rect
hTrackR = Rect -> ((Rect, Rect) -> Rect) -> Maybe (Rect, Rect) -> Rect
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Float -> Float -> Float -> Float -> Rect
Rect Float
0 Float
0 Float
0 Float
0) (Rect, Rect) -> Rect
forall a b. (a, b) -> a
fst Maybe (Rect, Rect)
hSb
    vGrab :: Float
vGrab = if Bool
onVThumb then V2 -> Float
v2Y V2
mouse Float -> Float -> Float
forall a. Num a => a -> a -> a
- Rect -> Float
rectY Rect
vThumbR else Rect -> Float
rectH Rect
vThumbR Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
    hGrab :: Float
hGrab = if Bool
onHThumb then V2 -> Float
v2X V2
mouse Float -> Float -> Float
forall a. Num a => a -> a -> a
- Rect -> Float
rectX Rect
hThumbR else Rect -> Float
rectW Rect
hThumbR Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
    drag1 :: Int
drag1
      | Bool
startV = Int
1
      | Bool
startH = Int
2
      | Bool
down Bool -> Bool -> Bool
&& Int
drag0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Int
drag0
      | Bool
otherwise = Int
0
    -- Thumb-anchored drags move from the next frame on; track presses jump
    -- the window to the click immediately.
    draggingV :: Bool
draggingV = Bool
down Bool -> Bool -> Bool
&& Int
drag1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& ((Int
drag0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
startV) Bool -> Bool -> Bool
|| (Bool
startV Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
onVThumb))
    draggingH :: Bool
draggingH = Bool
down Bool -> Bool -> Bool
&& Int
drag1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
&& ((Int
drag0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
startH) Bool -> Bool -> Bool
|| (Bool
startH Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
onHThumb))
    dragWin :: Int
dragWin = Int -> Int
clampWin (Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round ((V2 -> Float
v2Y V2
mouse Float -> Float -> Float
forall a. Num a => a -> a -> a
- Rect -> Float
rectY Rect
vTrackR Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
dragOff0) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
1 (Rect -> Float
rectH Rect
vTrackR Float -> Float -> Float
forall a. Num a => a -> a -> a
- Rect -> Float
rectH Rect
vThumbR) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
vis)))
    dragX :: Float
dragX = Float -> Float -> Float -> Float
forall a. Ord a => a -> a -> a -> a
clamp Float
0 Float
maxOffX ((V2 -> Float
v2X V2
mouse Float -> Float -> Float
forall a. Num a => a -> a -> a
- Rect -> Float
rectX Rect
hTrackR Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
dragOff0) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
1 (Rect -> Float
rectW Rect
hTrackR Float -> Float -> Float
forall a. Num a => a -> a -> a
- Rect -> Float
rectW Rect
hThumbR) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
maxOffX)
    wheelRows :: Int
wheelRows = Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (V2 -> Float
v2Y (ComboInput -> V2
ciScroll ComboInput
ci) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
comboBoxRowsPerNotch) :: Int
    wheelDelta :: Int
wheelDelta = if Bool
overDrop then Int
wheelRows else Int
0
    xWheel :: Float
xWheel = if Bool
overDrop then V2 -> Float
v2X (ComboInput -> V2
ciScroll ComboInput
ci) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
20 else Float
0
    win :: Int
win
      | Bool
draggingV = Int
dragWin
      | Int
nav Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Int -> Int
alignWin (Int
win0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wheelDelta)
      | Bool
otherwise = Int -> Int
clampWin (Int
win0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wheelDelta)
    xOff :: Float
xOff
      | Bool
draggingH = Float
dragX
      | Bool
otherwise = Float -> Float -> Float -> Float
forall a. Ord a => a -> a -> a -> a
clamp Float
0 Float
maxOffX (Float
storedX Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
xWheel)
    dragKind' :: Int
dragKind' = if Bool
down then Int
drag1 else Int
0
    dragOff' :: Float
dragOff' | Bool
startV = Float
vGrab | Bool
startH = Float
hGrab | Bool
otherwise = Float
dragOff0
    -- Enter commits only an explicitly highlighted row (hover or Up/Down).
    picked :: Bool
picked = Bool
isFocus Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
hi' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& ComboInput -> Bool
ciEnter ComboInput
ci
    pickedText :: Text
pickedText = case Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
hi') [Text]
displayed of
      Text
chosen : [Text]
_ | Int
hi' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 -> Text
chosen
      [Text]
_ -> Text
text
    escDismiss :: Bool
escDismiss = Bool
isFocus Bool -> Bool -> Bool
&& ComboInput -> Bool
ciEscape ComboInput
ci
    -- Commit points: Enter, a row click (the frame-side pick lands as a
    -- frame-start text the widget did not produce), and losing focus (which
    -- the blur frame after the focus clear detects). Escape is a cancel: it
    -- reverts the live text to the last committed value without committing.
    externalText :: Bool
externalText = Bool -> Bool
not (ComboInput -> Bool
ciEdited ComboInput
ci) Bool -> Bool -> Bool
&& Text
text Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= ComboState -> Text
csLive ComboState
cs0
    commitText :: Maybe Text
commitText
      | Bool
picked = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pickedText
      | Bool
externalText = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
text
      | ComboState -> Bool
csFocused ComboState
cs0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isFocus = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
text
      | Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing
    commitPulse :: Bool
commitPulse = Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
committed0) Maybe Text
commitText
    finalText :: Text
finalText
      | Bool
picked = Text
pickedText
      | Bool
escDismiss = Text
committed0
      | Bool
otherwise = Text
text

-- | Combo box: the 'searchField' with a select-style dropdown of options.
-- While the field holds focus, the shared select dropdown overlay lists the
-- options filtered by the field text (all of them while it is empty). The
-- value is free text: options are suggestions, not a closed set. See
-- 'comboStep' for when the value commits. Pass the current text; the result is
-- the text after this frame, and 'respChanged' on 'comboBox'' marks a commit.
{-# INLINE comboBox #-}
comboBox :: (Foldable f, Ui :> es) => Text -> f Text -> Text -> Eff es Text
comboBox :: forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
Text -> f Text -> Text -> Eff es Text
comboBox Text
placeholder f Text
options Text
value = (Response, Text) -> Text
forall a b. (a, b) -> b
snd ((Response, Text) -> Text)
-> Eff es (Response, Text) -> Eff es Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text -> Text -> Eff es (Response, Text)
forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
Text -> f Text -> Text -> Eff es (Response, Text)
comboBox' Text
placeholder f Text
options Text
value

comboBox' :: (Foldable f, Ui :> es) => Text -> f Text -> Text -> Eff es (Response, Text)
comboBox' :: forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
Text -> f Text -> Text -> Eff es (Response, Text)
comboBox' Text
placeholder f Text
options Text
value = do
  (resp, text) <-
    Int
-> Layout -> Text -> Text -> Maybe Float -> Eff es (Response, Text)
forall (es :: [Effect]).
(Ui :> es) =>
Int
-> Layout -> Text -> Text -> Maybe Float -> Eff es (Response, Text)
buildTextInput Int
textInputFlagSearch Layout
searchFieldLayout Text
placeholder Text
value Maybe Float
forall a. Maybe a
Nothing
  ctx <- askContext
  inp <- askInput
  let wid = Response -> WidgetId
rawRespId Response
resp
      key = WidgetId -> Int
intKey WidgetId
wid
      keys = Input -> SmallArray Key
inputKeys Input
inp
  isFocus <- keyboardFocused wid
  -- The dropdown only shows while the field is focused, so an unfocused
  -- combo steps with no rows. The matches stay lazy: the option window below
  -- forces only its rows, and the count is forced only on frames that store it.
  let matches = f Text -> Text -> [Text]
forall (f :: * -> *). Foldable f => f Text -> Text -> [Text]
comboFiltered f Text
options Text
text
      displayed = if Bool
isFocus then [Text]
matches else []
  store <- uiIO (getStore ctx)
  let cs0 =
        ComboState
          { csHighlight :: Int
csHighlight = Int -> Int -> IntMap Int -> Int
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault (-Int
1) (Slot -> Int -> Int
slotKey Slot
SlotComboHighlight Int
key) (WidgetStore -> IntMap Int
storeInt WidgetStore
store)
          , csWindow :: Int
csWindow = Int -> Int -> IntMap Int -> Int
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Int
0 (Slot -> Int -> Int
slotKey Slot
SlotComboScroll Int
key) (WidgetStore -> IntMap Int
storeInt WidgetStore
store)
          , csScrollX :: Float
csScrollX = Float -> Int -> IntMap Float -> Float
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Float
0 (Slot -> Int -> Int
slotKey Slot
SlotComboScrollX Int
key) (WidgetStore -> IntMap Float
storeFloat WidgetStore
store)
          , csContentW :: Float
csContentW = Float -> Int -> IntMap Float -> Float
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Float
0 (Slot -> Int -> Int
slotKey Slot
SlotComboContentW Int
key) (WidgetStore -> IntMap Float
storeFloat WidgetStore
store)
          , csDrag :: Int
csDrag = Int -> Int -> IntMap Int -> Int
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Int
0 (Slot -> Int -> Int
slotKey Slot
SlotComboDrag Int
key) (WidgetStore -> IntMap Int
storeInt WidgetStore
store)
          , csDragOff :: Float
csDragOff = Float -> Int -> IntMap Float -> Float
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Float
0 (Slot -> Int -> Int
slotKey Slot
SlotComboDragOff Int
key) (WidgetStore -> IntMap Float
storeFloat WidgetStore
store)
          , csCommitted :: Text
csCommitted = Text -> Int -> IntMap Text -> Text
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Text
value (Slot -> Int -> Int
slotKey Slot
SlotComboCommitted Int
key) (WidgetStore -> IntMap Text
storeText WidgetStore
store)
          , csLive :: Text
csLive = Text -> Int -> IntMap Text -> Text
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Text
text (Slot -> Int -> Int
slotKey Slot
SlotComboLive Int
key) (WidgetStore -> IntMap Text
storeText WidgetStore
store)
          , csFocused :: Bool
csFocused = Int -> Int -> IntMap Int -> Int
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Int
0 (Slot -> Int -> Int
slotKey Slot
SlotComboFocus Int
key) (WidgetStore -> IntMap Int
storeInt WidgetStore
store) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
          }
  contentW <- uiIO $
    if isFocus && not (null displayed)
      then foldM (\Float
widest Text
t -> Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
widest (Float -> Float)
-> ((Float, Float) -> Float) -> (Float, Float) -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float) -> IO (Float, Float) -> IO Float
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Context -> Text -> IO (Float, Float)
ctxMeasureText Context
ctx Text
t) 0 displayed
      else pure (csContentW cs0)
  let step =
        ComboInput -> ComboState -> ComboStep
comboStep
          ComboInput
            { ciFocused :: Bool
ciFocused = Bool
isFocus
            , ciEdited :: Bool
ciEdited = Response -> Bool
rawRespChanged Response
resp
            , ciText :: Text
ciText = Text
text
            , ciRows :: [Text]
ciRows = [Text]
displayed
            , ciContentW :: Float
ciContentW = Float
contentW
            , ciField :: Rect
ciField = Response -> Rect
rawRespRect Response
resp
            , ciMetrics :: FontMetrics
ciMetrics = Context -> FontMetrics
ctxFontMetrics Context
ctx
            , ciMouse :: V2
ciMouse = Input -> V2
inputMousePos Input
inp
            , ciPressed :: Bool
ciPressed = Input -> Bool
inputMousePressed Input
inp
            , ciDown :: Bool
ciDown = Input -> Bool
inputMouseDown Input
inp
            , ciScroll :: V2
ciScroll = Input -> V2
inputScroll Input
inp
            , ciKeyUp :: Bool
ciKeyUp = Key
KeyUp Key -> SmallArray Key -> Bool
forall a. Eq a => a -> SmallArray a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` SmallArray Key
keys
            , ciKeyDown :: Bool
ciKeyDown = Key
KeyDown Key -> SmallArray Key -> Bool
forall a. Eq a => a -> SmallArray a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` SmallArray Key
keys
            , ciEnter :: Bool
ciEnter = Key
KeyEnter Key -> SmallArray Key -> Bool
forall a. Eq a => a -> SmallArray a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` SmallArray Key
keys
            , ciEscape :: Bool
ciEscape = Key
KeyEscape Key -> SmallArray Key -> Bool
forall a. Eq a => a -> SmallArray a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` SmallArray Key
keys
            }
          ComboState
cs0
      cs1 = ComboStep -> ComboState
stepState ComboStep
step
      finalText = ComboState -> Text
csLive ComboState
cs1
  when (isFocus || stepRedraw step) $
    uiIO $ do
      let len = Text -> Int
T.length Text
finalText
      modifyStore ctx $ \WidgetStore
st ->
        let ints :: IntMap Int
ints =
              Int -> Int -> IntMap Int -> IntMap Int
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert (Slot -> Int -> Int
slotKey Slot
SlotComboHighlight Int
key) (ComboState -> Int
csHighlight ComboState
cs1) (IntMap Int -> IntMap Int) -> IntMap Int -> IntMap Int
forall a b. (a -> b) -> a -> b
$
                Int -> Int -> IntMap Int -> IntMap Int
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert (Slot -> Int -> Int
slotKey Slot
SlotComboScroll Int
key) (ComboState -> Int
csWindow ComboState
cs1) (IntMap Int -> IntMap Int) -> IntMap Int -> IntMap Int
forall a b. (a -> b) -> a -> b
$
                  Int -> Int -> IntMap Int -> IntMap Int
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert (Slot -> Int -> Int
slotKey Slot
SlotComboCount Int
key) ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
matches) (IntMap Int -> IntMap Int) -> IntMap Int -> IntMap Int
forall a b. (a -> b) -> a -> b
$
                    Int -> Int -> IntMap Int -> IntMap Int
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert (Slot -> Int -> Int
slotKey Slot
SlotComboFocus Int
key) (Bool -> Int
boolInt (ComboState -> Bool
csFocused ComboState
cs1)) (IntMap Int -> IntMap Int) -> IntMap Int -> IntMap Int
forall a b. (a -> b) -> a -> b
$
                      Int -> Int -> IntMap Int -> IntMap Int
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert (Slot -> Int -> Int
slotKey Slot
SlotComboDrag Int
key) (ComboState -> Int
csDrag ComboState
cs1) (WidgetStore -> IntMap Int
storeInt WidgetStore
st)
         in WidgetStore
st
              { storeInt =
                  if stepPicked step
                    then IM.insert (slotKey SlotCursor key) len (IM.insert (slotKey SlotAnchor key) len ints)
                    else ints
              , storeFloat =
                  IM.insert (slotKey SlotComboScrollX key) (csScrollX cs1) $
                    IM.insert (slotKey SlotComboContentW key) (csContentW cs1) $
                      IM.insert (slotKey SlotComboDragOff key) (csDragOff cs1) (storeFloat st)
              , storeText =
                  IM.insert (slotKey SlotComboLive key) finalText $
                    IM.insert (slotKey SlotComboCommitted key) (csCommitted cs1) $
                      IM.insert key finalText (storeText st)
              }
      when (stepDismissed step) $ do
        writeIORef (ctxFocusId ctx) (WidgetId 0)
        markEscapeConsumed ctx
      when (stepRedraw step) $ markDirty ctx
  -- The dropdown overlay reads its rows from the node's option list: the
  -- visible window of the filtered list. Unfocused combos set it too, since a
  -- click that focuses the field this frame shows the dropdown this frame.
  uiIO $ do
    findNodeByWidgetId ctx wid
      >>= mapM_ (\Int
idx -> NodeArena -> Int -> [Text] -> IO ()
setOptions (Context -> NodeArena
ctxNodeArena Context
ctx) Int
idx (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
comboBoxMaxVisible (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (ComboState -> Int
csWindow ComboState
cs1) [Text]
matches)))
    recordStoreText ctx key finalText
  pure (setChanged (isJust (stepCommit step)) resp, finalText)