{-# LANGUAGE OverloadedStrings #-}

-- | Dropdown select.
module NanoUI.Widgets.Select
  ( select
  , select'
  , selectWith
  , selectWith'
  , boundedSelect
  , boundedSelect'
  , enumSelect
  , enumSelect'
  )
where

import Control.Monad (forM_, when)
import Data.IORef (writeIORef)
import Data.IntMap.Strict qualified as IM
import Data.Text (Text)
import Data.Text qualified as T
import Effectful (Eff, type (:>))
import NanoUI.Context
  ( Context (..)
  , adoptStoreInt
  , getStore
  , intKey
  , recordStoreInt
  , registerFocusable
  , modifyStore
  )
import NanoUI.Font (menuItemRowH)
import NanoUI.Frame.Select (selectDropPickIndex, selectDropRect)
import NanoUI.Input (inputMousePos, inputMousePressed, inputMouseReleased)
import NanoUI.Layout.Arena (NodeType (..))
import NanoUI.Monad (Ui, askContext, askInput, nextId, uiIO)
import NanoUI.Store (WidgetStore (..), isSelectOpen, setSelectOpen)
import NanoUI.Style (Layout, defaultLayout)
import NanoUI.Types (Rect (..), clamp, rectContains, rectHit, rectNonEmpty, v2Y)
import NanoUI.Widgets.Combinators (withBoundedIndex)
import NanoUI.Widgets.Node (Response, addWidgetWithOptions, respRect, setChanged)

-- | Dropdown over @options@ in fold order. Pass the selected index; the result
-- is the index after this frame's pick.
{-# INLINE select #-}
select :: (Foldable f, Ui :> es) => f Text -> Int -> Eff es Int
select :: forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
f Text -> Int -> Eff es Int
select f Text
options Int
index = (Response, Int) -> Int
forall a b. (a, b) -> b
snd ((Response, Int) -> Int) -> Eff es (Response, Int) -> Eff es Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Layout -> Layout) -> f Text -> Int -> Eff es (Response, Int)
forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
(Layout -> Layout) -> f Text -> Int -> Eff es (Response, Int)
selectWith' Layout -> Layout
forall a. a -> a
id f Text
options Int
index

{-# INLINE select' #-}
select' :: (Foldable f, Ui :> es) => f Text -> Int -> Eff es (Response, Int)
select' :: forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
f Text -> Int -> Eff es (Response, Int)
select' = (Layout -> Layout) -> f Text -> Int -> Eff es (Response, Int)
forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
(Layout -> Layout) -> f Text -> Int -> Eff es (Response, Int)
selectWith' Layout -> Layout
forall a. a -> a
id

-- | 'select' with a layout modifier.
{-# INLINE selectWith #-}
selectWith :: (Foldable f, Ui :> es) => (Layout -> Layout) -> f Text -> Int -> Eff es Int
selectWith :: forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
(Layout -> Layout) -> f Text -> Int -> Eff es Int
selectWith Layout -> Layout
f f Text
options Int
index = (Response, Int) -> Int
forall a b. (a, b) -> b
snd ((Response, Int) -> Int) -> Eff es (Response, Int) -> Eff es Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Layout -> Layout) -> f Text -> Int -> Eff es (Response, Int)
forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
(Layout -> Layout) -> f Text -> Int -> Eff es (Response, Int)
selectWith' Layout -> Layout
f f Text
options Int
index

selectWith' ::
  (Foldable f, Ui :> es) =>
  (Layout -> Layout) ->
  f Text ->
  Int ->
  Eff es (Response, Int)
selectWith' :: forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
(Layout -> Layout) -> f Text -> Int -> Eff es (Response, Int)
selectWith' Layout -> Layout
f f Text
options Int
index = do
  wid <- Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
  ctx <- askContext
  uiIO $ registerFocusable ctx wid
  let
    opts = case (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 of
      [] -> [Text
""]
      [Text]
xs -> [Text]
xs
    n = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
opts
    key = WidgetId -> Int
intKey WidgetId
wid
  stored <- uiIO $ adoptStoreInt ctx wid key (clamp 0 (n - 1) index)
  store0 <- uiIO (getStore ctx)
  let
    current = 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
stored
    open = WidgetStore -> Int -> Bool
isSelectOpen WidgetStore
store0 Int
key
  resp <- addWidgetWithOptions wid NodeSelect "" opts 0 (f defaultLayout)
  inp <- askInput
  let
    rect@(Rect rx ry rw rh) = respRect resp
    mouse = Input -> V2
inputMousePos Input
inp
    dropRect = Float -> Float -> Float -> Float -> Int -> Rect
selectDropRect Float
rx Float
ry Float
rw Float
rh Int
n
    picked
      | Bool
open Bool -> Bool -> Bool
&& Rect -> Bool
rectNonEmpty Rect
rect Bool -> Bool -> Bool
&& Rect -> V2 -> Bool
rectContains Rect
dropRect V2
mouse Bool -> Bool -> Bool
&& Input -> Bool
inputMouseReleased Input
inp =
          Rect -> Float -> Int -> Float -> Maybe Int
selectDropPickIndex Rect
dropRect Float
menuItemRowH Int
n (V2 -> Float
v2Y V2
mouse)
      | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
    finalIdx = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
current (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)) Maybe Int
picked
  -- Opening, closing or picking changes the store, which wakes the loop.
  uiIO $ do
    when (rectHit rect mouse && inputMousePressed inp) $ do
      modifyStore ctx (\WidgetStore
st -> WidgetStore -> Int -> Bool -> WidgetStore
setSelectOpen WidgetStore
st Int
key (Bool -> Bool
not Bool
open))
      writeIORef (ctxFocusId ctx) wid
    forM_ picked $ \Int
i -> do
      Context -> (WidgetStore -> WidgetStore) -> IO ()
modifyStore Context
ctx (\WidgetStore
st -> WidgetStore -> Int -> Bool -> WidgetStore
setSelectOpen (WidgetStore
st {storeInt = IM.insert key i (storeInt st)}) Int
key Bool
False)
      IORef WidgetId -> WidgetId -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Context -> IORef WidgetId
ctxFocusId Context
ctx) WidgetId
wid
    recordStoreInt ctx key finalIdx
  -- Compare with the caller's index, not 'current': a dropdown or keyboard
  -- pick lands in the store between frames and must still report a change.
  pure (setChanged (finalIdx /= clamp 0 (n - 1) index) resp, finalIdx)

-- | Select over every value of a bounded enum, labelled by @encode@.
{-# INLINE boundedSelect #-}
boundedSelect :: (Bounded a, Enum a, Ui :> es) => (a -> Text) -> a -> Eff es a
boundedSelect :: forall a (es :: [Effect]).
(Bounded a, Enum a, Ui :> es) =>
(a -> Text) -> a -> Eff es a
boundedSelect a -> Text
encode a
value = (Response, a) -> a
forall a b. (a, b) -> b
snd ((Response, a) -> a) -> Eff es (Response, a) -> Eff es a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Text) -> a -> Eff es (Response, a)
forall a (es :: [Effect]).
(Bounded a, Enum a, Ui :> es) =>
(a -> Text) -> a -> Eff es (Response, a)
boundedSelect' a -> Text
encode a
value

boundedSelect' :: (Bounded a, Enum a, Ui :> es) => (a -> Text) -> a -> Eff es (Response, a)
boundedSelect' :: forall a (es :: [Effect]).
(Bounded a, Enum a, Ui :> es) =>
(a -> Text) -> a -> Eff es (Response, a)
boundedSelect' a -> Text
encode a
value = (a -> Text)
-> a
-> ([Text] -> Int -> Eff es (Response, Int))
-> Eff es (Response, a)
forall a r (f :: * -> *).
(Bounded a, Enum a, Functor f) =>
(a -> Text) -> a -> ([Text] -> Int -> f (r, Int)) -> f (r, a)
withBoundedIndex a -> Text
encode a
value [Text] -> Int -> Eff es (Response, Int)
forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
f Text -> Int -> Eff es (Response, Int)
select'

-- | 'boundedSelect' labelled with 'show'.
{-# INLINE enumSelect #-}
enumSelect :: (Bounded a, Enum a, Show a, Ui :> es) => a -> Eff es a
enumSelect :: forall a (es :: [Effect]).
(Bounded a, Enum a, Show a, Ui :> es) =>
a -> Eff es a
enumSelect = (a -> Text) -> a -> Eff es a
forall a (es :: [Effect]).
(Bounded a, Enum a, Ui :> es) =>
(a -> Text) -> a -> Eff es a
boundedSelect (String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show)

enumSelect' :: (Bounded a, Enum a, Show a, Ui :> es) => a -> Eff es (Response, a)
enumSelect' :: forall a (es :: [Effect]).
(Bounded a, Enum a, Show a, Ui :> es) =>
a -> Eff es (Response, a)
enumSelect' = (a -> Text) -> a -> Eff es (Response, a)
forall a (es :: [Effect]).
(Bounded a, Enum a, Ui :> es) =>
(a -> Text) -> a -> Eff es (Response, a)
boundedSelect' (String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show)