fjvallarino/monomer
1
1
Fork 0
mirror of https://github.com/fjvallarino/monomer.git synced 2024-09-21 00:38:01 +03:00
Code Issues Projects Releases Wiki Activity

Only change cursor if event is received by target. Improve styling on checkbox, radio and listView

Browse Source
This commit is contained in:
Francisco Vallarino 2020-10-30 15:54:01 -03:00
parent 726cba547d
commit 748c4f8e48
4 changed files with 30 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
app/Main.hs
View File

@ -82,13 +82,18 @@ buildUI model = trace "Creating UI" widgetTree9 where
--widgetTree8 = box (image_ "assets/images/pecans.jpg" [fitFill] `style` [width 200])
--widgetTree8 = hstack [image_ "assets/images/pecans.jpg" [fitFill] `style` [width 200]] --
widgetTree9 = vstack [
hstack [
radio fruit Apple,
radio fruit Orange,
checkbox condition1
],
dropdown_ dropdown1 items id label [maxHeight 200],
label "Integral",
integralField integer1,
label "Floating",
floatingField float1,
--image "assets/images/pecans.jpg"
listView_ dropdown1 items label [itemSelectedStyle (def `style` [bgColor orange])],
listView_ dropdown1 items label [],
--dropdown dropdown1 items id label
label "Text",
textField textField1

18
src/Monomer/Core/Themes/Dark.hs
View File

@ -81,8 +81,9 @@ darkBasic = def
& L.btnMainStyle . L.bgColor ?~ blue
& L.btnMainStyle . L.text ?~ normalFont
& L.btnMainStyle . L.padding ?~ (paddingV 3 <> paddingH 5)
& L.checkboxWidth .~ 25
& L.checkboxWidth .~ 18
& L.checkboxStyle . L.fgColor ?~ gray
& L.checkboxStyle . L.padding ?~ padding 3
& L.dialogFrameStyle . L.bgColor ?~ gray
& L.dialogFrameStyle . L.border ?~ border 1 darkGray
& L.dialogTitleStyle . L.text ?~ titleFont <> textLeft
@ -106,8 +107,9 @@ darkBasic = def
& L.listViewStyle . L.border ?~ borderNormal
& L.listViewItemStyle .~ listViewItemStyle
& L.listViewItemSelectedStyle .~ listViewItemSelectedStyle
& L.radioWidth .~ 25
& L.radioWidth .~ 18
& L.radioStyle . L.fgColor ?~ gray
& L.radioStyle . L.padding ?~ padding 3
& L.scrollBarColor .~ (gray & L.a .~ 0.2)
& L.scrollThumbColor .~ (darkGray & L.a .~ 0.6)
& L.scrollWidth .~ 10
@ -126,28 +128,30 @@ darkHover = darkBasic
& L.dropdownStyle . L.cursorIcon ?~ CursorHand
& L.dropdownItemStyle . L.bgColor ?~ gray
& L.dropdownItemStyle . L.cursorIcon ?~ CursorHand
& L.dropdownItemSelectedStyle . L.cursorIcon ?~ CursorHand
& L.inputFloatingStyle . L.cursorIcon ?~ CursorIBeam
& L.inputIntegralStyle . L.cursorIcon ?~ CursorIBeam
& L.inputTextStyle . L.cursorIcon ?~ CursorIBeam
& L.listViewItemStyle . L.bgColor ?~ gray
& L.listViewItemStyle . L.cursorIcon ?~ CursorHand
& L.listViewItemSelectedStyle . L.cursorIcon ?~ CursorHand
& L.radioStyle . L.fgColor ?~ white
& L.radioStyle . L.cursorIcon ?~ CursorHand
darkFocus :: ThemeState
darkFocus = darkBasic
& L.checkboxStyle . L.fgColor ?~ white
& L.checkboxStyle . L.fgColor ?~ lightSkyBlue
& L.dropdownStyle . L.border ?~ borderFocus
& L.dropdownListStyle . L.border ?~ borderFocus
& L.dropdownItemStyle . L.bgColor ?~ lightGray
& L.dropdownItemSelectedStyle . L.bgColor ?~ gray
& L.dropdownItemSelectedStyle . L.border ?~ border 1 lightGray
& L.inputFloatingStyle . L.border ?~ borderFocus
& L.inputIntegralStyle . L.border ?~ borderFocus
& L.inputTextStyle . L.border ?~ borderFocus
& L.listViewItemStyle . L.bgColor ?~ lightGray
& L.listViewStyle . L.border ?~ borderFocus
& L.listViewItemSelectedStyle . L.bgColor ?~ gray
& L.radioStyle . L.fgColor ?~ white
& L.listViewItemStyle . L.bgColor ?~ lightGray
& L.listViewItemSelectedStyle . L.border ?~ border 1 lightGray
& L.radioStyle . L.fgColor ?~ lightSkyBlue
darkDisabled :: ThemeState
darkDisabled = darkBasic

14
src/Monomer/Widgets/ListView.hs
View File

@ -347,14 +347,22 @@ makeListView widgetData items makeRow config state = widget where
| isWidgetVisible item viewport = items |> updateStyle idx item
| otherwise = items
updateStyle idx item
| idx == hlIdx
= item & L.children . ix 0 . L.style . L.basic
.~ (item ^. L.children . ix 0 . L.style . L.focus)
| idx == hlIdx = setFocusedItemStyle wenv item
| otherwise = item
children = inst ^. L.children . ix 0 . L.children
newChildren = Seq.foldlWithIndex foldItem Empty children
newInst = inst & L.children . ix 0 . L.children .~ newChildren
setFocusedItemStyle :: WidgetEnv s e -> WidgetInstance s e -> WidgetInstance s e
setFocusedItemStyle wenv item
| isHovered wenv item = item & hoverLens .~ (hoverStyle <> focusStyle)
| otherwise = item & basicLens .~ focusStyle
where
basicLens = L.children . ix 0 . L.style . L.basic
hoverLens = L.children . ix 0 . L.style . L.hover
hoverStyle = item ^. L.children . ix 0 . L.style . L.hover
focusStyle = item ^. L.children . ix 0 . L.style . L.focus
makeItemsList
:: (Eq a)
=> WidgetEnv s e

3
src/Monomer/Widgets/Util/Base.hs
View File

@ -96,12 +96,13 @@ handleStyleChange handler wenv target evt inst = newResult where
newSizeReqH = _wiSizeReqH instReqs
sizeReqChanged = oldSizeReqW /= newSizeReqW || oldSizeReqH /= newSizeReqH
-- Cursor
isTarget = _wiPath inst == target
curIcon = wenv ^. L.currentCursor
nonOverlay = isJust (wenv ^. L.overlayPath) && not (isInOverlay wenv inst)
newIcon
| nonOverlay = CursorArrow
| otherwise = fromMaybe CursorArrow (_sstCursorIcon style)
setCursor = newIcon /= curIcon && (isOnEnter evt || nonOverlay)
setCursor = isTarget && newIcon /= curIcon && (isOnEnter evt || nonOverlay)
-- Result
resizeReq = [ Resize | checkSize && sizeReqChanged ]
cursorReq = [ SetCursorIcon newIcon | setCursor ]