mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-10-26 19:49:50 +03:00
Avoid rendering on every frame if not needed
This commit is contained in:
parent
1967eca3bb
commit
ce7ce7fc6a
8
Info.plist
Normal file
8
Info.plist
Normal file
@ -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>
|
@ -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,
|
||||
|
@ -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");
|
||||
|
@ -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
|
||||
|
@ -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"
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
}
|
||||
|
||||
|
@ -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
|
||||
}
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
18
tasks.md
18
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?
|
||||
|
Loading…
Reference in New Issue
Block a user