diff --git a/index.html b/index.html index 3091410..f161478 100644 --- a/index.html +++ b/index.html @@ -42,7 +42,7 @@ let hls; - app.ports.initVideo.subscribe(function(arg) { + app.ports.polymnyVideoInit.subscribe(function(arg) { const video = document.getElementById('video'); if (Hls.isSupported()) { hls = new Hls(); @@ -52,11 +52,11 @@ // Transform available levels into an array of integers (height values). const availableQualities = hls.levels.map((l) => l.height); availableQualities.unshift(0); - app.ports.nowHasQualities.send(availableQualities); + app.ports.polymnyVideoNowHasQualities.send(availableQualities); }); hls.on(Hls.Events.LEVEL_SWITCHED, function (event, data) { - app.ports.nowHasQuality.send({ + app.ports.polymnyVideoNowHasQuality.send({ auto: hls.autoLevelEnabled, height: hls.levels[data.level].height }); @@ -68,7 +68,7 @@ } }); - app.ports.playPause.subscribe(function() { + app.ports.polymnyVideoPlayPause.subscribe(function() { const video = document.getElementById('video'); if (video.paused) { video.play(); @@ -77,26 +77,26 @@ } }); - app.ports.seek.subscribe(function(arg) { + app.ports.polymnyVideoSeek.subscribe(function(arg) { const video = document.getElementById('video'); console.log(arg); video.currentTime = arg; }); - app.ports.requestFullscreen.subscribe(function() { + app.ports.polymnyVideoRequestFullscreen.subscribe(function() { document.getElementById('full').requestFullscreen(); }); - app.ports.exitFullscreen.subscribe(function() { + app.ports.polymnyVideoExitFullscreen.subscribe(function() { document.exitFullscreen(); }); - app.ports.setPlaybackRate.subscribe(function(arg) { + app.ports.polymnyVideoSetPlaybackRate.subscribe(function(arg) { const video = document.getElementById('video'); video.playbackRate = arg; }); - app.ports.setQuality.subscribe(function(arg) { + app.ports.polymnyVideoSetQuality.subscribe(function(arg) { var old = hls.currentLevel; if (arg.auto) { hls.currentLevel = -1; @@ -108,14 +108,14 @@ }); } if (old === hls.currentLevel) { - app.ports.nowHasQuality.send({ + app.ports.polymnyVideoNowHasQuality.send({ auto: hls.autoLevelEnabled, height: hls.currentLevel === -1 ? 0 : hls.levels[hls.currentLevel].height }); } }); - app.ports.setVolume.subscribe(function(arg) { + app.ports.polymnyVideoSetVolume.subscribe(function(arg) { const video = document.getElementById('video'); video.volume = arg.volume; video.muted = arg.muted; diff --git a/src/Events.elm b/src/Events.elm new file mode 100644 index 0000000..b3fece3 --- /dev/null +++ b/src/Events.elm @@ -0,0 +1,190 @@ +module Events exposing (player, seekBar, subs, video) + +import Browser.Events +import DOM as Dom +import Element +import Html +import Html.Attributes +import Html.Events +import Json.Decode as Decode +import Quality +import Video exposing (Video) + + +subs : Video -> Sub Video.Msg +subs model = + Sub.batch + [ Video.nowHasQualities Video.NowHasQualities + , Video.nowHasQuality + (\x -> + case Decode.decodeValue Quality.decode x of + Ok s -> + Video.NowHasQuality s + + _ -> + Video.Noop + ) + , Browser.Events.onAnimationFrameDelta Video.AnimationFrameDelta + , Browser.Events.onKeyDown (decodeKeyDown model) + ] + + +player : List (Element.Attribute Video.Msg) +player = + List.map Element.htmlAttribute + [ Html.Events.on "fullscreenchange" decodeFullscreenChange + , Html.Events.on "mousemove" (Decode.succeed Video.MouseMove) + ] + + +video : List (Html.Attribute Video.Msg) +video = + [ Html.Attributes.id "video" + , Html.Events.on "playing" (Decode.succeed Video.NowPlaying) + , Html.Events.on "pause" (Decode.succeed Video.NowPaused) + , Html.Events.on "durationchange" decodeDurationChanged + , Html.Events.on "timeupdate" decodePosition + , Html.Events.on "volumechange" decodeVolumeChange + , Html.Events.on "progress" decodeProgress + , Html.Events.on "resize" decodeVideoResize + , Html.Events.on "ratechange" decodePlaybackRateChange + ] + + +seekBar : Video -> List (Element.Attribute Video.Msg) +seekBar model = + List.map Element.htmlAttribute + [ Html.Events.on "click" (decodeSeek model) + ] + + +decodeDurationChanged : Decode.Decoder Video.Msg +decodeDurationChanged = + Dom.target <| + Decode.map Video.NowHasDuration + (Decode.field "duration" Decode.float) + + +decodePosition : Decode.Decoder Video.Msg +decodePosition = + Dom.target <| + Decode.map Video.NowAtPosition + (Decode.field "currentTime" Decode.float) + + +decodeVolumeChange : Decode.Decoder Video.Msg +decodeVolumeChange = + Dom.target <| + Decode.map2 Video.NowAtVolume + (Decode.field "volume" Decode.float) + (Decode.field "muted" Decode.bool) + + +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) + + +decodeProgress : Decode.Decoder Video.Msg +decodeProgress = + decodeTimeRanges + |> Decode.field "asArray" + |> Decode.field "buffered" + |> Dom.target + |> Decode.map Video.NowLoaded + + +decodeTimeRanges : Decode.Decoder (List ( Float, Float )) +decodeTimeRanges = + Decode.list decodeTimeRange + + +decodeTimeRange : Decode.Decoder ( Float, Float ) +decodeTimeRange = + Decode.map2 Tuple.pair + (Decode.field "start" Decode.float) + (Decode.field "end" Decode.float) + + +decodeFullscreenChange : Decode.Decoder Video.Msg +decodeFullscreenChange = + Decode.value + |> Decode.nullable + |> Decode.field "fullscreenElement" + |> Decode.field "document" + |> Dom.target + |> Decode.map (\x -> Video.NowIsFullscreen (x /= Nothing)) + + +decodeVideoResize : Decode.Decoder Video.Msg +decodeVideoResize = + Dom.target <| + Decode.map2 (\x y -> Video.NowHasSize ( x, y )) + (Decode.field "videoWidth" Decode.int) + (Decode.field "videoHeight" Decode.int) + + +decodePlaybackRateChange : Decode.Decoder Video.Msg +decodePlaybackRateChange = + Dom.target <| + Decode.map Video.NowHasPlaybackRate + (Decode.field "playbackRate" Decode.float) + + +decodeKeyDown : Video -> Decode.Decoder Video.Msg +decodeKeyDown model = + Decode.field "keyCode" Decode.int + |> Decode.andThen + (\x -> + case x of + -- Enter key + 32 -> + Decode.succeed Video.PlayPause + + -- J key + 74 -> + Decode.succeed (Video.Seek (max 0 (model.position - 10))) + + -- L key + 76 -> + Decode.succeed (Video.Seek (min model.duration (model.position + 10))) + + -- K key + 75 -> + Decode.succeed Video.PlayPause + + -- Left arrow + 37 -> + Decode.succeed (Video.Seek (max 0 (model.position - 5))) + + -- Right arrow + 39 -> + Decode.succeed (Video.Seek (min model.duration (model.position + 5))) + + -- Down arrow + 40 -> + Decode.succeed (Video.SetVolume (max 0 (model.volume - 0.1)) model.muted) + + -- Top arrow + 38 -> + Decode.succeed (Video.SetVolume (min 1 (model.volume + 0.1)) model.muted) + + -- M key + 77 -> + Decode.succeed (Video.SetVolume model.volume (not model.muted)) + + -- F key + 70 -> + Decode.succeed + (if model.isFullscreen then + Video.ExitFullscreen + + else + Video.RequestFullscreen + ) + + _ -> + Decode.fail ("no shortcut for code " ++ String.fromInt x) + ) diff --git a/src/Main.elm b/src/Main.elm index 3b808ac..4f4a1e8 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -1,4 +1,4 @@ -port module Main exposing (..) +module Main exposing (..) import Browser import Browser.Events @@ -8,6 +8,7 @@ import Element.Background as Background import Element.Border as Border import Element.Font as Font import Element.Input as Input +import Events import Html import Html.Attributes import Html.Events @@ -17,6 +18,8 @@ import Quality import Simple.Animation as Animation exposing (Animation) import Simple.Animation.Animated as Animated import Simple.Animation.Property as P +import Video exposing (Video) +import Views main : Program Decode.Value Model Msg @@ -28,19 +31,8 @@ main = , subscriptions = \model -> Sub.batch - [ nowHasQualities NowHasQualities - , nowHasQuality - (\x -> - case Decode.decodeValue Quality.decode x of - Ok s -> - NowHasQuality s - - _ -> - Noop - ) - , Browser.Events.onAnimationFrameDelta AnimationFrameDelta - , Browser.Events.onResize (\x y -> NowHasWindowSize ( x, y )) - , Browser.Events.onKeyDown (decodeKeyDown model) + [ Events.subs model.video |> Sub.map VideoMsg + , Browser.Events.onResize (\x y -> NowHasScreenSize ( x, y )) ] , onUrlChange = \_ -> Noop , onUrlRequest = \_ -> Noop @@ -48,23 +40,8 @@ main = type alias Model = - { url : String - , playing : Bool - , position : Float - , duration : Float - , loaded : List ( Float, Float ) - , volume : Float - , muted : Bool - , isFullscreen : Bool - , quality : Maybe Quality.Quality - , qualities : List Int - , showBar : Bool - , animationFrame : Float - , videoSize : ( Int, Int ) + { video : Video , screenSize : ( Int, Int ) - , playbackRate : Float - , settings : Settings - , showSettings : Bool } @@ -76,29 +53,8 @@ type Settings type Msg = Noop - | PlayPause - | Seek Float - | ToggleSettings - | SetSettings Settings - | SetPlaybackRate Float - | SetQuality Quality.Quality - | SetVolume Float Bool - | RequestFullscreen - | ExitFullscreen - | AnimationFrameDelta Float - | MouseMove - | NowPlaying - | NowPaused - | NowHasDuration Float - | NowAtPosition Float - | NowAtVolume Float Bool - | NowLoaded (List ( Float, Float )) - | NowIsFullscreen Bool - | NowHasQualities (List Int) - | NowHasQuality Quality.Quality - | NowHasVideoSize ( Int, Int ) - | NowHasWindowSize ( Int, Int ) - | NowHasPlaybackRate Float + | VideoMsg Video.Msg + | NowHasScreenSize ( Int, Int ) init : Decode.Value -> ( Model, Cmd Msg ) @@ -116,25 +72,8 @@ init flags = Decode.decodeValue (Decode.field "height" Decode.int) flags |> Result.withDefault 0 in - ( Model - url - False - 0.0 - 1.0 - [] - 1.0 - False - False - Nothing - [] - True - 0 - ( 0, 0 ) - ( width, height ) - 1.0 - All - False - , initVideo url + ( { video = Video.fromUrl url, screenSize = ( width, height ) } + , Video.init url ) @@ -144,708 +83,22 @@ update msg model = Noop -> ( model, Cmd.none ) - PlayPause -> - ( model, playPause () ) + VideoMsg m -> + let + ( video, cmd ) = + Video.update m model.video + in + ( { model | video = video }, Cmd.map VideoMsg cmd ) - Seek time -> - ( model, seek time ) - - SetPlaybackRate rate -> - ( { model | showSettings = False, settings = All }, setPlaybackRate rate ) - - ToggleSettings -> - ( { model | showSettings = not model.showSettings }, Cmd.none ) - - SetSettings s -> - ( { model | settings = s }, Cmd.none ) - - RequestFullscreen -> - ( model, requestFullscreen () ) - - ExitFullscreen -> - ( model, exitFullscreen () ) - - SetQuality q -> - ( { model | showSettings = False, settings = All }, setQuality q ) - - SetVolume v m -> - ( model, setVolume { volume = v, muted = m } ) - - AnimationFrameDelta delta -> - if model.animationFrame + delta > 3500 then - ( { model | animationFrame = model.animationFrame + delta, showSettings = False, settings = All }, Cmd.none ) - - else - ( { model | animationFrame = model.animationFrame + delta }, Cmd.none ) - - MouseMove -> - ( { model | animationFrame = 0 }, Cmd.none ) - - NowPlaying -> - ( { model | playing = True }, Cmd.none ) - - NowPaused -> - ( { model | playing = False }, Cmd.none ) - - NowHasDuration duration -> - ( { model | duration = duration }, Cmd.none ) - - NowAtPosition position -> - ( { model | position = position }, Cmd.none ) - - NowAtVolume volume muted -> - ( { model | volume = volume, muted = muted }, Cmd.none ) - - NowLoaded loaded -> - ( { model | loaded = loaded }, Cmd.none ) - - NowIsFullscreen fullscreen -> - ( { model | isFullscreen = fullscreen }, Cmd.none ) - - NowHasQualities qualities -> - ( { model | qualities = qualities }, Cmd.none ) - - NowHasQuality quality -> - ( { model | quality = Just quality }, Cmd.none ) - - NowHasVideoSize size -> - ( { model | videoSize = size }, Cmd.none ) - - NowHasWindowSize size -> + NowHasScreenSize size -> ( { model | screenSize = size }, Cmd.none ) - NowHasPlaybackRate rate -> - ( { model | playbackRate = rate }, Cmd.none ) - view : Model -> Browser.Document Msg view model = { title = "Hello" - , body = [ Element.layout [ Element.height Element.fill ] (video model) ] + , body = + [ Element.layout [ Element.height Element.fill ] + (Element.map VideoMsg (Views.embed model.screenSize model.video)) + ] } - - -video : Model -> Element Msg -video model = - let - seen = - round (model.position * 1000) - - loaded = - List.filter (\( start, end ) -> start < model.position) model.loaded - - loadedToShow = - every model.duration loaded - - showRange : ( Float, Float, Bool ) -> Element msg - showRange ( start, end, isLoaded ) = - let - portion = - round (1000 * (end - start)) - in - Element.el - [ Element.width (Element.fillPortion portion) - , Element.height Element.fill - , if isLoaded then - Background.color (Element.rgba 1 1 1 0.5) - - else - Background.color (Element.rgba 1 1 1 0) - ] - Element.none - - loadedElement = - Element.row - [ Element.width Element.fill - , Element.height (Element.px 5) - , Element.centerY - , Border.rounded 5 - ] - (List.map showRange loadedToShow) - - remaining = - round ((model.duration - model.position) * 1000) - - bar = - animatedEl - (if model.animationFrame < 3000 then - fadeIn - - else - fadeOut - ) - [ Element.width Element.fill, Element.height Element.fill ] - (Element.column - [ Element.width Element.fill - , Element.alignBottom - , Font.color (Element.rgba 1 1 1 0.85) - ] - [ settings model - , Element.column - [ Element.width Element.fill - , Element.padding 10 - , Background.gradient { angle = 0, steps = [ Element.rgba 0 0 0 0.75, Element.rgba 0 0 0 0 ] } - ] - [ Element.row - [ Element.width Element.fill - , Element.height (Element.px 30) - , Border.rounded 5 - , Element.behindContent - (Element.el - [ Background.color (Element.rgba 1 1 1 0.25) - , Element.width Element.fill - , Element.height (Element.px 5) - , Element.centerY - , Border.rounded 5 - ] - Element.none - ) - , Element.behindContent loadedElement - , Element.inFront - (Element.el - (Element.width Element.fill - :: Element.height Element.fill - :: Element.pointer - :: seekBarEvents model - ) - Element.none - ) - ] - [ Element.el - [ Background.color (Element.rgba 1 0 0 0.75) - , Element.width (Element.fillPortion seen) - , Element.height Element.fill - , Border.roundEach { topLeft = 5, topRight = 0, bottomLeft = 5, bottomRight = 0 } - , Element.height (Element.px 5) - , Element.centerY - ] - Element.none - , Element.el [ Element.width (Element.fillPortion remaining) ] Element.none - ] - , Element.row - [ Element.spacing 10, Element.width Element.fill ] - [ playPauseButton model.playing - , volumeButton model.volume model.muted - , Element.el [ Element.moveDown 2.5 ] (Element.text (formatTime model.position ++ " / " ++ formatTime model.duration)) - , Element.row [ Element.spacing 10, Element.alignRight ] - [ settingsButton, fullscreenButton model.isFullscreen ] - ] - ] - ] - ) - - videoAspectRatio = - toFloat (Tuple.first model.videoSize) / toFloat (Tuple.second model.videoSize) - - screenAspectRatio = - toFloat (Tuple.first model.screenSize) / toFloat (Tuple.second model.screenSize) - - ( ( x, y ), ( w, h ) ) = - if videoAspectRatio > screenAspectRatio then - let - videoHeight = - Tuple.first model.screenSize * Tuple.second model.videoSize // Tuple.first model.videoSize - in - ( ( 0, (Tuple.second model.screenSize - videoHeight) // 2 ) - , ( Tuple.first model.screenSize, videoHeight ) - ) - - else - let - videoWidth = - Tuple.second model.screenSize * Tuple.first model.videoSize // Tuple.second model.videoSize - in - ( ( (Tuple.first model.screenSize - videoWidth) // 2, 0 ) - , ( videoWidth, Tuple.second model.screenSize ) - ) - in - Element.el - (Element.inFront bar - :: Element.width Element.fill - :: Element.height Element.fill - :: Background.color (Element.rgb 0 0 0) - :: Element.htmlAttribute (Html.Attributes.id "full") - :: playerEvents - ) - (Element.html - (Html.video - (Html.Attributes.style "position" "absolute" - :: Html.Attributes.width w - :: Html.Attributes.height h - :: Html.Attributes.style "top" (String.fromInt y ++ "px") - :: Html.Attributes.style "left" (String.fromInt x ++ "px") - :: videoEvents - ) - [] - ) - ) - - -settings : Model -> Element Msg -settings model = - let - makeMenuButton : Settings -> Element Msg -> Element Msg -> Element Msg - makeMenuButton s key value = - Input.button [ Element.width Element.fill, Element.paddingXY 0 10 ] - { label = - Element.row [ Element.width Element.fill, Element.spacing 20 ] - [ Element.el [ Font.bold, Element.alignLeft ] key - , Element.el [ Element.alignRight ] value - ] - , onPress = Just (SetSettings s) - } - - speedButton = - makeMenuButton Speed (Element.text "Speed") (Element.text ("x" ++ String.fromFloat model.playbackRate)) - - qualityButton = - case model.quality of - Just q -> - makeMenuButton Quality (Element.text "Quality") (Element.text (Quality.toString q)) - - _ -> - Element.none - - returnButton = - Input.button - [ Element.width Element.fill - , Element.paddingXY 0 10 - , Border.widthEach - { bottom = 1 - , top = 0 - , left = 0 - , right = 0 - } - , Border.color (Element.rgba 0.5 0.5 0.5 0.75) - ] - { label = Element.text "Return" - , onPress = Just (SetSettings All) - } - - speedOptions = - [ 0.5, 0.75, 1, 1.5, 2 ] - |> List.map - (\x -> - Input.button [ Element.width Element.fill, Element.paddingXY 0 10 ] - { label = - Element.row [ Element.width Element.fill ] - [ if x == model.playbackRate then - Icons.check False - - else - Element.el [ Font.color (Element.rgba 0 0 0 0) ] (Icons.check False) - , Element.el - [ Element.paddingEach - { left = 10 - , right = 0 - , top = 0 - , bottom = 0 - } - ] - (Element.text ("x" ++ String.fromFloat x)) - ] - , onPress = Just (SetPlaybackRate x) - } - ) - |> (\x -> returnButton :: x) - - qualityOptions = - model.qualities - |> List.map - (\x -> - Input.button [ Element.width Element.fill, Element.paddingXY 0 10 ] - { label = - Element.row [ Element.width Element.fill ] - [ if Quality.isSameOption (Just { auto = False, height = x }) model.quality then - Icons.check False - - else - Element.el [ Font.color (Element.rgba 0 0 0 0) ] (Icons.check False) - , Element.el - [ Element.paddingEach - { left = 10 - , right = 0 - , top = 0 - , bottom = 0 - } - ] - (Element.text (Quality.toString { auto = False, height = x })) - ] - , onPress = Just (SetQuality { auto = x == 0, height = x }) - } - ) - |> (\x -> returnButton :: x) - - buttons = - case model.settings of - All -> - [ speedButton, qualityButton ] - - Speed -> - speedOptions - - Quality -> - qualityOptions - in - animatedEl - (if model.showSettings then - fadeIn - - else - fadeOut - ) - [ Element.padding 10 - , Element.width Element.fill - , Element.height Element.fill - , Element.moveDown 20 - ] - (Element.column - [ Background.color (Element.rgba 0.2 0.2 0.2 0.75) - , Element.alignRight - , Element.paddingXY 20 10 - , Border.rounded 10 - ] - buttons - ) - - -playPauseButton : Bool -> Element Msg -playPauseButton playing = - let - icon = - if playing then - Icons.pause True - - else - Icons.play True - in - Input.button [] - { label = icon - , onPress = Just PlayPause - } - - -fullscreenButton : Bool -> Element Msg -fullscreenButton isFullscreen = - Input.button [] - (if isFullscreen then - { label = Icons.minimize False - , onPress = Just ExitFullscreen - } - - else - { label = Icons.maximize False - , onPress = Just RequestFullscreen - } - ) - - -volumeButton : Float -> Bool -> Element Msg -volumeButton volume muted = - let - icon = - if muted then - Icons.volumeX - - else if volume < 0.3 then - Icons.volume - - else if volume < 0.6 then - Icons.volume1 - - else - Icons.volume2 - in - Input.button [] - { label = icon True - , onPress = Just (SetVolume volume (not muted)) - } - - -settingsButton : Element Msg -settingsButton = - Input.button [] - { label = Icons.settings False - , onPress = Just ToggleSettings - } - - -playerEvents : List (Element.Attribute Msg) -playerEvents = - List.map Element.htmlAttribute - [ Html.Events.on "fullscreenchange" decodeFullscreenChange - , Html.Events.on "mousemove" (Decode.succeed MouseMove) - ] - - -videoEvents : List (Html.Attribute Msg) -videoEvents = - [ Html.Attributes.id "video" - , Html.Events.on "playing" (Decode.succeed NowPlaying) - , Html.Events.on "pause" (Decode.succeed NowPaused) - , Html.Events.on "durationchange" decodeDurationChanged - , Html.Events.on "timeupdate" decodePosition - , Html.Events.on "volumechange" decodeVolumeChange - , Html.Events.on "progress" decodeProgress - , Html.Events.on "resize" decodeVideoResize - , Html.Events.on "ratechange" decodePlaybackRateChange - ] - - -seekBarEvents : Model -> List (Element.Attribute Msg) -seekBarEvents model = - List.map Element.htmlAttribute - [ Html.Events.on "click" (decodeSeek model) - ] - - -decodeDurationChanged : Decode.Decoder Msg -decodeDurationChanged = - Dom.target <| - Decode.map NowHasDuration - (Decode.field "duration" Decode.float) - - -decodePosition : Decode.Decoder Msg -decodePosition = - Dom.target <| - Decode.map NowAtPosition - (Decode.field "currentTime" Decode.float) - - -decodeVolumeChange : Decode.Decoder Msg -decodeVolumeChange = - Dom.target <| - Decode.map2 NowAtVolume - (Decode.field "volume" Decode.float) - (Decode.field "muted" Decode.bool) - - -decodeSeek : Model -> Decode.Decoder Msg -decodeSeek model = - Decode.map2 (\x y -> Seek (toFloat x / toFloat y * model.duration)) - (Decode.field "layerX" Decode.int) - (Dom.target <| Decode.field "offsetWidth" Decode.int) - - -decodeProgress : Decode.Decoder Msg -decodeProgress = - decodeTimeRanges - |> Decode.field "asArray" - |> Decode.field "buffered" - |> Dom.target - |> Decode.map NowLoaded - - -decodeTimeRanges : Decode.Decoder (List ( Float, Float )) -decodeTimeRanges = - Decode.list decodeTimeRange - - -decodeTimeRange : Decode.Decoder ( Float, Float ) -decodeTimeRange = - Decode.map2 Tuple.pair - (Decode.field "start" Decode.float) - (Decode.field "end" Decode.float) - - -decodeFullscreenChange : Decode.Decoder Msg -decodeFullscreenChange = - Decode.value - |> Decode.nullable - |> Decode.field "fullscreenElement" - |> Decode.field "document" - |> Dom.target - |> Decode.map (\x -> NowIsFullscreen (x /= Nothing)) - - -decodeVideoResize : Decode.Decoder Msg -decodeVideoResize = - Dom.target <| - Decode.map2 (\x y -> NowHasVideoSize ( x, y )) - (Decode.field "videoWidth" Decode.int) - (Decode.field "videoHeight" Decode.int) - - -decodePlaybackRateChange : Decode.Decoder Msg -decodePlaybackRateChange = - Dom.target <| - Decode.map NowHasPlaybackRate - (Decode.field "playbackRate" Decode.float) - - -decodeKeyDown : Model -> Decode.Decoder Msg -decodeKeyDown model = - Decode.field "keyCode" Decode.int - |> Decode.andThen - (\x -> - case x of - -- Enter key - 32 -> - Decode.succeed PlayPause - - -- J key - 74 -> - Decode.succeed (Seek (max 0 (model.position - 10))) - - -- L key - 76 -> - Decode.succeed (Seek (min model.duration (model.position + 10))) - - -- K key - 75 -> - Decode.succeed PlayPause - - -- Left arrow - 37 -> - Decode.succeed (Seek (max 0 (model.position - 5))) - - -- Right arrow - 39 -> - Decode.succeed (Seek (min model.duration (model.position + 5))) - - -- Down arrow - 40 -> - Decode.succeed (SetVolume (max 0 (model.volume - 0.1)) model.muted) - - -- Top arrow - 38 -> - Decode.succeed (SetVolume (min 1 (model.volume + 0.1)) model.muted) - - -- M key - 77 -> - Decode.succeed (SetVolume model.volume (not model.muted)) - - -- F key - 70 -> - Decode.succeed - (if model.isFullscreen then - ExitFullscreen - - else - RequestFullscreen - ) - - _ -> - Decode.fail ("no shortcut for code " ++ String.fromInt x) - ) - - -every : Float -> List ( Float, Float ) -> List ( Float, Float, Bool ) -every duration input = - everyAux duration 0.0 [] input |> List.reverse |> List.filter (\( x, y, _ ) -> x /= y) - - -everyAux : Float -> Float -> List ( Float, Float, Bool ) -> List ( Float, Float ) -> List ( Float, Float, Bool ) -everyAux duration currentTime currentState input = - case input of - [] -> - ( currentTime, duration, False ) :: currentState - - [ ( start, end ) ] -> - ( end, duration, False ) :: ( start, end, True ) :: ( currentTime, start, False ) :: currentState - - ( start, end ) :: t -> - everyAux duration end (( start, end, True ) :: ( currentTime, start, False ) :: currentState) t - - -formatTime : Float -> String -formatTime s = - let - seconds = - round s - - minutes = - seconds // 60 |> modBy 60 - - hours = - seconds // 3600 - - secs = - modBy 60 seconds - - secsString = - if secs < 10 then - "0" ++ String.fromInt secs - - else - String.fromInt secs - - minutesString = - if minutes < 10 && hours > 0 then - "0" ++ String.fromInt minutes - - else - String.fromInt minutes - - hoursString = - if hours == 0 then - "" - - else - String.fromInt hours ++ ":" - in - hoursString ++ minutesString ++ ":" ++ secsString - - -port initVideo : String -> Cmd msg - - -port playPause : () -> Cmd msg - - -port seek : Float -> Cmd msg - - -port requestFullscreen : () -> Cmd msg - - -port exitFullscreen : () -> Cmd msg - - -port setPlaybackRate : Float -> Cmd msg - - -port setQuality : Quality.Quality -> Cmd msg - - -port setVolume : { volume : Float, muted : Bool } -> Cmd msg - - -port nowHasQualities : (List Int -> msg) -> Sub msg - - -port nowHasQuality : (Decode.Value -> msg) -> Sub msg - - -fadeIn : Animation -fadeIn = - Animation.fromTo - { duration = 500 - , options = [] - } - [ P.opacity 0 ] - [ P.opacity 1 ] - - -fadeOut : Animation -fadeOut = - Animation.fromTo - { duration = 500 - , options = [] - } - [ P.opacity 1 ] - [ P.opacity 0 ] - - -animatedEl : Animation -> List (Element.Attribute msg) -> Element msg -> Element msg -animatedEl = - animatedUi Element.el - - -animatedUi = - Animated.ui - { behindContent = Element.behindContent - , htmlAttribute = Element.htmlAttribute - , html = Element.html - } diff --git a/src/Video.elm b/src/Video.elm new file mode 100644 index 0000000..d598a01 --- /dev/null +++ b/src/Video.elm @@ -0,0 +1,234 @@ +port module Video exposing (Msg(..), Settings(..), Video, fromUrl, init, nowHasQualities, nowHasQuality, update) + +import Json.Decode as Decode +import Quality exposing (Quality) + + +type alias Video = + { url : String + , playing : Bool + , position : Float + , duration : Float + , loaded : List ( Float, Float ) + , volume : Float + , muted : Bool + , isFullscreen : Bool + , quality : Maybe Quality.Quality + , qualities : List Int + , showBar : Bool + , animationFrame : Float + , size : ( Int, Int ) + , playbackRate : Float + , settings : Settings + , showSettings : Bool + } + + +fromUrl : String -> Video +fromUrl url = + { url = url + , playing = False + , position = 0 + , duration = 0 + , loaded = [] + , volume = 1 + , muted = False + , isFullscreen = False + , quality = Nothing + , qualities = [] + , showBar = True + , animationFrame = 0 + , size = ( 0, 0 ) + , playbackRate = 1 + , settings = All + , showSettings = False + } + + +type Settings + = All + | Speed + | Quality + + +type Msg + = Noop + | PlayPause + | Seek Float + | ToggleSettings + | SetSettings Settings + | SetPlaybackRate Float + | SetQuality Quality.Quality + | SetVolume Float Bool + | RequestFullscreen + | ExitFullscreen + | AnimationFrameDelta Float + | MouseMove + | NowPlaying + | NowPaused + | NowHasDuration Float + | NowAtPosition Float + | NowAtVolume Float Bool + | NowLoaded (List ( Float, Float )) + | NowIsFullscreen Bool + | NowHasQualities (List Int) + | NowHasQuality Quality.Quality + | NowHasSize ( Int, Int ) + | NowHasPlaybackRate Float + + +update : Msg -> Video -> ( Video, Cmd Msg ) +update msg model = + case msg of + Noop -> + ( model, Cmd.none ) + + PlayPause -> + ( model, playPause ) + + Seek time -> + ( model, seek time ) + + SetPlaybackRate rate -> + ( { model | showSettings = False, settings = All }, setPlaybackRate rate ) + + ToggleSettings -> + ( { model | showSettings = not model.showSettings }, Cmd.none ) + + SetSettings s -> + ( { model | settings = s }, Cmd.none ) + + RequestFullscreen -> + ( model, requestFullscreen ) + + ExitFullscreen -> + ( model, exitFullscreen ) + + SetQuality q -> + ( { model | showSettings = False, settings = All }, setQuality q ) + + SetVolume v m -> + ( model, setVolume { volume = v, muted = m } ) + + AnimationFrameDelta delta -> + if model.animationFrame + delta > 3500 then + ( { model | animationFrame = model.animationFrame + delta, showSettings = False, settings = All }, Cmd.none ) + + else + ( { model | animationFrame = model.animationFrame + delta }, Cmd.none ) + + MouseMove -> + ( { model | animationFrame = 0 }, Cmd.none ) + + NowPlaying -> + ( { model | playing = True }, Cmd.none ) + + NowPaused -> + ( { model | playing = False }, Cmd.none ) + + NowHasDuration duration -> + ( { model | duration = duration }, Cmd.none ) + + NowAtPosition position -> + ( { model | position = position }, Cmd.none ) + + NowAtVolume volume muted -> + ( { model | volume = volume, muted = muted }, Cmd.none ) + + NowLoaded loaded -> + ( { model | loaded = loaded }, Cmd.none ) + + NowIsFullscreen fullscreen -> + ( { model | isFullscreen = fullscreen }, Cmd.none ) + + NowHasQualities qualities -> + ( { model | qualities = qualities }, Cmd.none ) + + NowHasQuality quality -> + ( { model | quality = Just quality }, Cmd.none ) + + NowHasSize size -> + ( { model | size = size }, Cmd.none ) + + NowHasPlaybackRate rate -> + ( { model | playbackRate = rate }, Cmd.none ) + + +port polymnyVideoInit : String -> Cmd msg + + +init : String -> Cmd msg +init = + polymnyVideoInit + + +port polymnyVideoPlayPause : () -> Cmd msg + + +playPause : Cmd msg +playPause = + polymnyVideoPlayPause () + + +port polymnyVideoSeek : Float -> Cmd msg + + +seek : Float -> Cmd msg +seek = + polymnyVideoSeek + + +port polymnyVideoRequestFullscreen : () -> Cmd msg + + +requestFullscreen : Cmd msg +requestFullscreen = + polymnyVideoRequestFullscreen () + + +port polymnyVideoExitFullscreen : () -> Cmd msg + + +exitFullscreen : Cmd msg +exitFullscreen = + polymnyVideoExitFullscreen () + + +port polymnyVideoSetPlaybackRate : Float -> Cmd msg + + +setPlaybackRate : Float -> Cmd msg +setPlaybackRate = + polymnyVideoSetPlaybackRate + + +port polymnyVideoSetQuality : Quality -> Cmd msg + + +setQuality : Quality -> Cmd msg +setQuality = + polymnyVideoSetQuality + + +port polymnyVideoSetVolume : { volume : Float, muted : Bool } -> Cmd msg + + +setVolume : { volume : Float, muted : Bool } -> Cmd msg +setVolume = + polymnyVideoSetVolume + + +port polymnyVideoNowHasQualities : (List Int -> msg) -> Sub msg + + +nowHasQualities : (List Int -> msg) -> Sub msg +nowHasQualities = + polymnyVideoNowHasQualities + + +port polymnyVideoNowHasQuality : (Decode.Value -> msg) -> Sub msg + + +nowHasQuality : (Decode.Value -> msg) -> Sub msg +nowHasQuality = + polymnyVideoNowHasQuality diff --git a/src/Views.elm b/src/Views.elm new file mode 100644 index 0000000..33415a1 --- /dev/null +++ b/src/Views.elm @@ -0,0 +1,451 @@ +module Views exposing (..) + +import Element exposing (Element) +import Element.Background as Background +import Element.Border as Border +import Element.Font as Font +import Element.Input as Input +import Events as Events +import Html +import Html.Attributes +import Icons +import Quality +import Simple.Animation as Animation exposing (Animation) +import Simple.Animation.Animated as Animated +import Simple.Animation.Property as P +import Video exposing (Video) + + +embed : ( Int, Int ) -> Video -> Element Video.Msg +embed screenSize model = + let + seen = + round (model.position * 1000) + + loaded = + List.filter (\( start, end ) -> start < model.position) model.loaded + + loadedToShow = + every model.duration loaded + + showRange : ( Float, Float, Bool ) -> Element msg + showRange ( start, end, isLoaded ) = + let + portion = + round (1000 * (end - start)) + in + Element.el + [ Element.width (Element.fillPortion portion) + , Element.height Element.fill + , if isLoaded then + Background.color (Element.rgba 1 1 1 0.5) + + else + Background.color (Element.rgba 1 1 1 0) + ] + Element.none + + loadedElement = + Element.row + [ Element.width Element.fill + , Element.height (Element.px 5) + , Element.centerY + , Border.rounded 5 + ] + (List.map showRange loadedToShow) + + remaining = + round ((model.duration - model.position) * 1000) + + bar = + animatedEl + (if model.animationFrame < 3000 then + fadeIn + + else + fadeOut + ) + [ Element.width Element.fill, Element.height Element.fill ] + (Element.column + [ Element.width Element.fill + , Element.alignBottom + , Font.color (Element.rgba 1 1 1 0.85) + ] + [ settings model + , Element.column + [ Element.width Element.fill + , Element.padding 10 + , Background.gradient { angle = 0, steps = [ Element.rgba 0 0 0 0.75, Element.rgba 0 0 0 0 ] } + ] + [ Element.row + [ Element.width Element.fill + , Element.height (Element.px 30) + , Border.rounded 5 + , Element.behindContent + (Element.el + [ Background.color (Element.rgba 1 1 1 0.25) + , Element.width Element.fill + , Element.height (Element.px 5) + , Element.centerY + , Border.rounded 5 + ] + Element.none + ) + , Element.behindContent loadedElement + , Element.inFront + (Element.el + (Element.width Element.fill + :: Element.height Element.fill + :: Element.pointer + :: Events.seekBar model + ) + Element.none + ) + ] + [ Element.el + [ Background.color (Element.rgba 1 0 0 0.75) + , Element.width (Element.fillPortion seen) + , Element.height Element.fill + , Border.roundEach { topLeft = 5, topRight = 0, bottomLeft = 5, bottomRight = 0 } + , Element.height (Element.px 5) + , Element.centerY + ] + Element.none + , Element.el [ Element.width (Element.fillPortion remaining) ] Element.none + ] + , Element.row + [ Element.spacing 10, Element.width Element.fill ] + [ playPauseButton model.playing + , volumeButton model.volume model.muted + , Element.el [ Element.moveDown 2.5 ] (Element.text (formatTime model.position ++ " / " ++ formatTime model.duration)) + , Element.row [ Element.spacing 10, Element.alignRight ] + [ settingsButton, fullscreenButton model.isFullscreen ] + ] + ] + ] + ) + + videoAspectRatio = + toFloat (Tuple.first model.size) / toFloat (Tuple.second model.size) + + screenAspectRatio = + toFloat (Tuple.first screenSize) / toFloat (Tuple.second screenSize) + + ( ( x, y ), ( w, h ) ) = + if videoAspectRatio > screenAspectRatio then + let + videoHeight = + Tuple.first screenSize * Tuple.second model.size // Tuple.first model.size + in + ( ( 0, (Tuple.second screenSize - videoHeight) // 2 ) + , ( Tuple.first screenSize, videoHeight ) + ) + + else + let + videoWidth = + Tuple.second screenSize * Tuple.first model.size // Tuple.second model.size + in + ( ( (Tuple.first screenSize - videoWidth) // 2, 0 ) + , ( videoWidth, Tuple.second screenSize ) + ) + in + Element.el + (Element.inFront bar + :: Element.width Element.fill + :: Element.height Element.fill + :: Background.color (Element.rgb 0 0 0) + :: Element.htmlAttribute (Html.Attributes.id "full") + :: Events.player + ) + (Element.html + (Html.video + (Html.Attributes.style "position" "absolute" + :: Html.Attributes.width w + :: Html.Attributes.height h + :: Html.Attributes.style "top" (String.fromInt y ++ "px") + :: Html.Attributes.style "left" (String.fromInt x ++ "px") + :: Events.video + ) + [] + ) + ) + + +settings : Video -> Element Video.Msg +settings model = + let + makeMenuButton : Video.Settings -> Element Video.Msg -> Element Video.Msg -> Element Video.Msg + makeMenuButton s key value = + Input.button [ Element.width Element.fill, Element.paddingXY 0 10 ] + { label = + Element.row [ Element.width Element.fill, Element.spacing 20 ] + [ Element.el [ Font.bold, Element.alignLeft ] key + , Element.el [ Element.alignRight ] value + ] + , onPress = Just (Video.SetSettings s) + } + + speedButton = + makeMenuButton Video.Speed (Element.text "Speed") (Element.text ("x" ++ String.fromFloat model.playbackRate)) + + qualityButton = + case model.quality of + Just q -> + makeMenuButton Video.Quality (Element.text "Quality") (Element.text (Quality.toString q)) + + _ -> + Element.none + + returnButton = + Input.button + [ Element.width Element.fill + , Element.paddingXY 0 10 + , Border.widthEach + { bottom = 1 + , top = 0 + , left = 0 + , right = 0 + } + , Border.color (Element.rgba 0.5 0.5 0.5 0.75) + ] + { label = Element.text "Return" + , onPress = Just (Video.SetSettings Video.All) + } + + speedOptions = + [ 0.5, 0.75, 1, 1.5, 2 ] + |> List.map + (\x -> + Input.button [ Element.width Element.fill, Element.paddingXY 0 10 ] + { label = + Element.row [ Element.width Element.fill ] + [ if x == model.playbackRate then + Icons.check False + + else + Element.el [ Font.color (Element.rgba 0 0 0 0) ] (Icons.check False) + , Element.el + [ Element.paddingEach + { left = 10 + , right = 0 + , top = 0 + , bottom = 0 + } + ] + (Element.text ("x" ++ String.fromFloat x)) + ] + , onPress = Just (Video.SetPlaybackRate x) + } + ) + |> (\x -> returnButton :: x) + + qualityOptions = + model.qualities + |> List.map + (\x -> + Input.button [ Element.width Element.fill, Element.paddingXY 0 10 ] + { label = + Element.row [ Element.width Element.fill ] + [ if Quality.isSameOption (Just { auto = False, height = x }) model.quality then + Icons.check False + + else + Element.el [ Font.color (Element.rgba 0 0 0 0) ] (Icons.check False) + , Element.el + [ Element.paddingEach + { left = 10 + , right = 0 + , top = 0 + , bottom = 0 + } + ] + (Element.text (Quality.toString { auto = False, height = x })) + ] + , onPress = Just (Video.SetQuality { auto = x == 0, height = x }) + } + ) + |> (\x -> returnButton :: x) + + buttons = + case model.settings of + Video.All -> + [ speedButton, qualityButton ] + + Video.Speed -> + speedOptions + + Video.Quality -> + qualityOptions + in + animatedEl + (if model.showSettings then + fadeIn + + else + fadeOut + ) + [ Element.padding 10 + , Element.width Element.fill + , Element.height Element.fill + , Element.moveDown 20 + ] + (Element.column + [ Background.color (Element.rgba 0.2 0.2 0.2 0.75) + , Element.alignRight + , Element.paddingXY 20 10 + , Border.rounded 10 + ] + buttons + ) + + +playPauseButton : Bool -> Element Video.Msg +playPauseButton playing = + let + icon = + if playing then + Icons.pause True + + else + Icons.play True + in + Input.button [] + { label = icon + , onPress = Just Video.PlayPause + } + + +fullscreenButton : Bool -> Element Video.Msg +fullscreenButton isFullscreen = + Input.button [] + (if isFullscreen then + { label = Icons.minimize False + , onPress = Just Video.ExitFullscreen + } + + else + { label = Icons.maximize False + , onPress = Just Video.RequestFullscreen + } + ) + + +volumeButton : Float -> Bool -> Element Video.Msg +volumeButton volume muted = + let + icon = + if muted then + Icons.volumeX + + else if volume < 0.3 then + Icons.volume + + else if volume < 0.6 then + Icons.volume1 + + else + Icons.volume2 + in + Input.button [] + { label = icon True + , onPress = Just (Video.SetVolume volume (not muted)) + } + + +settingsButton : Element Video.Msg +settingsButton = + Input.button [] + { label = Icons.settings False + , onPress = Just Video.ToggleSettings + } + + +every : Float -> List ( Float, Float ) -> List ( Float, Float, Bool ) +every duration input = + everyAux duration 0.0 [] input |> List.reverse |> List.filter (\( x, y, _ ) -> x /= y) + + +everyAux : Float -> Float -> List ( Float, Float, Bool ) -> List ( Float, Float ) -> List ( Float, Float, Bool ) +everyAux duration currentTime currentState input = + case input of + [] -> + ( currentTime, duration, False ) :: currentState + + [ ( start, end ) ] -> + ( end, duration, False ) :: ( start, end, True ) :: ( currentTime, start, False ) :: currentState + + ( start, end ) :: t -> + everyAux duration end (( start, end, True ) :: ( currentTime, start, False ) :: currentState) t + + +formatTime : Float -> String +formatTime s = + let + seconds = + round s + + minutes = + seconds // 60 |> modBy 60 + + hours = + seconds // 3600 + + secs = + modBy 60 seconds + + secsString = + if secs < 10 then + "0" ++ String.fromInt secs + + else + String.fromInt secs + + minutesString = + if minutes < 10 && hours > 0 then + "0" ++ String.fromInt minutes + + else + String.fromInt minutes + + hoursString = + if hours == 0 then + "" + + else + String.fromInt hours ++ ":" + in + hoursString ++ minutesString ++ ":" ++ secsString + + +fadeIn : Animation +fadeIn = + Animation.fromTo + { duration = 500 + , options = [] + } + [ P.opacity 0 ] + [ P.opacity 1 ] + + +fadeOut : Animation +fadeOut = + Animation.fromTo + { duration = 500 + , options = [] + } + [ P.opacity 1 ] + [ P.opacity 0 ] + + +animatedEl : Animation -> List (Element.Attribute msg) -> Element msg -> Element msg +animatedEl = + animatedUi Element.el + + +animatedUi = + Animated.ui + { behindContent = Element.behindContent + , htmlAttribute = Element.htmlAttribute + , html = Element.html + }