{-# 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
-> m (Event t ())
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
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)
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
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 :: 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
let
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
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)
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 :: 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
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 :: 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)
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 :: 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
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