Add zooming to images

index.html

@@ -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 {

src/Logic.purs

@@ -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

src/Model.purs

@@ -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

src/UI.purs

@@ -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 :: forall m. Boolean -> Image -> H.ComponentHTML Event () m
-renderFocused image =
+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
+                 case image.full of
-                <> maybe "" backgroundUrl (image.blurhashUrl)
+                    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))))