-- TODO move to widget folder
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo     #-}

module Potato.Flow.Vty.Common (
  ffilterButtonIndex
  , oneLineButton
  , buttonList
  , radioList
  , radioListSimple
  , checkBox
) where

import           Relude
import qualified Relude.Unsafe               as Unsafe

import           Potato.Flow.Vty.Attrs
import Potato.Reflex.Vty.Widget

import           Control.Monad.Fix
import           Control.Monad.NodeId
import qualified Data.List.Index             as L
import qualified Data.Text                   as T
import Data.Tuple.Extra

import qualified Graphics.Vty                as V
import           Reflex
import           Reflex.Vty




ffilterButtonIndex :: (Reflex t) => Int -> Event t Int -> Event t ()
ffilterButtonIndex :: forall t. Reflex t => Int -> Event t Int -> Event t ()
ffilterButtonIndex Int
i = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\Int
i' -> if Int
i forall a. Eq a => a -> a -> Bool
== Int
i' then forall a. a -> Maybe a
Just () else forall a. Maybe a
Nothing)


maximumlist :: [Int] -> Int
maximumlist :: [Int] -> Int
maximumlist = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
x Int
y ->if Int
x forall a. Ord a => a -> a -> Bool
>= Int
y then Int
x else Int
y) (-Int
1)

simpleDrag :: (Reflex t, MonadHold t m, MonadFix m, HasInput t m) => V.Button -> m (Event t ((Int, Int), (Int, Int)))
simpleDrag :: forall t (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, HasInput t m) =>
Button -> m (Event t ((Int, Int), (Int, Int)))
simpleDrag Button
btn = do
  Event t Drag2
