Merge pull request #398 from frasertweedale/perf/renderBox

renderBox: performance improvements
This commit is contained in:
Jonathan Daugherty 2022-09-29 19:50:32 -07:00 committed by GitHub
commit fdd40dad57
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 15 additions and 20 deletions

View File

@ -123,7 +123,6 @@ library
bimap >= 0.5 && < 0.6,
data-clist >= 0.1,
directory >= 1.2.5.0,
dlist,
exceptions >= 0.10.0,
filepath,
containers >= 0.5.7,

View File

@ -125,8 +125,8 @@ import Lens.Micro.Mtl (use, (%=))
import Control.Monad.State.Strict
import Control.Monad.Reader
import qualified Data.Foldable as F
import Data.Traversable (for)
import qualified Data.Text as T
import qualified Data.DList as DL
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.IMap as I
@ -642,30 +642,27 @@ renderBox br ws =
let availPrimary = c^.(contextPrimary br)
availSecondary = c^.(contextSecondary br)
renderHis _ prev [] = return $ DL.toList prev
renderHis remainingPrimary prev ((i, prim):rest) = do
result <- render $ limitPrimary br remainingPrimary
$ limitSecondary br availSecondary
$ cropToContext prim
renderHis (remainingPrimary - (result^.imageL.(to $ imagePrimary br)))
(DL.snoc prev (i, result)) rest
renderHi prim = do
remainingPrimary <- get
result <- lift $ render $ limitPrimary br remainingPrimary
$ limitSecondary br availSecondary
$ cropToContext prim
result <$ (put $! remainingPrimary - (result^.imageL.(to $ imagePrimary br)))
renderedHis <- renderHis availPrimary DL.empty his
(renderedHis, remainingPrimary) <-
runStateT (traverse (traverse renderHi) his) availPrimary
renderedLows <- case lows of
[] -> return []
ls -> do
let remainingPrimary = c^.(contextPrimary br) -
(sum $ (^._2.imageL.(to $ imagePrimary br)) <$> renderedHis)
primaryPerLow = remainingPrimary `div` length ls
let primaryPerLow = remainingPrimary `div` length ls
rest = remainingPrimary - (primaryPerLow * length ls)
secondaryPerLow = c^.(contextSecondary br)
primaries = replicate rest (primaryPerLow + 1) <>
replicate (length ls - rest) primaryPerLow
let renderLow ((i, prim), pri) =
(i,) <$> (render $ limitPrimary br pri
$ limitSecondary br secondaryPerLow
$ limitSecondary br availSecondary
$ cropToContext prim)
if remainingPrimary > 0 then mapM renderLow (zip ls primaries) else return []
@ -673,11 +670,10 @@ renderBox br ws =
let rendered = sortBy (compare `DF.on` fst) $ renderedHis ++ renderedLows
allResults = snd <$> rendered
allImages = (^.imageL) <$> allResults
allPrimaries = imagePrimary br <$> allImages
allTranslatedResults = (flip map) (zip [0..] allResults) $ \(i, result) ->
let off = locationFromOffset br offPrimary
offPrimary = sum $ take i allPrimaries
in addResultOffset off result
allTranslatedResults = flip evalState 0 $ for allResults $ \result -> do
offPrimary <- get
put $ offPrimary + (result ^. imageL . to (imagePrimary br))
pure $ addResultOffset (locationFromOffset br offPrimary) result
-- Determine the secondary dimension value to pad to. In a
-- vertical box we want all images to be the same width to
-- avoid attribute over-runs or blank spaces with the wrong