Remove DOM, adds support for thumbnails

This commit is contained in:
Thomas Forgione 2021-06-15 11:34:44 +02:00
parent b4705905e1
commit 638faccdb0
5 changed files with 85 additions and 13 deletions

View File

@ -6,7 +6,6 @@
"elm-version": "0.19.1",
"dependencies": {
"direct": {
"K-Adam/elm-dom": "1.0.0",
"andrewMacmurray/elm-simple-animation": "2.1.0",
"elm/browser": "1.0.2",
"elm/core": "1.0.5",

View File

@ -1,7 +1,6 @@
module Events exposing (player, seekBar, subs, video)
import Browser.Events
import DOM as Dom
import Element
import Html
import Html.Attributes
@ -73,26 +72,29 @@ seekBar : Video -> List (Element.Attribute Video.Msg)
seekBar model =
List.map Element.htmlAttribute
[ Html.Events.on "click" (decodeSeek model)
, Html.Events.on "mouseenter" decodeMouseEnter
, Html.Events.on "mouseleave" decodeMouseLeave
, Html.Events.on "mousemove" decodeMouseEnter
]
decodeDurationChanged : Decode.Decoder Video.Msg
decodeDurationChanged =
Dom.target <|
Decode.field "target" <|
Decode.map Video.NowHasDuration
(Decode.field "duration" Decode.float)
decodePosition : Decode.Decoder Video.Msg
decodePosition =
Dom.target <|
Decode.field "target" <|
Decode.map Video.NowAtPosition
(Decode.field "currentTime" Decode.float)
decodeVolumeChange : Decode.Decoder Video.Msg
decodeVolumeChange =
Dom.target <|
Decode.field "target" <|
Decode.map2 Video.NowAtVolume
(Decode.field "volume" Decode.float)
(Decode.field "muted" Decode.bool)
@ -102,15 +104,15 @@ decodeSeek : Video -> Decode.Decoder Video.Msg
decodeSeek model =
Decode.map2 (\x y -> Video.Seek (toFloat x / toFloat y * model.duration))
(Decode.field "layerX" Decode.int)
(Dom.target <| Decode.field "offsetWidth" Decode.int)
(Decode.field "target" <| Decode.field "offsetWidth" Decode.int)
decodeProgress : Decode.Decoder Video.Msg
decodeProgress =
decodeTimeRanges
|> Decode.field "asArray"
|> Decode.field "polymnyVideoAsArray"
|> Decode.field "buffered"
|> Dom.target
|> Decode.field "target"
|> Decode.map Video.NowLoaded
@ -131,14 +133,14 @@ decodeFullscreenChange =
Decode.value
|> Decode.nullable
|> Decode.field "fullscreenElement"
|> Decode.field "document"
|> Dom.target
|> Decode.field "polymnyVideoDocument"
|> Decode.field "target"
|> Decode.map (\x -> Video.NowIsFullscreen (x /= Nothing))
decodeVideoResize : Decode.Decoder Video.Msg
decodeVideoResize =
Dom.target <|
Decode.field "target" <|
Decode.map2 (\x y -> Video.NowHasSize ( x, y ))
(Decode.field "videoWidth" Decode.int)
(Decode.field "videoHeight" Decode.int)
@ -146,11 +148,23 @@ decodeVideoResize =
decodePlaybackRateChange : Decode.Decoder Video.Msg
decodePlaybackRateChange =
Dom.target <|
Decode.field "target" <|
Decode.map Video.NowHasPlaybackRate
(Decode.field "playbackRate" Decode.float)
decodeMouseEnter : Decode.Decoder Video.Msg
decodeMouseEnter =
Decode.map2 (\x y -> Video.NowHasMiniature (Just ( x, y )))
(Decode.field "offsetX" Decode.int)
(Decode.field "target" <| Decode.field "offsetWidth" Decode.int)
decodeMouseLeave : Decode.Decoder Video.Msg
decodeMouseLeave =
Decode.succeed (Video.NowHasMiniature Nothing)
decodeKeyDown : Video -> Decode.Decoder Video.Msg
decodeKeyDown model =
Decode.field "keyCode" Decode.int

View File

@ -2,7 +2,6 @@ module Main exposing (..)
import Browser
import Browser.Events
import DOM as Dom
import Element exposing (Element)
import Element.Background as Background
import Element.Border as Border

View File

@ -35,6 +35,7 @@ type alias Video =
, showSettings : Bool
, subtitles : List SubtitleTrack
, subtitleTrack : Maybe SubtitleTrack
, showMiniature : Maybe ( Int, Int )
}
@ -58,6 +59,7 @@ fromUrl url =
, showSettings = False
, subtitles = []
, subtitleTrack = Nothing
, showMiniature = Nothing
}
@ -105,6 +107,7 @@ type Msg
| NowHasPlaybackRate Float
| NowHasSubtitles (List SubtitleTrack)
| NowHasSubtitleTrack (Maybe SubtitleTrack)
| NowHasMiniature (Maybe ( Int, Int ))
update : Msg -> Video -> ( Video, Cmd Msg )
@ -192,6 +195,9 @@ update msg model =
NowHasSubtitleTrack track ->
( { model | subtitleTrack = track }, Cmd.none )
NowHasMiniature miniature ->
( { model | showMiniature = miniature }, Cmd.none )
port polymnyVideoInit : String -> Cmd msg

View File

@ -101,6 +101,60 @@ embed screenSize model =
)
Element.none
)
, Element.above
(case model.showMiniature of
Just ( position, size ) ->
let
relativePosition =
toFloat position / toFloat size
percentage =
String.fromFloat (relativePosition * 100) ++ "%"
miniatureId =
round (relativePosition * 100)
miniatureIdString =
"miniature-" ++ String.padLeft 3 '0' (String.fromInt miniatureId) ++ ".png"
miniatureUrl =
model.url
|> String.split "/"
|> List.reverse
|> List.drop 1
|> (\list -> miniatureIdString :: list)
|> List.reverse
|> String.join "/"
rightPosition =
(position - 180 - 6)
|> max 0
|> min (size - 360 - 28)
|> toFloat
in
Element.column
[ Element.moveRight rightPosition
, Element.spacing 10
]
[ Element.image
[ Border.color (Element.rgb 1 1 1)
, Border.width 2
]
{ src = miniatureUrl, description = "miniature" }
, Element.el
[ Element.centerX
, Font.shadow
{ offset = ( 0, 0 )
, blur = 4
, color = Element.rgb 0 0 0
}
]
(Element.text (formatTime (relativePosition * model.duration)))
]
_ ->
Element.none
)
]
[ Element.el
[ Background.color (Element.rgba 1 0 0 0.75)