Avoid rendering on every frame if not needed

Info.plist

@@ -0,0 +1,8 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+  <key>NSSupportsAutomaticGraphicsSwitching</key>
+  <string>YES</string>
+</dict>
+</plist>

app/Main.hs

@@ -37,7 +37,7 @@ main = do
         --mainWindowState MainWindowFullScreen,
         --mainWindowState MainWindowMaximized,
         --mainWindowState $ MainWindowNormal (640, 480),
-        maxFps 60,
+        maxFps 30,
         mainWindowTitle "This is my title",
         useHdpi True,
         appTheme theme,

cbits/glew.c

@@ -5,6 +5,10 @@ void initGlew() {
   glewExperimental = GL_TRUE;
   GLenum err = glewInit();
 
+  const GLubyte* renderer = glGetString (GL_RENDERER); // get renderer string
+  const GLubyte* version = glGetString (GL_VERSION); // version as a string
+  fprintf(stderr, "Renderer: %s\nVersion: %s\n", renderer, version);
+
   if(err != GLEW_OK) {
     fprintf(stderr, "Could not init GLEW: %s\n", glewGetErrorString(err));
     printf("\n");

docs/library-use.md

@@ -1 +1,7 @@
 Explain how merge and state are used, why sometimes you can just ignore everything and keep old state, etc
+
+
+How to use Integrated Graphics on Mac
+  - http://supermegaultragroovy.com/2016/12/10/auto-graphics-switching/
+  - cp Info.plist .stack-work/install/x86_64-osx/038234698686d9a563517e4a60068716e0293db857c392f5c98337eda15cfeeb/8.6.5/bin
+  - cp Info.plist /Users/francisco/.stack/programs/x86_64-osx/ghc-8.6.5/lib/ghc-8.6.5/bin

src/Monomer/Core/WidgetTypes.hs

@@ -69,6 +69,9 @@ data WidgetRequest s
   | SetOverlay Path
   | ResetOverlay
   | SetCursorIcon CursorIcon
+  | RenderOnce
+  | RenderEvery Path Int
+  | RenderStop Path
   | ExitApplication Bool
   | UpdateWindow WindowRequest
   | UpdateModel (s -> s)
@@ -253,6 +256,9 @@ instance Show (WidgetRequest s) where
   show ResetOverlay = "ResetOverlay"
   show (SetOverlay path) = "SetOverlay: " ++ show path
   show (SetCursorIcon icon) = "SetCursorIcon: " ++ show icon
+  show RenderOnce = "RenderOnce"
+  show (RenderEvery path ms) = "RenderEvery: " ++ show path ++ " - " ++ show ms
+  show (RenderStop path) = "RenderStop: " ++ show path
   show ExitApplication{} = "ExitApplication"
   show (UpdateWindow req) = "UpdateWindow: " ++ show req
   show UpdateModel{} = "UpdateModel"

src/Monomer/Event/Core.hs

@@ -1,4 +1,5 @@
 module Monomer.Event.Core (
+  isActionEvent,
   convertEvents
 ) where
 
@@ -12,6 +13,13 @@ import Monomer.Core.BasicTypes
 import Monomer.Event.Keyboard
 import Monomer.Event.Types
 
+isActionEvent :: SDL.EventPayload -> Bool
+isActionEvent SDL.MouseButtonEvent{} = True
+isActionEvent SDL.MouseWheelEvent{} = True
+isActionEvent SDL.KeyboardEvent{} = True
+isActionEvent SDL.TextInputEvent{} = True
+isActionEvent _ = False
+
 convertEvents :: Double -> Point -> [SDL.EventPayload] -> [SystemEvent]
 convertEvents devicePixelRate mousePos events = catMaybes convertedEvents where
   convertedEvents = fmap convertEvent events

src/Monomer/Main/Core.hs

@@ -12,16 +12,19 @@ module Monomer.Main.Core (
   runApp
 ) where
 
+import Debug.Trace
+
 import Control.Concurrent (threadDelay)
 import Control.Lens
 import Control.Monad.Extra
 import Control.Monad.State
 import Data.Default
 import Data.Maybe
+import Data.List (foldl')
 import Data.Text (Text)
 import Data.Typeable (Typeable)
 
-import qualified Data.Map as M
+import qualified Data.Map as Map
 import qualified Graphics.Rendering.OpenGL as GL
 import qualified SDL
 import qualified Data.Sequence as Seq
@@ -48,6 +51,7 @@ data MainLoopArgs s e ep = MainLoopArgs {
   _mlTheme :: Theme,
   _mlAppStartTs :: Int,
   _mlMaxFps :: Int,
+  _mlLatestRenderTs :: Int,
   _mlFrameStartTs :: Int,
   _mlFrameAccumTs :: Int,
   _mlFrameCount :: Int,
@@ -116,7 +120,7 @@ runApp window maxFps fonts theme exitEvent widgetRoot = do
     _weRenderer = renderer,
     _weTheme = theme,
     _weAppWindowSize = newWindowSize,
-    _weGlobalKeys = M.empty,
+    _weGlobalKeys = Map.empty,
     _weCurrentCursor = CursorArrow,
     _weFocusedPath = rootPath,
     _weOverlayPath = Nothing,
@@ -138,6 +142,7 @@ runApp window maxFps fonts theme exitEvent widgetRoot = do
     _mlTheme = theme,
     _mlMaxFps = maxFps,
     _mlAppStartTs = 0,
+    _mlLatestRenderTs = 0,
     _mlFrameStartTs = startTs,
     _mlFrameAccumTs = 0,
     _mlFrameCount = 0,
@@ -187,7 +192,7 @@ mainLoop window renderer loopArgs = do
     _weRenderer = renderer,
     _weTheme = _mlTheme,
     _weAppWindowSize = windowSize,
-    _weGlobalKeys = M.empty,
+    _weGlobalKeys = Map.empty,
     _weCurrentCursor = currentCursor,
     _weFocusedPath = focused,
     _weOverlayPath = overlay,
@@ -219,17 +224,28 @@ mainLoop window renderer loopArgs = do
   newRoot <- if windowResized then resizeWindow window seWenv seRoot
                               else return seRoot
 
-  renderWidgets window renderer seWenv newRoot
-
   endTicks <- fmap fromIntegral SDL.ticks
 
+  -- Rendering
+  renderCurrentReq <- checkRenderCurrent startTicks _mlFrameStartTs
+
+  let renderEvent = any isActionEvent eventsPayload
+  let renderNeeded = windowResized || renderEvent || renderCurrentReq
+
+  when renderNeeded $
+    renderWidgets window renderer seWenv newRoot
+
+  renderRequested .= windowResized
+
   let fps = realToFrac _mlMaxFps
-  let frameLength = 1000000 / fps
-  let newTs = fromIntegral $ endTicks - startTicks
+  let frameLength = round (1000000 / fps)
+  let newTs = endTicks - startTicks
   let tempDelay = abs (frameLength - newTs * 1000)
-  let nextFrameDelay = round $ min frameLength tempDelay
+  let nextFrameDelay = min frameLength tempDelay
+  let latestRenderTs = if renderNeeded then startTicks else _mlLatestRenderTs
   let newLoopArgs = loopArgs {
     _mlAppStartTs = _mlAppStartTs + ts,
+    _mlLatestRenderTs = latestRenderTs,
     _mlFrameStartTs = startTicks,
     _mlFrameAccumTs = if newSecond then 0 else _mlFrameAccumTs + ts,
     _mlFrameCount = if newSecond then 0 else _mlFrameCount + 1,
@@ -245,6 +261,24 @@ mainLoop window renderer loopArgs = do
 
   unless shouldQuit (mainLoop window renderer newLoopArgs)
 
+checkRenderCurrent :: (MonomerM s m) => Int -> Int -> m Bool
+checkRenderCurrent currTs renderTs = do
+  renderNext <- use renderRequested
+  schedule <- use renderSchedule
+  return (renderNext || nextRender schedule)
+  where
+    foldHelper acc curr = acc || renderScheduleDone currTs renderTs curr
+    nextRender schedule = foldl' foldHelper False schedule
+
+renderScheduleDone :: Int -> Int -> RenderSchedule -> Bool
+renderScheduleDone currTs renderTs schedule = nextStep < currTs where
+  RenderSchedule _ start ms = schedule
+  stepsDone = round (fromIntegral (renderTs - start) / fromIntegral ms)
+  currStep = start + ms * stepsDone
+  nextStep
+    | currStep >= renderTs = currStep
+    | otherwise = currStep + ms
+
 renderWidgets
   :: (MonomerM s m)
   => SDL.Window

src/Monomer/Main/Handlers.hs

@@ -137,6 +137,9 @@ handleRequests reqs step = foldM handleRequest step reqs where
     SetOverlay path -> handleSetOverlay path step
     ResetOverlay -> handleResetOverlay step
     SetCursorIcon icon -> handleSetCursorIcon icon step
+    RenderOnce -> handleRenderOnce step
+    RenderEvery path ms -> handleRenderEvery path ms step
+    RenderStop path -> handleRenderStop path step
     ExitApplication exit -> handleExitApplication exit step
     UpdateWindow req -> handleUpdateWindow req step
     UpdateModel fn -> handleUpdateModel fn step
@@ -157,6 +160,8 @@ handleResizeWidgets reqs previousStep =
       let (wenv, events, widgetRoot) = previousStep
       let newWidgetRoot = resizeWidget wenv windowSize widgetRoot
 
+      L.renderRequested .= True
+
       return (wenv, events, newWidgetRoot)
     _ -> return previousStep
 
@@ -240,7 +245,36 @@ handleSetCursorIcon icon previousStep = do
 
   return previousStep
 
-handleExitApplication :: (MonomerM s m) => Bool -> HandlerStep s e -> m (HandlerStep s e)
+handleRenderOnce :: (MonomerM s m) => HandlerStep s e -> m (HandlerStep s e)
+handleRenderOnce previousStep = do
+  L.renderRequested .= True
+  return previousStep
+
+handleRenderEvery
+  :: (MonomerM s m) => Path -> Int -> HandlerStep s e -> m (HandlerStep s e)
+handleRenderEvery path ms previousStep = do
+  schedule <- use L.renderSchedule
+  L.renderSchedule .= addSchedule schedule
+  return previousStep
+  where
+    (wenv, _, _) = previousStep
+    newValue = RenderSchedule {
+      _rsPath = path,
+      _rsStart = _weTimestamp wenv,
+      _rsMs = ms
+    }
+    addSchedule schedule
+      | ms > 0 = Map.insert path newValue schedule
+      | otherwise = schedule
+
+handleRenderStop :: (MonomerM s m) => Path -> HandlerStep s e -> m (HandlerStep s e)
+handleRenderStop path previousStep = do
+  schedule <- use L.renderSchedule
+  L.renderSchedule .= Map.delete path schedule
+  return previousStep
+
+handleExitApplication
+  :: (MonomerM s m) => Bool -> HandlerStep s e -> m (HandlerStep s e)
 handleExitApplication exit previousStep = do
   L.exitApplication .= exit
   return previousStep

src/Monomer/Main/Lens.hs

@@ -9,5 +9,6 @@ import Control.Lens.TH (abbreviatedFields, makeLensesWith)
 import Monomer.Core.Lens
 import Monomer.Main.Types
 
-makeLensesWith abbreviatedFields ''MonomerContext
 makeLensesWith abbreviatedFields ''AppConfig
+makeLensesWith abbreviatedFields ''MonomerContext
+makeLensesWith abbreviatedFields ''RenderSchedule

src/Monomer/Main/Platform.hs

@@ -76,7 +76,8 @@ initSDLWindow config = do
       SDL.glColorPrecision = SDL.V4 8 8 8 0,
       SDL.glDepthPrecision = 24,
       SDL.glStencilPrecision = 8,
-      SDL.glProfile = SDL.Core SDL.Debug 3 2,
+      --SDL.glProfile = SDL.Core SDL.Debug 3 2,
+      SDL.glProfile = SDL.Core SDL.Normal 3 2,
       SDL.glMultisampleSamples = 1
     }
     (winW, winH) = case _apcWindowState config of

src/Monomer/Main/Types.hs

@@ -28,6 +28,12 @@ import Monomer.Graphics.Types
 
 type MonomerM s m = (Eq s, MonadState (MonomerContext s) m, MonadIO m)
 
+data RenderSchedule = RenderSchedule {
+  _rsPath :: Path,
+  _rsStart :: Int,
+  _rsMs :: Int
+} deriving (Eq, Show)
+
 data WidgetTask
   = forall i . Typeable i => WidgetTask Path (Async i)
   | forall i . Typeable i => WidgetProducer Path (TChan i) (Async ())
@@ -46,6 +52,8 @@ data MonomerContext s = MonomerContext {
   _mcPathOverlay :: Maybe Path,
   _mcWidgetTasks :: Seq WidgetTask,
   _mcCursorIcons :: Map CursorIcon SDLR.Cursor,
+  _mcRenderRequested :: Bool,
+  _mcRenderSchedule :: Map Path RenderSchedule,
   _mcExitApplication :: Bool
 }
 

src/Monomer/Main/Util.hs

@@ -36,6 +36,8 @@ initMonomerContext model win winSize useHiDPI devicePixelRate = MonomerContext {
   _mcPathOverlay = Nothing,
   _mcWidgetTasks = Seq.empty,
   _mcCursorIcons = Map.empty,
+  _mcRenderRequested = False,
+  _mcRenderSchedule = Map.empty,
   _mcExitApplication = False
 }
 

src/Monomer/Widgets/Composite.hs

@@ -475,6 +475,9 @@ toParentReq (SetCursorIcon icon) = Just (SetCursorIcon icon)
 toParentReq (SendMessage path message) = Just (SendMessage path message)
 toParentReq (RunTask path action) = Just (RunTask path action)
 toParentReq (RunProducer path action) = Just (RunProducer path action)
+toParentReq RenderOnce = Just RenderOnce
+toParentReq (RenderEvery path ms) = Just (RenderEvery path ms)
+toParentReq (RenderStop path) = Just (RenderStop path)
 toParentReq (ExitApplication exit) = Just (ExitApplication exit)
 toParentReq (UpdateWindow req) = Just (UpdateWindow req)
 toParentReq (UpdateModel fn) = Nothing

src/Monomer/Widgets/InputField.hs

@@ -279,12 +279,16 @@ makeInputField config state = widget where
             _wiWidget = makeInputField config newState
           }
         | otherwise = inst
-      newResult = resultReqs [StartTextInput (_wiViewport inst)] newInst
+      path = _wiPath inst
+      reqs = [RenderEvery path 500, StartTextInput (_wiViewport inst)]
+      newResult = resultReqs reqs newInst
       focusResult = handleFocusChange _ifcOnFocus _ifcOnFocusReq config newInst
       result = maybe newResult (mergeResults newResult) focusResult
 
     Blur -> Just result where
-      newResult = resultReqs [StopTextInput] inst
+      path = _wiPath inst
+      reqs = [RenderStop path, StopTextInput]
+      newResult = resultReqs reqs inst
       blurResult = handleFocusChange _ifcOnBlur _ifcOnBlurReq config inst
       result = maybe newResult (mergeResults newResult) blurResult
 

src/Monomer/Widgets/Scroll.hs

@@ -205,7 +205,7 @@ makeScroll config state = widget where
     Move point -> result where
       drag bar = updateScrollThumb state bar point contentArea sctx
       makeWidget state = rebuildWidget wenv state inst
-      makeResult state = resultReqs scrollReqs (makeWidget state)
+      makeResult state = resultReqs (RenderOnce : scrollReqs) (makeWidget state)
       result = fmap (makeResult . drag) dragging
     WheelScroll _ (Point wx wy) wheelDirection -> result where
       changedX = wx /= 0 && childWidth > cw

src/Monomer/Widgets/Util/Style.hs

@@ -151,7 +151,9 @@ handleSizeChange wenv target evt cfg inst = reqs where
   newSizeReqH = _wiSizeReqH instReqs
   sizeReqChanged = oldSizeReqW /= newSizeReqW || oldSizeReqH /= newSizeReqH
   -- Result
-  reqs = [ ResizeWidgets | checkSize && sizeReqChanged ]
+  resizeReq = [ ResizeWidgets | checkSize && sizeReqChanged ]
+  enterReq = [ RenderOnce | isOnEnter evt ]
+  reqs = resizeReq ++ enterReq
 
 handleCursorChange
   :: WidgetEnv s e

tasks.md

@@ -271,6 +271,7 @@
     - Add Bold/Italic support (instead of different Font for each case)
   - Button should change color when clicked/actioned
   - Check label with flexHeight (multilabel was not showing first line if it did not fit)
+  - Add Maps on Theme to handle user widget settings
   - Handle window title, maximize, etc
     - Also handle as requests?
     - Provide a way of exiting application/close window handler
@@ -278,6 +279,12 @@
   - Avoid excessive delay on window resize
   - Check 1px difference on right side of labels/buttons (probably already fixed)
   - VStack should set itself to a fixed size if all children are fixed
+  - Remember use case for containerStyleOnMerge (scroll size, but can't replicate)
+    - Using it makes everything painfully slow
+    - Most likely related to focus of nested components. Maybe filtering move/hover out is enough?
+    - Now fixed, but still need to test old use cases work fine
+  - Default to integrated graphics
+    - http://supermegaultragroovy.com/2016/12/10/auto-graphics-switching/
 
 - Pending
   - Add testing
@@ -293,11 +300,9 @@
     - Composite example
     - Something of generative art (OpenGL example)
   - Add user documentation
-  - Add Maps on Theme to handle user widget settings
 
 Maybe postponed after release?
-  - Check if SDL can be initialized headless (for tests that involve the API)
-    - https://discourse.libsdl.org/t/possible-to-run-sdl2-headless/25665/2
+  - Can we avoid redrawing if no event happened?
   - Improve listView performance (avoid merge/resize)
     - Maybe some composites could have a typeclass for its constructor, and react differently if provided Eq?
     - Still need to provide method for custom mergeNeeded check
@@ -309,19 +314,18 @@ Maybe postponed after release?
     - Handle undo history
     - Handle mouse selection
     - Create numeric wrapper that allows increasing/decreasing with mouse
+  - Check if SDL can be initialized headless (for tests that involve the API)
+    - https://discourse.libsdl.org/t/possible-to-run-sdl2-headless/25665/2
   - Avoid findNextFocus on unfocusable children (listView items)
     - Does this make sense? Check with a composite listView item
     - Focus event may need to be handled to update highlighted item
-  - Remember use case for containerStyleOnMerge (scroll size, but can't replicate)
-    - Using it makes everything painfully slow
-    - Most likely related to focus of nested components. Maybe filtering move/hover out is enough?
-    - Now fixed, but still need to test old use cases work fine
   - Scroll wheel rate should be configurable, or even depend on content size
   - Create Keystroke component (shortcuts and general key handling like Esc for dialog)
   - Create Tooltip component. It just wraps a given component and draws the tooltip with renderOverlay
   - Create Theme widget to override global theme
   - Image widget could also have a ByteString version
   - Compare Cairo/Skia/ImDrawList interfaces to make Renderer able to handle future implementations
+    - https://github.com/ollix/MetalNanoVG
   - Can _wiChildren be removed from Widget and only be kept in Container?
   - Image
     - Can performance be improved?