Add zooming to images

This commit is contained in:
Emi Simpson 2022-11-11 17:27:58 -05:00
parent 387e7d1b47
commit 156c703d3d
Signed by: Emi
GPG key ID: A12F2C2FFDC3D847
4 changed files with 59 additions and 18 deletions

View file

@ -45,16 +45,32 @@ body {
left: 0;
height: 100%;
width: 100%;
background: rgba(0, 0, 0, 60%);
display: grid;
justify-items: center;
align-items: center;
box-sizing: border-box;
overflow: auto;
}
#focused-panel > img {
#focused-bg {
position: fixed;
top: 0;
left: 0;
background: rgba(0, 0, 0, 60%);
height: 100%;
width: 100%;
z-index: -1;
}
#focused-panel.unzoomed > div.blurhash-frame {
max-height: 80vh;
max-width: 60vw;
}
#focused-panel.unzoomed > div > img {
max-height: 80vh;
max-width: 60vw;
cursor: zoom-in;
}
#focused-panel.zoomed > div > img {
cursor: zoom-out;
padding: 50px;
}
#spinner {

View file

@ -14,7 +14,7 @@ import Fetch (fetch)
import Data.Array (head)
import Data.Base64 (decodeBase64, fromString)
import Data.Either (Either(..), hush, note)
import Data.Maybe (Maybe(..))
import Data.Maybe (fromMaybe, Maybe(..))
import Data.Newtype (unwrap)
import Data.ArrayBuffer.ArrayBuffer (byteLength)
import Data.ArrayBuffer.Builder (DataBuff, execPut, putDataBuff)
@ -60,9 +60,9 @@ convertImageFromProtobuf protoimage = let protoimage' = unwrap protoimage in do
fullUrl <- note (IndexMissingField "images[].full_url") protoimage'.full_url
thumbUrl <- note (IndexMissingField "images[].thumb_url") protoimage'.thumb_url
blurhash <- note (IndexMissingField "images[].blurhash") protoimage'.blurhash
format <- note (IndexMissingField "images[].format") protoimage'.format
width' <- note (IndexMissingField "images[].width") protoimage'.width
height' <- note (IndexMissingField "images[].height") protoimage'.height
let format = fromMaybe Format.Format_WEBP protoimage'.format
let blurhashUrl = decodeBlurhash32 blurhash
let key = hush <$> (importKey =<< liftEffect (databuffToBuffer $ unwrap rawKey))
let thumb = Unloaded thumbUrl

View file

@ -49,11 +49,16 @@ type Image =
, height :: Int
}
type Focus =
{ imageIndex :: Int
, zoom :: Boolean
}
type LoadedGallery =
{ title :: Maybe String
, desc :: Maybe String
, images :: Array Image
, focus :: Maybe Int
, focus :: Maybe Focus
}
data Model

View file

@ -11,7 +11,7 @@ import Aviary.Model ( GalleryError(..)
import Control.Parallel (parSequence_)
import Data.Array (index, mapWithIndex, modifyAt)
import Data.Maybe (maybe, Maybe(..))
import Data.Maybe (fromMaybe, maybe, Maybe(..))
import Effect.Aff (Aff)
import Halogen as H
import Halogen.HTML as HH
@ -24,6 +24,8 @@ data Event = LoadThumbs
| FullLoaded Int ImageData
| Focus Int
| Unfocus
| Zoom
| Unzoom
component :: forall query input. Model -> H.Component query input Event Aff
component initialState = H.mkComponent
@ -67,17 +69,25 @@ renderThumbnail pos image =
[ HH.img [HP.src url]
]
renderFocused :: forall m. Image -> H.ComponentHTML Event () m
renderFocused image =
renderFocused :: forall m. Boolean -> Image -> H.ComponentHTML Event () m
renderFocused zoom image =
HH.div
[ HP.id "focused-panel"
, HE.onClick \_ -> Unfocus
, HP.class_ $ ClassName if zoom then "zoomed" else "unzoomed"
]
[ HH.div
[ HP.id "focused-bg"
, HE.onClick \_ -> Unfocus
]
[]
, HH.div
[ HP.style
( widthHeight image.width image.height
<> maybe "" backgroundUrl (image.blurhashUrl)
)
case image.full of
ILoaded _ -> ""
_ ->
( maybe "" backgroundUrl (image.blurhashUrl)
<> widthHeight image.width image.height
)
, HP.class_ $ ClassName "blurhash-frame"
]
case image.full of
@ -96,7 +106,10 @@ renderFocused image =
]
]
ILoaded url ->
[ HH.img [HP.src url]
[ HH.img
[ HP.src url
, HE.onClick \_ -> if zoom then Unzoom else Zoom
]
]
]
@ -131,22 +144,29 @@ update LoadThumbs = do
GLoaded {images} -> parSequence_ $ mapWithIndex fetchThumbAction images
update (ThumbLoaded pos newData) = H.modify_ $ setThumb newData pos
update (FullLoaded pos newData) = H.modify_ $ setFull newData pos
update (Focus newFocus) = do
update (Focus imageIndex) = do
_ <- H.modify_ \model -> case model of
GError e -> GError e
GLoaded gal -> GLoaded gal{ focus = Just newFocus }
GLoaded gal -> GLoaded gal{ focus = Just { imageIndex, zoom: false } }
model <- H.get
case model of
GError _ -> pure unit
GLoaded gal ->
let focusedImage = index gal.images newFocus
let focusedImage = index gal.images imageIndex
in case focusedImage of
Just focusedImage' -> fetchFullAction newFocus focusedImage'
Just focusedImage' -> fetchFullAction imageIndex focusedImage'
Nothing ->
H.put $ GError $ UnexpectedError "Focus event raised with an out of bounds index!"
update Unfocus = H.modify_ \model -> case model of
GError e -> GError e
GLoaded gal -> GLoaded gal { focus = Nothing }
update Zoom = H.modify_ \model -> case model of
GError e -> GError e
GLoaded gal -> GLoaded gal { focus = gal.focus <#> _{ zoom = true } }
update Unzoom = H.modify_ \model -> case model of
GError e -> GError e
GLoaded gal -> GLoaded gal { focus = gal.focus <#> _{ zoom = false } }
render :: forall m. Model -> H.ComponentHTML Event () m
render (GError e) = HH.div
@ -162,4 +182,4 @@ render (GLoaded {title, desc, images, focus}) = HH.div_
]
(mapWithIndex renderThumbnail images)
] <>
(maybe [] (renderFocused >>> pure) (index images =<< focus)))
(maybe [] (renderFocused (fromMaybe false (_.zoom <$> focus)) >>> pure) (index images =<< (_.imageIndex <$> focus))))