Merge pull request #307 from phsmenon/fix-cache-clickables

Include clickable elements in the rendering cache.
This commit is contained in:
Jonathan Daugherty 2021-02-05 19:53:19 -08:00 committed by GitHub
commit 4e983975b3
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 21 additions and 5 deletions

View File

@ -249,7 +249,7 @@ data RenderState n =
RS { viewportMap :: !(M.Map n Viewport)
, rsScrollRequests :: ![(n, ScrollRequest)]
, observedNames :: !(S.Set n)
, renderCache :: !(M.Map n (Result n))
, renderCache :: !(M.Map n ([n], Result n))
, clickableNames :: ![n]
} deriving (Read, Show, Generic, NFData)

View File

@ -962,24 +962,40 @@ vRelease p =
-- use the rendered version from the cache. If not, render the specified
-- widget and update the cache with the result.
--
-- To ensure that mouse events are emitted correctly for cached widgets,
-- in addition to the rendered widget, we also cache (the names of)
-- any clickable extents that were rendered and restore that when utilizing
-- the cache.
--
-- See also 'invalidateCacheEntry'.
cached :: (Ord n) => n -> Widget n -> Widget n
cached n w =
Widget (hSize w) (vSize w) $ do
result <- cacheLookup n
case result of
Just prevResult -> return prevResult
Just (clickables, prevResult) -> do
clickableNamesL %= (clickables ++)
return prevResult
Nothing -> do
wResult <- render w
cacheUpdate n wResult
clickables <- renderedClickables wResult
cacheUpdate n (clickables, wResult)
return wResult
where
-- Given the rendered result of a Widget, collect the list of "clickable" names
-- from the extents that were in the result.
renderedClickables :: (Ord n) => Result n -> RenderM n [n]
renderedClickables renderResult = do
allClickables <- use clickableNamesL
return [extentName e | e <- renderResult^.extentsL, extentName e `elem` allClickables]
cacheLookup :: (Ord n) => n -> RenderM n (Maybe (Result n))
cacheLookup :: (Ord n) => n -> RenderM n (Maybe ([n], Result n))
cacheLookup n = do
cache <- lift $ gets (^.renderCacheL)
return $ M.lookup n cache
cacheUpdate :: (Ord n) => n -> Result n -> RenderM n ()
cacheUpdate :: (Ord n) => n -> ([n], Result n) -> RenderM n ()
cacheUpdate n r = lift $ modify (& renderCacheL %~ M.insert n r)
-- | Render the specified widget in a named viewport with the