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, bimap >= 0.5 && < 0.6,
data-clist >= 0.1, data-clist >= 0.1,
directory >= 1.2.5.0, directory >= 1.2.5.0,
dlist,
exceptions >= 0.10.0, exceptions >= 0.10.0,
filepath, filepath,
containers >= 0.5.7, containers >= 0.5.7,

View File

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