dragEv <- forall t (m :: * -> *).
(Reflex t, MonadFix m, MonadHold t m, HasInput t m) =>
Button -> m (Event t Drag2)
drag2 Button
btn
  return $ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {k} (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push Event t Drag2
dragEv forall a b. (a -> b) -> a -> b
$ \(Drag2 (Int
fromX, Int
fromY) (Int
toX, Int
toY) Button
_ [Modifier]
_ DragState
ds) -> do
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if DragState
ds forall a. Eq a => a -> a -> Bool
== DragState
DragEnd
      then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ((Int
fromX, Int
fromY), (Int
toX, Int
toY))
      else forall a. Maybe a
Nothing

makeOneLineButtonImage :: V.Attr -> V.Attr -> ((Int,Int,Int), Text, Bool) -> V.Image
makeOneLineButtonImage :: Attr -> Attr -> ((Int, Int, Int), Text, Bool) -> Image
makeOneLineButtonImage Attr
defAttr Attr
downAttr ((Int
x,Int
y,Int
_), Text
t, Bool
downclickTODO) = Int -> Int -> Image -> Image
V.translate Int
x Int
y forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Image
V.text' Attr
attr (Text
"["forall a. Semigroup a => a -> a -> a
<>Text
tforall a. Semigroup a => a -> a -> a
<>Text
"]") where
  attr :: Attr
attr = if Bool
downclickTODO then Attr
downAttr else Attr
defAttr


oneLineButton :: forall t m. (MonadFix m, MonadHold t m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m)
  => Behavior t (V.Attr, V.Attr)
  -> Dynamic t Text -- ^ button content
  -> m (Event t ()) -- ^ event when button is clicked
oneLineButton :: forall t (m :: * -> *).
(MonadFix m, MonadHold t m, HasDisplayRegion t m,
 HasImageWriter t m, HasInput t m) =>
Behavior t (Attr, Attr) -> Dynamic t Text -> m (Event t ())
oneLineButton Behavior t (Attr, Attr)
attrBeh Dynamic t Text
buttonDyn = do
  Dynamic t Int
dw <- forall {k} (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayWidth
  Event t ((Int, Int), (Int, Int))
clickEv <- forall t (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, HasInput t m) =>
Button -> m (Event t ((Int, Int), (Int, Int)))
simpleDrag Button
V.BLeft
  let
    selectEv :: Event t ()
selectEv = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {k} (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push Event t ((Int, Int), (Int, Int))
clickEv forall a b. (a -> b) -> a -> b
$ \((Int
px,Int
py),(Int
ex,Int
ey)) -> do
      Text
t <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current forall a b. (a -> b) -> a -> b
$ Dynamic t Text
buttonDyn
      let l :: Int
l = Text -> Int
T.length Text
t forall a. Num a => a -> a -> a
+ Int
2
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Int
py forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
ey forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
px forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
ex forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
px forall a. Ord a => a -> a -> Bool
< Int
l Bool -> Bool -> Bool
&& Int
ex forall a. Ord a => a -> a -> Bool
< Int
l
        then forall a. a -> Maybe a
Just ()
        else forall a. Maybe a
Nothing

  (Attr
defAttr, Attr
downAttr) <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t (Attr, Attr)
attrBeh

  let
    -- ((x,y,length), contents, downClickTODO)
    buttonDyn' :: Dynamic t ((Int,Int,Int), Text, Bool)
    buttonDyn' :: Dynamic t ((Int, Int, Int), Text, Bool)
buttonDyn' = forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t Int
dw Dynamic t Text
buttonDyn forall a b. (a -> b) -> a -> b
$ \Int
w Text
t -> ((Int
0,Int
0, Text -> Int
T.length Text
t forall a. Num a => a -> a -> a
+ Int
2), Text
t, Bool
False)

  -- TODO pass correct theme based on style
  forall {k} (t :: k) (m :: * -> *).
HasImageWriter t m =>
Behavior t [Image] -> m ()
tellImages forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((Int, Int, Int), Text, Bool)
b -> [Attr -> Attr -> ((Int, Int, Int), Text, Bool) -> Image
makeOneLineButtonImage Attr
defAttr Attr
downAttr ((Int, Int, Int), Text, Bool)
b]) forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t ((Int, Int, Int), Text, Bool)
buttonDyn'
  return $ Event t ()
selectEv

-- TODO pass in sel and default attrs
-- | option to pass in height is a hack to work around circular dependency issues as when using Layout, displayWidth may be dependent on returned dynamic height
buttonList :: forall t m. (MonadFix m, MonadHold t m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasTheme t m)
  => Dynamic t [Text] -- ^ list of button contents
  -> Maybe (Dynamic t Int) -- ^ optional width (displayWidth is used if Nothing)
  -> m (Event t Int, Dynamic t Int) -- ^ (event when button is clicked, height)
buttonList :: forall t (m :: * -> *).
(MonadFix m, MonadHold t m, HasDisplayRegion t m,
 HasImageWriter t m, HasInput t m, HasTheme t m) =>
Dynamic t [Text]
-> Maybe (Dynamic t Int) -> m (Event t Int, Dynamic t Int)
buttonList Dynamic t [Text]
buttonsDyn Maybe (Dynamic t Int)
mWidthDyn = do
  Dynamic t Int
dw <- case Maybe (Dynamic t Int)
mWidthDyn of
    Maybe (Dynamic t Int)
Nothing -> forall {k} (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayWidth
    Just Dynamic t Int
widthDyn -> forall (m :: * -> *) a. Monad m => a -> m a
return Dynamic t Int
widthDyn
  Event t ((Int, Int), (Int, Int))
clickEv <- forall t (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, HasInput t m) =>
Button -> m (Event t ((Int, Int), (Int, Int)))
simpleDrag Button
V.BLeft

  -- TODO the better version of this highlights button on mouse down and "clicks" so long as you don't drag off the button
  --dragPosDyn
  --isDraggingDyn

  let
    -- ((x,y,length), contents, downclickTODO)
    buttons :: Dynamic t [((Int,Int,Int), Text, Bool)]
    buttons :: Dynamic t [((Int, Int, Int), Text, Bool)]
buttons = forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t Int
dw Dynamic t [Text]
buttonsDyn forall a b. (a -> b) -> a -> b
$ forall {b} {t :: * -> *}.
(Num b, Traversable t) =>
Int -> t Text -> t ((Int, b, Int), Text, Bool)
fn where
      fn :: Int -> t Text -> t ((Int, b, Int), Text, Bool)
fn Int
w t Text
bs = t ((Int, b, Int), Text, Bool)
r where
        mapaccumfn :: (Int, b) -> Text -> ((Int, b), ((Int, b, Int), Text, Bool))
mapaccumfn (Int
x,b
y) Text
t = ((Int
nextx, b
ny), ((Int
nx,b
ny,Int
buttonl),Text
t, Bool
False)) where
          buttonl :: Int
buttonl = Text -> Int
T.length Text
t forall a. Num a => a -> a -> a
+ Int
2
          nextx' :: Int
nextx' = Int
x forall a. Num a => a -> a -> a
+ Int
buttonl
          (Int
nx,b
ny,Int
nextx) = if Int
nextx' forall a. Ord a => a -> a -> Bool
> Int
w then (Int
0,b
yforall a. Num a => a -> a -> a
+b
1, Int
buttonl) else (Int
x,b
y, Int
nextx')
        ((Int, b)
_,t ((Int, b, Int), Text, Bool)
r) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (Int, b) -> Text -> ((Int, b), ((Int, b, Int), Text, Bool))
mapaccumfn (Int
0, b
0) t Text
bs

    -- TODO replace with makeOneLineButtonImage
    makeImage :: ((Int,Int,Int), Text, Bool) -> V.Image
    makeImage :: ((Int, Int, Int), Text, Bool) -> Image
makeImage ((Int
x,Int
y,Int
_), Text
t, Bool
downclickTODO) = Int -> Int -> Image -> Image
V.translate Int
x Int
y forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Image
V.text' Attr
attr (Text
"["forall a. Semigroup a => a -> a -> a
<>Text
tforall a. Semigroup a => a -> a -> a
<>Text
"]") where
      attr :: Attr
attr = if Bool
downclickTODO then Attr
lg_layer_selected else Attr
lg_default
    heightDyn :: Dynamic t Int
heightDyn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. Num a => a -> a -> a
+Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
maximumlist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a, b, c) -> b
snd3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> a
fst3)) Dynamic t [((Int, Int, Int), Text, Bool)]
buttons
    selectEv :: Event t Int
selectEv = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {k} (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push Event t ((Int, Int), (Int, Int))
clickEv forall a b. (a -> b) -> a -> b
$ \((Int
px,Int
py),(Int
ex,Int
ey)) -> do
      [((Int, Int, Int), Text, Bool)]
bs <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current forall a b. (a -> b) -> a -> b
$ Dynamic t [((Int, Int, Int), Text, Bool)]
buttons
      return $ forall a. (Int -> a -> Bool) -> [a] -> Maybe Int
L.ifindIndex (\Int
_ ((Int
x,Int
y,Int
l),Text
_,Bool
_) -> Int
py forall a. Eq a => a -> a -> Bool
== Int
y Bool -> Bool -> Bool
&& Int
ey forall a. Eq a => a -> a -> Bool
== Int
y Bool -> Bool -> Bool
&& Int
px forall a. Ord a => a -> a -> Bool
>= Int
x Bool -> Bool -> Bool
&& Int
ex forall a. Ord a => a -> a -> Bool
>= Int
x Bool -> Bool -> Bool
&& Int
px forall a. Ord a => a -> a -> Bool
< Int
xforall a. Num a => a -> a -> a
+Int
l Bool -> Bool -> Bool
&& Int
ex forall a. Ord a => a -> a -> Bool
< Int
xforall a. Num a => a -> a -> a
+Int
l) [((Int, Int, Int), Text, Bool)]
bs
  forall {k} (t :: k) (m :: * -> *).
HasImageWriter t m =>
Behavior t [Image] -> m ()
tellImages forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int, Int, Int), Text, Bool) -> Image
makeImage) forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t [((Int, Int, Int), Text, Bool)]
buttons
  return $ (Event t Int
selectEv, Dynamic t Int
heightDyn)

