Add anim suffix to animation widgets

app/Main.hs

@@ -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

examples/generative/Main.hs

@@ -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
       ]

examples/generative/Widgets/CirclesGrid.hs

@@ -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

examples/ticker/Main.hs

@@ -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 [

examples/todo/Main.hs

@@ -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 [

examples/tutorial/Tutorial05_Producers.hs

@@ -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

src/Monomer/Widgets/Animation/Fade.hs

@@ -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
 

src/Monomer/Widgets/Animation/Slide.hs

@@ -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
 

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.

test/unit/Monomer/Widgets/Animation/FadeSpec.hs

@@ -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)

test/unit/Monomer/Widgets/Animation/SlideSpec.hs

@@ -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)