Add some keybindings
Left -> view prev image Right -> view next image Escape -> close viewed image 1 -> focus the first image of the gallery
This commit is contained in:
parent
8c5e4591a6
commit
5ca93955bd
|
@ -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" ]
|
||||
|
|
33
src/UI.purs
33
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
|
||||
|
|
Loading…
Reference in New Issue