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"
|
, "transformers"
|
||||||
, "web-file"
|
, "web-file"
|
||||||
, "web-html"
|
, "web-html"
|
||||||
|
, "web-uievents"
|
||||||
]
|
]
|
||||||
, packages = ./packages.dhall
|
, packages = ./packages.dhall
|
||||||
, sources = [ "src/**/*.purs", "test/**/*.purs" ]
|
, 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 as HH
|
||||||
import Halogen.HTML.Events as HE
|
import Halogen.HTML.Events as HE
|
||||||
import Halogen.HTML.Properties as HP
|
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.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
|
data Event = LoadThumbs
|
||||||
| ThumbLoaded Int ImageData
|
| ThumbLoaded Int ImageData
|
||||||
|
@ -28,13 +34,14 @@ data Event = LoadThumbs
|
||||||
| Unzoom
|
| Unzoom
|
||||||
| Pan Boolean -- True if right
|
| Pan Boolean -- True if right
|
||||||
| DownloadFocused
|
| DownloadFocused
|
||||||
| Null
|
| Init
|
||||||
|
| RegisterListeners
|
||||||
|
|
||||||
component :: forall query input. Model -> H.Component query input Event Aff
|
component :: forall query input. Model -> H.Component query input Event Aff
|
||||||
component initialState = H.mkComponent
|
component initialState = H.mkComponent
|
||||||
{ initialState: \_ -> initialState
|
{ initialState: \_ -> initialState
|
||||||
, render
|
, render
|
||||||
, eval: H.mkEval $ H.defaultEval { handleAction = update, initialize = Just LoadThumbs }
|
, eval: H.mkEval $ H.defaultEval { handleAction = update, initialize = Just Init }
|
||||||
}
|
}
|
||||||
|
|
||||||
backgroundUrl :: String -> String
|
backgroundUrl :: String -> String
|
||||||
|
@ -159,7 +166,23 @@ fetchFullAction position image = do
|
||||||
newData <- H.liftAff $ fetchFull image
|
newData <- H.liftAff $ fetchFull image
|
||||||
update $ FullLoaded position newData
|
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 :: 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
|
update LoadThumbs = do
|
||||||
model <- H.get
|
model <- H.get
|
||||||
case model of
|
case model of
|
||||||
|
@ -201,7 +224,6 @@ update DownloadFocused = do
|
||||||
Nothing ->
|
Nothing ->
|
||||||
H.put $ GError $ UnexpectedError "Focus event raised with an out of bounds index!"
|
H.put $ GError $ UnexpectedError "Focus event raised with an out of bounds index!"
|
||||||
_ -> pure unit
|
_ -> pure unit
|
||||||
update Null = pure unit
|
|
||||||
|
|
||||||
|
|
||||||
render :: forall m. Model -> H.ComponentHTML Event () m
|
render :: forall m. Model -> H.ComponentHTML Event () m
|
||||||
|
@ -211,11 +233,6 @@ render (GError e) = HH.div
|
||||||
[ HH.p_ [ HH.text $ show e ]
|
[ HH.p_ [ HH.text $ show e ]
|
||||||
]
|
]
|
||||||
render (GLoaded {title, desc, images, focus}) = HH.div_
|
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.h1_ >>> pure) title) <>
|
||||||
(maybe [] (HH.text >>> pure >>> HH.p_ >>> pure) desc) <>
|
(maybe [] (HH.text >>> pure >>> HH.p_ >>> pure) desc) <>
|
||||||
[ HH.div
|
[ HH.div
|
||||||
|
|
Loading…
Reference in New Issue