@@ -70,26 +70,24 @@ virtualListWithSelection heightPx rowPx maxIndex i0 setI listTag listAttrs rowTa
7070 preItems = min startingIndex numItems
7171 in (topPx - preItems * sizeIncrement, (startingIndex - preItems, preItems + numItems * 2))
7272
73−{-# NOINLINE virtualList #-}
7473virtualList :: forall t m k v a. (MonadWidget t m, Ord k)
75− => Dynamic t Int -- ^ The height of the visible region in pixels
76− -> Int -- ^ The height of each row in pixels
77− -> Dynamic t Int -- ^ The total number of items
74+ => Dynamic t Int -- ^ A 'Dynamic' of the visible region's height in pixels
75+ -> Int -- ^ The fixed height of each row in pixels
76+ -> Dynamic t Int -- ^ A 'Dynamic' of the total number of items
7877 -> Int -- ^ The index of the row to scroll to on initialization
7978 -> Event t Int -- ^ An 'Event' containing a row index. Used to scroll to the given index.
80− -> (k -> Int) -- ^ Index to Key function, used to determine position of Map elements
79+ -> (k -> Int) -- ^ Key to Index function, used to position items.
8180 -> Map k v -- ^ The initial 'Map' of items
82− -> Event t (Map k (Maybe v)) -- ^ The update 'Event'
83− -> (k -> v -> Event t v -> m a) -- ^ The row child element builder
84− -> m (Dynamic t (Int, Int), Dynamic t (Map k a)) -- ^ A tuple containing: a 'Dynamic' of the index (based on the current scroll position) and number of items currently being rendered, and the Dynamic list result
85−virtualList heightPx rowPx maxIndex i0 setI keyToIndex items0 itemUpdate itemBuilder = do
86− totalHeightStyle <- mapDyn (toHeightStyle . (*) rowPx) maxIndex
87− containerStyle <- mapDyn toContainer heightPx
88− viewportStyle <- mapDyn toViewport heightPx
81+ -> Event t (Map k (Maybe v)) -- ^ The update 'Event'. Nothing values are removed from the list and Just values are added or updated.
82+ -> (k -> v -> Event t v -> m a) -- ^ The row child element builder.
83+ -> m (Dynamic t (Int, Int), Dynamic t (Map k a)) -- ^ A tuple containing: a 'Dynamic' of the index (based on the current scroll position) and number of items currently being rendered, and the 'Dynamic' list result
84+virtualList heightPx rowPx maxIndex i0 setI keyToIndex items0 itemsUpdate itemBuilder = do
85+ virtualH <- mapDyn (mkVirtualHeight . (*) rowPx) maxIndex
86+ containerStyle <- mapDyn mkContainer heightPx
87+ viewportStyle <- mapDyn mkViewport heightPx
8988 pb <- getPostBuild
90− rec (viewport, result) <- elDynAttr "div" containerStyle $ elDynAttr' "div" viewportStyle $ do
91− elDynAttr "div" totalHeightStyle $ listWithKeyShallowDiff items0 itemUpdate $ \k v e -> do
92− elAttr "div" (toStyleAttr $ ("height" =: (show rowPx <> "px") <> "top" =: ((<>"px") $ show $ keyToIndex k * rowPx) <> "position" =: "absolute" <> "width" =: "100%")) $ itemBuilder k v e
89+ rec (viewport, result) <- elDynAttr "div" containerStyle $ elDynAttr' "div" viewportStyle $ elDynAttr "div" virtualH $
90+ listWithKeyShallowDiff items0 itemsUpdate $ \k v e -> elAttr "div" (mkRow k) $ itemBuilder k v e
9391 scrollPosition <- holdDyn 0 $ leftmost [ domEvent Scroll viewport
9492 , fmap (const (i0 * rowPx)) pb
9593 ]
@@ -98,11 +96,44 @@ virtualList heightPx rowPx maxIndex i0 setI keyToIndex items0 itemUpdate itemBui
9896 return (nubDyn window, result)
9997 where
10098 toStyleAttr m = "style" =: (Map.foldWithKey (\k v s -> k <> ":" <> v <> ";" <> s) "" m)
101− toViewport h = toStyleAttr $ "overflow" =: "auto" <> "position" =: "absolute" <>
99+ mkViewport h = toStyleAttr $ "overflow" =: "auto" <> "position" =: "absolute" <>
102100 "left" =: "0" <> "right" =: "0" <> "height" =: (show h <> "px")
103− toContainer h = toStyleAttr $ "position" =: "relative" <> "height" =: (show h <> "px")
104− toHeightStyle h = toStyleAttr ("height" =: (show h <> "px") <> "overflow" =: "hidden" <> "position" =: "relative")
101+ mkContainer h = toStyleAttr $ "position" =: "relative" <> "height" =: (show h <> "px")
102+ mkVirtualHeight h = let h' = h * rowPx
103+ in toStyleAttr $ "height" =: (show h <> "px") <>
104+ "overflow" =: "hidden" <>
105+ "position" =: "relative"
106+ mkRow k = toStyleAttr $ "height" =: (show rowPx <> "px") <>
107+ "top" =: ((<>"px") $ show $ keyToIndex k * rowPx) <>
108+ "position" =: "absolute" <>
109+ "width" =: "100%"
105110 findWindow windowSize sizeIncrement startingPosition =
106111 let (startingIndex, topOffsetPx) = startingPosition `divMod'` sizeIncrement
107112 numItems = (windowSize + sizeIncrement - 1) `div` sizeIncrement
108113 in (startingIndex, numItems)
114+
115+virtualListBuffered
116+ :: (Ord k, MonadWidget t m)
117+ => Int
118+ -> Dynamic t Int
119+ -> Int
120+ -> Dynamic t Int
121+ -> Int
122+ -> Event t Int
123+ -> (k -> Int)
124+ -> Map k v
125+ -> Event t (Map k (Maybe v))
126+ -> (k -> v -> Event t v -> m a)
127+ -> m (Event t (Int, Int), Dynamic t (Map k a))
128+virtualListBuffered buffer heightPx rowPx maxIndex i0 setI keyToIndex items0 itemsUpdate itemBuilder = do
129+ (win, m) <- virtualList heightPx rowPx maxIndex i0 setI keyToIndex items0 itemsUpdate itemBuilder
130+ pb <- getPostBuild
131+ let extendWin o l = (max 0 (o - l * (buffer-1) `div` 2), l * buffer)
132+ rec let winHitEdge = fmapMaybe id $ attachWith (\(oldOffset, oldLimit) (winOffset, winLimit) ->
133+ if winOffset > oldOffset && winOffset + winLimit < oldOffset + oldLimit
134+ then Nothing
135+ else Just (extendWin winOffset winLimit)) (current winBuffered) (updated win)
136+ winBuffered <- holdDyn (0, 0) $ leftmost [ winHitEdge
137+ , fmap (uncurry extendWin) $ tagDyn win pb
138+ ]
139+ return (updated winBuffered, m)