-- TODO pass in sel and default attrs

-- | option to pass in height is a hack to work around circular dependency issues as when using Layout, displayWidth may be dependent on returned dynamic height
-- override style: does not modify state internally, instead state must be passed back in
radioList :: forall t m. (Reflex t, MonadNodeId m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasTheme t m)
  => Dynamic t [Text] -- ^ list of button contents
  -> Dynamic t [Int] -- ^ which buttons are "active"
  -> Maybe (Dynamic t Int) -- ^ optional width (displayWidth is used if Nothing)
  -> m (Event t Int, Dynamic t Int) -- ^ (event when button is clicked, height)
radioList :: forall t (m :: * -> *).
(Reflex t, MonadNodeId m, HasDisplayRegion t m, HasImageWriter t m,
 HasInput t m, HasTheme t m) =>
Dynamic t [Text]
-> Dynamic t [Int]
-> Maybe (Dynamic t Int)
-> m (Event t Int, Dynamic t Int)
radioList Dynamic t [Text]
buttonsDyn Dynamic t [Int]
activeDyn Maybe (Dynamic t Int)
mWidthDyn = do
  Dynamic t Int
dw <- case Maybe (Dynamic t Int)
mWidthDyn of
    Maybe (Dynamic t Int)
Nothing -> forall {k} (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayWidth
    Just Dynamic t Int
widthDyn -> forall (m :: * -> *) a. Monad m => a -> m a
return Dynamic t Int
widthDyn
  Event t MouseDown
mouseDownEv <- forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasInput t m) =>
Button -> m (Event t MouseDown)
mouseDown Button
V.BLeft
  let
    -- ((x,y,length), contents)
    buttons' :: Dynamic t [((Int,Int,Int), Text)]
    buttons' :: Dynamic t [((Int, Int, Int), Text)]
