mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-09-11 12:05:35 +03:00
Add node prefix to key, enabled, visible and focusable
This commit is contained in:
parent
da1a9ba726
commit
b4d92f279f
@ -62,7 +62,7 @@ editableItem model idx = widget where
|
||||
widget = hgrid [
|
||||
label $ "Item " <> showt idx,
|
||||
textField (singular $ items . ix idx . itemDesc)
|
||||
] `key` widgetKey
|
||||
] `nodeKey` widgetKey
|
||||
|
||||
rotateSeq Empty = Empty
|
||||
rotateSeq (x :<| xs) = xs |> x
|
||||
|
24
app/Main.hs
24
app/Main.hs
@ -208,8 +208,8 @@ buildUI wenv model = traceShow "Creating UI" widgetTree where
|
||||
button "Increase" IncButton
|
||||
]
|
||||
widgetAnimate = vstack [
|
||||
animSlideIn_ [slideLeft] (label "Hello!!!!" `styleBasic` [bgColor red]) `key` "anim1",
|
||||
animSlideOut_ [slideLeft] (label "Good bye!!!!" `styleBasic` [bgColor green]) `key` "anim2",
|
||||
animSlideIn_ [slideLeft] (label "Hello!!!!" `styleBasic` [bgColor red]) `nodeKey` "anim1",
|
||||
animSlideOut_ [slideLeft] (label "Good bye!!!!" `styleBasic` [bgColor green]) `nodeKey` "anim2",
|
||||
hstack [
|
||||
labelS (model ^. clickCount),
|
||||
button "Increase" IncButton
|
||||
@ -281,7 +281,7 @@ buildUI wenv model = traceShow "Creating UI" widgetTree where
|
||||
radioV Apple (model ^. fruit) RadioSt,
|
||||
radioV Orange (model ^. fruit) RadioSt,
|
||||
radioV Pear (model ^. fruit) RadioSt
|
||||
] `key` "radio hstack",
|
||||
] `nodeKey` "radio hstack",
|
||||
textField textField1,
|
||||
hstack [
|
||||
checkbox condition1,
|
||||
@ -387,16 +387,16 @@ buildUI wenv model = traceShow "Creating UI" widgetTree where
|
||||
label ("Click count: " <> showt (model ^. clickCount)),
|
||||
button "Increase" IncButton
|
||||
],
|
||||
image "assets/images/beach.jpg" `visible` False `key` "Beach",
|
||||
image "assets/images/pecans.jpg" `key` "Pecans"
|
||||
image "assets/images/beach.jpg" `nodeVisible` False `nodeKey` "Beach",
|
||||
image "assets/images/pecans.jpg" `nodeKey` "Pecans"
|
||||
]
|
||||
widgetTree11 = vstack [
|
||||
hstack [
|
||||
label ("Click count: " <> showt (model ^. clickCount)),
|
||||
button "Increase" IncButton
|
||||
],
|
||||
image "assets/images/pecans.jpg" `visible` False `key` "Pecans",
|
||||
image "assets/images/beach.jpg" `key` "Beach"
|
||||
image "assets/images/pecans.jpg" `nodeVisible` False `nodeKey` "Pecans",
|
||||
image "assets/images/beach.jpg" `nodeKey` "Beach"
|
||||
]
|
||||
widgetTree5 = zstack_ [onlyTopActive False] [
|
||||
hgrid [
|
||||
@ -434,7 +434,7 @@ buildUI wenv model = traceShow "Creating UI" widgetTree where
|
||||
vstack [
|
||||
--textDropdown_ dropdown1 items id [onChange DropdownVal, onChangeIdx DropdownIdx],
|
||||
label "1" `styleBasic` [bgColor pink, border 1 pink]
|
||||
] `visible` False,
|
||||
] `nodeVisible` False,
|
||||
label "" `styleBasic` [bgColor orange],
|
||||
label "" `styleBasic` [bgColor gray],
|
||||
label "" `styleBasic` [bgColor blue],
|
||||
@ -480,15 +480,15 @@ buildUI wenv model = traceShow "Creating UI" widgetTree where
|
||||
longMessage word = "Are you sure?\n\n\n\n" <> T.replicate 100 (word <> " ")
|
||||
widgetTree = zstack [
|
||||
widgetTreeFull,
|
||||
alertMsg_ (longMessage "Alert") CloseAlert [titleCaption "Hey!"] `visible` model ^. showAlert,
|
||||
confirmMsg_ (longMessage "Confirm") AcceptConfirm CancelConfirm [titleCaption "Hey!"] `visible` model ^. showConfirm
|
||||
alertMsg_ (longMessage "Alert") CloseAlert [titleCaption "Hey!"] `nodeVisible` model ^. showAlert,
|
||||
confirmMsg_ (longMessage "Confirm") AcceptConfirm CancelConfirm [titleCaption "Hey!"] `nodeVisible` model ^. showConfirm
|
||||
]
|
||||
widgetTreeFull = vstack [
|
||||
hstack [
|
||||
radioV Apple (model ^. fruit) RadioSt,
|
||||
radioV Orange (model ^. fruit) RadioSt,
|
||||
radioV Pear (model ^. fruit) RadioSt
|
||||
] `key` "radio hstack",
|
||||
] `nodeKey` "radio hstack",
|
||||
hgrid [
|
||||
button "Show Alert" ShowAlert,
|
||||
mainButton "Show Confirm" ShowConfirm
|
||||
@ -523,5 +523,5 @@ buildUI wenv model = traceShow "Creating UI" widgetTree where
|
||||
],
|
||||
textDropdown_ dropdown1 items id [onChange DropdownVal, onChangeIdx DropdownIdx],
|
||||
button_ "Click\nme!" (PrintMessage "Button clicked") [] --multiline, ellipsis
|
||||
] `key` "main vstack" `styleBasic` [borderT 20 red, borderL 10 blue, borderR 10 green, borderB 10 gray, radius 50] --, padding 20
|
||||
] `nodeKey` "main vstack" `styleBasic` [borderT 20 red, borderL 10 blue, borderR 10 green, borderB 10 gray, radius 50] --, padding 20
|
||||
items = fmap (\i -> "This is a long label: " <> showt i) [1..100::Int]
|
||||
|
@ -100,10 +100,10 @@ For reference, the colors mentioned by name in the examples come from
|
||||
## Enabled and visible
|
||||
|
||||
Besides `styleBasic`, other two common attributes of a node you may be interested in
|
||||
controlling are `enabled` and `visible`, both boolean.
|
||||
controlling are `nodeEnabled` and `nodeVisible`, both boolean.
|
||||
|
||||
```haskell
|
||||
colorPicker fontColor `visible` (model ^. showPicker)
|
||||
colorPicker fontColor `nodeVisible` (model ^. showPicker)
|
||||
```
|
||||
|
||||
## Model updates
|
||||
|
@ -35,7 +35,7 @@ The only context where you need to be careful is if the position of your widgets
|
||||
change. Just to clarify: this only is a concern if there are widgets with state
|
||||
involved, although it's probably safer to just always handle it.
|
||||
|
||||
In the example, a `key` is associated to each row. It works similarly to `styleBasic`
|
||||
In the example, a `nodeKey` is associated to each row. It works similarly to `styleBasic`
|
||||
but receives a Text argument.
|
||||
|
||||
```haskell
|
||||
@ -44,7 +44,7 @@ listItem idx item = hstack [
|
||||
textField (items . singular (ix idx) . text),
|
||||
spacer,
|
||||
button "Delete" (RemoveItem idx)
|
||||
] `key` showt (item ^. ts) `styleBasic` [paddingT 5]
|
||||
] `nodeKey` showt (item ^. ts) `styleBasic` [paddingT 5]
|
||||
```
|
||||
|
||||
In the case of a `textField`, the internal state contains the current cursor
|
||||
@ -54,7 +54,7 @@ which you can move around with the arrow keys as usual. If you add a few more
|
||||
items and use tab to navigate to a different textField, you will notice that
|
||||
each textField keeps the cursor position it had before losing focus, even after
|
||||
their position in the list changed (of course, this is the expected behavior).
|
||||
Just for fun, try removing the `key` from that function: you will see that the
|
||||
Just for fun, try removing the `nodeKey` from that function: you will see that the
|
||||
textField did not _move_ to the correct position, as the incorrect cursor
|
||||
position indicates.
|
||||
|
||||
|
@ -44,8 +44,8 @@ from lowest to highest layer level.
|
||||
|
||||
```haskell
|
||||
pushLayers = zstack [
|
||||
image_ "./assets/images/red-button.png" [fitFill] `visible` not (model ^. hoverButton),
|
||||
image_ "./assets/images/red-button-hover.png" [fitFill] `visible` model ^. hoverButton,
|
||||
image_ "./assets/images/red-button.png" [fitFill] `nodeVisible` not (model ^. hoverButton),
|
||||
image_ "./assets/images/red-button-hover.png" [fitFill] `nodeVisible` model ^. hoverButton,
|
||||
label "Push!" `styleBasic` [textFont "Bold", textSize 20, textCenter]
|
||||
]
|
||||
```
|
||||
|
@ -86,7 +86,7 @@ how can you get the WidgetId of a widget node?
|
||||
|
||||
### Key, Path and WidgetId
|
||||
|
||||
The are three ways of identifying a widget. One, as we've seen, is the `key`.
|
||||
The are three ways of identifying a widget. One, as we've seen, is the `nodeKey`.
|
||||
This is a user defined identifier and it exists because its just easier to use.
|
||||
Besides key, there are two identifiers which are mostly internal, unless you are
|
||||
writing custom widgets or making WidgetRequests:
|
||||
|
@ -94,7 +94,7 @@ buildUI wenv model = widgetTree where
|
||||
hstack [
|
||||
label "Query:",
|
||||
spacer,
|
||||
textField query `key` "query",
|
||||
textField query `nodeKey` "query",
|
||||
spacer,
|
||||
mainButton "Search" BooksSearch
|
||||
] `styleBasic` [bgColor sectionBgColor, padding 25]
|
||||
@ -110,10 +110,10 @@ buildUI wenv model = widgetTree where
|
||||
searchForm,
|
||||
countLabel,
|
||||
box_ [mergeRequired booksChanged] $
|
||||
vscroll (vstack (bookRow wenv <$> model ^. books)) `key` "mainScroll"
|
||||
vscroll (vstack (bookRow wenv <$> model ^. books)) `nodeKey` "mainScroll"
|
||||
],
|
||||
bookOverlay `visible` isJust (model ^. selected),
|
||||
searchOverlay `visible` model ^. searching
|
||||
bookOverlay `nodeVisible` isJust (model ^. selected),
|
||||
searchOverlay `nodeVisible` model ^. searching
|
||||
]
|
||||
|
||||
handleEvent
|
||||
|
@ -59,7 +59,7 @@ buildUI wenv model = widgetTree where
|
||||
hstack [
|
||||
label "Type:",
|
||||
spacer,
|
||||
textDropdown_ activeGen genTypes genTypeDesc [] `key` "activeType",
|
||||
textDropdown_ activeGen genTypes genTypeDesc [] `nodeKey` "activeType",
|
||||
spacer,
|
||||
labeledCheckbox "Show config:" showCfg
|
||||
] `styleBasic` [padding 20, bgColor sectionBg],
|
||||
@ -67,15 +67,15 @@ buildUI wenv model = widgetTree where
|
||||
hstack [
|
||||
circlesGrid (model ^. circlesCfg) `styleBasic` [padding 20],
|
||||
widgetCircleCfg
|
||||
`visible` model ^. showCfg
|
||||
`nodeVisible` model ^. showCfg
|
||||
`styleBasic` [padding 20, width 200, bgColor sectionBg]
|
||||
] `visible` (model ^. activeGen == CirclesGrid),
|
||||
] `nodeVisible` (model ^. activeGen == CirclesGrid),
|
||||
hstack [
|
||||
boxesPalette (model ^. boxesCfg) `styleBasic` [padding 20],
|
||||
widgetBoxCfg
|
||||
`visible` model ^. showCfg
|
||||
`nodeVisible` model ^. showCfg
|
||||
`styleBasic` [padding 20, width 200, bgColor sectionBg]
|
||||
] `visible` (model ^. activeGen == BoxesPalette)
|
||||
] `nodeVisible` (model ^. activeGen == BoxesPalette)
|
||||
]
|
||||
]
|
||||
|
||||
|
@ -88,7 +88,7 @@ buildUI wenv model = widgetTree where
|
||||
tickerFade idx t = animRow where
|
||||
action = TickerRemovePair (t ^. symbolPair)
|
||||
item = tickerRow wenv idx t
|
||||
animRow = animFadeOut_ [onFinished action] item `key` (t ^. symbolPair)
|
||||
animRow = animFadeOut_ [onFinished action] item `nodeKey` (t ^. symbolPair)
|
||||
|
||||
tickerRows = zipWith tickerFade [0..] (catMaybes orderedTickers)
|
||||
|
||||
@ -96,7 +96,7 @@ buildUI wenv model = widgetTree where
|
||||
hstack [
|
||||
label "New pair:",
|
||||
spacer,
|
||||
keystroke [("Enter", TickerAddClick)] $ textField newPair `key` "newPair",
|
||||
keystroke [("Enter", TickerAddClick)] $ textField newPair `nodeKey` "newPair",
|
||||
spacer,
|
||||
button "Add" TickerAddClick
|
||||
] `styleBasic` [padding 20, bgColor sectionBg],
|
||||
|
@ -24,7 +24,7 @@ todoRowKey :: Todo -> Text
|
||||
todoRowKey todo = "todoRow" <> showt (todo ^. todoId)
|
||||
|
||||
todoRow :: TodoWenv -> TodoModel -> Int -> Todo -> TodoNode
|
||||
todoRow wenv model idx t = animRow `key` todoKey where
|
||||
todoRow wenv model idx t = animRow `nodeKey` todoKey where
|
||||
sectionBg = wenv ^. L.theme . L.sectionColor
|
||||
rowButtonColor = wenv ^. L.theme . L.userColorMap . at "rowButton" . non def
|
||||
rowSepColor = gray & L.a .~ 0.5
|
||||
@ -74,14 +74,14 @@ todoEdit wenv model = editNode where
|
||||
hstack [
|
||||
label "Task:",
|
||||
spacer,
|
||||
textField (activeTodo . description) `key` "todoDesc"
|
||||
textField (activeTodo . description) `nodeKey` "todoDesc"
|
||||
],
|
||||
spacer,
|
||||
hgrid [
|
||||
hstack [
|
||||
label "Type:",
|
||||
spacer,
|
||||
textDropdownS (activeTodo . todoType) todoTypes `key` "todoType",
|
||||
textDropdownS (activeTodo . todoType) todoTypes `nodeKey` "todoType",
|
||||
spacer -- Added here to avoid grid expanding it to 1/3 total width
|
||||
],
|
||||
hstack [
|
||||
@ -93,7 +93,7 @@ todoEdit wenv model = editNode where
|
||||
spacer,
|
||||
hstack [
|
||||
filler,
|
||||
saveTodoBtn `enabled` (model ^. activeTodo . description /= ""),
|
||||
saveTodoBtn `nodeEnabled` (model ^. activeTodo . description /= ""),
|
||||
spacer,
|
||||
button "Cancel" TodoCancel
|
||||
]
|
||||
@ -110,8 +110,8 @@ buildUI wenv model = widgetTree where
|
||||
|
||||
todoList = vstack (zipWith (todoRow wenv model) [0..] (model ^. todos))
|
||||
|
||||
newButton = mainButton "New" TodoNew `key` "todoNew"
|
||||
`visible` not isEditing
|
||||
newButton = mainButton "New" TodoNew `nodeKey` "todoNew"
|
||||
`nodeVisible` not isEditing
|
||||
|
||||
editLayer = content where
|
||||
saveAction = case model ^. action of
|
||||
@ -120,9 +120,9 @@ buildUI wenv model = widgetTree where
|
||||
|
||||
dualSlide content = outer where
|
||||
inner = animSlideIn_ [slideTop, duration 200] content
|
||||
`key` "animEditIn"
|
||||
`nodeKey` "animEditIn"
|
||||
outer = animSlideOut_ [slideTop, duration 200, onFinished TodoHideEditDone] inner
|
||||
`key` "animEditOut"
|
||||
`nodeKey` "animEditOut"
|
||||
|
||||
content = vstack [
|
||||
dualSlide $
|
||||
@ -141,7 +141,7 @@ buildUI wenv model = widgetTree where
|
||||
|
||||
widgetTree = zstack [
|
||||
mainLayer,
|
||||
editLayer `visible` isEditing
|
||||
editLayer `nodeVisible` isEditing
|
||||
]
|
||||
|
||||
handleEvent
|
||||
|
@ -61,7 +61,7 @@ buildUI wenv model = widgetTree where
|
||||
filler
|
||||
] `styleBasic` [paddingT 10, paddingB 5],
|
||||
colorPicker fontColor
|
||||
`visible` (model ^. showPicker)
|
||||
`nodeVisible` (model ^. showPicker)
|
||||
`styleBasic` [paddingB 10],
|
||||
|
||||
sampleTextLabel
|
||||
|
@ -43,17 +43,17 @@ buildUI wenv model = widgetTree where
|
||||
spacer,
|
||||
button "Delete" (RemoveItem idx)
|
||||
]
|
||||
] `key` showt (item ^. ts) `styleBasic` [paddingT 10]
|
||||
] `nodeKey` showt (item ^. ts) `styleBasic` [paddingT 10]
|
||||
|
||||
widgetTree = vstack [
|
||||
keystroke [("Enter", AddItem)] $ hstack [
|
||||
label "Description:",
|
||||
spacer,
|
||||
textField_ newItemText [placeholder "Write here!"] `key` "description",
|
||||
textField_ newItemText [placeholder "Write here!"] `nodeKey` "description",
|
||||
spacer,
|
||||
button "Add" AddItem
|
||||
`styleBasic` [paddingH 5]
|
||||
`enabled` (model ^. newItemText /= "")
|
||||
`nodeEnabled` (model ^. newItemText /= "")
|
||||
],
|
||||
|
||||
separatorLine `styleBasic` [paddingT 20, paddingB 10],
|
||||
|
@ -30,8 +30,8 @@ buildUI
|
||||
-> WidgetNode AppModel AppEvent
|
||||
buildUI wenv model = widgetTree where
|
||||
pushLayers = zstack [
|
||||
image_ "./assets/images/red-button.png" [fitFill] `visible` not (model ^. hoverButton),
|
||||
image_ "./assets/images/red-button-hover.png" [fitFill] `visible` model ^. hoverButton,
|
||||
image_ "./assets/images/red-button.png" [fitFill] `nodeVisible` not (model ^. hoverButton),
|
||||
image_ "./assets/images/red-button-hover.png" [fitFill] `nodeVisible` model ^. hoverButton,
|
||||
label "Push!" `styleBasic` [textFont "Bold", textSize 20, textCenter]
|
||||
]
|
||||
pushButton = box_ [onClick AppGenRandom, onEnter AppOnEnterBtn, onLeave AppOnLeaveBtn] pushLayers
|
||||
@ -39,7 +39,7 @@ buildUI wenv model = widgetTree where
|
||||
numberLabel = labelS (model ^. selected)
|
||||
`styleBasic` [textFont "Bold", textSize 100, textColor black, textCenter, width 160]
|
||||
numberedImage url idx = scroll (image_ url [fitNone])
|
||||
`visible` (model ^. selected == idx)
|
||||
`nodeVisible` (model ^. selected == idx)
|
||||
imageSet = hstack [
|
||||
numberedImage "https://picsum.photos/id/1020/800/600" 1,
|
||||
numberedImage "https://picsum.photos/id/1047/800/600" 2,
|
||||
|
@ -34,7 +34,7 @@ buildUI wenv model = widgetTree where
|
||||
`styleBasic` [textFont "Bold", textSize 80, textCenter, textMiddle, flexHeight 100]
|
||||
|
||||
widgetTree = vstack [
|
||||
animFadeIn timeLabel `key` "fadeTimeLabel"
|
||||
animFadeIn timeLabel `nodeKey` "fadeTimeLabel"
|
||||
]
|
||||
|
||||
handleEvent
|
||||
|
@ -119,7 +119,7 @@ buildUI wenv model = widgetTree where
|
||||
widgetTree = zstack [
|
||||
baseLayer,
|
||||
box_ [alignCenter, alignMiddle] dialogLayer
|
||||
`visible` model ^. showDialog
|
||||
`nodeVisible` model ^. showDialog
|
||||
`styleBasic` [bgColor (gray & L.a .~ 0.8)]
|
||||
]
|
||||
|
||||
|
@ -139,8 +139,8 @@ buildUI wenv model = widgetTree where
|
||||
widgetTree = vstack [
|
||||
button "Reset canvas" AppResetCanvas,
|
||||
spacer,
|
||||
canvas `key` "mainCanvas" `styleBasic` [border 1 gray]
|
||||
-- canvas_ [canvasColor pink] `key` "mainCanvas" `styleBasic` [border 1 gray]
|
||||
canvas `nodeKey` "mainCanvas" `styleBasic` [border 1 gray]
|
||||
-- canvas_ [canvasColor pink] `nodeKey` "mainCanvas" `styleBasic` [border 1 gray]
|
||||
] `styleBasic` [padding 10]
|
||||
|
||||
handleEvent
|
||||
|
@ -513,9 +513,6 @@ class CmbMaxDim t where
|
||||
maxDim :: Double -> t
|
||||
|
||||
-- Style
|
||||
infixl 5 `key`
|
||||
infixl 5 `enabled`
|
||||
infixl 5 `visible`
|
||||
infixl 5 `styleBasic`
|
||||
infixl 5 `styleHover`
|
||||
infixl 5 `styleFocus`
|
||||
@ -523,22 +520,6 @@ infixl 5 `styleFocusHover`
|
||||
infixl 5 `styleActive`
|
||||
infixl 5 `styleDisabled`
|
||||
|
||||
-- | Key combinator, used mainly infix for widgets.
|
||||
class CmbKey t a | t -> a where
|
||||
key :: t -> a -> t
|
||||
|
||||
-- | Enabled combinator, used mainly infix for widgets.
|
||||
class CmbEnabled t where
|
||||
enabled :: t -> Bool -> t
|
||||
|
||||
-- | Visible combinator, used mainly infix for widgets.
|
||||
class CmbVisible t where
|
||||
visible :: t -> Bool -> t
|
||||
|
||||
-- | Focusable combinator, used mainly infix for widgets.
|
||||
class CmbStyleFocusable t where
|
||||
focusable :: t -> Bool -> t
|
||||
|
||||
-- | Basic style combinator, used mainly infix for widgets as a list.
|
||||
class CmbStyleBasic t where
|
||||
styleBasic :: t -> [StyleState] -> t
|
||||
|
@ -12,6 +12,11 @@ Helper functions for style types.
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
|
||||
module Monomer.Core.StyleUtil (
|
||||
getContentArea,
|
||||
nodeKey,
|
||||
nodeEnabled,
|
||||
nodeVisible,
|
||||
nodeFocusable,
|
||||
styleFont,
|
||||
styleFontSize,
|
||||
styleFontSpaceH,
|
||||
@ -23,7 +28,6 @@ module Monomer.Core.StyleUtil (
|
||||
styleFgColor,
|
||||
styleSndColor,
|
||||
styleHlColor,
|
||||
getContentArea,
|
||||
getOuterSize,
|
||||
addOuterSize,
|
||||
addOuterBounds,
|
||||
@ -50,11 +54,6 @@ import Monomer.Helper
|
||||
|
||||
import qualified Monomer.Core.Lens as L
|
||||
|
||||
-- | Returns the content area (i.e., ignoring border and padding) of the node.
|
||||
getContentArea :: WidgetNode s e -> StyleState -> Rect
|
||||
getContentArea node style = fromMaybe def area where
|
||||
area = removeOuterBounds style (node ^. L.info . L.viewport)
|
||||
|
||||
instance CmbStyleBasic Style where
|
||||
styleBasic oldStyle states = newStyle where
|
||||
newStyle = oldStyle & L.basic .~ maybeConcat states
|
||||
@ -79,18 +78,6 @@ instance CmbStyleDisabled Style where
|
||||
styleDisabled oldStyle states = newStyle where
|
||||
newStyle = oldStyle & L.disabled .~ maybeConcat states
|
||||
|
||||
instance CmbKey (WidgetNode s e) Text where
|
||||
key node key = node & L.info . L.key ?~ WidgetKey key
|
||||
|
||||
instance CmbEnabled (WidgetNode s e) where
|
||||
enabled node state = node & L.info . L.enabled .~ state
|
||||
|
||||
instance CmbVisible (WidgetNode s e) where
|
||||
visible node visibility = node & L.info . L.visible .~ visibility
|
||||
|
||||
instance CmbStyleFocusable (WidgetNode s e) where
|
||||
focusable node isFocusable = node & L.info . L.focusable .~ isFocusable
|
||||
|
||||
instance CmbStyleBasic (WidgetNode s e) where
|
||||
styleBasic node states = node & L.info . L.style .~ newStyle where
|
||||
state = mconcat states
|
||||
@ -127,6 +114,32 @@ instance CmbStyleDisabled (WidgetNode s e) where
|
||||
oldStyle = node ^. L.info . L.style
|
||||
newStyle = oldStyle & L.disabled ?~ state
|
||||
|
||||
infixl 5 `nodeKey`
|
||||
infixl 5 `nodeEnabled`
|
||||
infixl 5 `nodeVisible`
|
||||
infixl 5 `nodeFocusable`
|
||||
|
||||
-- | Sets the key of the given node.
|
||||
nodeKey :: WidgetNode s e -> Text -> WidgetNode s e
|
||||
nodeKey node key = node & L.info . L.key ?~ WidgetKey key
|
||||
|
||||
-- | Sets whether the given node is enabled.
|
||||
nodeEnabled :: WidgetNode s e -> Bool -> WidgetNode s e
|
||||
nodeEnabled node state = node & L.info . L.enabled .~ state
|
||||
|
||||
-- | Sets whether the given node is visible.
|
||||
nodeVisible :: WidgetNode s e -> Bool -> WidgetNode s e
|
||||
nodeVisible node visibility = node & L.info . L.visible .~ visibility
|
||||
|
||||
-- | Sets whether the given node is focusable.
|
||||
nodeFocusable :: WidgetNode s e -> Bool -> WidgetNode s e
|
||||
nodeFocusable node isFocusable = node & L.info . L.focusable .~ isFocusable
|
||||
|
||||
-- | Returns the content area (i.e., ignoring border and padding) of the node.
|
||||
getContentArea :: WidgetNode s e -> StyleState -> Rect
|
||||
getContentArea node style = fromMaybe def area where
|
||||
area = removeOuterBounds style (node ^. L.info . L.viewport)
|
||||
|
||||
-- | Returns the font of the given style state, or the default.
|
||||
styleFont :: StyleState -> Font
|
||||
styleFont style = fromMaybe def font where
|
||||
|
@ -164,7 +164,7 @@ buildUI dialogBody pAcceptEvt pCancelEvt config wenv model = mainTree where
|
||||
cancel = fromMaybe "Cancel" (_cfcCancel config)
|
||||
emptyOverlay = collectTheme wenv L.emptyOverlayStyle
|
||||
|
||||
acceptBtn = mainButton accept acceptEvt `key` "acceptBtn"
|
||||
acceptBtn = mainButton accept acceptEvt `nodeKey` "acceptBtn"
|
||||
cancelBtn = button cancel cancelEvt
|
||||
buttons = hstack [ acceptBtn, spacer, cancelBtn ]
|
||||
|
||||
|
@ -210,8 +210,8 @@ buildUI config wenv model = mainTree where
|
||||
colorRow L.g "Green",
|
||||
spacer_ [width 2],
|
||||
colorRow L.b "Blue",
|
||||
spacer_ [width 2] `visible` showAlpha,
|
||||
alphaRow L.a "Alpha" `visible` showAlpha
|
||||
spacer_ [width 2] `nodeVisible` showAlpha,
|
||||
alphaRow L.a "Alpha" `nodeVisible` showAlpha
|
||||
],
|
||||
spacer_ [width 2],
|
||||
box_ [alignTop] colorSample `styleBasic` [flexHeight 50]
|
||||
|
@ -209,7 +209,7 @@ handleEventResize = describe "handleEventResize" $ do
|
||||
_ -> [Model (model & clicks %~ (+1))]
|
||||
buildChild wenv model = vstack [
|
||||
button "Click" ChildBtnClicked,
|
||||
label "Test" `styleBasic` [height 3000] `visible` (model ^. clicks > 0)
|
||||
label "Test" `styleBasic` [height 3000] `nodeVisible` (model ^. clicks > 0)
|
||||
]
|
||||
handleEvent
|
||||
:: WidgetEnv MainModel MainEvt
|
||||
@ -258,18 +258,18 @@ handleEventLocalKeySingleState = describe "handleEventLocalKeySingleState" $
|
||||
buildUI1 wenv model = hstack [
|
||||
vstack [
|
||||
textField text1
|
||||
] `key` "localTxt1",
|
||||
] `nodeKey` "localTxt1",
|
||||
vstack [
|
||||
textField text1
|
||||
] `key` "localTxt2"
|
||||
] `nodeKey` "localTxt2"
|
||||
]
|
||||
buildUI2 wenv model = hstack [
|
||||
vstack [
|
||||
textField text1
|
||||
] `key` "localTxt2",
|
||||
] `nodeKey` "localTxt2",
|
||||
vstack [
|
||||
textField text1
|
||||
] `key` "localTxt1"
|
||||
] `nodeKey` "localTxt1"
|
||||
]
|
||||
cmpNode1 = composite "main" id buildUI1 handleEvent
|
||||
cmpNode2 = composite_ "main" id buildUI2 handleEvent [mergeRequired (\_ _ -> True)]
|
||||
@ -300,7 +300,7 @@ handleEventLocalKeyRemoveItem = describe "handleEventLocalKeyRemoveItem" $
|
||||
MainBtnClicked -> [Model $ model & items .~ [0, 2, 3]]
|
||||
_ -> []
|
||||
buildUI wenv model = vstack (button "Button" MainBtnClicked : (keyedLabel <$> model ^. items))
|
||||
keyedLabel idx = label "Test" `key` ("key" <> showt idx)
|
||||
keyedLabel idx = label "Test" `nodeKey` ("key" <> showt idx)
|
||||
node = composite "main" id buildUI handleEvent
|
||||
evts = [evtClick (Point 100 10)]
|
||||
oldNode = nodeInit wenv node
|
||||
|
@ -133,12 +133,12 @@ handleEventLocalKey = describe "handleEventLocalKey" $
|
||||
where
|
||||
wenv = mockWenvEvtUnit (TestModel "" "")
|
||||
cntNode1 = vstack [
|
||||
textField text1 `key` "txt1",
|
||||
textField text2 `key` "txt2"
|
||||
textField text1 `nodeKey` "txt1",
|
||||
textField text2 `nodeKey` "txt2"
|
||||
]
|
||||
cntNode2 = vstack [
|
||||
textField text2 `key` "txt2",
|
||||
textField text1 `key` "txt1"
|
||||
textField text2 `nodeKey` "txt2",
|
||||
textField text1 `nodeKey` "txt1"
|
||||
]
|
||||
evts1 = [evtT "aacc", moveCharL, moveCharL]
|
||||
model1 = nodeHandleEventModel wenv evts1 cntNode1
|
||||
|
@ -65,8 +65,8 @@ mergeReq = describe "mergeReq" $ do
|
||||
|
||||
where
|
||||
wenv = mockWenv ()
|
||||
btnNew = button "Click" (BtnClick 0) `key` "btnNew"
|
||||
btnOld = button "Click" (BtnClick 0) `key` "btnOld"
|
||||
btnNew = button "Click" (BtnClick 0) `nodeKey` "btnNew"
|
||||
btnOld = button "Click" (BtnClick 0) `nodeKey` "btnOld"
|
||||
box1 = box btnNew
|
||||
box2 = box_ [mergeRequired (\_ _ -> True)] btnNew
|
||||
box3 = box_ [mergeRequired (\_ _ -> False)] btnNew
|
||||
@ -110,7 +110,7 @@ handleEvent = describe "handleEvent" $ do
|
||||
onLeave BoxOnLeave,
|
||||
onBtnPressed BoxOnPressed,
|
||||
onBtnReleased BoxOnReleased] (label "Test")
|
||||
boxNode = nodeInit wenv (btnBox `focusable` True)
|
||||
boxNode = nodeInit wenv (btnBox `nodeFocusable` True)
|
||||
evts es = nodeHandleEventEvts wenv es boxNode
|
||||
|
||||
handleEventIgnoreEmpty :: Spec
|
||||
|
@ -84,7 +84,7 @@ getSizeReqItemsV = describe "several items, vertical, one not visible" $ do
|
||||
gridNode = vgrid [
|
||||
label "Hello",
|
||||
label "how",
|
||||
label "" `visible` False,
|
||||
label "" `nodeVisible` False,
|
||||
label "are you?"
|
||||
]
|
||||
(sizeReqW, sizeReqH) = nodeGetSizeReq wenv gridNode
|
||||
@ -200,7 +200,7 @@ resizeItemsV = describe "several items, vertical, one not visible" $ do
|
||||
gridNode = vgrid [
|
||||
label "Label 1",
|
||||
label "Label Number Two",
|
||||
label "Label invisible" `visible` False,
|
||||
label "Label invisible" `nodeVisible` False,
|
||||
label "Label 3"
|
||||
]
|
||||
newNode = nodeInit wenv gridNode
|
||||
|
@ -137,7 +137,7 @@ handleMessageReset = describe "handleMessageReset" $ do
|
||||
button "Button 1" Button1 `styleBasic` [height 480],
|
||||
button "Button 2" Button2 `styleBasic` [height 480],
|
||||
button "Button 3" Button3 `styleBasic` [height 480]
|
||||
]) `key` "mainScroll"
|
||||
]) `nodeKey` "mainScroll"
|
||||
cmpNode = composite "main" id buildUI handleEvent
|
||||
events es = nodeHandleEventEvts wenv es cmpNode
|
||||
|
||||
|
@ -76,7 +76,7 @@ handleEventFirstVisible = describe "handleEventFirstVisible" $ do
|
||||
zstackNode = zstack [
|
||||
button "Click 1" (BtnClick 1),
|
||||
button "Click 2" (BtnClick 2),
|
||||
button "Click 3" (BtnClick 3) `visible` False
|
||||
button "Click 3" (BtnClick 3) `nodeVisible` False
|
||||
]
|
||||
clickEvts p = nodeHandleEventEvts wenv [evtClick p] zstackNode
|
||||
|
||||
@ -95,7 +95,7 @@ handleEventAllLayersActive = describe "handleEventAllLayersActive" $ do
|
||||
vstack [
|
||||
button "Click 2" (BtnClick 2) `styleBasic` [height 10]
|
||||
],
|
||||
button "Click 3" (BtnClick 3) `visible` False
|
||||
button "Click 3" (BtnClick 3) `nodeVisible` False
|
||||
]
|
||||
clickEvts p = nodeHandleEventEvts wenv [evtClick p] zstackNode
|
||||
|
||||
@ -152,7 +152,7 @@ handleEventFocusChange = describe "handleEventFocusChange" $
|
||||
hstack [
|
||||
button "1" (BtnClick 1),
|
||||
button "2" (BtnClick 2)
|
||||
] `visible` (model > 2)
|
||||
] `nodeVisible` (model > 2)
|
||||
]
|
||||
cmpNode = composite "main" id buildUI handleEvent
|
||||
evts es = nodeHandleEventEvts wenv es cmpNode
|
||||
@ -175,11 +175,11 @@ handleEventFocusKeep = describe "handleEventFocusKeep" $
|
||||
buildUI wenv model = zstack [
|
||||
hstack [
|
||||
confirmMsg "Message" (BtnClick 3) (BtnClick 4)
|
||||
] `visible` (model <= 2),
|
||||
] `nodeVisible` (model <= 2),
|
||||
hstack [
|
||||
button "1" (BtnClick 1),
|
||||
button "2" (BtnClick 2)
|
||||
] `visible` (model > 2)
|
||||
] `nodeVisible` (model > 2)
|
||||
]
|
||||
cmpNode = composite "main" id buildUI handleEvent
|
||||
evts es = nodeHandleEventEvts wenv es cmpNode
|
||||
|
Loading…
Reference in New Issue
Block a user