frontend/src/elm/SplitPane.elm - fidlbolt - Git at Google

 -- 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
     ( Model
     , Msg(..)
     , Orientation(..)
     , decode
     , encode
     , init
     , 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
     }


 {-| 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 Vertical 0.5 "SplitContainer"

 To use multiple split containers in a page, they must have unique IDs.

 -}
 init : Orientation -> Position -> String -> Model
 init orientation splitPosition id =
     { orientation = orientation
     , state = Static splitPosition
     , id = id
     , bounds = emptyBounds
     }


 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
       -- Toggles the orientation.
     | ToggleOrientation
       -- 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 )

         ToggleOrientation ->
             let
                 orientation =
                     case model.orientation of
                         Horizontal ->
                             Vertical

                         Vertical ->
                             Horizontal
             in
             ( { model | orientation = orientation }, 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
             )


 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 -> Sub Msg
 subscriptions model =
     case model.state of
         Static _ ->
             Sub.none

         Moving _ ->
             Sub.batch
                 [ Browser.Events.onMouseMove
                     (Decode.map2 DragMove decodeMouseState decodeCoords)
                 , Browser.Events.onMouseUp
                     (Decode.map DragStop decodeCoords)
                 ]


 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)
             )
	-- 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
	( Model
	, Msg(..)
	, Orientation(..)
	, decode
	, encode
	, init
	, 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
	}


	{-\| 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 Vertical 0.5 "SplitContainer"

	To use multiple split containers in a page, they must have unique IDs.

	-}
	init : Orientation -> Position -> String -> Model
	init orientation splitPosition id =
	{ orientation = orientation
	, state = Static splitPosition
	, id = id
	, bounds = emptyBounds
	}


	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
	-- Toggles the orientation.
	\| ToggleOrientation
	-- 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 )

	ToggleOrientation ->
	let
	orientation =
	case model.orientation of
	Horizontal ->
	Vertical

	Vertical ->
	Horizontal
	in
	( { model \| orientation = orientation }, 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
	)


	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 -> Sub Msg
	subscriptions model =
	case model.state of
	Static _ ->
	Sub.none

	Moving _ ->
	Sub.batch
	[ Browser.Events.onMouseMove
	(Decode.map2 DragMove decodeMouseState decodeCoords)
	, Browser.Events.onMouseUp
	(Decode.map DragStop decodeCoords)
	]


	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)
	)