From ab2af4945f121cd645386dac4c8b9131564b605e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Simon=20H=C3=B8jberg?= Date: Wed, 11 Dec 2024 13:50:23 -0500 Subject: [PATCH] Fix split resize in release builds by vendoring SplitPane To support Elm 0.19.1 (and crucially to support optimize mode), this is vendored version of [quentin/elm-split-pane](https://github.com/quentin/elm-split-pane) which builds on a series of forks: * The original: [doodledood/elm-split-pane](https://github.com/doodledood/elm-split-pane) * 0.19.0 support: [whale9490/elm-split-pane](https://github.com/whale9490/elm-split-pane) * 0.19.1 support: [quentin/elm-split-pane](https://github.com/quentin/elm-split-pane) --- elm.json | 5 +- src/SplitPane/Bound.elm | 66 +++ src/SplitPane/README.md | 9 + src/SplitPane/SplitPane.elm | 738 +++++++++++++++++++++++++++ src/Ucm/Workspace/WorkspacePanes.elm | 2 +- src/Window.elm | 2 +- src/main.css | 14 +- 7 files changed, 824 insertions(+), 12 deletions(-) create mode 100644 src/SplitPane/Bound.elm create mode 100644 src/SplitPane/README.md create mode 100644 src/SplitPane/SplitPane.elm diff --git a/elm.json b/elm.json index db0a0de..e90fe62 100644 --- a/elm.json +++ b/elm.json @@ -30,8 +30,7 @@ "rtfeldman/elm-iso8601-date-strings": "1.1.4", "ryan-haskell/date-format": "1.0.0", "stoeffel/set-extra": "1.2.3", - "wernerdegroot/listzipper": "4.0.0", - "whale9490/elm-split-pane": "1.0.0" + "wernerdegroot/listzipper": "4.0.0" }, "indirect": { "elm/bytes": "1.0.8", @@ -46,4 +45,4 @@ "direct": {}, "indirect": {} } -} \ No newline at end of file +} diff --git a/src/SplitPane/Bound.elm b/src/SplitPane/Bound.elm new file mode 100644 index 0000000..4ccd15b --- /dev/null +++ b/src/SplitPane/Bound.elm @@ -0,0 +1,66 @@ +module SplitPane.Bound exposing (Bound, Bounded, getValue, putValue, updateValue, putBound, createBound, createBounded) + +{-| This module defines a value that is between two other values. + +@docs Bound, Bounded, getValue, putValue, updateValue, putBound, createBound, createBounded + +-} + + +{-| Type that defines a border of values +-} +type alias Bound a = + ( a, a ) + + +{-| Type that defines a value that is within a border of two other values +-} +type alias Bounded a = + ( a, Bound a ) + + +{-| Create a new bounded value. +-} +getValue : Bounded comparable -> comparable +getValue value = + Tuple.first value + + +{-| Create a new bounded value. +-} +createBounded : comparable -> Bound comparable -> Bounded comparable +createBounded value bound = + putValue ( value, bound ) value + + +{-| Change the value that is bounded. +-} +putValue : Bounded comparable -> comparable -> Bounded comparable +putValue ( _, bound ) value = + ( boundTo bound value, bound ) + + +{-| Update the value that is bounded. +-} +updateValue : (comparable -> comparable) -> Bounded comparable -> Bounded comparable +updateValue f ( value, bound ) = + ( boundTo bound (f value), bound ) + + +{-| Change the bound of the bounded value. +-} +putBound : Bounded comparable -> Bound comparable -> Bounded comparable +putBound ( value, _ ) bound = + ( value, bound ) + + +{-| Create a new bound that can be used to restrict a value. +-} +createBound : comparable -> comparable -> Bound comparable +createBound a b = + ( min a b, max a b ) + + +boundTo : Bound comparable -> comparable -> comparable +boundTo ( a, b ) = + min b << max a diff --git a/src/SplitPane/README.md b/src/SplitPane/README.md new file mode 100644 index 0000000..e3f7976 --- /dev/null +++ b/src/SplitPane/README.md @@ -0,0 +1,9 @@ +# SplitPane + +To support Elm 0.19.1 (and crucially to support optimize mode), this is +vendored version of [quentin/elm-split-pane](https://github.com/quentin/elm-split-pane) which builds on a series of forks: + + +* The original: [doodledood/elm-split-pane](https://github.com/doodledood/elm-split-pane) +* 0.19.0 support: [whale9490/elm-split-pane](https://github.com/whale9490/elm-split-pane) +* 0.19.1 support: [quentin/elm-split-pane](https://github.com/quentin/elm-split-pane) diff --git a/src/SplitPane/SplitPane.elm b/src/SplitPane/SplitPane.elm new file mode 100644 index 0000000..8e1e43c --- /dev/null +++ b/src/SplitPane/SplitPane.elm @@ -0,0 +1,738 @@ +module SplitPane.SplitPane exposing + ( view, createViewConfig + , update, subscriptions + , State, init, configureSplitter, orientation, draggable + , percentage, px + , Msg, Orientation(..), SizeUnit(..), ViewConfig, UpdateConfig, CustomSplitter, HtmlDetails + , customUpdate, createUpdateConfig, createCustomSplitter + ) + +{-| This is a split pane view library. Can be used to split views into multiple parts with a splitter between them. + +Check out the [examples] to see how it works. + +[examples]: https://github.com/doodledood/elm-split-pane/tree/master/examples + + +# View + +@docs view, createViewConfig + + +# Update + +@docs update, subscriptions + + +# State + +@docs State, init, configureSplitter, orientation, draggable + + +# Helpers + +@docs percentage, px + + +# Definitions + +@docs Msg, Orientation, SizeUnit, ViewConfig, UpdateConfig, CustomSplitter, HtmlDetails + + +# Customization + +@docs customUpdate, createUpdateConfig, createCustomSplitter + +-} + +import Browser.Events +import Html exposing (Attribute, Html, div, span) +import Html.Attributes exposing (class, style) +import Html.Events +import Json.Decode as D exposing (at, field) +import Json.Encode exposing (encode, float, int) +import Maybe +import SplitPane.Bound + exposing + ( Bounded + , createBound + , createBounded + , getValue + , updateValue + ) + + + +-- MODEL + + +{-| Size unit for setting slider - either percentage value between 0.0 and 1.0 or pixel value (> 0) +-} +type SizeUnit + = Percentage (Bounded Float) + | Px (Bounded Int) + + +{-| Orientation of pane. +-} +type Orientation + = Horizontal + | Vertical + + +{-| Keeps dimensions of pane. +-} +type alias PaneDOMInfo = + { width : Int + , height : Int + } + + +{-| Keep relevant information for the drag operations. +-} +type alias DragInfo = + { paneInfo : PaneDOMInfo + , anchor : Position + } + + +{-| Drag state information. +-} +type DragState + = Draggable (Maybe DragInfo) + | NotDraggable + + +{-| Tracks state of pane. +-} +type State + = State + { orientation : Orientation + , splitterPosition : SizeUnit + , dragState : DragState + } + + +{-| Internal messages. +-} +type Msg + = SplitterClick DOMInfo + | SplitterMove Position + | SplitterLeftAlone Position + + +{-| Describes a mouse/touch position +-} +type alias Position = + { x : Int + , y : Int + } + + +{-| Sets whether the pane is draggable or not +-} +draggable : Bool -> State -> State +draggable isDraggable (State state) = + State + { state + | dragState = + if isDraggable then + Draggable Nothing + + else + NotDraggable + } + + +{-| Changes orientation of the pane. +-} +orientation : Orientation -> State -> State +orientation ori (State state) = + State { state | orientation = ori } + + +{-| Change the splitter position and limit +-} +configureSplitter : SizeUnit -> State -> State +configureSplitter newPosition (State state) = + State + { state + | splitterPosition = newPosition + } + + +{-| Creates a percentage size unit from a float +-} +percentage : Float -> Maybe ( Float, Float ) -> SizeUnit +percentage x bound = + let + newBound = + case bound of + Just ( lower, upper ) -> + createBound lower upper + + Nothing -> + createBound 0.0 1.0 + in + Percentage <| createBounded x newBound + + +{-| Creates a pixel size unit from an int +-} +px : Int -> Maybe ( Int, Int ) -> SizeUnit +px x bound = + let + newBound = + case bound of + Just ( lower, upper ) -> + createBound lower upper + + Nothing -> + createBound 0 9999999999 + in + Px <| createBounded x newBound + + + +-- INIT + + +{-| Initialize a new model. + + init Horizontal + +-} +init : Orientation -> State +init o = + State + { orientation = o + , splitterPosition = percentage 0.5 Nothing + , dragState = Draggable Nothing + } + + + +-- UPDATE + + +domInfoToPosition : DOMInfo -> Position +domInfoToPosition { x, y, touchX, touchY } = + case ( ( x, y ), ( touchX, touchY ) ) of + ( _, ( Just posX, Just posY ) ) -> + { x = posX, y = posY } + + ( ( Just posX, Just posY ), _ ) -> + { x = posX, y = posY } + + _ -> + { x = 0, y = 0 } + + +{-| Configuration for updates. +-} +type UpdateConfig msg + = UpdateConfig + { onResize : SizeUnit -> Maybe msg + , onResizeStarted : Maybe msg + , onResizeEnded : Maybe msg + } + + +{-| Creates the update configuration. +Gives you the option to respond to various things that happen. + + For example: + - Draw a different view when the pane is resized: + + updateConfig + { onResize (\p -> Just (SwitchViews p)) + , onResizeStarted Nothing + , onResizeEnded Nothing + } + +-} +createUpdateConfig : + { onResize : SizeUnit -> Maybe msg + , onResizeStarted : Maybe msg + , onResizeEnded : Maybe msg + } + -> UpdateConfig msg +createUpdateConfig config = + UpdateConfig config + + +{-| Updates internal model. +-} +update : Msg -> State -> State +update msg model = + let + ( updatedModel, _ ) = + customUpdate + (createUpdateConfig + { onResize = \_ -> Nothing + , onResizeStarted = Nothing + , onResizeEnded = Nothing + } + ) + msg + model + in + updatedModel + + +{-| Updates internal model using custom configuration. +-} +customUpdate : UpdateConfig msg -> Msg -> State -> ( State, Maybe msg ) +customUpdate (UpdateConfig updateConfig) msg (State state) = + case ( state.dragState, msg ) of + ( Draggable Nothing, SplitterClick pos ) -> + ( State + { state + | dragState = + Draggable <| + Just + { paneInfo = + { width = pos.parentWidth + , height = pos.parentHeight + } + , anchor = + { x = Maybe.withDefault 0 pos.x + , y = Maybe.withDefault 0 pos.y + } + } + } + , updateConfig.onResizeStarted + ) + + ( Draggable (Just _), SplitterLeftAlone _ ) -> + ( State { state | dragState = Draggable Nothing } + , updateConfig.onResizeEnded + ) + + ( Draggable (Just { paneInfo, anchor }), SplitterMove newRequestedPosition ) -> + let + step = + { x = newRequestedPosition.x - anchor.x + , y = newRequestedPosition.y - anchor.y + } + + newSplitterPosition = + resize state.orientation state.splitterPosition step paneInfo.width paneInfo.height + in + ( State + { state + | splitterPosition = newSplitterPosition + , dragState = + Draggable <| + Just + { paneInfo = + { width = paneInfo.width + , height = paneInfo.height + } + , anchor = + { x = newRequestedPosition.x + , y = newRequestedPosition.y + } + } + } + , updateConfig.onResize newSplitterPosition + ) + + _ -> + ( State state, Nothing ) + + +resize : Orientation -> SizeUnit -> Position -> Int -> Int -> SizeUnit +resize ori splitterPosition step paneWidth paneHeight = + case ori of + Horizontal -> + case splitterPosition of + Px p -> + Px <| updateValue (\v -> v + step.x) p + + Percentage p -> + Percentage <| updateValue (\v -> v + toFloat step.x / toFloat paneWidth) p + + Vertical -> + case splitterPosition of + Px p -> + Px <| updateValue (\v -> v + step.y) p + + Percentage p -> + Percentage <| updateValue (\v -> v + toFloat step.y / toFloat paneHeight) p + + + +-- VIEW + + +{-| Lets you specify attributes such as style and children for the splitter element +-} +type alias HtmlDetails msg = + { attributes : List (Attribute msg) + , children : List (Html msg) + } + + +{-| Describes a custom splitter +-} +type CustomSplitter msg + = CustomSplitter (Html msg) + + +createDefaultSplitterDetails : Orientation -> DragState -> HtmlDetails msg +createDefaultSplitterDetails ori dragState = + case ori of + Horizontal -> + { attributes = + defaultHorizontalSplitterStyle dragState + , children = [] + } + + Vertical -> + { attributes = + defaultVerticalSplitterStyle dragState + , children = [] + } + + +{-| Creates a custom splitter. + + myCustomSplitter : CustomSplitter Msg + myCustomSplitter = + createCustomSplitter PaneMsg + { attributes = + [ style + [ ( "width", "20px" ) + , ( "height", "20px" ) + ] + ] + , children = + [] + } + +-} +createCustomSplitter : + (Msg -> msg) + -> HtmlDetails msg + -> CustomSplitter msg +createCustomSplitter toMsg details = + CustomSplitter <| + span + (onMouseDown toMsg :: onTouchStart toMsg :: onTouchEnd toMsg :: onTouchMove toMsg :: onTouchCancel toMsg :: details.attributes) + details.children + + +{-| Configuration for the view. +-} +type ViewConfig msg + = ViewConfig + { toMsg : Msg -> msg + , splitter : Maybe (CustomSplitter msg) + } + + +{-| Creates a configuration for the view. +-} +createViewConfig : + { toMsg : Msg -> msg + , customSplitter : Maybe (CustomSplitter msg) + } + -> ViewConfig msg +createViewConfig { toMsg, customSplitter } = + ViewConfig + { toMsg = toMsg + , splitter = customSplitter + } + + +{-| Creates a view. + + view : Model -> Html Msg + view = + SplitPane.view viewConfig firstView secondView + + + viewConfig : ViewConfig Msg + viewConfig = + createViewConfig + { toMsg = PaneMsg + , customSplitter = Nothing + } + + firstView : Html a + firstView = + img [ src "http://4.bp.blogspot.com/-s3sIvuCfg4o/VP-82RkCOGI/AAAAAAAALSY/509obByLvNw/s1600/baby-cat-wallpaper.jpg" ] [] + + + secondView : Html a + secondView = + img [ src "http://2.bp.blogspot.com/-pATX0YgNSFs/VP-82AQKcuI/AAAAAAAALSU/Vet9e7Qsjjw/s1600/Cat-hd-wallpapers.jpg" ] [] + +-} +view : ViewConfig msg -> Html msg -> Html msg -> State -> Html msg +view (ViewConfig viewConfig) firstView secondView (State state) = + let + splitter = + getConcreteSplitter viewConfig state.orientation state.dragState + in + div + (class "pane-container" :: paneContainerStyle state.orientation) + [ div + (class "pane-first-view" + :: firstChildViewStyle (State state) + ) + [ firstView ] + , splitter + , div + (class "pane-second-view" + :: secondChildViewStyle (State state) + ) + [ secondView ] + ] + + +getConcreteSplitter : + { toMsg : Msg -> msg + , splitter : Maybe (CustomSplitter msg) + } + -> Orientation + -> DragState + -> Html msg +getConcreteSplitter viewConfig ori dragState = + case viewConfig.splitter of + Just (CustomSplitter splitter) -> + splitter + + Nothing -> + case createCustomSplitter viewConfig.toMsg <| createDefaultSplitterDetails ori dragState of + CustomSplitter defaultSplitter -> + defaultSplitter + + + +-- STYLES + + +paneContainerStyle : Orientation -> List (Attribute a) +paneContainerStyle ori = + [ style "overflow" "hidden" + , style "display" "flex" + , style "flexDirection" <| + case ori of + Horizontal -> + "row" + + Vertical -> + "column" + , style "justifyContent" "center" + , style "alignItems" "center" + , style "width" "100%" + , style "height" "100%" + , style "boxSizing" "border-box" + ] + + +firstChildViewStyle : State -> List (Attribute a) +firstChildViewStyle (State state) = + case state.splitterPosition of + Px p -> + let + v = + (encode 0 <| int <| getValue p) ++ "px" + in + case state.orientation of + Horizontal -> + [ style "display" "flex" + , style "width" v + , style "height" "100%" + , style "overflow" "hidden" + , style "boxSizing" "border-box" + , style "position" "relative" + ] + + Vertical -> + [ style "display" "flex" + , style "width" "100%" + , style "height" v + , style "overflow" "hidden" + , style "boxSizing" "border-box" + , style "position" "relative" + ] + + Percentage p -> + let + v = + encode 0 <| float <| getValue p + in + [ style "display" "flex" + , style "flex" v + , style "width" "100%" + , style "height" "100%" + , style "overflow" "hidden" + , style "boxSizing" "border-box" + , style "position" "relative" + ] + + +secondChildViewStyle : State -> List (Attribute a) +secondChildViewStyle (State state) = + case state.splitterPosition of + Px _ -> + [ style "display" "flex" + , style "flex" "1" + , style "width" "100%" + , style "height" "100%" + , style "overflow" "hidden" + , style "boxSizing" "border-box" + , style "position" "relative" + ] + + Percentage p -> + let + v = + encode 0 <| float <| 1 - getValue p + in + [ style "display" "flex" + , style "flex" v + , style "width" "100%" + , style "height" "100%" + , style "overflow" "hidden" + , style "boxSizing" "border-box" + , style "position" "relative" + ] + + +defaultVerticalSplitterStyle : DragState -> List (Attribute a) +defaultVerticalSplitterStyle dragState = + baseDefaultSplitterStyles + ++ [ style "height" "11px" + , style "width" "100%" + , style "margin" "-5px 0" + , style "borderTop" "5px solid rgba(255, 255, 255, 0)" + , style "borderBottom" "5px solid rgba(255, 255, 255, 0)" + ] + ++ (case dragState of + Draggable _ -> + [ style "cursor" "row-resize" ] + + NotDraggable -> + [] + ) + + +defaultHorizontalSplitterStyle : DragState -> List (Attribute a) +defaultHorizontalSplitterStyle dragState = + baseDefaultSplitterStyles + ++ [ style "width" "11px" + , style "height" "100%" + , style "margin" "0 -5px" + , style "borderLeft" "5px solid rgba(255, 255, 255, 0)" + , style "borderRight" "5px solid rgba(255, 255, 255, 0)" + ] + ++ (case dragState of + Draggable _ -> + [ style "cursor" "col-resize" ] + + NotDraggable -> + [] + ) + + +baseDefaultSplitterStyles : List (Attribute a) +baseDefaultSplitterStyles = + [ style "width" "100%" + , style "background" "#000" + , style "boxSizing" "border-box" + , style "opacity" ".2" + , style "zIndex" "1" + , style "webkitUserSelect" "none" + , style "mozUserSelect" "none" + , style "userSelect" "none" + , style "backgroundClip" "padding-box" + ] + + + +-- EVENT HANDLERS + + +onMouseDown : (Msg -> msg) -> Attribute msg +onMouseDown toMsg = + Html.Events.custom "mousedown" <| D.map (\d -> { message = toMsg <| SplitterClick d, preventDefault = True, stopPropagation = False }) domInfo + + +onTouchStart : (Msg -> msg) -> Attribute msg +onTouchStart toMsg = + Html.Events.custom "touchstart" <| D.map (\d -> { message = toMsg <| SplitterClick d, preventDefault = True, stopPropagation = True }) domInfo + + +onTouchEnd : (Msg -> msg) -> Attribute msg +onTouchEnd toMsg = + Html.Events.custom "touchend" <| D.map (\d -> { message = toMsg <| SplitterLeftAlone <| domInfoToPosition d, preventDefault = True, stopPropagation = True }) domInfo + + +onTouchCancel : (Msg -> msg) -> Attribute msg +onTouchCancel toMsg = + Html.Events.custom "touchcancel" <| D.map (\d -> { message = toMsg <| SplitterLeftAlone <| domInfoToPosition d, preventDefault = True, stopPropagation = True }) domInfo + + +onTouchMove : (Msg -> msg) -> Attribute msg +onTouchMove toMsg = + Html.Events.custom "touchmove" <| D.map (\d -> { message = toMsg <| SplitterMove <| domInfoToPosition d, preventDefault = True, stopPropagation = True }) domInfo + + +{-| The position of the touch relative to the whole document. So if you are +scrolled down a bunch, you are still getting a coordinate relative to the +very top left corner of the _whole_ document. +-} +type alias DOMInfo = + { x : Maybe Int + , y : Maybe Int + , touchX : Maybe Int + , touchY : Maybe Int + , parentWidth : Int + , parentHeight : Int + } + + +{-| The decoder used to extract a `DOMInfo` from a JavaScript touch event. +-} +domInfo : D.Decoder DOMInfo +domInfo = + D.map6 DOMInfo + (D.maybe (field "clientX" D.int)) + (D.maybe (field "clientY" D.int)) + (D.maybe (at [ "touches", "0", "clientX" ] D.int)) + (D.maybe (at [ "touches", "0", "clientY" ] D.int)) + (at [ "currentTarget", "parentElement", "clientWidth" ] D.int) + (at [ "currentTarget", "parentElement", "clientHeight" ] D.int) + + + +-- SUBSCRIPTIONS + + +{-| Subscribes to relevant events for resizing +-} +subscriptions : State -> Sub Msg +subscriptions (State state) = + case state.dragState of + Draggable (Just _) -> + Sub.batch + [ Browser.Events.onMouseMove <| + D.map SplitterMove + (D.map2 Position + (D.field "pageX" D.int) + (D.field "pageY" D.int) + ) + , Browser.Events.onMouseUp <| + D.map SplitterLeftAlone + (D.map2 Position + (D.field "pageX" D.int) + (D.field "pageY" D.int) + ) + ] + + _ -> + Sub.none diff --git a/src/Ucm/Workspace/WorkspacePanes.elm b/src/Ucm/Workspace/WorkspacePanes.elm index 9e0d885..de3000c 100644 --- a/src/Ucm/Workspace/WorkspacePanes.elm +++ b/src/Ucm/Workspace/WorkspacePanes.elm @@ -4,7 +4,7 @@ import Code.Config exposing (Config) import Code.Definition.Reference exposing (Reference) import Html exposing (Html, div) import Html.Attributes exposing (class) -import SplitPane +import SplitPane.SplitPane as SplitPane import Ucm.AppContext exposing (AppContext) import Ucm.Workspace.WorkspaceContext exposing (WorkspaceContext) import Ucm.Workspace.WorkspacePane as WorkspacePane diff --git a/src/Window.elm b/src/Window.elm index d6dd095..acaae75 100644 --- a/src/Window.elm +++ b/src/Window.elm @@ -13,7 +13,7 @@ import Html , text ) import Html.Attributes exposing (attribute, class, classList, id) -import SplitPane +import SplitPane.SplitPane as SplitPane import UI import UI.Modal as Modal exposing (Modal) diff --git a/src/main.css b/src/main.css index 4423ced..9df229e 100644 --- a/src/main.css +++ b/src/main.css @@ -11,11 +11,11 @@ @import "./css/ucm/contextual-tag.css"; .connecting { - margin: 16rem auto; - width: 32rem; - display: flex; - flex-direction: column; - justify-content: center; - align-items: center; - flex-shrink: 0; + margin: 16rem auto; + width: 32rem; + display: flex; + flex-direction: column; + justify-content: center; + align-items: center; + flex-shrink: 0; }