From 885e0194c5450cf09d47817671f3a37e04643f58 Mon Sep 17 00:00:00 2001 From: Nicolas Perriault Date: Thu, 13 Jul 2017 17:34:00 +0200 Subject: [PATCH] Fix #115: Add keyboard navigation to media viewer. --- elm-package.json | 1 + src/Subscription.elm | 5 +++++ src/Types.elm | 4 ++++ src/Update/Main.elm | 17 +++++++++++++++++ src/Update/Viewer.elm | 39 ++++++++++++++++++++++++++++++++++++++- src/View/Viewer.elm | 18 +++++++----------- tests/elm-package.json | 1 + 7 files changed, 73 insertions(+), 12 deletions(-) diff --git a/elm-package.json b/elm-package.json index 1855ba5..1b43701 100644 --- a/elm-package.json +++ b/elm-package.json @@ -16,6 +16,7 @@ "elm-lang/dom": "1.1.1 <= v < 2.0.0", "elm-lang/html": "2.0.0 <= v < 3.0.0", "elm-lang/http": "1.0.0 <= v < 2.0.0", + "elm-lang/keyboard": "1.0.1 <= v < 2.0.0", "elm-lang/navigation": "2.1.0 <= v < 3.0.0", "elm-lang/websocket": "1.0.2 <= v < 2.0.0", "evancz/url-parser": "2.0.1 <= v < 3.0.0", diff --git a/src/Subscription.elm b/src/Subscription.elm index bc70101..fe16ecc 100644 --- a/src/Subscription.elm +++ b/src/Subscription.elm @@ -1,6 +1,7 @@ module Subscription exposing (subscriptions) import Autocomplete +import Keyboard import Mastodon.WebSocket import Ports import Time @@ -44,6 +45,9 @@ subscriptions { clients, currentView } = uploadErrorSub = Ports.uploadError (DraftEvent << UploadError) + + keyDownsSub = + Keyboard.downs KeyMsg in Sub.batch [ timeSub @@ -52,4 +56,5 @@ subscriptions { clients, currentView } = , autoCompleteSub , uploadSuccessSub , uploadErrorSub + , keyDownsSub ] diff --git a/src/Types.elm b/src/Types.elm index 0611dea..c387111 100644 --- a/src/Types.elm +++ b/src/Types.elm @@ -1,6 +1,7 @@ module Types exposing (..) import Autocomplete +import Keyboard import Mastodon.Http exposing (Response, Links) import Mastodon.Model exposing (..) import Navigation @@ -34,6 +35,8 @@ type DraftMsg type ViewerMsg = CloseViewer | OpenViewer (List Attachment) Attachment + | PrevAttachment + | NextAttachment type alias MastodonResult a = @@ -99,6 +102,7 @@ type Msg | DraftEvent DraftMsg | FilterNotifications NotificationFilter | FollowAccount Account + | KeyMsg Keyboard.KeyCode | LogoutClient Client | TimelineLoadNext String String | MastodonEvent MastodonMsg diff --git a/src/Update/Main.elm b/src/Update/Main.elm index c2dfa7d..309573e 100644 --- a/src/Update/Main.elm +++ b/src/Update/Main.elm @@ -55,6 +55,23 @@ update msg model = } ! [] + KeyMsg code -> + case ( code, model.viewer ) of + ( 27, Just _ ) -> + -- Esc + update (ViewerEvent CloseViewer) model + + ( 37, Just _ ) -> + -- Left arrow + update (ViewerEvent PrevAttachment) model + + ( 39, Just _ ) -> + -- Right arrow + update (ViewerEvent NextAttachment) model + + _ -> + model ! [] + ClearError index -> { model | errors = removeAt index model.errors } ! [] diff --git a/src/Update/Viewer.elm b/src/Update/Viewer.elm index cb068fc..58dccb0 100644 --- a/src/Update/Viewer.elm +++ b/src/Update/Viewer.elm @@ -1,8 +1,19 @@ -module Update.Viewer exposing (update) +module Update.Viewer exposing (getPrevNext, update) +import List.Extra exposing (elemIndex, getAt) +import Mastodon.Model exposing (..) import Types exposing (..) +getPrevNext : Viewer -> ( Maybe Attachment, Maybe Attachment ) +getPrevNext { attachments, attachment } = + let + index = + Maybe.withDefault -1 <| elemIndex attachment attachments + in + ( getAt (index - 1) attachments, getAt (index + 1) attachments ) + + update : ViewerMsg -> Maybe Viewer -> ( Maybe Viewer, Cmd Msg ) update viewerMsg viewer = case viewerMsg of @@ -11,3 +22,29 @@ update viewerMsg viewer = OpenViewer attachments attachment -> (Just <| Viewer attachments attachment) ! [] + + PrevAttachment -> + case viewer of + Just viewer -> + case getPrevNext viewer of + ( Just prev, _ ) -> + (Just <| Viewer viewer.attachments prev) ! [] + + _ -> + Just viewer ! [] + + Nothing -> + viewer ! [] + + NextAttachment -> + case viewer of + Just viewer -> + case getPrevNext viewer of + ( _, Just next ) -> + (Just <| Viewer viewer.attachments next) ! [] + + _ -> + Just viewer ! [] + + Nothing -> + viewer ! [] diff --git a/src/View/Viewer.elm b/src/View/Viewer.elm index fa7bee2..6013d7a 100644 --- a/src/View/Viewer.elm +++ b/src/View/Viewer.elm @@ -2,21 +2,18 @@ module View.Viewer exposing (viewerView) import Html exposing (..) import Html.Attributes exposing (..) -import List.Extra exposing (find, elemIndex, getAt) import Types exposing (..) +import Update.Viewer exposing (getPrevNext) import View.Events exposing (..) viewerView : Viewer -> Html Msg -viewerView { attachments, attachment } = +viewerView ({ attachments, attachment } as viewer) = let - index = - Maybe.withDefault -1 <| elemIndex attachment attachments - ( prev, next ) = - ( getAt (index - 1) attachments, getAt (index + 1) attachments ) + getPrevNext viewer - navLink label className target = + navLink label className target event = case target of Nothing -> text "" @@ -25,8 +22,7 @@ viewerView { attachments, attachment } = a [ href "" , class className - , onClickWithPreventAndStop <| - ViewerEvent (OpenViewer attachments target) + , onClickWithPreventAndStop event ] [ text label ] in @@ -36,7 +32,7 @@ viewerView { attachments, attachment } = , onClickWithPreventAndStop <| ViewerEvent CloseViewer ] [ span [ class "close" ] [ text "×" ] - , navLink "❮" "prev" prev + , navLink "❮" "prev" prev <| ViewerEvent NextAttachment , case attachment.type_ of "image" -> img [ class "viewer-content", src attachment.url ] [] @@ -49,5 +45,5 @@ viewerView { attachments, attachment } = , loop True ] [ source [ src attachment.url ] [] ] - , navLink "❯" "next" next + , navLink "❯" "next" next <| ViewerEvent NextAttachment ] diff --git a/tests/elm-package.json b/tests/elm-package.json index 54c8e0c..fb55aef 100644 --- a/tests/elm-package.json +++ b/tests/elm-package.json @@ -23,6 +23,7 @@ "elm-lang/dom": "1.1.1 <= v < 2.0.0", "elm-lang/html": "2.0.0 <= v < 3.0.0", "elm-lang/http": "1.0.0 <= v < 2.0.0", + "elm-lang/keyboard": "1.0.1 <= v < 2.0.0", "elm-lang/navigation": "2.1.0 <= v < 3.0.0", "elm-lang/websocket": "1.0.2 <= v < 2.0.0", "evancz/url-parser": "2.0.1 <= v < 3.0.0",