blob: 9c43996df188dab51b182330732fdc735ede961c [file] [log] [blame]
-- Copyright 2020 The Fuchsia Authors. All rights reserved.
-- Use of this source code is governed by a BSD-style license that can be
-- found in the LICENSE file.
module SplitPane exposing
( Layout(..)
, Model
, Msg(..)
, Orientation(..)
, decode
, encode
, init
, initCmd
, subscriptions
, update
, view
)
{-| This module provides draggable split panes.
It only sets width/height styles. The client is responsible for customizing
these CSS classes:
- .split-container, applied to the overall container div.
- .split-item, applied to the two panes inside the container.
- .split-item--first, applied only to the top/left pane.
- .split-item--second, applied only to the bottom/right pane.
- .split-splitter, applied to the splitter between the two panes.
- .split-{container,item,splitter}--horizontal, applied in horizontal mode.
- .split-{container,item,splitter}--vertical, applied in vertical mode.
-}
import Browser.Dom
import Browser.Events
import Html exposing (Html)
import Html.Attributes as Attributes
import Html.Events as Events
import Json.Decode as Decode
import Json.Encode as Encode
import Task
------------- MODEL ------------------------------------------------------------
type alias Model =
{ -- Current orientation of the splitter.
orientation : Orientation
-- Keep track of whether the split is being dragged and its position.
, state : State
-- HTML id to use for the container div.
, id : String
-- Bounds of the container div.
, bounds : Bounds
}
{-| Layout chosen by the user. Auto means Horizontal for narrow windows and
Vertical for wide windows.
-}
type Layout
= Locked Orientation
| Auto
{-| Orientation can be confusing. This module uses the terms to refer to the
splitter, so Horizontal means top/bottom and Vertical means left/right.
-}
type Orientation
= Horizontal
| Vertical
type State
= Static Position
| Moving Position
{-| The position of the splitter is a fraction from 0 to 1, where 0 means
dragged all the way to the top/left and 1 means all the way to the bottom/right.
-}
type alias Position =
Float
type alias Bounds =
{ x : Pixels
, y : Pixels
, width : Pixels
, height : Pixels
}
{-| Pixels means the CSS pixel unit (not necessary the same as display pixels).
-}
type alias Pixels =
Float
{-| Initializes a split pane. For example:
init Auto 0.5 "SplitContainer"
To use multiple split containers in a page, they must have unique IDs.
-}
init : Layout -> Position -> String -> Model
init layout splitPosition id =
{ orientation =
case layout of
Locked orientation ->
orientation
Auto ->
Vertical
, state = Static splitPosition
, id = id
, bounds = emptyBounds
}
initCmd : Layout -> Cmd Msg
initCmd layout =
case layout of
Locked _ ->
Cmd.none
Auto ->
autoOrient
emptyBounds : Bounds
emptyBounds =
{ x = 0, y = 0, width = 0, height = 0 }
position : State -> Position
position state =
case state of
Static x ->
x
Moving x ->
x
------------- UPDATE -----------------------------------------------------------
type Msg
= NoOp
-- Update the layout.
| SetLayout Layout
-- Set the orientation for the Auto layout, given the window width.
| AutoOrient Float
-- PreDragStart is necessary to kick off getting the container div bounds.
-- Without it, if you resize the window and then start dragging, there is
-- an annoying flicker effect.
| PreDragStart
-- Start dragging, providing the updated container bounds.
| DragStart Bounds
-- Continue dragging, indicating whether the mouse is still down or not.
| DragMove MouseState Coords
-- Finish dragging.
| DragStop Coords
type MouseState
= MouseUp
| MouseDown
{-| Coords represents a position relative to the top-left of the page.
-}
type alias Coords =
{ pageX : Pixels
, pageY : Pixels
}
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
NoOp ->
( model, Cmd.none )
SetLayout layout ->
case layout of
Locked orientation ->
( { model | orientation = orientation }, Cmd.none )
Auto ->
( model, autoOrient )
AutoOrient width ->
( { model
| orientation =
if width < 1200 then
Horizontal
else
Vertical
}
, Cmd.none
)
PreDragStart ->
( model, startDrag model )
DragStart bounds ->
( { model
| bounds = bounds
, state = Moving (position model.state)
}
, Cmd.none
)
DragMove mouseState coords ->
( { model
| state =
case mouseState of
MouseDown ->
Moving (coordsToPosition coords model)
MouseUp ->
Static (position model.state)
}
, Cmd.none
)
DragStop coords ->
( { model
| state = Static (coordsToPosition coords model)
}
, Cmd.none
)
autoOrient : Cmd Msg
autoOrient =
Task.perform (\vp -> AutoOrient vp.viewport.width) Browser.Dom.getViewport
startDrag : Model -> Cmd Msg
startDrag model =
let
element =
Browser.Dom.getElement model.id |> Task.map .element
handle result =
case result of
Ok bounds ->
DragStart bounds
Err _ ->
NoOp
in
Task.attempt handle element
coordsToPosition : Coords -> Model -> Position
coordsToPosition coords model =
let
fraction =
case model.orientation of
Horizontal ->
(coords.pageY - model.bounds.y) / model.bounds.height
Vertical ->
(coords.pageX - model.bounds.x) / model.bounds.width
in
clamp 0 1 fraction
------------- SUBSCRIPTIONS ----------------------------------------------------
subscriptions : Model -> Layout -> Sub Msg
subscriptions model layout =
let
mouseSubscriptions =
case model.state of
Static _ ->
[]
Moving _ ->
[ Browser.Events.onMouseMove
(Decode.map2 DragMove decodeMouseState decodeCoords)
, Browser.Events.onMouseUp
(Decode.map DragStop decodeCoords)
]
handleResize =
\w _ -> AutoOrient (toFloat w)
resizeSubscriptions =
case layout of
Locked _ ->
[]
Auto ->
[ Browser.Events.onResize handleResize ]
in
Sub.batch (mouseSubscriptions ++ resizeSubscriptions)
decodeMouseState : Decode.Decoder MouseState
decodeMouseState =
Decode.field "buttons" <|
Decode.map
(\buttons ->
case buttons of
1 ->
MouseDown
_ ->
MouseUp
)
Decode.int
decodeCoords : Decode.Decoder Coords
decodeCoords =
Decode.map2 Coords
(Decode.field "pageX" Decode.float)
(Decode.field "pageY" Decode.float)
------------- VIEW -------------------------------------------------------------
{-| Creates the split pane view. The toMsg parameter converts a SplitPane.Msg to
the top-level Msg type of the app.
-}
view : Html msg -> Html msg -> (Msg -> msg) -> Model -> Html msg
view firstView secondView toMsg model =
let
orientationModifier =
case model.orientation of
Horizontal ->
"horizontal"
Vertical ->
"vertical"
classWithOrientation className =
Attributes.class
(className ++ " " ++ className ++ "--" ++ orientationModifier)
-- Keep the cursor in the center of the resize bar.
firstItemSize =
size model.orientation
("calc("
++ String.fromFloat (position model.state * 100)
++ "% - "
++ String.fromFloat (splitterSize / 2)
++ "px)"
)
-- But don't let the half the bar disappear under the far edge.
firstItemMaxSize =
maxSize
model.orientation
("calc(100% - " ++ String.fromFloat splitterSize ++ "px)")
in
Html.div
[ Attributes.id model.id
, classWithOrientation "split-container"
]
[ Html.div
[ classWithOrientation "split-item"
, Attributes.class "split-item--first"
, firstItemSize
, firstItemMaxSize
]
[ firstView ]
, Html.div
[ classWithOrientation "split-splitter"
, size model.orientation (String.fromFloat splitterSize ++ "px")
, Events.onMouseDown (toMsg PreDragStart)
]
[]
, Html.div
[ classWithOrientation "split-item"
, Attributes.class "split-item--second"
]
[ secondView ]
]
splitterSize : Pixels
splitterSize =
8
size : Orientation -> String -> Html.Attribute msg
size orientation value =
case orientation of
Horizontal ->
Attributes.style "height" value
Vertical ->
Attributes.style "width" value
maxSize : Orientation -> String -> Html.Attribute msg
maxSize orientation value =
case orientation of
Horizontal ->
Attributes.style "max-height" value
Vertical ->
Attributes.style "max-width" value
------------- ENCODE / DECODE --------------------------------------------------
{-| Encodes the model. This only includes the orientation and drag position. It
omits the ID, bounds, and static/moving, since persisting those is not useful.
-}
encode : Model -> Encode.Value
encode model =
Encode.object
[ ( "orientation", encodeOrientation model.orientation )
, ( "state", Encode.float (position model.state) )
]
{-| Decodes the model. You must provide the ID.
-}
decode : String -> Decode.Decoder Model
decode id =
Decode.map4 Model
(Decode.field "orientation" decodeOrientation)
(Decode.field "state" (Decode.map Static Decode.float))
(Decode.succeed id)
(Decode.succeed emptyBounds)
encodeOrientation : Orientation -> Encode.Value
encodeOrientation orientation =
case orientation of
Horizontal ->
Encode.string "horizontal"
Vertical ->
Encode.string "vertical"
decodeOrientation : Decode.Decoder Orientation
decodeOrientation =
Decode.string
|> Decode.andThen
(\string ->
case string of
"horizontal" ->
Decode.succeed Horizontal
"vertical" ->
Decode.succeed Vertical
_ ->
Decode.fail ("Invalid orientation: " ++ string)
)