From 5ca93955bdcdcae7c49d9fd79e58d12aa5ec31d6 Mon Sep 17 00:00:00 2001
From: Emi Simpson <emi@alchemi.dev>
Date: Tue, 15 Nov 2022 14:35:50 -0500
Subject: [PATCH] Add some keybindings

Left -> view prev image
Right -> view next image
Escape -> close viewed image
1 -> focus the first image of the gallery
---
 spago.dhall |  1 +
 src/UI.purs | 33 +++++++++++++++++++++++++--------
 2 files changed, 26 insertions(+), 8 deletions(-)

diff --git a/spago.dhall b/spago.dhall
index 3b57475..33af8a0 100644
--- a/spago.dhall
+++ b/spago.dhall
@@ -36,6 +36,7 @@ to generate this file without the comments in this block.
   , "transformers"
   , "web-file"
   , "web-html"
+  , "web-uievents"
   ]
 , packages = ./packages.dhall
 , sources = [ "src/**/*.purs", "test/**/*.purs" ]
diff --git a/src/UI.purs b/src/UI.purs
index 529c34d..0bb532e 100644
--- a/src/UI.purs
+++ b/src/UI.purs
@@ -17,7 +17,13 @@ import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
+import Halogen.Query.Event (eventListener)
+import Web.HTML (window) as Web
 import Web.HTML.Common (ClassName(..))
+import Web.HTML.HTMLDocument as HTMLDocument
+import Web.HTML.Window (document) as Web
+import Web.UIEvent.KeyboardEvent as KE
+import Web.UIEvent.KeyboardEvent.EventTypes as KET
 
 data Event = LoadThumbs
     | ThumbLoaded Int ImageData
@@ -28,13 +34,14 @@ data Event = LoadThumbs
     | Unzoom
     | Pan Boolean -- True if right
     | DownloadFocused
-    | Null
+    | Init
+    | RegisterListeners
 
 component :: forall query input. Model -> H.Component query input Event Aff
 component initialState = H.mkComponent
     { initialState: \_ -> initialState
     , render
-    , eval: H.mkEval $ H.defaultEval { handleAction = update, initialize = Just LoadThumbs }
+    , eval: H.mkEval $ H.defaultEval { handleAction = update, initialize = Just Init }
     }
 
 backgroundUrl :: String -> String
@@ -159,7 +166,23 @@ fetchFullAction position image = do
     newData <- H.liftAff $ fetchFull image
     update $ FullLoaded position newData
 
+eventByKey :: KE.KeyboardEvent -> Maybe Event
+eventByKey ev = case KE.key ev of
+    "ArrowLeft" -> Just $ Pan false
+    "ArrowRight" -> Just $ Pan true
+    "Escape" -> Just $ Unfocus
+    "1" -> Just $ Focus 0
+    _ -> Nothing
+
 update :: Event -> H.HalogenM Model Event () Event Aff Unit
+update Init = update RegisterListeners <> update LoadThumbs
+update RegisterListeners = do
+    document <- H.liftEffect $ Web.document =<< Web.window
+    H.subscribe' \_ ->
+      eventListener
+        KET.keydown
+        (HTMLDocument.toEventTarget document)
+        (KE.fromEvent >>> (=<<) eventByKey)
 update LoadThumbs = do
     model <- H.get
     case model of
@@ -201,7 +224,6 @@ update DownloadFocused = do
                 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
@@ -211,11 +233,6 @@ 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