Fix #115: Add keyboard navigation to media viewer.
This commit is contained in:
Nicolas Perriault
parent
7c602100a5
commit
885e0194c5
|
|
@ -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",
|
||||
|
|
|
|||
|
|
@ -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
|
||||
]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 } ! []
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ! []
|
||||
|
|
|
|||
|
|
@ -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
|
||||
]
|
||||
|
|
|
|||
|
|
@ -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…
Reference in New Issue