{-# LANGUAGE BangPatterns #-}

module NanoUI.Widgets.TextCommon
  ( -- * Character classes and word boundaries
    TextCharClass (..)
  , textCharClass
  , textWordBounds
    -- * Selection and caret helpers
  , textSelectionForClick
  , textSelectionForDrag
  , selectionCaretGeom
  ) where

import Data.Char (isAlphaNum, isSpace)
import Data.Text (Text)
import qualified Data.Text as T
import NanoUI.Types (clamp)

-- | Character classification for double-click word selection.
data TextCharClass = TextWord | TextSpace | TextOther
  deriving (TextCharClass -> TextCharClass -> Bool
(TextCharClass -> TextCharClass -> Bool)
-> (TextCharClass -> TextCharClass -> Bool) -> Eq TextCharClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextCharClass -> TextCharClass -> Bool
== :: TextCharClass -> TextCharClass -> Bool
$c/= :: TextCharClass -> TextCharClass -> Bool
/= :: TextCharClass -> TextCharClass -> Bool
Eq)

textCharClass :: Char -> TextCharClass
textCharClass :: Char -> TextCharClass
textCharClass Char
c
  | Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' = TextCharClass
TextWord
  | Char -> Bool
isSpace Char
c = TextCharClass
TextSpace
  | Bool
otherwise = TextCharClass
TextOther

-- | Find the word bounds around a character position in text.
textWordBounds :: Text -> Int -> (Int, Int)
textWordBounds :: Text -> Int -> (Int, Int)
textWordBounds Text
text Int
raw
  | Text -> Bool
T.null Text
text = (Int
0, Int
0)
  | Bool
otherwise =
      -- Split once: repeatedly indexing UTF-8 text makes long-word selection
      -- quadratic. The clamped index guarantees a non-empty suffix.
      let i :: Int
i = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Text -> Int
T.length Text
text Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
raw
          (Text
before, Text
after) = Int -> Text -> (Text, Text)
T.splitAt Int
i Text
text
          sameClass :: Char -> Bool
sameClass = (TextCharClass -> TextCharClass -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> TextCharClass
textCharClass (HasCallStack => Text -> Char
Text -> Char
T.head Text
after)) (TextCharClass -> Bool) -> (Char -> TextCharClass) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> TextCharClass
textCharClass
       in ( Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length ((Char -> Bool) -> Text -> Text
T.takeWhileEnd Char -> Bool
sameClass Text
before)
          , Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length ((Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
sameClass Text
after)
          )

-- | Calculate selection span for single/double/triple click.
textSelectionForClick :: Text -> Int -> Int -> (Int, Int)
textSelectionForClick :: Text -> Int -> Int -> (Int, Int)
textSelectionForClick Text
value Int
idx Int
clicks
  | Int
clicks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3 = (Int
0, Text -> Int
T.length Text
value)
  | Int
clicks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = Text -> Int -> (Int, Int)
textWordBounds Text
value Int
idx
  | Bool
otherwise = (Int
idx, Int
idx)

-- | Calculate selection span when dragging mouse across text.
textSelectionForDrag :: Text -> Int -> Int -> Int -> (Int, Int)
textSelectionForDrag :: Text -> Int -> Int -> Int -> (Int, Int)
textSelectionForDrag Text
value Int
anchor Int
idx Int
clicks
  | Int
clicks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3 = (Int
0, Text -> Int
T.length Text
value)
  | Int
clicks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 =
      let (Int
a0, Int
a1) = Text -> Int -> (Int, Int)
textWordBounds Text
value Int
anchor
          (Int
c0, Int
c1) = Text -> Int -> (Int, Int)
textWordBounds Text
value Int
idx
       in (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
a0 Int
c0, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
a1 Int
c1)
  | Bool
otherwise = (Int
anchor, Int
idx)

-- | Shared caret geometry (caretX, caretY, caretH).
{-# INLINE selectionCaretGeom #-}
selectionCaretGeom :: Float -> Float -> Float -> Float -> (Float, Float, Float)
selectionCaretGeom :: Float -> Float -> Float -> Float -> (Float, Float, Float)
selectionCaretGeom Float
originX Float
originY Float
pw Float
lineH =
  (Float
originX Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
pw, Float
originY Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
1, Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
4 (Float
lineH Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2))