{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
module Potato.Flow.Vty.Params (
ParamsWidgetConfig(..)
, ParamsWidget(..)
, holdParamsWidget
, selectParamsFromSelection
, networkParamsWidgetOutputDynForTesting
, holdSuperStyleWidget
) where
import Relude
import Potato.Flow
import Potato.Flow.OwlHelpers
import Potato.Flow.Vty.Common
import Potato.Reflex.Vty.Helpers
import Potato.Flow.Vty.PotatoReader
import Potato.Flow.Vty.Attrs
import Potato.Reflex.Vty.Widget.TextInputHelpers
import Control.Monad.Fix
import Control.Monad.NodeId
import Data.Align
import Data.Char (isNumber)
import Data.Dependent.Sum (DSum ((:=>)))
import qualified Data.IntMap as IM
import qualified Data.List.Extra as L
import qualified Data.Maybe
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import qualified Data.Text.Zipper as TZ
import Data.These
import Data.Tuple.Extra
import qualified Data.List as List
import qualified Graphics.Vty as V
import Reflex
import Reflex.Network
import Reflex.Potato.Helpers
import Reflex.Vty
deriving instance Show FocusId
listForMi :: (Monad m) => [a] -> ((a, Int) -> m b) -> m [b]
listForMi :: forall (m :: * -> *) a b.
Monad m =>
[a] -> ((a, Int) -> m b) -> m [b]
listForMi [a]
x (a, Int) -> m b
f = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a b. [a] -> [b] -> [(a, b)]
zip [a]
x [Int
0..]) (a, Int) -> m b
f
controllersWithId_to_llama :: ControllersWithId -> Llama
controllersWithId_to_llama :: ControllersWithId -> Llama
controllersWithId_to_llama = OwlPFCmd -> Llama
makePFCLlama forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControllersWithId -> OwlPFCmd
OwlPFCManipulate
paramsNavigation :: (MonadWidget t m) => m (Event t Int)
paramsNavigation :: forall t (m :: * -> *). MonadWidget t m => m (Event t Int)
paramsNavigation = do
Event t KeyCombo
tabEv <- forall {k} (m :: * -> *) (t :: k).
(Monad m, Reflex t, HasInput t m) =>
Key -> m (Event t KeyCombo)
key (Char -> Key
V.KChar Char
'\t')
Event t KeyCombo
returnEv <- forall {k} (m :: * -> *) (t :: k).
(Monad m, Reflex t, HasInput t m) =>
Key -> m (Event t KeyCombo)
key Key
V.KEnter
let fwd :: Event t Int
fwd = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const Int
1) forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t KeyCombo
tabEv, Event t KeyCombo
returnEv]
Event t Int
back <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const (-Int
1)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (m :: * -> *) (t :: k).
(Monad m, Reflex t, HasInput t m) =>
Key -> m (Event t KeyCombo)
key Key
V.KBackTab
return $ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t Int
fwd, Event t Int
back]
repeatNavigation :: (MonadWidget t m, HasFocus t m) => m ()
repeatNavigation :: forall t (m :: * -> *). (MonadWidget t m, HasFocus t m) => m ()
repeatNavigation = do
Event t Int
navEv <- forall t (m :: * -> *). MonadWidget t m => m (Event t Int)
paramsNavigation
forall {k} (t :: k) (m :: * -> *).
HasFocus t m =>
Event t Refocus -> m ()
requestFocus forall a b. (a -> b) -> a -> b
$ Int -> Refocus
Refocus_Shift forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t Int
navEv
type ParamsSelector a = (Eq a) => SuperOwl -> Maybe a
type DefaultParamsSelector a = PotatoDefaultParameters -> a
type ToolOverrideSelector = Tool -> Bool
toolOverrideTextAlign :: ToolOverrideSelector
toolOverrideTextAlign :: ToolOverrideSelector
toolOverrideTextAlign = (forall a. Eq a => a -> a -> Bool
== Tool
Tool_Text)
toolOverrideSuperStyle :: ToolOverrideSelector
toolOverrideSuperStyle :: ToolOverrideSelector
toolOverrideSuperStyle = (\Tool
t -> Tool
t forall a. Eq a => a -> a -> Bool
== Tool
Tool_Box Bool -> Bool -> Bool
|| Tool
t forall a. Eq a => a -> a -> Bool
== Tool
Tool_Text Bool -> Bool -> Bool
|| Tool
t forall a. Eq a => a -> a -> Bool
== Tool
Tool_Line)
toolOverrideLineStyle :: ToolOverrideSelector
toolOverrideLineStyle :: ToolOverrideSelector
toolOverrideLineStyle = (\Tool
t -> Tool
t forall a. Eq a => a -> a -> Bool
== Tool
Tool_Line)
toolOverrideSBoxType :: ToolOverrideSelector
toolOverrideSBoxType :: ToolOverrideSelector
toolOverrideSBoxType = (forall a b. a -> b -> a
const Bool
False)
selectParamsFromSelection :: (Eq a) => ParamsSelector a -> Selection -> Maybe (Selection, Maybe a)
selectParamsFromSelection :: forall a.
Eq a =>
ParamsSelector a -> Selection -> Maybe (Selection, Maybe a)
selectParamsFromSelection ParamsSelector a
ps (SuperOwlParliament Seq SuperOwl
selection) = Maybe (Selection, Maybe a)
r where
params :: [(SuperOwl, a)]
params = forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> ParamsSelector a
ps SuperOwl
sowl forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> forall a. a -> Maybe a
Just (SuperOwl
sowl, a
a)) forall a b. (a -> b) -> a -> b
$ Seq SuperOwl
selection
values :: [a]
values = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd [(SuperOwl, a)]
params
subSelection :: Selection
subSelection = Seq SuperOwl -> Selection
SuperOwlParliament forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(SuperOwl, a)]
params
r :: Maybe (Selection, Maybe a)
r = case [a]
values of
[] -> forall a. Maybe a
Nothing
a
x:[a]
xs -> if forall a. Eq a => [a] -> Bool
L.allSame [a]
values
then forall a. a -> Maybe a
Just (Selection
subSelection, forall a. a -> Maybe a
Just a
x)
else forall a. a -> Maybe a
Just (Selection
subSelection, forall a. Maybe a
Nothing)
makeParamsInputDyn :: (Eq a) => ToolOverrideSelector -> ParamsSelector a -> DefaultParamsSelector a -> Tool -> Selection -> PotatoDefaultParameters -> Maybe (Selection, Maybe a, Tool)
makeParamsInputDyn :: forall a.
Eq a =>
ToolOverrideSelector
-> ParamsSelector a
-> DefaultParamsSelector a
-> Tool
-> Selection
-> PotatoDefaultParameters
-> Maybe (Selection, Maybe a, Tool)
makeParamsInputDyn ToolOverrideSelector
tooloverridef ParamsSelector a
psf DefaultParamsSelector a
dpsf Tool
tool Selection
selection PotatoDefaultParameters
pdp = Maybe (Selection, Maybe a, Tool)
r where
r :: Maybe (Selection, Maybe a, Tool)
r = if ToolOverrideSelector
tooloverridef Tool
tool
then forall a. a -> Maybe a
Just (Selection
selection, forall a. a -> Maybe a
Just (DefaultParamsSelector a
dpsf PotatoDefaultParameters
pdp), Tool
tool)
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Selection
a,Maybe a
b) -> (Selection
a,Maybe a
b,Tool
tool)) forall a b. (a -> b) -> a -> b
$ forall a.
Eq a =>
ParamsSelector a -> Selection -> Maybe (Selection, Maybe a)
selectParamsFromSelection ParamsSelector a
psf Selection
selection
makeLineStyleInputDyn :: Tool -> Selection -> PotatoDefaultParameters -> Maybe (Selection, Maybe (Maybe LineStyle, Maybe LineStyle), Tool)
makeLineStyleInputDyn :: Tool
-> Selection
-> PotatoDefaultParameters
-> Maybe
(Selection, Maybe (Maybe LineStyle, Maybe LineStyle), Tool)
makeLineStyleInputDyn Tool
tool Selection
selection PotatoDefaultParameters
pdp = Maybe (Selection, Maybe (Maybe LineStyle, Maybe LineStyle), Tool)
r where
selectLineStyleFromSelection :: Selection -> Maybe (Selection, Maybe (Maybe LineStyle, Maybe LineStyle))
selectLineStyleFromSelection :: Selection
-> Maybe (Selection, Maybe (Maybe LineStyle, Maybe LineStyle))
selectLineStyleFromSelection (SuperOwlParliament Seq SuperOwl
selection) = Maybe (Selection, Maybe (Maybe LineStyle, Maybe LineStyle))
r_d1 where
ps :: SuperOwl -> (Maybe LineStyle, Maybe LineStyle)
ps = (\SElt
x -> (SElt -> Maybe LineStyle
getSEltLineStyle SElt
x, SElt -> Maybe LineStyle
getSEltLineStyleEnd SElt
x)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> SElt
superOwl_toSElt_hack
rawparams :: Seq (SuperOwl, (Maybe LineStyle, Maybe LineStyle))
rawparams = forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
ffilter (\(SuperOwl
_,(Maybe LineStyle
x,Maybe LineStyle
y)) -> forall a. Maybe a -> Bool
isJust Maybe LineStyle
x Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe LineStyle
y) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> (SuperOwl
sowl, SuperOwl -> (Maybe LineStyle, Maybe LineStyle)
ps SuperOwl
sowl)) forall a b. (a -> b) -> a -> b
$ Seq SuperOwl
selection
startvalues :: [LineStyle]
startvalues = forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList 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. (a, b) -> a
fst 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. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Seq (SuperOwl, (Maybe LineStyle, Maybe LineStyle))
rawparams
endvalues :: [LineStyle]
endvalues = forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList 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. (a, b) -> b
snd 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. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Seq (SuperOwl, (Maybe LineStyle, Maybe LineStyle))
rawparams
subSelection :: Selection
subSelection = Seq SuperOwl -> Selection
SuperOwlParliament forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Seq (SuperOwl, (Maybe LineStyle, Maybe LineStyle))
rawparams
r_d1 :: Maybe (Selection, Maybe (Maybe LineStyle, Maybe LineStyle))
r_d1 = case ([LineStyle]
startvalues, [LineStyle]
endvalues) of
([],[]) -> forall a. Maybe a
Nothing
(LineStyle
x:[LineStyle]
_, LineStyle
y:[LineStyle]
_) -> forall a. a -> Maybe a
Just (Selection
subSelection, forall a. a -> Maybe a
Just
(if forall a. Eq a => [a] -> Bool
L.allSame [LineStyle]
startvalues then forall a. a -> Maybe a
Just LineStyle
x else forall a. Maybe a
Nothing,
if forall a. Eq a => [a] -> Bool
L.allSame [LineStyle]
endvalues then forall a. a -> Maybe a
Just LineStyle
y else forall a. Maybe a
Nothing))
r :: Maybe (Selection, Maybe (Maybe LineStyle, Maybe LineStyle), Tool)
r = if ToolOverrideSelector
toolOverrideLineStyle Tool
tool
then forall a. a -> Maybe a
Just (Selection
selection, forall a. a -> Maybe a
Just (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PotatoDefaultParameters -> LineStyle
_potatoDefaultParameters_lineStyle PotatoDefaultParameters
pdp, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PotatoDefaultParameters -> LineStyle
_potatoDefaultParameters_lineStyleEnd PotatoDefaultParameters
pdp), Tool
tool)
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Selection
a,Maybe (Maybe LineStyle, Maybe LineStyle)
b) -> (Selection
a,Maybe (Maybe LineStyle, Maybe LineStyle)
b,Tool
tool)) forall a b. (a -> b) -> a -> b
$ Selection
-> Maybe (Selection, Maybe (Maybe LineStyle, Maybe LineStyle))
selectLineStyleFromSelection Selection
selection
type MaybeParamsWidgetOutputDyn t m b = Dynamic t (Maybe (m (Dynamic t Int, Event t (), Event t b)))
type ParamsWidgetOutputDyn t m b = Dynamic t (m (Dynamic t Int, Event t (), Event t b))
type ParamsWidgetFn t m a b = Dynamic t PotatoDefaultParameters -> Dynamic t (Selection, Maybe a, Tool) -> ParamsWidgetOutputDyn t m b
networkParamsWidgetOutputDynForTesting :: (MonadWidget t m, HasPotato t m) => ParamsWidgetOutputDyn t m b -> m (Dynamic t Int, Event t (), Event t b)
networkParamsWidgetOutputDynForTesting :: forall t (m :: * -> *) b.
(MonadWidget t m, HasPotato t m) =>
ParamsWidgetOutputDyn t m b
-> m (Dynamic t Int, Event t (), Event t b)
networkParamsWidgetOutputDynForTesting ParamsWidgetOutputDyn t m b
p = do
Event t (Dynamic t Int, Event t (), Event t b)
out' <- forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m (Event t a)
networkView ParamsWidgetOutputDyn t m b
p
Dynamic t (Dynamic t Int)
outHeightDyn <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn (forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn Int
0) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> a
fst3 Event t (Dynamic t Int, Event t (), Event t b)
out'
Event t ()
outCaptureEv <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m) =>
Event t a -> Event t (Event t a) -> m (Event t a)
switchHold forall {k} (t :: k) a. Reflex t => Event t a
never forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> b
snd3 Event t (Dynamic t Int, Event t (), Event t b)
out'
Event t b
outEv <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m) =>
Event t a -> Event t (Event t a) -> m (Event t a)
switchHold forall {k} (t :: k) a. Reflex t => Event t a
never forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> c
thd3 Event t (Dynamic t Int, Event t (), Event t b)
out'
return (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Dynamic t (Dynamic t Int)
outHeightDyn, Event t ()
outCaptureEv, Event t b
outEv)
holdMaybeParamsWidget :: forall t m a b. (MonadWidget t m)
=> Dynamic t PotatoDefaultParameters
-> Dynamic t (Maybe (Selection, Maybe a, Tool))
-> ParamsWidgetFn t m a b
-> m (MaybeParamsWidgetOutputDyn t m b)
holdMaybeParamsWidget :: forall t (m :: * -> *) a b.
MonadWidget t m =>
Dynamic t PotatoDefaultParameters
-> Dynamic t (Maybe (Selection, Maybe a, Tool))
-> ParamsWidgetFn t m a b
-> m (MaybeParamsWidgetOutputDyn t m b)
holdMaybeParamsWidget Dynamic t PotatoDefaultParameters
pdpDyn Dynamic t (Maybe (Selection, Maybe a, Tool))
mInputDyn ParamsWidgetFn t m a b
widgetFn = do
Dynamic t (Maybe (Selection, Maybe a, Tool))
uniqDyn <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> a -> Bool) -> Dynamic t a -> m (Dynamic t a)
holdUniqDynBy (\Maybe (Selection, Maybe a, Tool)
a Maybe (Selection, Maybe a, Tool)
b -> forall a. Maybe a -> Bool
isJust Maybe (Selection, Maybe a, Tool)
a forall a. Eq a => a -> a -> Bool
== forall a. Maybe a -> Bool
isJust Maybe (Selection, Maybe a, Tool)
b) Dynamic t (Maybe (Selection, Maybe a, Tool))
mInputDyn
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t (Maybe (Selection, Maybe a, Tool))
uniqDyn forall a b. (a -> b) -> a -> b
$ \case
Maybe (Selection, Maybe a, Tool)
Nothing -> forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn forall a. Maybe a
Nothing
Just (Selection, Maybe a, Tool)
_ -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParamsWidgetFn t m a b
widgetFn Dynamic t PotatoDefaultParameters
pdpDyn (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe (forall a. IsParliament a => a
isParliament_empty, forall a. Maybe a
Nothing, Tool
Tool_Select)) Dynamic t (Maybe (Selection, Maybe a, Tool))
mInputDyn)
emptyWidget :: (Monad m) => m ()
emptyWidget :: forall (m :: * -> *). Monad m => m ()
emptyWidget = forall (m :: * -> *) a. Monad m => a -> m a
return ()
data SuperStyleCell = SSC_TL | SSC_TR | SSC_BL | SSC_BR | SSC_V | SSC_H | SSC_Fill deriving (Int -> SuperStyleCell -> ShowS
[SuperStyleCell] -> ShowS
SuperStyleCell -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SuperStyleCell] -> ShowS
$cshowList :: [SuperStyleCell] -> ShowS
show :: SuperStyleCell -> String
$cshow :: SuperStyleCell -> String
showsPrec :: Int -> SuperStyleCell -> ShowS
$cshowsPrec :: Int -> SuperStyleCell -> ShowS
Show)
updateFromSuperStyle :: SuperStyleCell -> (SuperStyle -> TZ.TextZipper)
updateFromSuperStyle :: SuperStyleCell -> SuperStyle -> TextZipper
updateFromSuperStyle SuperStyleCell
ssc = TextZipper -> TextZipper
TZ.top forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TextZipper
TZ.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperStyleCell -> SuperStyle -> Char
gettfn SuperStyleCell
ssc where
gettfn :: SuperStyleCell -> SuperStyle -> Char
gettfn SuperStyleCell
ssc' = forall a. a -> Maybe a -> a
fromMaybe Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperStyleCell -> SuperStyle -> MPChar
gettfn' SuperStyleCell
ssc'
gettfn' :: SuperStyleCell -> SuperStyle -> MPChar
gettfn' = \case
SuperStyleCell
SSC_TL -> SuperStyle -> MPChar
_superStyle_tl
SuperStyleCell
SSC_TR -> SuperStyle -> MPChar
_superStyle_tr
SuperStyleCell
SSC_BL -> SuperStyle -> MPChar
_superStyle_bl
SuperStyleCell
SSC_BR -> SuperStyle -> MPChar
_superStyle_br
SuperStyleCell
SSC_V -> SuperStyle -> MPChar
_superStyle_vertical
SuperStyleCell
SSC_H -> SuperStyle -> MPChar
_superStyle_horizontal
SuperStyleCell
SSC_Fill -> (\case
FillStyle_Simple Char
c -> forall a. a -> Maybe a
Just Char
c
FillStyle
_ -> forall a. Maybe a
Nothing) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperStyle -> FillStyle
_superStyle_fill
makeSuperStyleTextEntry :: (MonadWidget t m, HasPotato t m) => SuperStyleCell -> Dynamic t (Maybe SuperStyle) -> m (Behavior t PChar)
makeSuperStyleTextEntry :: forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
SuperStyleCell
-> Dynamic t (Maybe SuperStyle) -> m (Behavior t Char)
makeSuperStyleTextEntry SuperStyleCell
ssc Dynamic t (Maybe SuperStyle)
mssDyn = do
Maybe SuperStyle
mss0 <- 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 (Maybe SuperStyle)
mssDyn
let modifyEv :: Event t (TextZipper -> TextZipper)
modifyEv = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\SuperStyle
ss -> forall a b. a -> b -> a
const (SuperStyleCell -> SuperStyle -> TextZipper
updateFromSuperStyle SuperStyleCell
ssc SuperStyle
ss))) (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Maybe SuperStyle)
mssDyn))
Dynamic t Text
ti <- forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Event t (TextZipper -> TextZipper)
-> TextZipper -> m (Dynamic t Text)
singleCellTextInput Event t (TextZipper -> TextZipper)
modifyEv forall a b. (a -> b) -> a -> b
$ case Maybe SuperStyle
mss0 of
Maybe SuperStyle
Nothing -> TextZipper
""
Just SuperStyle
ss0 -> SuperStyleCell -> SuperStyle -> TextZipper
updateFromSuperStyle SuperStyleCell
ssc SuperStyle
ss0
forall (m :: * -> *) a. Monad m => a -> m a
return 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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
t -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Char
' ' (\(Char
c,Text
_) -> Char
c) (Text -> Maybe (Char, Text)
T.uncons Text
t)) forall a b. (a -> b) -> a -> b
$ Dynamic t Text
ti
makeSuperStyleEvent :: (Reflex t)
=> Behavior t PChar
-> Behavior t PChar
-> Behavior t PChar
-> Behavior t PChar
-> Behavior t PChar
-> Behavior t PChar
-> Behavior t PChar
-> Event t ()
-> Event t SuperStyle
makeSuperStyleEvent :: forall t.
Reflex t =>
Behavior t Char
-> Behavior t Char
-> Behavior t Char
-> Behavior t Char
-> Behavior t Char
-> Behavior t Char
-> Behavior t Char
-> Event t ()
-> Event t SuperStyle
makeSuperStyleEvent Behavior t Char
tl Behavior t Char
v Behavior t Char
bl Behavior t Char
h Behavior t Char
f Behavior t Char
tr Behavior t Char
br Event t ()
trig = forall {k} (t :: k) a b.
Reflex t =>
(a -> PushM t b) -> Event t a -> Event t b
pushAlways () -> PushM t SuperStyle
pushfn Event t ()
trig where
pushfn :: () -> PushM t SuperStyle
pushfn ()
_ = do
Char
tl' <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Char
tl
Char
v' <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Char
v
Char
bl' <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Char
bl
Char
h' <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Char
h
Char
f' <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Char
f
Char
tr' <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Char
tr
Char
br' <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Char
br
return $ forall a. Default a => a
def {
_superStyle_tl :: MPChar
_superStyle_tl = forall a. a -> Maybe a
Just Char
tl'
, _superStyle_tr :: MPChar
_superStyle_tr = forall a. a -> Maybe a
Just Char
tr'
, _superStyle_bl :: MPChar
_superStyle_bl = forall a. a -> Maybe a
Just Char
bl'
, _superStyle_br :: MPChar
_superStyle_br = forall a. a -> Maybe a
Just Char
br'
, _superStyle_vertical :: MPChar
_superStyle_vertical = forall a. a -> Maybe a
Just Char
v'
, _superStyle_horizontal :: MPChar
_superStyle_horizontal = forall a. a -> Maybe a
Just Char
h'
, _superStyle_fill :: FillStyle
_superStyle_fill = Char -> FillStyle
FillStyle_Simple Char
f'
}
presetSuperStyles :: [[Char]]
presetSuperStyles :: [String]
presetSuperStyles = [String
"╔╗╚╝║═ ",String
"****|- ", String
"██████ ", String
"┌┐└┘│─ "]
holdSuperStyleWidget :: forall t m. (MonadLayoutWidget t m, HasPotato t m) => ParamsWidgetFn t m SuperStyle (Either Llama SetPotatoDefaultParameters)
holdSuperStyleWidget :: forall t (m :: * -> *).
(MonadLayoutWidget t m, HasPotato t m) =>
ParamsWidgetFn
t m SuperStyle (Either Llama SetPotatoDefaultParameters)
holdSuperStyleWidget Dynamic t PotatoDefaultParameters
pdpDyn Dynamic t (Selection, Maybe SuperStyle, Tool)
inputDyn = forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn forall a b. (a -> b) -> a -> b
$ mdo
do
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
HasTheme t m) =>
Behavior t Text -> m ()
text Behavior t Text
"style:"
Dynamic t Int
typeChoiceDyn <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ 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
0 [Text
"custom", Text
"presets"]
Event t (Int, Event t (), Event t SuperStyle)
setStyleEvEv <- forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m (Event t a)
networkView forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t Int
typeChoiceDyn forall a b. (a -> b) -> a -> b
$ \case
Int
1 -> do
Event t SuperStyle
setStyleEv' <- do
[Event t String]
presetClicks <- forall (m :: * -> *) a b.
Monad m =>
[a] -> ((a, Int) -> m b) -> m [b]
listForMi [String]
presetSuperStyles forall a b. (a -> b) -> a -> b
$ \(String
s,Int
i) -> (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ 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 b a. (Show a, IsString b) => a -> b
show Int
i forall a. Semigroup a => a -> a -> a
<> Behavior t Text
". " forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant (String -> Text
T.pack String
s))
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 (\MouseDown
_ -> String
s)) (forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasInput t m) =>
Button -> m (Event t MouseDown)
mouseDown Button
V.BLeft)
return $ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> SuperStyle
superStyle_fromListFormat (forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t String]
presetClicks)
return (Int
5, forall {k} (t :: k) a. Reflex t => Event t a
never, Event t SuperStyle
setStyleEv')
Int
0 -> do
let
mssDyn :: Dynamic t (Maybe SuperStyle)
mssDyn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> b
snd3 Dynamic t (Selection, Maybe SuperStyle, Tool)
inputDyn
(Dynamic t (Maybe FocusId)
focusDyn,Behavior t Char
tl,Behavior t Char
v,Behavior t Char
bl,Behavior t Char
h,Behavior t Char
f,Behavior t Char
tr,Behavior t Char
br) <- do
(Behavior t Char
tl'',Behavior t Char
h'',Behavior t Char
tr'') <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
Behavior t Char
tl' <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
SuperStyleCell
-> Dynamic t (Maybe SuperStyle) -> m (Behavior t Char)
makeSuperStyleTextEntry SuperStyleCell
SSC_TL Dynamic t (Maybe SuperStyle)
mssDyn
Behavior t Char
h' <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
SuperStyleCell
-> Dynamic t (Maybe SuperStyle) -> m (Behavior t Char)
makeSuperStyleTextEntry SuperStyleCell
SSC_H Dynamic t (Maybe SuperStyle)
mssDyn
Behavior t Char
tr' <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
SuperStyleCell
-> Dynamic t (Maybe SuperStyle) -> m (Behavior t Char)
makeSuperStyleTextEntry SuperStyleCell
SSC_TR Dynamic t (Maybe SuperStyle)
mssDyn
return (Behavior t Char
tl',Behavior t Char
h',Behavior t Char
tr')
(Behavior t Char
v'',Behavior t Char
f'') <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
Behavior t Char
v' <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
SuperStyleCell
-> Dynamic t (Maybe SuperStyle) -> m (Behavior t Char)
makeSuperStyleTextEntry SuperStyleCell
SSC_V Dynamic t (Maybe SuperStyle)
mssDyn
Behavior t Char
f' <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
SuperStyleCell
-> Dynamic t (Maybe SuperStyle) -> m (Behavior t Char)
makeSuperStyleTextEntry SuperStyleCell
SSC_Fill Dynamic t (Maybe SuperStyle)
mssDyn
()
_ <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => m ()
emptyWidget
return (Behavior t Char
v',Behavior t Char
f')
(Behavior t Char
bl'',Behavior t Char
br'') <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
Behavior t Char
bl' <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
SuperStyleCell
-> Dynamic t (Maybe SuperStyle) -> m (Behavior t Char)
makeSuperStyleTextEntry SuperStyleCell
SSC_BL Dynamic t (Maybe SuperStyle)
mssDyn
()
_ <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => m ()
emptyWidget
Behavior t Char
br' <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
SuperStyleCell
-> Dynamic t (Maybe SuperStyle) -> m (Behavior t Char)
makeSuperStyleTextEntry SuperStyleCell
SSC_BR Dynamic t (Maybe SuperStyle)
mssDyn
return (Behavior t Char
bl',Behavior t Char
br')
Dynamic t (Maybe FocusId)
focusDyn' <- forall {k} (t :: k) (m :: * -> *).
HasFocus t m =>
m (Dynamic t (Maybe FocusId))
focusedId
return (Dynamic t (Maybe FocusId)
focusDyn',Behavior t Char
tl'',Behavior t Char
v'',Behavior t Char
bl'',Behavior t Char
h'',Behavior t Char
f'',Behavior t Char
tr'',Behavior t Char
br'')
Event t ()
captureEv1 <- forall t (m :: * -> *).
(Reflex t, MonadFix m, MonadNodeId m, HasInput t m) =>
UpdateTextZipperMethod -> m (Event t ())
makeCaptureFromUpdateTextZipperMethod UpdateTextZipperMethod
updateTextZipperForSingleCharacter
Dynamic t (Maybe FocusId)
focusDynUnique <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn Dynamic t (Maybe FocusId)
focusDyn
let
setStyleEv' :: Event t SuperStyle
setStyleEv' = forall t.
Reflex t =>
Behavior t Char
-> Behavior t Char
-> Behavior t Char
-> Behavior t Char
-> Behavior t Char
-> Behavior t Char
-> Behavior t Char
-> Event t ()
-> Event t SuperStyle
makeSuperStyleEvent Behavior t Char
tl Behavior t Char
v Behavior t Char
bl Behavior t Char
h Behavior t Char
f Behavior t Char
tr Behavior t Char
br (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Maybe FocusId)
focusDynUnique)
captureEv' :: Event t ()
captureEv' = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [forall (f :: * -> *) a. Functor f => f a -> f ()
void Event t SuperStyle
setStyleEv', Event t ()
captureEv1]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
5, Event t ()
captureEv', Event t SuperStyle
setStyleEv')
Event t SuperStyle
setStyleEv <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m) =>
Event t a -> Event t (Event t a) -> m (Event t a)
switchHold forall {k} (t :: k) a. Reflex t => Event t a
never (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> c
thd3 Event t (Int, Event t (), Event t SuperStyle)
setStyleEvEv)
Event t ()
captureEv <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m) =>
Event t a -> Event t (Event t a) -> m (Event t a)
switchHold forall {k} (t :: k) a. Reflex t => Event t a
never (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> b
snd3 Event t (Int, Event t (), Event t SuperStyle)
setStyleEvEv)
Dynamic t Int
heightDyn <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Int
0 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> a
fst3 Event t (Int, Event t (), Event t SuperStyle)
setStyleEvEv)
let
selectionDyn :: Dynamic t Selection
selectionDyn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> a
fst3 Dynamic t (Selection, Maybe SuperStyle, Tool)
inputDyn
pushSuperStyleFn :: SuperStyle -> PushM t (Maybe (Either Llama SetPotatoDefaultParameters))
pushSuperStyleFn :: SuperStyle
-> PushM t (Maybe (Either Llama SetPotatoDefaultParameters))
pushSuperStyleFn SuperStyle
ss = do
(SuperOwlParliament Seq SuperOwl
selection, Maybe SuperStyle
_, Tool
tool) <- 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 (Selection, Maybe SuperStyle, Tool)
inputDyn
PotatoDefaultParameters
pdp <- 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 PotatoDefaultParameters
pdpDyn
let
fmapfn :: SuperOwl -> Maybe (Int, DSum CTag Identity)
fmapfn SuperOwl
sowl = case SEltLabel -> Maybe SuperStyle
getSEltLabelSuperStyle (SuperOwl -> SEltLabel
superOwl_toSEltLabel_hack SuperOwl
sowl) of
Maybe SuperStyle
Nothing -> forall a. Maybe a
Nothing
Just SuperStyle
oldss -> if SuperStyle
oldss forall a. Eq a => a -> a -> Bool
== SuperStyle
ss
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (SuperOwl -> Int
_superOwl_id SuperOwl
sowl, CTag CSuperStyle
CTagSuperStyle forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> forall a. a -> Identity a
Identity (DeltaSuperStyle -> CSuperStyle
CSuperStyle ((SuperStyle, SuperStyle) -> DeltaSuperStyle
DeltaSuperStyle (SuperStyle
oldss, SuperStyle
ss))))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if ToolOverrideSelector
toolOverrideSuperStyle Tool
tool
then if PotatoDefaultParameters -> SuperStyle
_potatoDefaultParameters_superStyle PotatoDefaultParameters
pdp forall a. Eq a => a -> a -> Bool
== SuperStyle
ss
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def { _setPotatoDefaultParameters_superStyle :: Maybe SuperStyle
_setPotatoDefaultParameters_superStyle = forall a. a -> Maybe a
Just SuperStyle
ss }
else case forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe SuperOwl -> Maybe (Int, DSum CTag Identity)
fmapfn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Seq SuperOwl
selection of
[] -> forall a. Maybe a
Nothing
[(Int, DSum CTag Identity)]
x -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControllersWithId -> Llama
controllersWithId_to_llama forall a b. (a -> b) -> a -> b
$ forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int, DSum CTag Identity)]
x
ssparamsEv :: Event t (Either Llama SetPotatoDefaultParameters)
ssparamsEv = forall {k} (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push SuperStyle
-> PushM t (Maybe (Either Llama SetPotatoDefaultParameters))
pushSuperStyleFn Event t SuperStyle
setStyleEv
return (Dynamic t Int
heightDyn, Event t ()
captureEv, Event t (Either Llama SetPotatoDefaultParameters)
ssparamsEv)
data LineStyleCell = LSC_L | LSC_R | LSC_U | LSC_D
updateFromLineStyle :: LineStyleCell -> (LineStyle -> TZ.TextZipper)
updateFromLineStyle :: LineStyleCell -> LineStyle -> TextZipper
updateFromLineStyle LineStyleCell
lsc = TextZipper -> TextZipper
TZ.top forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TextZipper
TZ.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineStyleCell -> LineStyle -> Text
gettfn LineStyleCell
lsc where
gettfn :: LineStyleCell -> LineStyle -> Text
gettfn = \case
LineStyleCell
LSC_L -> LineStyle -> Text
_lineStyle_leftArrows
LineStyleCell
LSC_R -> LineStyle -> Text
_lineStyle_rightArrows
LineStyleCell
LSC_U -> LineStyle -> Text
_lineStyle_upArrows
LineStyleCell
LSC_D -> LineStyle -> Text
_lineStyle_downArrows
makeLineStyleEvent :: (Reflex t)
=> Behavior t Text
-> Behavior t Text
-> Behavior t Text
-> Behavior t Text
-> Event t ()
-> Event t LineStyle
makeLineStyleEvent :: forall t.
Reflex t =>
Behavior t Text
-> Behavior t Text
-> Behavior t Text
-> Behavior t Text
-> Event t ()
-> Event t LineStyle
makeLineStyleEvent Behavior t Text
l Behavior t Text
r Behavior t Text
u Behavior t Text
d Event t ()
trig = forall {k} (t :: k) a b.
Reflex t =>
(a -> PushM t b) -> Event t a -> Event t b
pushAlways () -> PushM t LineStyle
pushfn Event t ()
trig where
pushfn :: () -> PushM t LineStyle
pushfn ()
_ = do
Text
l' <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
l
Text
r' <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
r
Text
u' <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
u
Text
d' <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
d
return $ forall a. Default a => a
def {
_lineStyle_leftArrows :: Text
_lineStyle_leftArrows = Text
l'
, _lineStyle_rightArrows :: Text
_lineStyle_rightArrows = Text
r'
, _lineStyle_upArrows :: Text
_lineStyle_upArrows = Text
u'
, _lineStyle_downArrows :: Text
_lineStyle_downArrows = Text
d'
}
makeLineStyleTextEntry :: (MonadWidget t m, HasPotato t m) => LineStyleCell -> Dynamic t (Maybe LineStyle) -> m (Dynamic t Text)
makeLineStyleTextEntry :: forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
LineStyleCell -> Dynamic t (Maybe LineStyle) -> m (Dynamic t Text)
makeLineStyleTextEntry LineStyleCell
lsc Dynamic t (Maybe LineStyle)
mlsDyn = do
Maybe LineStyle
mls0 <- 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 (Maybe LineStyle)
mlsDyn
let modifyEv :: Event t (TextZipper -> TextZipper)
modifyEv = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\LineStyle
ss -> forall a b. a -> b -> a
const (LineStyleCell -> LineStyle -> TextZipper
updateFromLineStyle LineStyleCell
lsc LineStyle
ss))) (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Maybe LineStyle)
mlsDyn))
Dynamic t Text
ti <- forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Event t (TextZipper -> TextZipper)
-> TextZipper -> m (Dynamic t Text)
singleCellTextInput Event t (TextZipper -> TextZipper)
modifyEv forall a b. (a -> b) -> a -> b
$ case Maybe LineStyle
mls0 of
Maybe LineStyle
Nothing -> TextZipper
""
Just LineStyle
ls0 -> LineStyleCell -> LineStyle -> TextZipper
updateFromLineStyle LineStyleCell
lsc LineStyle
ls0
return Dynamic t Text
ti
presetLineStyles :: [([Char], [Char], [Char], [Char])]
presetLineStyles :: [(String, String, String, String)]
presetLineStyles = [(String
"",String
"",String
"",String
""), (String
"<",String
">",String
"^",String
"v"), (String
"⇦",String
"⇨",String
"⇧",String
"⇩")]
presetLineStyle_toText :: ([Char], [Char], [Char], [Char]) -> Text
presetLineStyle_toText :: (String, String, String, String) -> Text
presetLineStyle_toText (String
l,String
r,String
u,String
d) = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
l forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> String
r forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> String
u forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> String
d
leftmostEither :: (Reflex t) => Event t a -> Event t b -> Event t (Either a b)
leftmostEither :: forall t a b.
Reflex t =>
Event t a -> Event t b -> Event t (Either a b)
leftmostEither Event t a
eva Event t b
evb = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left Event t a
eva), (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right Event t b
evb)]
holdLineStyleWidgetNew :: forall t m. (MonadLayoutWidget t m, HasPotato t m) => ParamsWidgetFn t m (Maybe LineStyle, Maybe LineStyle) (Either Llama SetPotatoDefaultParameters)
holdLineStyleWidgetNew :: forall t (m :: * -> *).
(MonadLayoutWidget t m, HasPotato t m) =>
ParamsWidgetFn
t
m
(Maybe LineStyle, Maybe LineStyle)
(Either Llama SetPotatoDefaultParameters)
holdLineStyleWidgetNew Dynamic t PotatoDefaultParameters
pdpDyn Dynamic
t (Selection, Maybe (Maybe LineStyle, Maybe LineStyle), Tool)
inputDyn = forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn forall a b. (a -> b) -> a -> b
$ do
Behavior t PotatoStyle
potatostylebeh <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. PotatoConfig t -> Behavior t PotatoStyle
_potatoConfig_style forall t (m :: * -> *). HasPotato t m => m (PotatoConfig t)
askPotato
let buttonAttrBeh :: Behavior t (Attr, Attr)
buttonAttrBeh = forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Behavior t PotatoStyle
potatostylebeh (\PotatoStyle
ps -> (PotatoStyle -> Attr
_potatoStyle_normal PotatoStyle
ps, PotatoStyle -> Attr
_potatoStyle_selected PotatoStyle
ps))
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
HasTheme t m) =>
Behavior t Text -> m ()
text Behavior t Text
"line end style:"
(Dynamic t Int
endChoiceDyn, Event t ()
flipButtonEv) <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
Dynamic t Int
endChoiceDyn' <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col forall a b. (a -> b) -> a -> b
$ (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
17 forall a b. (a -> b) -> a -> b
$ 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
0 [Text
"both", Text
"start", Text
"end"]
Event t ()
flipButtonEv' <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col forall a b. (a -> b) -> a -> b
$ (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ 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)
buttonAttrBeh Dynamic t Text
"flip"
return (Dynamic t Int
endChoiceDyn', Event t ()
flipButtonEv')
Dynamic t Int
typeChoiceDyn <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ 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
0 [Text
"custom", Text
"presets"]
Event t (Int, Event t (), Event t LineStyle)
setStyleEvEv <- do
forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m (Event t a)
networkView forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t Int
typeChoiceDyn Dynamic t Int
endChoiceDyn forall a b. (a -> b) -> a -> b
$ \Int
tc' Int
ec' -> case (Int
tc', Int
ec') of
(Int
1, Int
_) -> do
Event t LineStyle
setStyleEv' <- do
[Event t (String, String, String, String)]
presetClicks <- forall (m :: * -> *) a b.
Monad m =>
[a] -> ((a, Int) -> m b) -> m [b]
listForMi [(String, String, String, String)]
presetLineStyles forall a b. (a -> b) -> a -> b
$ \((String, String, String, String)
s, Int
i) -> (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ 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 {k} (t :: k) a. Reflex t => a -> Behavior t a
constant (forall b a. (Show a, IsString b) => a -> b
show Int
i forall a. Semigroup a => a -> a -> a
<> Text
". " forall a. Semigroup a => a -> a -> a
<> (String, String, String, String) -> Text
presetLineStyle_toText (String, String, String, String)
s))
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 (\MouseDown
_ -> (String, String, String, String)
s)) (forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasInput t m) =>
Button -> m (Event t MouseDown)
mouseDown Button
V.BLeft)
return $ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, String, String, String) -> LineStyle
lineStyle_fromListFormat (forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t (String, String, String, String)]
presetClicks)
return (Int
5, forall {k} (t :: k) a. Reflex t => Event t a
never, Event t LineStyle
setStyleEv')
(Int
0, Int
ec) -> do
let
joinmaybetuple :: Maybe (Maybe a, Maybe a) -> (Maybe a, Maybe a)
joinmaybetuple Maybe (Maybe a, Maybe a)
mx = case Maybe (Maybe a, Maybe a)
mx of
Maybe (Maybe a, Maybe a)
Nothing -> (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
Just (Maybe a, Maybe a)
x -> (Maybe a, Maybe a)
x
lssDyn :: Dynamic t (Maybe LineStyle)
lssDyn = forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a} {a}. Maybe (Maybe a, Maybe a) -> (Maybe a, Maybe a)
joinmaybetuple forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> b
snd3 Dynamic
t (Selection, Maybe (Maybe LineStyle, Maybe LineStyle), Tool)
inputDyn) forall a b. (a -> b) -> a -> b
$ \(Maybe LineStyle
start, Maybe LineStyle
end) -> case Int
ec of
Int
0 -> if Maybe LineStyle
start forall a. Eq a => a -> a -> Bool
== Maybe LineStyle
end then Maybe LineStyle
start else forall a. Maybe a
Nothing
Int
1 -> Maybe LineStyle
start
Int
2 -> Maybe LineStyle
end
(Dynamic t (Maybe FocusId)
focusDyn,Dynamic t Bool
wasChangeDyn,Dynamic t Text
l,Dynamic t Text
r,Dynamic t Text
u,Dynamic t Text
d) <- do
Dynamic t Text
l_d1 <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
8 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
HasTheme t m) =>
Behavior t Text -> m ()
text Behavior t Text
" left:"
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
LineStyleCell -> Dynamic t (Maybe LineStyle) -> m (Dynamic t Text)
makeLineStyleTextEntry LineStyleCell
LSC_L Dynamic t (Maybe LineStyle)
lssDyn
Dynamic t Text
r_d1 <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
8 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
HasTheme t m) =>
Behavior t Text -> m ()
text Behavior t Text
"right:"
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
LineStyleCell -> Dynamic t (Maybe LineStyle) -> m (Dynamic t Text)
makeLineStyleTextEntry LineStyleCell
LSC_R Dynamic t (Maybe LineStyle)
lssDyn
Dynamic t Text
u_d1 <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
8 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
HasTheme t m) =>
Behavior t Text -> m ()
text Behavior t Text
"up:"
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
LineStyleCell -> Dynamic t (Maybe LineStyle) -> m (Dynamic t Text)
makeLineStyleTextEntry LineStyleCell
LSC_U Dynamic t (Maybe LineStyle)
lssDyn
Dynamic t Text
d_d1 <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
8 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
HasTheme t m) =>
Behavior t Text -> m ()
text Behavior t Text
"down:"
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
LineStyleCell -> Dynamic t (Maybe LineStyle) -> m (Dynamic t Text)
makeLineStyleTextEntry LineStyleCell
LSC_D Dynamic t (Maybe LineStyle)
lssDyn
Dynamic t (Maybe FocusId)
focusDyn' <- forall {k} (t :: k) (m :: * -> *).
HasFocus t m =>
m (Dynamic t (Maybe FocusId))
focusedId
let trueInputChangeEv :: Event t Bool
trueInputChangeEv = forall {k} (t :: k) a b.
Reflex t =>
Event t a -> Event t b -> Event t a
difference (forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t Text
l_d1 forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True, forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t Text
r_d1 forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True, forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t Text
u_d1 forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True, forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t Text
d_d1 forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True]) (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Maybe LineStyle)
lssDyn)
Dynamic t Bool
wasChangeDyn' <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Bool
False forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Maybe FocusId)
focusDyn' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False, Event t Bool
trueInputChangeEv]
return (Dynamic t (Maybe FocusId)
focusDyn',Dynamic t Bool
wasChangeDyn',Dynamic t Text
l_d1,Dynamic t Text
r_d1,Dynamic t Text
u_d1,Dynamic t Text
d_d1)
Event t ()
captureEv'' <- forall t (m :: * -> *).
(Reflex t, MonadFix m, MonadNodeId m, HasInput t m) =>
UpdateTextZipperMethod -> m (Event t ())
makeCaptureFromUpdateTextZipperMethod UpdateTextZipperMethod
updateTextZipperForSingleCharacter
Dynamic t (Maybe FocusId)
focusDynUnique <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn Dynamic t (Maybe FocusId)
focusDyn
let
setStyleEv' :: Event t LineStyle
setStyleEv' = forall t.
Reflex t =>
Behavior t Text
-> Behavior t Text
-> Behavior t Text
-> Behavior t Text
-> Event t ()
-> Event t LineStyle
makeLineStyleEvent (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Text
l) (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Text
r) (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Text
u) (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Text
d) (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a.
Reflex t =>
Behavior t Bool -> Event t a -> Event t a
gate (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Bool
wasChangeDyn) (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Maybe FocusId)
focusDynUnique))
captureEv' :: Event t ()
captureEv' = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [forall (f :: * -> *) a. Functor f => f a -> f ()
void Event t LineStyle
setStyleEv', Event t ()
captureEv'']
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
7, Event t ()
captureEv', Event t LineStyle
setStyleEv')
Event t LineStyle
setStyleEv <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m) =>
Event t a -> Event t (Event t a) -> m (Event t a)
switchHold forall {k} (t :: k) a. Reflex t => Event t a
never (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> c
thd3 Event t (Int, Event t (), Event t LineStyle)
setStyleEvEv)
Event t ()
captureEv <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m) =>
Event t a -> Event t (Event t a) -> m (Event t a)
switchHold forall {k} (t :: k) a. Reflex t => Event t a
never (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> b
snd3 Event t (Int, Event t (), Event t LineStyle)
setStyleEvEv)
Dynamic t Int
heightDyn <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Int
0 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> a
fst3 Event t (Int, Event t (), Event t LineStyle)
setStyleEvEv)
let
selectionDyn :: Dynamic t Selection
selectionDyn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> a
fst3 Dynamic
t (Selection, Maybe (Maybe LineStyle, Maybe LineStyle), Tool)
inputDyn
pushLineStyleFn :: Either () LineStyle -> PushM t (Maybe (Either Llama SetPotatoDefaultParameters))
pushLineStyleFn :: Either () LineStyle
-> PushM t (Maybe (Either Llama SetPotatoDefaultParameters))
pushLineStyleFn Either () LineStyle
eflipss = do
PotatoDefaultParameters
pdp <- 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 PotatoDefaultParameters
pdpDyn
Int
whichEnd' <- 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
endChoiceDyn
(SuperOwlParliament Seq SuperOwl
selection, Maybe (Maybe LineStyle, Maybe LineStyle)
_, Tool
tool) <- 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 (Selection, Maybe (Maybe LineStyle, Maybe LineStyle), Tool)
inputDyn
let
whichEnd :: SetLineStyleEnd
whichEnd = case Int
whichEnd' of
Int
0 -> SetLineStyleEnd
SetLineStyleEnd_Both
Int
1 -> SetLineStyleEnd
SetLineStyleEnd_Start
Int
2 -> SetLineStyleEnd
SetLineStyleEnd_End
(Bool
setstart, Bool
setend) = case SetLineStyleEnd
whichEnd of
SetLineStyleEnd
SetLineStyleEnd_Start -> (Bool
True, Bool
False)
SetLineStyleEnd
SetLineStyleEnd_End -> (Bool
False, Bool
True)
SetLineStyleEnd
SetLineStyleEnd_Both -> (Bool
True, Bool
True)
whichEndFn :: SuperOwl -> Maybe LineStyle
whichEndFn SuperOwl
sowl = case SetLineStyleEnd
whichEnd of
SetLineStyleEnd
SetLineStyleEnd_Start -> Maybe LineStyle
startStyle
SetLineStyleEnd
SetLineStyleEnd_End -> Maybe LineStyle
endStyle
SetLineStyleEnd
SetLineStyleEnd_Both -> if Maybe LineStyle
startStyle forall a. Eq a => a -> a -> Bool
== Maybe LineStyle
endStyle then Maybe LineStyle
startStyle else forall a. Maybe a
Nothing
where
seltl :: SEltLabel
seltl = SuperOwl -> SEltLabel
superOwl_toSEltLabel_hack SuperOwl
sowl
startStyle :: Maybe LineStyle
startStyle = SEltLabel -> Maybe LineStyle
getSEltLabelLineStyle SEltLabel
seltl
endStyle :: Maybe LineStyle
endStyle = SEltLabel -> Maybe LineStyle
getSEltLabelLineStyleEnd SEltLabel
seltl
return $ case Either () LineStyle
eflipss of
Left () -> case forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe SuperOwl -> Maybe Llama
fmapleftfn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Seq SuperOwl
selection of
[] -> forall a. Maybe a
Nothing
[Llama]
x -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Llama] -> Llama
makeCompositionLlama forall a b. (a -> b) -> a -> b
$ [Llama]
x
where
fmapleftfn :: SuperOwl -> Maybe Llama
fmapleftfn SuperOwl
sowl = SuperOwl -> Maybe Llama
makeLlamaForFlipLineStyle SuperOwl
sowl
Right LineStyle
ss -> if ToolOverrideSelector
toolOverrideLineStyle Tool
tool
then if PotatoDefaultParameters -> LineStyle
_potatoDefaultParameters_lineStyle PotatoDefaultParameters
pdp forall a. Eq a => a -> a -> Bool
== LineStyle
ss
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
forall a. Default a => a
def {
_setPotatoDefaultParameters_lineStyle :: Maybe LineStyle
_setPotatoDefaultParameters_lineStyle = if Bool
setstart then forall a. a -> Maybe a
Just LineStyle
ss else SetPotatoDefaultParameters -> Maybe LineStyle
_setPotatoDefaultParameters_lineStyle forall a. Default a => a
def
, _setPotatoDefaultParameters_lineStyleEnd :: Maybe LineStyle
_setPotatoDefaultParameters_lineStyleEnd = if Bool
setend then forall a. a -> Maybe a
Just LineStyle
ss else SetPotatoDefaultParameters -> Maybe LineStyle
_setPotatoDefaultParameters_lineStyleEnd forall a. Default a => a
def
}
else case forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe SuperOwl -> Maybe Llama
fmaprightfn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Seq SuperOwl
selection of
[] -> forall a. Maybe a
Nothing
[Llama]
x -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Llama] -> Llama
makeCompositionLlama forall a b. (a -> b) -> a -> b
$ [Llama]
x
where
fmaprightfn :: SuperOwl -> Maybe Llama
fmaprightfn SuperOwl
sowl = case SuperOwl -> Maybe LineStyle
whichEndFn SuperOwl
sowl of
Maybe LineStyle
Nothing -> Maybe Llama
llama
Just LineStyle
oldss -> if LineStyle
oldss forall a. Eq a => a -> a -> Bool
== LineStyle
ss then forall a. Maybe a
Nothing else Maybe Llama
llama
where llama :: Maybe Llama
llama = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SuperOwl -> SetLineStyleEnd -> LineStyle -> Llama
makeLlamaForLineStyle SuperOwl
sowl SetLineStyleEnd
whichEnd LineStyle
ss
ssparamsEv :: Event t (Either Llama SetPotatoDefaultParameters)
ssparamsEv = forall {k} (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push Either () LineStyle
-> PushM t (Maybe (Either Llama SetPotatoDefaultParameters))
pushLineStyleFn (forall t a b.
Reflex t =>
Event t a -> Event t b -> Event t (Either a b)
leftmostEither Event t ()
flipButtonEv Event t LineStyle
setStyleEv)
return (Dynamic t Int
heightDyn, Event t ()
captureEv, Event t (Either Llama SetPotatoDefaultParameters)
ssparamsEv)
holdTextAlignmentWidget :: forall t m. (MonadLayoutWidget t m, HasPotato t m) => ParamsWidgetFn t m TextAlign (Either Llama SetPotatoDefaultParameters)
holdTextAlignmentWidget :: forall t (m :: * -> *).
(MonadLayoutWidget t m, HasPotato t m) =>
ParamsWidgetFn
t m TextAlign (Either Llama SetPotatoDefaultParameters)
holdTextAlignmentWidget Dynamic t PotatoDefaultParameters
_ Dynamic t (Selection, Maybe TextAlign, Tool)
inputDyn = forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn forall a b. (a -> b) -> a -> b
$ do
let
mtaDyn :: Dynamic t (Maybe TextAlign)
mtaDyn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> b
snd3 Dynamic t (Selection, Maybe TextAlign, Tool)
inputDyn
selectionDyn :: Dynamic t Selection
selectionDyn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> a
fst3 Dynamic t (Selection, Maybe TextAlign, Tool)
inputDyn
let
alignDyn :: Dynamic t [Int]
alignDyn = forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t (Maybe TextAlign)
mtaDyn forall a b. (a -> b) -> a -> b
$ \case
Maybe TextAlign
Nothing -> []
Just TextAlign
TextAlign_Left -> [Int
0]
Just TextAlign
TextAlign_Center -> [Int
1]
Just TextAlign
TextAlign_Right -> [Int
2]
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
HasTheme t m) =>
Behavior t Text -> m ()
text Behavior t Text
"text align:"
(Event t Int
setAlignmentEv', Dynamic t Int
_) <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ 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
"left",Text
"center",Text
"right"]) Dynamic t [Int]
alignDyn forall a. Maybe a
Nothing
let
setAlignmentEv :: Event t TextAlign
setAlignmentEv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\case
Int
0 -> TextAlign
TextAlign_Left
Int
1 -> TextAlign
TextAlign_Center
Int
2 -> TextAlign
TextAlign_Right
) forall a b. (a -> b) -> a -> b
$ Event t Int
setAlignmentEv'
pushAlignmentFn :: TextAlign -> PushM t (Maybe (Either Llama SetPotatoDefaultParameters))
pushAlignmentFn :: TextAlign
-> PushM t (Maybe (Either Llama SetPotatoDefaultParameters))
pushAlignmentFn TextAlign
ta = do
(SuperOwlParliament Seq SuperOwl
selection, Maybe TextAlign
_, Tool
tool) <- 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 (Selection, Maybe TextAlign, Tool)
inputDyn
let
fmapfn :: SuperOwl -> Maybe (Int, DSum CTag Identity)
fmapfn SuperOwl
sowl = case SEltLabel -> Maybe TextStyle
getSEltLabelBoxTextStyle (SuperOwl -> SEltLabel
superOwl_toSEltLabel_hack SuperOwl
sowl) of
Maybe TextStyle
Nothing -> forall a. Maybe a
Nothing
Just TextStyle
oldts -> if TextStyle
oldts forall a. Eq a => a -> a -> Bool
== TextAlign -> TextStyle
TextStyle TextAlign
ta
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (SuperOwl -> Int
_superOwl_id SuperOwl
sowl, CTag CTextStyle
CTagBoxTextStyle forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> forall a. a -> Identity a
Identity (DeltaTextStyle -> CTextStyle
CTextStyle ((TextStyle, TextStyle) -> DeltaTextStyle
DeltaTextStyle (TextStyle
oldts, TextAlign -> TextStyle
TextStyle TextAlign
ta))))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if ToolOverrideSelector
toolOverrideTextAlign Tool
tool
then forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def { _setPotatoDefaultParameters_box_text_textAlign :: Maybe TextAlign
_setPotatoDefaultParameters_box_text_textAlign = forall a. a -> Maybe a
Just TextAlign
ta }
else case forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe SuperOwl -> Maybe (Int, DSum CTag Identity)
fmapfn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Seq SuperOwl
selection of
[] -> forall a. Maybe a
Nothing
[(Int, DSum CTag Identity)]
x -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControllersWithId -> Llama
controllersWithId_to_llama forall a b. (a -> b) -> a -> b
$ forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int, DSum CTag Identity)]
x
alignmentParamsEv :: Event t (Either Llama SetPotatoDefaultParameters)
alignmentParamsEv = forall {k} (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push TextAlign
-> PushM t (Maybe (Either Llama SetPotatoDefaultParameters))
pushAlignmentFn Event t TextAlign
setAlignmentEv
return (Dynamic t Int
2, forall {k} (t :: k) a. Reflex t => Event t a
never, Event t (Either Llama SetPotatoDefaultParameters)
alignmentParamsEv)
holdSBoxTypeWidget :: forall t m. (MonadLayoutWidget t m) => ParamsWidgetFn t m SBoxType (Either Llama SetPotatoDefaultParameters)
holdSBoxTypeWidget :: forall t (m :: * -> *).
MonadLayoutWidget t m =>
ParamsWidgetFn
t m SBoxType (Either Llama SetPotatoDefaultParameters)
holdSBoxTypeWidget Dynamic t PotatoDefaultParameters
_ Dynamic t (Selection, Maybe SBoxType, Tool)
inputDyn = forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn forall a b. (a -> b) -> a -> b
$ do
let
mBoxType :: Dynamic t (Maybe SBoxType)
mBoxType = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> b
snd3 Dynamic t (Selection, Maybe SBoxType, Tool)
inputDyn
selectionDyn :: Dynamic t Selection
selectionDyn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> a
fst3 Dynamic t (Selection, Maybe SBoxType, Tool)
inputDyn
Maybe SBoxType
mbt0 <- 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 (Maybe SBoxType)
mBoxType
let
stateDyn :: Dynamic t (Bool, Bool)
stateDyn = forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t (Maybe SBoxType)
mBoxType forall a b. (a -> b) -> a -> b
$ \case
Maybe SBoxType
Nothing -> (Bool
False,Bool
False)
Just SBoxType
SBoxType_Box -> (Bool
True,Bool
False)
Just SBoxType
SBoxType_BoxText -> (Bool
True,Bool
True)
Just SBoxType
SBoxType_NoBox -> (Bool
False,Bool
False)
Just SBoxType
SBoxType_NoBoxText -> (Bool
False,Bool
True)
borderDyn :: Dynamic t Bool
borderDyn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Dynamic t (Bool, Bool)
stateDyn
textDyn :: Dynamic t Bool
textDyn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd Dynamic t (Bool, Bool)
stateDyn
(Event t Bool
b,Event t Bool
t) <- do
Event t Bool
b_d1 <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
8 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
HasTheme t m) =>
Behavior t Text -> m ()
text Behavior t Text
"border:"
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ 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
borderDyn
Event t Bool
t_d1 <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
8 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
HasTheme t m) =>
Behavior t Text -> m ()
text Behavior t Text
" text:"
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ 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
textDyn
return (Event t Bool
b_d1,Event t Bool
t_d1)
let
captureEv :: Event t ()
captureEv = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t Bool
b,Event t Bool
t]
pushSBoxTypeFn :: These Bool Bool -> PushM t (Maybe (Either Llama SetPotatoDefaultParameters))
pushSBoxTypeFn :: These Bool Bool
-> PushM t (Maybe (Either Llama SetPotatoDefaultParameters))
pushSBoxTypeFn These Bool Bool
bt = do
(SuperOwlParliament Seq SuperOwl
selection, Maybe SBoxType
_, Tool
tool) <- 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 (Selection, Maybe SBoxType, Tool)
inputDyn
(Bool, Bool)
curState <- 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 (Bool, Bool)
stateDyn
let
fmapfn :: SuperOwl -> Maybe (Int, DSum CTag Identity)
fmapfn SuperOwl
sowl = case SEltLabel -> Maybe SBoxType
getSEltLabelBoxType (SuperOwl -> SEltLabel
superOwl_toSEltLabel_hack SuperOwl
sowl) of
Maybe SBoxType
Nothing -> forall a. Maybe a
Nothing
Just SBoxType
oldbt -> if SBoxType
oldbt forall a. Eq a => a -> a -> Bool
== SBoxType
newbt
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (SuperOwl -> Int
_superOwl_id SuperOwl
sowl, CTag CBoxType
CTagBoxType forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> forall a. a -> Identity a
Identity ((SBoxType, SBoxType) -> CBoxType
CBoxType (SBoxType
oldbt, SBoxType
newbt)))
where
newbt :: SBoxType
newbt = case These Bool Bool
bt of
This Bool
border -> Bool -> Bool -> SBoxType
make_sBoxType Bool
border (SBoxType -> Bool
sBoxType_isText SBoxType
oldbt)
That Bool
text -> Bool -> Bool -> SBoxType
make_sBoxType (SBoxType -> Bool
sBoxType_hasBorder SBoxType
oldbt) Bool
text
These Bool
border Bool
text -> Bool -> Bool -> SBoxType
make_sBoxType Bool
border Bool
text
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if ToolOverrideSelector
toolOverrideSBoxType Tool
tool
then forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def { _setPotatoDefaultParameters_sBoxType :: Maybe SBoxType
_setPotatoDefaultParameters_sBoxType = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case These Bool Bool
bt of
This Bool
border -> Bool -> Bool -> SBoxType
make_sBoxType Bool
border (forall a b. (a, b) -> b
snd (Bool, Bool)
curState)
That Bool
text -> Bool -> Bool -> SBoxType
make_sBoxType (forall a b. (a, b) -> a
fst (Bool, Bool)
curState) Bool
text
These Bool
border Bool
text -> Bool -> Bool -> SBoxType
make_sBoxType Bool
border Bool
text
}
else case forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe SuperOwl -> Maybe (Int, DSum CTag Identity)
fmapfn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Seq SuperOwl
selection of
[] -> forall a. Maybe a
Nothing
[(Int, DSum CTag Identity)]
x -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControllersWithId -> Llama
controllersWithId_to_llama forall a b. (a -> b) -> a -> b
$ forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int, DSum CTag Identity)]
x
sBoxTypeParamsEv :: Event t (Either Llama SetPotatoDefaultParameters)
sBoxTypeParamsEv = forall {k} (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push These Bool Bool
-> PushM t (Maybe (Either Llama SetPotatoDefaultParameters))
pushSBoxTypeFn (forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Event t Bool
b Event t Bool
t)
return (Dynamic t Int
2, Event t ()
captureEv, Event t (Either Llama SetPotatoDefaultParameters)
sBoxTypeParamsEv)
holdCanvasSizeWidget :: forall t m. (MonadLayoutWidget t m, HasPotato t m) => Dynamic t SCanvas -> ParamsWidgetFn t m () XY
holdCanvasSizeWidget :: forall t (m :: * -> *).
(MonadLayoutWidget t m, HasPotato t m) =>
Dynamic t SCanvas -> ParamsWidgetFn t m () XY
holdCanvasSizeWidget Dynamic t SCanvas
canvasDyn Dynamic t PotatoDefaultParameters
_ Dynamic t (Selection, Maybe (), Tool)
_ = forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn forall a b. (a -> b) -> a -> b
$ do
let
cSizeDyn :: Dynamic t XY
cSizeDyn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LBox -> XY
_lBox_size forall b c a. (b -> c) -> (a -> b) -> a -> c
. SCanvas -> LBox
_sCanvas_box) Dynamic t SCanvas
canvasDyn
cWidthDyn :: Dynamic t Int
cWidthDyn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(V2 Int
x Int
_) -> Int
x) Dynamic t XY
cSizeDyn
cHeightDyn :: Dynamic t Int
cHeightDyn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(V2 Int
_ Int
y) -> Int
y) Dynamic t XY
cSizeDyn
(Dynamic t (Maybe FocusId)
focusDyn,Dynamic t Int
wDyn,Dynamic t Int
hDyn) <- do
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
HasTheme t m) =>
Behavior t Text -> m ()
text Behavior t Text
"canvas:"
Dynamic t Int
wDyn' <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
8 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
HasTheme t m) =>
Behavior t Text -> m ()
text Behavior t Text
" width:"
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Dynamic t Int -> m (Dynamic t Int)
dimensionInput Dynamic t Int
cWidthDyn
Dynamic t Int
hDyn' <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
8 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
HasTheme t m) =>
Behavior t Text -> m ()
text Behavior t Text
"height:"
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Dynamic t Int -> m (Dynamic t Int)
dimensionInput Dynamic t Int
cHeightDyn
Dynamic t (Maybe FocusId)
focusDyn' <- forall {k} (t :: k) (m :: * -> *).
HasFocus t m =>
m (Dynamic t (Maybe FocusId))
focusedId
return (Dynamic t (Maybe FocusId)
focusDyn',Dynamic t Int
wDyn',Dynamic t Int
hDyn')
Dynamic t (Maybe FocusId)
focusDynUnique <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn Dynamic t (Maybe FocusId)
focusDyn
let
outputEv :: Event t XY
outputEv = 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 (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Maybe FocusId)
focusDynUnique) forall a b. (a -> b) -> a -> b
$ \()
_ -> do
Int
cw <- 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
cWidthDyn
Int
ch <- 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
cHeightDyn
Int
w <- 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
wDyn
Int
h <- 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
hDyn
return $ if Int
cw forall a. Eq a => a -> a -> Bool
/= Int
w Bool -> Bool -> Bool
|| Int
ch forall a. Eq a => a -> a -> Bool
/= Int
h
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
V2 (Int
wforall a. Num a => a -> a -> a
-Int
cw) (Int
hforall a. Num a => a -> a -> a
-Int
ch)
else forall a. Maybe a
Nothing
Event t ()
captureEv1 <- forall t (m :: * -> *).
(Reflex t, MonadFix m, MonadNodeId m, HasInput t m) =>
UpdateTextZipperMethod -> m (Event t ())
makeCaptureFromUpdateTextZipperMethod UpdateTextZipperMethod
updateTextZipperForNumberInput
let
captureEv :: Event t ()
captureEv = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [forall (f :: * -> *) a. Functor f => f a -> f ()
void Event t XY
outputEv, Event t ()
captureEv1]
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamic t Int
3, Event t ()
captureEv, Event t XY
outputEv)
data SEltParams = SEltParams {
}
data ParamsWidgetConfig t = ParamsWidgetConfig {
forall t. ParamsWidgetConfig t -> Dynamic t Selection
_paramsWidgetConfig_selectionDyn :: Dynamic t Selection
, forall t. ParamsWidgetConfig t -> Dynamic t SCanvas
_paramsWidgetConfig_canvasDyn :: Dynamic t SCanvas
, forall t. ParamsWidgetConfig t -> Dynamic t PotatoDefaultParameters
_paramsWidgetConfig_defaultParamsDyn :: Dynamic t PotatoDefaultParameters
, forall t. ParamsWidgetConfig t -> Dynamic t Tool
_paramsWidgetConfig_toolDyn :: Dynamic t Tool
, forall t. ParamsWidgetConfig t -> Event t ()
_paramsWidgetConfig_loseFocusEv :: Event t ()
}
data ParamsWidget t = ParamsWidget {
forall t. ParamsWidget t -> Event t Llama
_paramsWidget_paramsEvent :: Event t Llama
, forall t. ParamsWidget t -> Event t XY
_paramsWidget_canvasSizeEvent :: Event t XY
, forall t. ParamsWidget t -> Event t SetPotatoDefaultParameters
_paramsWidget_setDefaultParamsEvent :: Event t SetPotatoDefaultParameters
, forall t. ParamsWidget t -> Event t ()
_paramsWidget_captureInputEv :: Event t ()
, forall t. ParamsWidget t -> Dynamic t Int
_paramsWidget_widgetHeight :: Dynamic t Int
}
joinHold :: (Reflex t, MonadHold t m) => Event t (Dynamic t a) -> Dynamic t a -> m (Dynamic t a)
joinHold :: forall t (m :: * -> *) a.
(Reflex t, MonadHold t m) =>
Event t (Dynamic t a) -> Dynamic t a -> m (Dynamic t a)
joinHold Event t (Dynamic t a)
ev Dynamic t a
d0 = do
Dynamic t (Dynamic t a)
dyndyn <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Dynamic t a
d0 Event t (Dynamic t a)
ev
return $ forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Dynamic t (Dynamic t a)
dyndyn
fth4 :: (a,b,c,d) -> d
fth4 :: forall a b c d. (a, b, c, d) -> d
fth4 (a
_,b
_,c
_,d
d) = d
d
fstsndthd4 :: (a,b,c,d) -> (a,b,c)
fstsndthd4 :: forall a b c d. (a, b, c, d) -> (a, b, c)
fstsndthd4 (a
a,b
b,c
c,d
_) = (a
a,b
b,c
c)
holdParamsWidget :: forall t m. (MonadWidget t m, HasPotato t m)
=> ParamsWidgetConfig t
-> m (ParamsWidget t)
holdParamsWidget :: forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
ParamsWidgetConfig t -> m (ParamsWidget t)
holdParamsWidget ParamsWidgetConfig {Dynamic t Tool
Dynamic t PotatoDefaultParameters
Dynamic t Selection
Dynamic t SCanvas
Event t ()
_paramsWidgetConfig_loseFocusEv :: Event t ()
_paramsWidgetConfig_toolDyn :: Dynamic t Tool
_paramsWidgetConfig_defaultParamsDyn :: Dynamic t PotatoDefaultParameters
_paramsWidgetConfig_canvasDyn :: Dynamic t SCanvas
_paramsWidgetConfig_selectionDyn :: Dynamic t Selection
_paramsWidgetConfig_loseFocusEv :: forall t. ParamsWidgetConfig t -> Event t ()
_paramsWidgetConfig_toolDyn :: forall t. ParamsWidgetConfig t -> Dynamic t Tool
_paramsWidgetConfig_defaultParamsDyn :: forall t. ParamsWidgetConfig t -> Dynamic t PotatoDefaultParameters
_paramsWidgetConfig_canvasDyn :: forall t. ParamsWidgetConfig t -> Dynamic t SCanvas
_paramsWidgetConfig_selectionDyn :: forall t. ParamsWidgetConfig t -> Dynamic t Selection
..} = mdo
let
selectionDyn :: Dynamic t Selection
selectionDyn = Dynamic t Selection
_paramsWidgetConfig_selectionDyn
canvasDyn :: Dynamic t SCanvas
canvasDyn = forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t SCanvas
_paramsWidgetConfig_canvasDyn Dynamic t ()
canvasSizeChangeEventDummyDyn forall a b. a -> b -> a
const
defaultParamsDyn :: Dynamic t PotatoDefaultParameters
defaultParamsDyn = Dynamic t PotatoDefaultParameters
_paramsWidgetConfig_defaultParamsDyn
toolDyn :: Dynamic t Tool
toolDyn = Dynamic t Tool
_paramsWidgetConfig_toolDyn
mTextAlignInputDyn :: Dynamic t (Maybe (Selection, Maybe TextAlign, Tool))
mTextAlignInputDyn = forall (f :: * -> *) a b c d.
Applicative f =>
f a -> f b -> f c -> (a -> b -> c -> d) -> f d
ffor3 Dynamic t Tool
toolDyn Dynamic t Selection
selectionDyn Dynamic t PotatoDefaultParameters
defaultParamsDyn forall a b. (a -> b) -> a -> b
$ forall a.
Eq a =>
ToolOverrideSelector
-> ParamsSelector a
-> DefaultParamsSelector a
-> Tool
-> Selection
-> PotatoDefaultParameters
-> Maybe (Selection, Maybe a, Tool)
makeParamsInputDyn
ToolOverrideSelector
toolOverrideTextAlign
((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TextStyle TextAlign
ta) -> TextAlign
ta)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEltLabel -> Maybe TextStyle
getSEltLabelBoxTextStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> SEltLabel
superOwl_toSEltLabel_hack)
PotatoDefaultParameters -> TextAlign
_potatoDefaultParameters_box_text_textAlign
mSuperStyleInputDyn :: Dynamic t (Maybe (Selection, Maybe SuperStyle, Tool))
mSuperStyleInputDyn = forall (f :: * -> *) a b c d.
Applicative f =>
f a -> f b -> f c -> (a -> b -> c -> d) -> f d
ffor3 Dynamic t Tool
toolDyn Dynamic t Selection
selectionDyn Dynamic t PotatoDefaultParameters
defaultParamsDyn forall a b. (a -> b) -> a -> b
$ forall a.
Eq a =>
ToolOverrideSelector
-> ParamsSelector a
-> DefaultParamsSelector a
-> Tool
-> Selection
-> PotatoDefaultParameters
-> Maybe (Selection, Maybe a, Tool)
makeParamsInputDyn
ToolOverrideSelector
toolOverrideSuperStyle
(SEltLabel -> Maybe SuperStyle
getSEltLabelSuperStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> SEltLabel
superOwl_toSEltLabel_hack)
PotatoDefaultParameters -> SuperStyle
_potatoDefaultParameters_superStyle
mLineStyleInputDyn :: Dynamic
t
(Maybe (Selection, Maybe (Maybe LineStyle, Maybe LineStyle), Tool))
mLineStyleInputDyn = forall (f :: * -> *) a b c d.
Applicative f =>
f a -> f b -> f c -> (a -> b -> c -> d) -> f d
ffor3 Dynamic t Tool
toolDyn Dynamic t Selection
selectionDyn Dynamic t PotatoDefaultParameters
defaultParamsDyn forall a b. (a -> b) -> a -> b
$ Tool
-> Selection
-> PotatoDefaultParameters
-> Maybe
(Selection, Maybe (Maybe LineStyle, Maybe LineStyle), Tool)
makeLineStyleInputDyn
mSBoxTypeInputDyn :: Dynamic t (Maybe (Selection, Maybe SBoxType, Tool))
mSBoxTypeInputDyn = forall (f :: * -> *) a b c d.
Applicative f =>
f a -> f b -> f c -> (a -> b -> c -> d) -> f d
ffor3 Dynamic t Tool
toolDyn Dynamic t Selection
selectionDyn Dynamic t PotatoDefaultParameters
defaultParamsDyn forall a b. (a -> b) -> a -> b
$ forall a.
Eq a =>
ToolOverrideSelector
-> ParamsSelector a
-> DefaultParamsSelector a
-> Tool
-> Selection
-> PotatoDefaultParameters
-> Maybe (Selection, Maybe a, Tool)
makeParamsInputDyn
ToolOverrideSelector
toolOverrideSBoxType
(SEltLabel -> Maybe SBoxType
getSEltLabelBoxType forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> SEltLabel
superOwl_toSEltLabel_hack)
PotatoDefaultParameters -> SBoxType
_potatoDefaultParameters_sBoxType
mCanvasSizeInputDyn :: Dynamic t (Maybe (Selection, Maybe (), Tool))
mCanvasSizeInputDyn = forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t Tool
toolDyn Dynamic t Selection
selectionDyn (\Tool
t Selection
s -> if forall a. IsParliament a => a -> Bool
isParliament_null Selection
s then forall a. a -> Maybe a
Just (forall a. IsParliament a => a
isParliament_empty, forall a. Maybe a
Nothing, Tool
t) else forall a. Maybe a
Nothing)
(Event t (Either Llama SetPotatoDefaultParameters)
paramsOutputEv, Event t ()
captureEv, Event t XY
canvasSizeOutputEv, Dynamic t Int
heightDyn) <- forall t (m :: * -> *) a.
(HasDisplayRegion t m, Reflex t, MonadHold t m, MonadFix m) =>
Layout t (Focus t m) a -> m a
initManager_ forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col forall a b. (a -> b) -> a -> b
$ do
forall t (m :: * -> *). (MonadWidget t m, HasFocus t m) => m ()
repeatNavigation
forall {k} (t :: k) (m :: * -> *).
HasFocus t m =>
Event t Refocus -> m ()
requestFocus forall a b. (a -> b) -> a -> b
$ (Refocus
Refocus_Clear forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t ()
_paramsWidgetConfig_loseFocusEv)
MaybeParamsWidgetOutputDyn
t (Layout t (Focus t m)) (Either Llama SetPotatoDefaultParameters)
textAlignmentWidget <- forall t (m :: * -> *) a b.
MonadWidget t m =>
Dynamic t PotatoDefaultParameters
-> Dynamic t (Maybe (Selection, Maybe a, Tool))
-> ParamsWidgetFn t m a b
-> m (MaybeParamsWidgetOutputDyn t m b)
holdMaybeParamsWidget Dynamic t PotatoDefaultParameters
defaultParamsDyn Dynamic t (Maybe (Selection, Maybe TextAlign, Tool))
mTextAlignInputDyn forall t (m :: * -> *).
(MonadLayoutWidget t m, HasPotato t m) =>
ParamsWidgetFn
t m TextAlign (Either Llama SetPotatoDefaultParameters)
holdTextAlignmentWidget
MaybeParamsWidgetOutputDyn
t (Layout t (Focus t m)) (Either Llama SetPotatoDefaultParameters)
superStyleWidget2 <- forall t (m :: * -> *) a b.
MonadWidget t m =>
Dynamic t PotatoDefaultParameters
-> Dynamic t (Maybe (Selection, Maybe a, Tool))
-> ParamsWidgetFn t m a b
-> m (MaybeParamsWidgetOutputDyn t m b)
holdMaybeParamsWidget Dynamic t PotatoDefaultParameters
defaultParamsDyn Dynamic t (Maybe (Selection, Maybe SuperStyle, Tool))
mSuperStyleInputDyn forall t (m :: * -> *).
(MonadLayoutWidget t m, HasPotato t m) =>
ParamsWidgetFn
t m SuperStyle (Either Llama SetPotatoDefaultParameters)
holdSuperStyleWidget
MaybeParamsWidgetOutputDyn
t (Layout t (Focus t m)) (Either Llama SetPotatoDefaultParameters)
lineStyleWidget <- forall t (m :: * -> *) a b.
MonadWidget t m =>
Dynamic t PotatoDefaultParameters
-> Dynamic t (Maybe (Selection, Maybe a, Tool))
-> ParamsWidgetFn t m a b
-> m (MaybeParamsWidgetOutputDyn t m b)
holdMaybeParamsWidget Dynamic t PotatoDefaultParameters
defaultParamsDyn Dynamic
t
(Maybe (Selection, Maybe (Maybe LineStyle, Maybe LineStyle), Tool))
mLineStyleInputDyn forall t (m :: * -> *).
(MonadLayoutWidget t m, HasPotato t m) =>
ParamsWidgetFn
t
m
(Maybe LineStyle, Maybe LineStyle)
(Either Llama SetPotatoDefaultParameters)
holdLineStyleWidgetNew
MaybeParamsWidgetOutputDyn
t (Layout t (Focus t m)) (Either Llama SetPotatoDefaultParameters)
sBoxTypeWidget <- forall t (m :: * -> *) a b.
MonadWidget t m =>
Dynamic t PotatoDefaultParameters
-> Dynamic t (Maybe (Selection, Maybe a, Tool))
-> ParamsWidgetFn t m a b
-> m (MaybeParamsWidgetOutputDyn t m b)
holdMaybeParamsWidget Dynamic t PotatoDefaultParameters
defaultParamsDyn Dynamic t (Maybe (Selection, Maybe SBoxType, Tool))
mSBoxTypeInputDyn forall t (m :: * -> *).
MonadLayoutWidget t m =>
ParamsWidgetFn
t m SBoxType (Either Llama SetPotatoDefaultParameters)
holdSBoxTypeWidget
MaybeParamsWidgetOutputDyn t (Layout t (Focus t m)) XY
canvasSizeWidget <- forall t (m :: * -> *) a b.
MonadWidget t m =>
Dynamic t PotatoDefaultParameters
-> Dynamic t (Maybe (Selection, Maybe a, Tool))
-> ParamsWidgetFn t m a b
-> m (MaybeParamsWidgetOutputDyn t m b)
holdMaybeParamsWidget Dynamic t PotatoDefaultParameters
defaultParamsDyn Dynamic t (Maybe (Selection, Maybe (), Tool))
mCanvasSizeInputDyn (forall t (m :: * -> *).
(MonadLayoutWidget t m, HasPotato t m) =>
Dynamic t SCanvas -> ParamsWidgetFn t m () XY
holdCanvasSizeWidget Dynamic t SCanvas
canvasDyn)
let
controllersWithIdParamsWidgets :: Dynamic
t
[Layout
t
(Focus t m)
(Dynamic t Int, Event t (),
Event t (Either Llama SetPotatoDefaultParameters))]
controllersWithIdParamsWidgets = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 (forall a. a -> [a] -> [a]
:[]))) forall a b. (a -> b) -> a -> b
$ [MaybeParamsWidgetOutputDyn
t (Layout t (Focus t m)) (Either Llama SetPotatoDefaultParameters)
textAlignmentWidget, MaybeParamsWidgetOutputDyn
t (Layout t (Focus t m)) (Either Llama SetPotatoDefaultParameters)
superStyleWidget2, MaybeParamsWidgetOutputDyn
t (Layout t (Focus t m)) (Either Llama SetPotatoDefaultParameters)
lineStyleWidget, MaybeParamsWidgetOutputDyn
t (Layout t (Focus t m)) (Either Llama SetPotatoDefaultParameters)
sBoxTypeWidget]
Event
t
(Event t (Either Llama SetPotatoDefaultParameters), Event t (),
Event t XY, Dynamic t Int)
paramsNetwork <- forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m (Event t a)
networkView forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic
t
[Layout
t
(Focus t m)
(Dynamic t Int, Event t (),
Event t (Either Llama SetPotatoDefaultParameters))]
controllersWithIdParamsWidgets MaybeParamsWidgetOutputDyn t (Layout t (Focus t m)) XY
canvasSizeWidget forall a b. (a -> b) -> a -> b
$ \[Layout
t
(Focus t m)
(Dynamic t Int, Event t (),
Event t (Either Llama SetPotatoDefaultParameters))]
widgets Maybe
(Layout t (Focus t m) (Dynamic t Int, Event t (), Event t XY))
mcsw -> forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col forall a b. (a -> b) -> a -> b
$ do
[(Dynamic t Int, Event t (Either Llama SetPotatoDefaultParameters),
Event t ())]
outputs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Layout
t
(Focus t m)
(Dynamic t Int, Event t (),
Event t (Either Llama SetPotatoDefaultParameters))]
widgets forall a b. (a -> b) -> a -> b
$ \Layout
t
(Focus t m)
(Dynamic t Int, Event t (),
Event t (Either Llama SetPotatoDefaultParameters))
w -> mdo
(Dynamic t Int
sz, Event t ()
captureEv', Event t (Either Llama SetPotatoDefaultParameters)
ev) <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
sz Layout
t
(Focus t m)
(Dynamic t Int, Event t (),
Event t (Either Llama SetPotatoDefaultParameters))
w
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamic t Int
sz, Event t (Either Llama SetPotatoDefaultParameters)
ev, Event t ()
captureEv')
(Dynamic t Int
cssz, Event t XY
cssev, Event t ()
captureEv2) <- case Maybe
(Layout t (Focus t m) (Dynamic t Int, Event t (), Event t XY))
mcsw of
Maybe
(Layout t (Focus t m) (Dynamic t Int, Event t (), Event t XY))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamic t Int
0, forall {k} (t :: k) a. Reflex t => Event t a
never, forall {k} (t :: k) a. Reflex t => Event t a
never)
Just Layout t (Focus t m) (Dynamic t Int, Event t (), Event t XY)
csw -> mdo
(Dynamic t Int
cssz', Event t ()
csCaptureEv', Event t XY
cssev') <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
cssz' Layout t (Focus t m) (Dynamic t Int, Event t (), Event t XY)
csw
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamic t Int
cssz', Event t XY
cssev', Event t ()
csCaptureEv')
let
heightDyn'' :: Dynamic t Int
heightDyn'' = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(+) Dynamic t Int
cssz forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(+)) Dynamic t Int
0 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> a
fst3 [(Dynamic t Int, Event t (Either Llama SetPotatoDefaultParameters),
Event t ())]
outputs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall t a. Reflex t => String -> [Event t a] -> Event t a
leftmostWarn String
"paramsLayout" (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> b
snd3 [(Dynamic t Int, Event t (Either Llama SetPotatoDefaultParameters),
Event t ())]
outputs), forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost (Event t ()
captureEv2 forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> c
thd3 [(Dynamic t Int, Event t (Either Llama SetPotatoDefaultParameters),
Event t ())]
outputs), Event t XY
cssev, Dynamic t Int
heightDyn'')
Dynamic t Int
heightDyn' <- forall t (m :: * -> *) a.
(Reflex t, MonadHold t m) =>
Event t (Dynamic t a) -> Dynamic t a -> m (Dynamic t a)
joinHold (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c d. (a, b, c, d) -> d
fth4 Event
t
(Event t (Either Llama SetPotatoDefaultParameters), Event t (),
Event t XY, Dynamic t Int)
paramsNetwork) Dynamic t Int
0
(Event t (Either Llama SetPotatoDefaultParameters)
paramsOutputEv', Event t ()
captureEv', Event t XY
canvasSizeOutputEv') <- forall t (m :: * -> *) a b c.
(Reflex t, MonadHold t m) =>
Event t a
-> Event t b
-> Event t c
-> Event t (Event t a, Event t b, Event t c)
-> m (Event t a, Event t b, Event t c)
switchHoldTriple forall {k} (t :: k) a. Reflex t => Event t a
never forall {k} (t :: k) a. Reflex t => Event t a
never forall {k} (t :: k) a. Reflex t => Event t a
never forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c d. (a, b, c, d) -> (a, b, c)
fstsndthd4 Event
t
(Event t (Either Llama SetPotatoDefaultParameters), Event t (),
Event t XY, Dynamic t Int)
paramsNetwork
return (Event t (Either Llama SetPotatoDefaultParameters)
paramsOutputEv', Event t ()
captureEv', Event t XY
canvasSizeOutputEv', Dynamic t Int
heightDyn')
let
maybeLeft :: Either a b -> Maybe a
maybeLeft (Left a
a) = forall a. a -> Maybe a
Just a
a
maybeLeft Either a b
_ = forall a. Maybe a
Nothing
maybeRight :: Either a a -> Maybe a
maybeRight (Right a
a) = forall a. a -> Maybe a
Just a
a
maybeRight Either a a
_ = forall a. Maybe a
Nothing
Dynamic t ()
canvasSizeChangeEventDummyDyn <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn () (forall (f :: * -> *) a. Functor f => f a -> f ()
void Event t XY
canvasSizeOutputEv)
forall (m :: * -> *) a. Monad m => a -> m a
return ParamsWidget {
_paramsWidget_paramsEvent :: Event t Llama
_paramsWidget_paramsEvent = (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe Either Llama SetPotatoDefaultParameters -> Maybe Llama
maybeLeft Event t (Either Llama SetPotatoDefaultParameters)
paramsOutputEv)
, _paramsWidget_canvasSizeEvent :: Event t XY
_paramsWidget_canvasSizeEvent = Event t XY
canvasSizeOutputEv
, _paramsWidget_setDefaultParamsEvent :: Event t SetPotatoDefaultParameters
_paramsWidget_setDefaultParamsEvent = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe Either Llama SetPotatoDefaultParameters
-> Maybe SetPotatoDefaultParameters
maybeRight Event t (Either Llama SetPotatoDefaultParameters)
paramsOutputEv
, _paramsWidget_captureInputEv :: Event t ()
_paramsWidget_captureInputEv = Event t ()
captureEv
, _paramsWidget_widgetHeight :: Dynamic t Int
_paramsWidget_widgetHeight = Dynamic t Int
heightDyn
}