Browse Source

Fix #115: Add keyboard navigation to media viewer.

master
Nicolas Perriault 5 years ago
parent
commit
885e0194c5
No known key found for this signature in database GPG Key ID: DA5E4C83904F7A2A
  1. 1
      elm-package.json
  2. 5
      src/Subscription.elm
  3. 4
      src/Types.elm
  4. 17
      src/Update/Main.elm
  5. 39
      src/Update/Viewer.elm
  6. 18
      src/View/Viewer.elm
  7. 1
      tests/elm-package.json

1
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",

5
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
]

4
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

17
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 } ! []

39
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 ! []

18
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
]

1
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",

Loading…
Cancel
Save