{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo     #-}

module Potato.Flow.Vty.Params (
  ParamsWidgetConfig(..)
  , ParamsWidget(..)
  , holdParamsWidget

  -- exposed for testing
  , 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


-- Maybe Params stuff

-- | method type for picking out params from SuperSEltLabel
type ParamsSelector a = (Eq a) => SuperOwl -> Maybe a
-- | method type for picking out params when there is no selection
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 Bool -> Bool -> Bool
|| Tool
t forall a. Eq a => a -> a -> Bool
== Tool
Tool_CartLine)

toolOverrideLineStyle :: ToolOverrideSelector
toolOverrideLineStyle :: ToolOverrideSelector
toolOverrideLineStyle = (\Tool
t -> Tool
t forall a. Eq a => a -> a -> Bool
== Tool
Tool_Line Bool -> Bool -> Bool
|| Tool
t forall a. Eq a => a -> a -> Bool
== Tool
Tool_CartLine)

toolOverrideSBoxType :: ToolOverrideSelector
toolOverrideSBoxType :: ToolOverrideSelector
toolOverrideSBoxType = (forall a b. a -> b -> a
const Bool
False) -- NOTE default variant here does nothing as this is always overriden based on tool


-- | method to extract common parameters from a selection
-- returns Nothing if nothing in the selection has the selected param
-- returns Just (selection, Nothing) if selection that has the selected param do not share the same value
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
  -- TODO don't do list conversion in between whataver ugh
  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

-- similar to makeParamsInputDyn except specialized for LineStyle
-- LineStyle is special because it is split between start/end and we L.allSame on each end individually
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))

  -- NOTE the outer maybe in `Maybe (Maybe LineStyle, Maybe LineStyle)` is redundant
  -- should be joined into the inner `Maybe`s when used
  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))
-- if the `Maybe a` part is `Nothing` then the selection has different such properties
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)


-- |
-- returned Dynamic contains Nothing if selection was Nothing, otherwise contains Just the widget to modify parameters
-- remember that input dynamic must not be disconnected from output event or there will be an infinite loop!
-- maybe use delayEvent :: forall t m a. (Adjustable t m) => Event t a -> m) (Event t a) 😱
holdMaybeParamsWidget :: forall t m a b. (MonadWidget t m)
  => Dynamic t PotatoDefaultParameters
  -> Dynamic t (Maybe (Selection, Maybe a, Tool)) -- ^ selection/params input
  -> ParamsWidgetFn t m a b -- ^ function creating widget, note that it should always return non-nothing but using Maybe type makes life easier
  -> 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
  -- only remake the widget if it goes from Just to Nothing
  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
    -- eh this is weird, fromMaybe should always succeed, maybe using fromJust is ok due to laziness but I don't care to find out
    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 ()



-- SuperStyle stuff
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 {
        -- TODO Nothing is text cell was blank...
        _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_point      :: PChar
        , _superStyle_fill :: FillStyle
_superStyle_fill       = Char -> FillStyle
FillStyle_Simple Char
f'
      }

-- TODO move to SELts.hs
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
            -- TODO highlight if style matches selection
            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
        -- TODO the awesome version of this has a toggle box so that you can choose to do horiz/vertical together (once you support separate horiz/vert left/right/top/down styles)
        -- TODO also a toggle for setting corners to common sets
        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
          --(tile . fixed) 1 $ text (fmap (T.pack . superStyle_toListFormat . Data.Maybe.fromJust) $ current mssDyn)
          (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 -- TODO you can modify this too, why not, 2 boxes for the same thing
            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 -- TODO you can modify this too, why not, 2 boxes for the same thing
            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
          -- TODO maybe just do it when any of the cell dynamics are updated rather than when focus changes...
          -- TODO if we do it on focus change, you don't want to set when escape is pressed... so maybe it's better just to do 🖕
          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'
      }

-- TODO someday do backwards expanding text entry boxes for LSC_R and LSC_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))
  -- TODO need to use different text input type
  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


-- TODO move to SELts.hs
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)]

-- TODO lineystel widget should be like this
-- [x] start | [x] end    (the one being modified is highlighted)
-- custom | preset
-- ....
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:"
  -- TODO in the future, we'd like to be able to disable line ends more easily (without going into presets)
  -- i.e. [x] start | [x] end
  -- alternatively, consider combining with super sytyle
  (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
            -- TODO highlight if style matches selection
            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
          --(tile . fixed) 1 $ text (fmap (T.pack . superStyle_toListFormat . Data.Maybe.fromJust) $ current mssDyn)
          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
          -- track if there were changes made in the cell and reset each time we change cells
          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
$
              -- is there a better syntax to do this LOL?
              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)


-- Text Alignment stuff
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:"
  -- I'm actually not sure why using alignDyn here isn't causing an infinite loop
  -- I guess the whole widget is getting recreated when alignment changes... but when I sampled alignDyn instead, it didn't update correctly 🤷🏼‍♀️
  (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
      -- Not great, this will override everything in selection without having a "grayed out state" and do the override in a not so great way, but whatever
      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
        -- UNTESTED, it's probably currect but the tool overrides this default so I never actually tested it
        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)

  -- TODO
  return (Dynamic t Int
2, Event t ()
captureEv, Event t (Either Llama SetPotatoDefaultParameters)
sBoxTypeParamsEv)

-- manually pass in 'Dynamic t SCanvas' because it's not a property of th selection
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) -- it's a delta D:
        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
    -- causes causality loop idk why :(
    --captureEv = leftmost [void outputEv, void (updated wDyn), void (updated hDyn)]
    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 {
    --_sEltParams_sBox =
  }

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
  -- many params don't set anything until they lose focus. However if we lose focus because we clicked onto another pane, that focus event doesn't propogate down far enough so we have to pass it down manually
  , 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

    -- show canvas params when nothing is selected
    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)

  -- TODO consider doing initManager_ within the widgets if you don't want to tab from one widget to the next
  (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)

    -- apparently textAlignmentWidget gets updated after any change which causes the whole network to rerender and we lose our focus state...
    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')
      -- canvas size widget is special becaues it's output type is different
      (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
      -- NOTE multiple capture events will fire at once due to the way makeCaptureFromUpdateTextZipperMethod is scoped
      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
    -- TODO move to Data.Either.Extra
    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
  }