buttons' = forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t Int
dw Dynamic t [Text]
buttonsDyn forall a b. (a -> b) -> a -> b
$ forall {b} {t :: * -> *}.
(Num b, Traversable t) =>
Int -> t Text -> t ((Int, b, Int), Text)
fn where
      fn :: Int -> t Text -> t ((Int, b, Int), Text)
fn Int
w t Text
bs = t ((Int, b, Int), Text)
r where
        mapaccumfn :: (Int, b) -> Text -> ((Int, b), ((Int, b, Int), Text))
mapaccumfn (Int
x,b
y) Text
t = ((Int
nextx, b
ny), ((Int
nx,b
ny,Int
buttonl),Text
t)) where
          buttonl :: Int
buttonl = Text -> Int
T.length Text
t forall a. Num a => a -> a -> a
+ Int
2
          nextx' :: Int
nextx' = Int
x forall a. Num a => a -> a -> a
+ Int
buttonl
          (Int
nx,b
ny,Int
nextx) = if Int
nextx' forall a. Ord a => a -> a -> Bool
> Int
w then (Int
0,b
yforall a. Num a => a -> a -> a
+b
1, Int
buttonl) else (Int
x,b
y, Int
nextx')
        ((Int, b)
_,t ((Int, b, Int), Text)
r) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (Int, b) -> Text -> ((Int, b), ((Int, b, Int), Text))
mapaccumfn (Int
0, b
0) t Text
bs
    buttons :: Dynamic t [((Int,Int,Int), Text, Bool)]
    buttons :: Dynamic t [((Int, Int, Int), Text, Bool)]
buttons = forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t [((Int, Int, Int), Text)]
buttons' Dynamic t [Int]
activeDyn forall a b. (a -> b) -> a -> b
$ forall {a} {b}. [(a, b)] -> [Int] -> [(a, b, Bool)]
fn where
      fn :: [(a, b)] -> [Int] -> [(a, b, Bool)]
fn [(a, b)]
bs [Int]
actives' = [(a, b, Bool)]
r where
        actives :: [Int]
actives = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort [Int]
actives'
        ifoldrfn :: a -> (a, b) -> ([(a, b, Bool)], [a]) -> ([(a, b, Bool)], [a])
ifoldrfn a
_ (a
l,b
t) ([(a, b, Bool)]
output, []) = ((a
l,b
t,Bool
False)forall a. a -> [a] -> [a]
:[(a, b, Bool)]
output, [])
        ifoldrfn a
i (a
l,b
t) ([(a, b, Bool)]
output, a
a:[a]
as) = if a
i forall a. Eq a => a -> a -> Bool
== a
a
          then ((a
l,b
t,Bool
True)forall a. a -> [a] -> [a]
:[(a, b, Bool)]
output, [a]
as)
          else ((a
l,b
t,Bool
False)forall a. a -> [a] -> [a]
:[(a, b, Bool)]
output, a
aforall a. a -> [a] -> [a]
:[a]
as)
        ([(a, b, Bool)]
r,[Int]
_) = forall a b. (Int -> a -> b -> b) -> b -> [a] -> b
L.ifoldr forall {a} {a} {b}.
Eq a =>
a -> (a, b) -> ([(a, b, Bool)], [a]) -> ([(a, b, Bool)], [a])
ifoldrfn ([],[Int]
actives) [(a, b)]
bs
    makeImage :: ((Int,Int,Int), Text, Bool) -> V.Image
    makeImage :: ((Int, Int, Int), Text, Bool) -> Image
makeImage ((Int
x,Int
y,Int
_), Text
t, Bool
selected) = Int -> Int -> Image -> Image
V.translate Int
x Int
y forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Image
V.text' Attr
attr Text
c where
      attr :: Attr
attr = if Bool
selected then Attr
lg_layer_selected else Attr
lg_default
      --c = if selected then "[" <> t <> "]" else " " <> t <> " "
      c :: Text
c = Text
"["forall a. Semigroup a => a -> a -> a
<>Text
tforall a. Semigroup a => a -> a -> a
<>Text
"]"
    heightDyn :: Dynamic t Int
heightDyn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. Num a => a -> a -> a
+Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
maximumlist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a, b, c) -> b
snd3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> a
fst3)) Dynamic t [((Int, Int, Int), Text, Bool)]
buttons
    selectEv :: Event t Int
