Preload images adjacent to the currently viewed image

This commit is contained in:
Emi Simpson 2022-11-15 17:59:33 -05:00
parent 5ca93955bd
commit 4530c347a5
Signed by: Emi
GPG Key ID: A12F2C2FFDC3D847
2 changed files with 23 additions and 13 deletions

View File

@ -34,6 +34,7 @@ to generate this file without the comments in this block.
, "strings"
, "subtlecrypto"
, "transformers"
, "tuples"
, "web-file"
, "web-html"
, "web-uievents"

View File

@ -10,8 +10,9 @@ import Aviary.Model ( GalleryError(..)
)
import Control.Parallel (parSequence_)
import Data.Array (index, length, mapWithIndex, modifyAt)
import Data.Array (index, length, mapMaybe, mapWithIndex, modifyAt)
import Data.Maybe (fromMaybe, maybe, Maybe(..))
import Data.Tuple (uncurry, Tuple(..))
import Effect.Aff (Aff)
import Halogen as H
import Halogen.HTML as HH
@ -33,7 +34,7 @@ data Event = LoadThumbs
| Zoom
| Unzoom
| Pan Boolean -- True if right
| DownloadFocused
| DownloadImages (Array Int)
| Init
| RegisterListeners
@ -174,6 +175,10 @@ eventByKey ev = case KE.key ev of
"1" -> Just $ Focus 0
_ -> Nothing
focusedIndex :: Model -> Maybe Int
focusedIndex (GLoaded { focus: Just { imageIndex } }) = Just imageIndex
focusedIndex _ = Nothing
update :: Event -> H.HalogenM Model Event () Event Aff Unit
update Init = update RegisterListeners <> update LoadThumbs
update RegisterListeners = do
@ -194,7 +199,8 @@ update (Focus imageIndex) = do
_ <- H.modify_ \model -> case model of
GError e -> GError e
GLoaded gal -> GLoaded gal{ focus = Just { imageIndex, zoom: false } }
update DownloadFocused
_ <- update $ DownloadImages [imageIndex]
update $ DownloadImages [imageIndex - 1, imageIndex + 1]
update Unfocus = H.modify_ \model -> case model of
GError e -> GError e
GLoaded gal -> GLoaded gal { focus = Nothing }
@ -204,25 +210,28 @@ update Zoom = H.modify_ \model -> case model of
update Unzoom = H.modify_ \model -> case model of
GError e -> GError e
GLoaded gal -> GLoaded gal { focus = gal.focus <#> _{ zoom = false } }
update (Pan right) = do
update (Pan right) = let offset = if right then 1 else -1 in do
_ <- H.modify_ \model -> case model of
GError e -> GError e
GLoaded gal -> GLoaded gal
{ focus = gal.focus <#> \foc ->
foc{ imageIndex =
mod (foc.imageIndex + (if right then 1 else -1)) (length gal.images)
mod (foc.imageIndex + offset) (length gal.images)
}
}
update DownloadFocused
update DownloadFocused = do
focus <- H.get <#> focusedIndex
let generateIndicies :: Int -> Array Int
generateIndicies = pure >>> (<*>) [identity, (+) offset]
let maybeEvent = focus <#> generateIndicies <#> DownloadImages
maybe (pure unit) update maybeEvent
update (DownloadImages indicies) = do
model <- H.get
case model of
GLoaded {images, focus: Just {imageIndex}} ->
let focusedImage = index images imageIndex
in case focusedImage of
Just focusedImage' -> fetchFullAction imageIndex focusedImage'
Nothing ->
H.put $ GError $ UnexpectedError "Focus event raised with an out of bounds index!"
GLoaded { images } ->
parSequence_ $ indicies
# (<$>) (\i -> mod i (length images))
# mapMaybe (\i -> index images i <#> Tuple i)
<#> uncurry fetchFullAction
_ -> pure unit