Add panning buttons

index.html

@@ -67,7 +67,28 @@ p {
 	background: rgba(0, 0, 0, 60%);
 	height: 100%;
 	width: 100%;
+	z-index: -2;
+}
+#focused-controls {
+	height: 100%;
+	width: 100%;
+	top: 0;
+	left: 0;
+}
+#prev-image, #next-image {
 	z-index: -1;
+	position: fixed;
+	height: fit-content;
+	font-size: 70px;
+	top: 0;
+	bottom: 0;
+	margin: auto 0;
+}
+#prev-image {
+	left: 10vw;
+}
+#next-image {
+	right: 10vw;
 }
 #focused-panel.unzoomed > div.blurhash-frame {
 	max-height: 80vh;

src/UI.purs

@@ -10,7 +10,7 @@ import Aviary.Model ( GalleryError(..)
                     )
 
 import Control.Parallel (parSequence_)
-import Data.Array (index, mapWithIndex, modifyAt)
+import Data.Array (index, length, mapWithIndex, modifyAt)
 import Data.Maybe (fromMaybe, maybe, Maybe(..))
 import Effect.Aff (Aff)
 import Halogen as H
@@ -26,6 +26,9 @@ data Event = LoadThumbs
     | Unfocus
     | Zoom
     | Unzoom
+    | Pan Boolean -- True if right
+    | DownloadFocused
+    | Null
 
 component :: forall query input. Model -> H.Component query input Event Aff
 component initialState = H.mkComponent
@@ -80,6 +83,18 @@ renderFocused zoom image =
             , HE.onClick \_ -> Unfocus
             ]
             []
+        , HH.div
+            [ HP.id "prev-image"
+            , HE.onClick \_ -> Pan false
+            ]
+            [ HH.text "❰"
+            ]
+        , HH.div
+            [ HP.id "next-image"
+            , HE.onClick \_ -> Pan true
+            ]
+            [ HH.text "❱"
+            ]
         , HH.div
             [ HP.style
                  case image.full of
@@ -148,15 +163,7 @@ update (Focus imageIndex) =  do
     _ <- H.modify_ \model -> case model of
         GError e -> GError e
         GLoaded gal -> GLoaded gal{ focus = Just { imageIndex, zoom: false } }
-    model <- H.get
+    update DownloadFocused
-    case model of
-        GError _ -> pure unit
-        GLoaded gal ->
-            let focusedImage = index gal.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!"
 update Unfocus = H.modify_ \model -> case model of
     GError e -> GError e
     GLoaded gal -> GLoaded gal { focus = Nothing }
@@ -166,6 +173,27 @@ 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
+    _ <- 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)
+                }
+            }
+    update DownloadFocused
+update DownloadFocused = 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!"
+        _ -> pure unit
+update Null = pure unit
 
 
 render :: forall m. Model -> H.ComponentHTML Event () m
@@ -175,6 +203,11 @@ render (GError e) = HH.div
     [ HH.p_ [ HH.text $ show e ]
     ]
 render (GLoaded {title, desc, images, focus}) = HH.div_
+    -- [ HE.onKeyDown \e -> Log $ E.key e -- case E.key e of
+    --     -- "ArrowRight" -> Pan true
+    --     -- "ArrowLeft" -> Pan false
+    -- ]
+    -- Pending https://github.com/purescript-halogen/purescript-halogen/issues/806
     ((maybe [] (HH.text >>> pure >>> HH.h1_ >>> pure) title) <>
     (maybe [] (HH.text >>> pure >>> HH.p_ >>> pure) desc)    <>
     [ HH.div