selectEv = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {k} (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push Event t MouseDown
mouseDownEv forall a b. (a -> b) -> a -> b
$ \(MouseDown Button
_ (Int
px,Int
py) [Modifier]
_) -> do
      [((Int, Int, Int), Text, Bool)]
bs <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current forall a b. (a -> b) -> a -> b
$ Dynamic t [((Int, Int, Int), Text, Bool)]
buttons
      return $ forall a. (Int -> a -> Bool) -> [a] -> Maybe Int
L.ifindIndex (\Int
_ ((Int
x,Int
y,Int
l),Text
_,Bool
_) -> Int
py forall a. Eq a => a -> a -> Bool
== Int
y Bool -> Bool -> Bool
&& Int
px forall a. Ord a => a -> a -> Bool
>= Int
x Bool -> Bool -> Bool
&& Int
px forall a. Ord a => a -> a -> Bool
< Int
xforall a. Num a => a -> a -> a
+Int
l) [((Int, Int, Int), Text, Bool)]
bs
  forall {k} (t :: k) (m :: * -> *).
HasImageWriter t m =>
Behavior t [Image] -> m ()
tellImages forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int, Int, Int), Text, Bool) -> Image
makeImage) forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t [((Int, Int, Int), Text, Bool)]
buttons
  return $ (Event t Int
selectEv, Dynamic t Int
heightDyn)

-- TODO pass in sel and default attrs

radioListSimple :: forall t m. (Reflex t, MonadFix m, MonadHold t m, MonadNodeId m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasTheme t m)
  => Int -- ^ initial choice
  -> [Text] -- ^ list of button contents (must be at least one)
  -> m (Dynamic t Int) -- ^ which radio is selected
radioListSimple :: forall t (m :: * -> *).
(Reflex t, MonadFix m, MonadHold t m, MonadNodeId m,
 HasDisplayRegion t m, HasImageWriter t m, HasInput t m,
 HasTheme t m) =>
Int -> [Text] -> m (Dynamic t Int)
radioListSimple Int
initial [Text]
buttons = mdo
  (Event t Int
radioEvs,Dynamic t Int
_) <- forall t (m :: * -> *).
(Reflex t, MonadNodeId m, HasDisplayRegion t m, HasImageWriter t m,
 HasInput t m, HasTheme t m) =>
Dynamic t [Text]
-> Dynamic t [Int]
-> Maybe (Dynamic t Int)
-> m (Event t Int, Dynamic t Int)
radioList (forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn [Text]
buttons) Dynamic t [Int]
radioDyn forall a. Maybe a
Nothing
  Dynamic t [Int]
radioDyn <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn [Int
initial] forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
x->[Int
x]) Event t Int
radioEvs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> a
Unsafe.head) Dynamic t [Int]
radioDyn



-- TODO focus + enter to select via keyboard
-- | creates a check box "[x]" in upper left corner of region
-- override style: does not modify state internally, instead state must be passed back in
checkBox
  :: forall t m. (Reflex t, MonadFix m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasTheme t m)
  => Dynamic t Bool
  -> m (Event t Bool)
checkBox :: forall t (m :: * -> *).
(Reflex t, MonadFix m, HasDisplayRegion t m, HasImageWriter t m,
 HasInput t m, HasTheme t m) =>
Dynamic t Bool -> m (Event t Bool)
checkBox Dynamic t Bool
stateDyn = do
  forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
 HasTheme t m) =>
Behavior t Text -> m ()
text (forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Bool
stateDyn) (\Bool
s -> if Bool
s then Text
"[x]" else Text
"[ ]"))
  Event t MouseDown
mouseDownEv <- forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasInput t m) =>
Button -> m (Event t MouseDown)
mouseDown Button
V.BLeft
  let toggleEv :: Event t ()
toggleEv = forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t MouseDown
mouseDownEv forall a b. (a -> b) -> a -> b
$ \(MouseDown Button
_ (Int
px,Int
py) [Modifier]
_) -> if Int
px forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
px forall a. Ord a => a -> a -> Bool
< Int
3 Bool -> Bool -> Bool
&& Int
py forall a. Eq a => a -> a -> Bool
== Int
0 then forall a. a -> Maybe a
Just () else forall a. Maybe a
Nothing
  return $ forall {k} (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
tag (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not Dynamic t Bool
stateDyn)) Event t ()
toggleEv