mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-09-11 12:05:35 +03:00
Add anim suffix to animation widgets
This commit is contained in:
parent
e6de3c4b58
commit
49fb421780
@ -208,8 +208,8 @@ buildUI wenv model = traceShow "Creating UI" widgetTree where
|
||||
button "Increase" IncButton
|
||||
]
|
||||
widgetAnimate = vstack [
|
||||
slideIn_ [leftSide] (label "Hello!!!!" `style` [bgColor red]) `key` "anim1",
|
||||
slideOut_ [leftSide] (label "Good bye!!!!" `style` [bgColor green]) `key` "anim2",
|
||||
animSlideIn_ [slideLeft] (label "Hello!!!!" `style` [bgColor red]) `key` "anim1",
|
||||
animSlideOut_ [slideLeft] (label "Good bye!!!!" `style` [bgColor green]) `key` "anim2",
|
||||
hstack [
|
||||
labelS (model ^. clickCount),
|
||||
button "Increase" IncButton
|
||||
|
@ -49,7 +49,10 @@ buildUI wenv model = widgetTree where
|
||||
label "Palette type",
|
||||
textDropdown (boxesCfg . paletteType) [1..4],
|
||||
label "Palette size",
|
||||
dial_ (boxesCfg . paletteSize) 1 50 [dragRate 0.5]
|
||||
vstack [
|
||||
dial_ (boxesCfg . paletteSize) 1 50 [dragRate 0.5],
|
||||
labelS (model ^. boxesCfg . paletteSize) `style` [textSize 14, textCenter]
|
||||
]
|
||||
]
|
||||
|
||||
widgetTree = vstack [
|
||||
@ -92,7 +95,7 @@ main = do
|
||||
model = GenerativeModel CirclesGrid False def def
|
||||
config = [
|
||||
appWindowTitle "Generative art",
|
||||
appTheme lightTheme,
|
||||
appTheme darkTheme,
|
||||
appFontDef "Regular" "./assets/fonts/Roboto-Regular.ttf",
|
||||
appInitEvent GenerativeInit
|
||||
]
|
||||
|
@ -99,7 +99,7 @@ drawCircle renderer state vp iw cols idx = do
|
||||
fill renderer
|
||||
stroke renderer
|
||||
where
|
||||
colors = [cyan, deepPink, orange, white]
|
||||
colors = [cyan, deepPink, orange, paleGreen]
|
||||
sizeFactor = 0.3 + 1.1 * (state ^. mouseY - vp ^. L.y) / vp ^. L.h
|
||||
randFactor = (state ^. mouseX - vp ^. L.x) / vp ^. L.w
|
||||
currw = sizeFactor * iw
|
||||
|
@ -85,9 +85,11 @@ buildUI wenv model = widgetTree where
|
||||
|
||||
tickerList = vstack tickerRows where
|
||||
orderedTickers = (\e -> model ^? tickers . ix e) <$> model ^. symbolPairs
|
||||
tickerFade idx t = fadeOut_ [onFinished action] item `key` (t ^. symbolPair) where
|
||||
tickerFade idx t = animRow where
|
||||
action = TickerRemovePair (t ^. symbolPair)
|
||||
item = tickerRow wenv idx t
|
||||
animRow = animFadeOut_ [onFinished action] item `key` (t ^. symbolPair)
|
||||
|
||||
tickerRows = zipWith tickerFade [0..] (catMaybes orderedTickers)
|
||||
|
||||
widgetTree = vstack [
|
||||
|
@ -24,7 +24,7 @@ todoRowKey :: Todo -> Text
|
||||
todoRowKey todo = "todoRow" <> showt (todo ^. todoId)
|
||||
|
||||
todoRow :: TodoWenv -> TodoModel -> Int -> Todo -> TodoNode
|
||||
todoRow wenv model idx t = slideWidget `key` todoKey where
|
||||
todoRow wenv model idx t = animRow `key` todoKey where
|
||||
sectionBg = wenv ^. L.theme . L.sectionColor
|
||||
rowButtonColor = wenv ^. L.theme . L.userColorMap . at "rowButton" . non def
|
||||
rowSepColor = gray & L.a .~ 0.5
|
||||
@ -58,7 +58,7 @@ todoRow wenv model idx t = slideWidget `key` todoKey where
|
||||
rowButton remixDeleteBinLine (TodoDeleteBegin idx t)
|
||||
] `style` (paddingV 15 : [borderB 1 rowSepColor | not isLast])
|
||||
|
||||
slideWidget = fadeOut_ [onFinished (TodoDelete idx t)] todoInfo
|
||||
animRow = animFadeOut_ [onFinished (TodoDelete idx t)] todoInfo
|
||||
|
||||
|
||||
todoEdit :: TodoWenv -> TodoModel -> TodoNode
|
||||
@ -119,9 +119,9 @@ buildUI wenv model = widgetTree where
|
||||
_ -> TodoAdd
|
||||
|
||||
dualSlide content = outer where
|
||||
inner = slideIn_ [topSide, duration 200] content
|
||||
inner = animSlideIn_ [slideTop, duration 200] content
|
||||
`key` "animEditIn"
|
||||
outer = slideOut_ [topSide, duration 200, onFinished TodoHideEditDone] inner
|
||||
outer = animSlideOut_ [slideTop, duration 200, onFinished TodoHideEditDone] inner
|
||||
`key` "animEditOut"
|
||||
|
||||
content = vstack [
|
||||
|
@ -29,10 +29,12 @@ buildUI
|
||||
-> WidgetNode AppModel AppEvent
|
||||
buildUI wenv model = widgetTree where
|
||||
timeString = T.pack . show $ model ^. currentTime
|
||||
|
||||
timeLabel = label (T.takeWhile (/= '.') timeString)
|
||||
`style` [textFont "Bold", textSize 80, textCenter, textMiddle, flexHeight 100]
|
||||
|
||||
widgetTree = vstack [
|
||||
fadeIn timeLabel `key` "fadeTimeLabel"
|
||||
animFadeIn timeLabel `key` "fadeTimeLabel"
|
||||
]
|
||||
|
||||
handleEvent
|
||||
|
@ -25,10 +25,10 @@ Messages:
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Monomer.Widgets.Animation.Fade (
|
||||
fadeIn,
|
||||
fadeIn_,
|
||||
fadeOut,
|
||||
fadeOut_
|
||||
animFadeIn,
|
||||
animFadeIn_,
|
||||
animFadeOut,
|
||||
animFadeOut_
|
||||
) where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
@ -97,22 +97,22 @@ instance Default FadeState where
|
||||
}
|
||||
|
||||
-- | Animates a widget from not visible state to fully visible.
|
||||
fadeIn :: WidgetEvent e => WidgetNode s e -> WidgetNode s e
|
||||
fadeIn managed = fadeIn_ def managed
|
||||
animFadeIn :: WidgetEvent e => WidgetNode s e -> WidgetNode s e
|
||||
animFadeIn managed = animFadeIn_ def managed
|
||||
|
||||
-- | Animates a widget from not visible state to fully visible. Accepts config.
|
||||
fadeIn_ :: WidgetEvent e => [FadeCfg e] -> WidgetNode s e -> WidgetNode s e
|
||||
fadeIn_ configs managed = makeNode "fadeIn" widget managed where
|
||||
animFadeIn_ :: WidgetEvent e => [FadeCfg e] -> WidgetNode s e -> WidgetNode s e
|
||||
animFadeIn_ configs managed = makeNode "animFadeIn" widget managed where
|
||||
config = mconcat configs
|
||||
widget = makeFade True config def
|
||||
|
||||
-- | Animates a widget from visible state to not visible.
|
||||
fadeOut :: WidgetEvent e => WidgetNode s e -> WidgetNode s e
|
||||
fadeOut managed = fadeOut_ def managed
|
||||
animFadeOut :: WidgetEvent e => WidgetNode s e -> WidgetNode s e
|
||||
animFadeOut managed = animFadeOut_ def managed
|
||||
|
||||
-- | Animates a widget from visible state to not visible. Accepts config.
|
||||
fadeOut_ :: WidgetEvent e => [FadeCfg e] -> WidgetNode s e -> WidgetNode s e
|
||||
fadeOut_ configs managed = makeNode "fadeOut" widget managed where
|
||||
animFadeOut_ :: WidgetEvent e => [FadeCfg e] -> WidgetNode s e -> WidgetNode s e
|
||||
animFadeOut_ configs managed = makeNode "animFadeOut" widget managed where
|
||||
config = mconcat configs
|
||||
widget = makeFade False config def
|
||||
|
||||
|
@ -25,14 +25,14 @@ Messages:
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
|
||||
module Monomer.Widgets.Animation.Slide (
|
||||
slideIn,
|
||||
slideIn_,
|
||||
slideOut,
|
||||
slideOut_,
|
||||
leftSide,
|
||||
rightSide,
|
||||
topSide,
|
||||
bottomSide
|
||||
animSlideIn,
|
||||
animSlideIn_,
|
||||
animSlideOut,
|
||||
animSlideOut_,
|
||||
slideLeft,
|
||||
slideRight,
|
||||
slideTop,
|
||||
slideBottom
|
||||
) where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
@ -100,20 +100,20 @@ instance CmbOnFinished (SlideCfg e) e where
|
||||
}
|
||||
|
||||
-- | Slide from/to left.
|
||||
leftSide :: SlideCfg e
|
||||
leftSide = def { _slcDirection = Just SlideLeft }
|
||||
slideLeft :: SlideCfg e
|
||||
slideLeft = def { _slcDirection = Just SlideLeft }
|
||||
|
||||
-- | Slide from/to right.
|
||||
rightSide :: SlideCfg e
|
||||
rightSide = def { _slcDirection = Just SlideRight }
|
||||
slideRight :: SlideCfg e
|
||||
slideRight = def { _slcDirection = Just SlideRight }
|
||||
|
||||
-- | Slide from/to top.
|
||||
topSide :: SlideCfg e
|
||||
topSide = def { _slcDirection = Just SlideUp }
|
||||
slideTop :: SlideCfg e
|
||||
slideTop = def { _slcDirection = Just SlideUp }
|
||||
|
||||
-- | Slide from/to bottom.
|
||||
bottomSide :: SlideCfg e
|
||||
bottomSide = def { _slcDirection = Just SlideDown }
|
||||
slideBottom :: SlideCfg e
|
||||
slideBottom = def { _slcDirection = Just SlideDown }
|
||||
|
||||
data SlideState = SlideState {
|
||||
_slsRunning :: Bool,
|
||||
@ -127,24 +127,24 @@ instance Default SlideState where
|
||||
}
|
||||
|
||||
-- | Animates a widget from the left to fully visible.
|
||||
slideIn :: WidgetEvent e => WidgetNode s e -> WidgetNode s e
|
||||
slideIn managed = slideIn_ def managed
|
||||
animSlideIn :: WidgetEvent e => WidgetNode s e -> WidgetNode s e
|
||||
animSlideIn managed = animSlideIn_ def managed
|
||||
|
||||
-- | Animates a widget from the provided direction to fully visible (defaults
|
||||
-- | to left). Accepts config.
|
||||
slideIn_ :: WidgetEvent e => [SlideCfg e] -> WidgetNode s e -> WidgetNode s e
|
||||
slideIn_ configs managed = makeNode "slideIn" widget managed where
|
||||
animSlideIn_ :: WidgetEvent e => [SlideCfg e] -> WidgetNode s e -> WidgetNode s e
|
||||
animSlideIn_ configs managed = makeNode "animSlideIn" widget managed where
|
||||
config = mconcat configs
|
||||
widget = makeSlide True config def
|
||||
|
||||
-- | Animates a widget to the left from visible to not visible.
|
||||
slideOut :: WidgetEvent e => WidgetNode s e -> WidgetNode s e
|
||||
slideOut managed = slideOut_ def managed
|
||||
animSlideOut :: WidgetEvent e => WidgetNode s e -> WidgetNode s e
|
||||
animSlideOut managed = animSlideOut_ def managed
|
||||
|
||||
-- | Animates a widget to the the provided direction from visible to not
|
||||
-- | visible (defaults to left). Accepts config.
|
||||
slideOut_ :: WidgetEvent e => [SlideCfg e] -> WidgetNode s e -> WidgetNode s e
|
||||
slideOut_ configs managed = makeNode "slideOut" widget managed where
|
||||
animSlideOut_ :: WidgetEvent e => [SlideCfg e] -> WidgetNode s e -> WidgetNode s e
|
||||
animSlideOut_ configs managed = makeNode "animSlideOut" widget managed where
|
||||
config = mconcat configs
|
||||
widget = makeSlide False config def
|
||||
|
||||
|
6
tasks.md
6
tasks.md
@ -784,14 +784,16 @@
|
||||
- Add ignoreStyle to button.
|
||||
- themeSwitch should report theme has changed, and mergeRequired consider it.
|
||||
- Is selectList's merge redundant? Container seems to take care of everything.
|
||||
|
||||
Next
|
||||
- Add anim suffix to animation widgets.
|
||||
- Update Todo example to overlay edit section.
|
||||
|
||||
Next
|
||||
- Rethink activeStyle, activeTheme, active style related function names.
|
||||
- Order of arguments?
|
||||
- Document themes and how widgets use them.
|
||||
- Maybe spacer should be 8 pixels wide.
|
||||
- Scroll bar width
|
||||
- Default checkbox mark
|
||||
- Fix Tutorial 6 colors.
|
||||
- Remove dpr calculations from NanoVGRenderer.
|
||||
- Same with FontManager.
|
||||
|
@ -54,8 +54,8 @@ initWidget = describe "initWidget" $ do
|
||||
|
||||
where
|
||||
wenv = mockWenvEvtUnit ()
|
||||
nodeNormal = fadeIn (label "Test")
|
||||
nodeAuto = fadeIn_ [autoStart, duration 100] (label "Test")
|
||||
nodeNormal = animFadeIn (label "Test")
|
||||
nodeAuto = animFadeIn_ [autoStart, duration 100] (label "Test")
|
||||
reqs node = nodeHandleEvents_ wenv WInit [] node ^?! ix 0 . _1 . _3
|
||||
|
||||
handleMessage :: Spec
|
||||
@ -77,7 +77,7 @@ handleMessage = describe "handleMessage" $ do
|
||||
|
||||
where
|
||||
wenv = mockWenv ()
|
||||
baseNode = fadeIn_ [autoStart, duration 100, onFinished OnTestFinished] (label "Test")
|
||||
baseNode = animFadeIn_ [autoStart, duration 100, onFinished OnTestFinished] (label "Test")
|
||||
node = nodeInit wenv baseNode
|
||||
res msg = widgetHandleMessage (node^. L.widget) wenv node rootPath msg
|
||||
evts msg = eventsFromReqs (reqs msg)
|
||||
@ -95,4 +95,4 @@ getSizeReq = describe "getSizeReq" $ do
|
||||
wenv = mockWenvEvtUnit ()
|
||||
lblNode = label "Test label"
|
||||
(lSizeReqW, lSizeReqH) = nodeGetSizeReq wenv lblNode
|
||||
(tSizeReqW, tSizeReqH) = nodeGetSizeReq wenv (fadeIn lblNode)
|
||||
(tSizeReqW, tSizeReqH) = nodeGetSizeReq wenv (animFadeIn lblNode)
|
||||
|
@ -54,8 +54,8 @@ initWidget = describe "initWidget" $ do
|
||||
|
||||
where
|
||||
wenv = mockWenvEvtUnit ()
|
||||
nodeNormal = slideIn (label "Test")
|
||||
nodeAuto = slideIn_ [autoStart, duration 100] (label "Test")
|
||||
nodeNormal = animSlideIn (label "Test")
|
||||
nodeAuto = animSlideIn_ [autoStart, duration 100] (label "Test")
|
||||
reqs node = nodeHandleEvents_ wenv WInit [] node ^?! ix 0 . _1 . _3
|
||||
|
||||
handleMessage :: Spec
|
||||
@ -77,7 +77,7 @@ handleMessage = describe "handleMessage" $ do
|
||||
|
||||
where
|
||||
wenv = mockWenv ()
|
||||
baseNode = slideIn_ [autoStart, duration 100, onFinished OnTestFinished] (label "Test")
|
||||
baseNode = animSlideIn_ [autoStart, duration 100, onFinished OnTestFinished] (label "Test")
|
||||
node = nodeInit wenv baseNode
|
||||
res msg = widgetHandleMessage (node^. L.widget) wenv node rootPath msg
|
||||
evts msg = eventsFromReqs (reqs msg)
|
||||
@ -95,4 +95,4 @@ getSizeReq = describe "getSizeReq" $ do
|
||||
wenv = mockWenvEvtUnit ()
|
||||
lblNode = label "Test label"
|
||||
(lSizeReqW, lSizeReqH) = nodeGetSizeReq wenv lblNode
|
||||
(tSizeReqW, tSizeReqH) = nodeGetSizeReq wenv (slideIn lblNode)
|
||||
(tSizeReqW, tSizeReqH) = nodeGetSizeReq wenv (animSlideIn lblNode)
|
||||
|
Loading…
Reference in New Issue
Block a user