added Search, refactored scrollingNav

This commit is contained in:
Lucas Payr 2020-04-10 08:04:33 +02:00
parent 57a221aa45
commit 82b59530fd
8 changed files with 249 additions and 157 deletions

View File

@ -154,17 +154,6 @@ validatedInput model =
} }
] ]
scrollingNavCard : Element msg
scrollingNavCard =
[ Element.el Heading.h3 <| Element.text "Scrolling Nav"
, Element.text "Resize the screen and open the side-menu. Then start scrolling to see the scrolling navigation in action."
|> List.singleton
|> Element.paragraph []
]
|> Element.column (Grid.simple ++ Card.large ++ [Element.height <| Element.fill])
view : Model -> Element Msg view : Model -> Element Msg
view model = view model =
Element.column (Grid.section ++ [ Element.centerX ]) Element.column (Grid.section ++ [ Element.centerX ])
@ -176,6 +165,6 @@ view model =
, Element.wrappedRow (Grid.simple ++ [Element.height <| Element.shrink]) <| , Element.wrappedRow (Grid.simple ++ [Element.height <| Element.shrink]) <|
[ filterSelect model.filterSelect [ filterSelect model.filterSelect
, validatedInput model.validatedInput , validatedInput model.validatedInput
, scrollingNavCard
] ]
] ]

View File

@ -21,7 +21,7 @@ import Framework.Tag as Tag
import Html exposing (Html) import Html exposing (Html)
import Html.Attributes as Attributes import Html.Attributes as Attributes
import Icons import Icons
import Layout exposing (Direction, Layout) import Layout exposing (Part, Layout)
import Core.Style exposing (Style) import Core.Style exposing (Style)
import Reusable import Reusable
import Set exposing (Set) import Set exposing (Set)
@ -43,6 +43,7 @@ type alias LoadedModel =
, layout : Layout , layout : Layout
, displayDialog : Bool , displayDialog : Bool
, deviceClass : DeviceClass , deviceClass : DeviceClass
, search : String
} }
@ -55,14 +56,16 @@ type LoadedMsg
= StatelessSpecific Stateless.Msg = StatelessSpecific Stateless.Msg
| ReusableSpecific Reusable.Msg | ReusableSpecific Reusable.Msg
| ComponentSpecific Component.Msg | ComponentSpecific Component.Msg
| ScrollingNavSpecific (ScrollingNav.Msg Section) | UpdateScrollingNav (ScrollingNav.Model Section -> ScrollingNav.Model Section)
| TimePassed Int | TimePassed Int
| AddSnackbar String | AddSnackbar String
| ToggleDialog Bool | ToggleDialog Bool
| ChangedSidebar (Maybe Direction) | ChangedSidebar (Maybe Part)
| Resized { width : Int, height : Int } | Resized { width : Int, height : Int }
| Load String | Load String
| JumpTo Section | JumpTo Section
| ChangedSearch String
| Idle
type Msg type Msg
@ -109,6 +112,11 @@ style =
, moreVerticalIcon = , moreVerticalIcon =
Icons.moreVertical |> Element.html |> Element.el [] Icons.moreVertical |> Element.html |> Element.el []
, spacing = 8 , spacing = 8
, title = Heading.h2
, searchIcon =
Icons.search |> Element.html |> Element.el []
, search =
Color.simple ++ [Font.color <| Element.rgb255 0 0 0 ]
} }
@ -119,6 +127,12 @@ initialModel { viewport } =
ScrollingNav.init ScrollingNav.init
{ labels = Section.toString { labels = Section.toString
, arrangement = Section.asList , arrangement = Section.asList
, toMsg = \result ->
case result of
Ok fun ->
UpdateScrollingNav fun
Err _ ->
Idle
} }
in in
( { component = Component.init ( { component = Component.init
@ -133,8 +147,9 @@ initialModel { viewport } =
} }
|> Element.classifyDevice |> Element.classifyDevice
|> .class |> .class
, search = ""
} }
, cmd |> Cmd.map ScrollingNavSpecific , cmd
) )
@ -261,16 +276,15 @@ view model =
] ]
, onChangedSidebar = ChangedSidebar , onChangedSidebar = ChangedSidebar
, title = , title =
(if m.deviceClass == Phone || m.deviceClass == Tablet then "Elm-Ui-Widgets"
m.scrollingNav
|> ScrollingNav.current Section.fromString
|> Maybe.map Section.toString
|> Maybe.withDefault "Elm-Ui-Widgets"
else
"Elm-Ui-Widgets"
)
|> Element.text |> Element.text
|> Element.el Heading.h1 |> Element.el Heading.h1
, search =
Just
{ text = m.search
, onChange = ChangedSearch
, label = "Search"
}
} }
@ -310,22 +324,17 @@ updateLoaded msg model =
) )
(Cmd.map StatelessSpecific) (Cmd.map StatelessSpecific)
ScrollingNavSpecific m -> UpdateScrollingNav fun ->
model.scrollingNav ( { model | scrollingNav = model.scrollingNav |> fun}
|> ScrollingNav.update m , Cmd.none
|> Tuple.mapBoth )
(\scrollingNav ->
{ model
| scrollingNav = scrollingNav
}
)
(Cmd.map ScrollingNavSpecific)
TimePassed int -> TimePassed int ->
( { model ( { model
| layout = model.layout |> Layout.timePassed int | layout = model.layout |> Layout.timePassed int
} }
, Cmd.none , ScrollingNav.getPos
|> Task.perform UpdateScrollingNav
) )
AddSnackbar string -> AddSnackbar string ->
@ -344,7 +353,7 @@ updateLoaded msg model =
) )
ChangedSidebar sidebar -> ChangedSidebar sidebar ->
( { model | layout = model.layout |> Layout.setSidebar sidebar } ( { model | layout = model.layout |> Layout.activate sidebar }
, Cmd.none , Cmd.none
) )
@ -354,10 +363,18 @@ updateLoaded msg model =
JumpTo section -> JumpTo section ->
( model ( model
, model.scrollingNav , model.scrollingNav
|> ScrollingNav.jumpTo section |> ScrollingNav.jumpTo
|> Cmd.map ScrollingNavSpecific { section = section
, onChange = always Idle
}
) )
ChangedSearch string ->
( { model | search = string},Cmd.none)
Idle ->
( model , Cmd.none)
update : Msg -> Model -> ( Model, Cmd Msg ) update : Msg -> Model -> ( Model, Cmd Msg )
update msg model = update msg model =
@ -377,9 +394,7 @@ update msg model =
subscriptions : Model -> Sub Msg subscriptions : Model -> Sub Msg
subscriptions model = subscriptions model =
Sub.batch Sub.batch
[ ScrollingNav.subscriptions [ Time.every 50 (always (TimePassed 50))
|> Sub.map ScrollingNavSpecific
, Time.every 50 (always (TimePassed 50))
, Events.onResize (\h w -> Resized { height = h, width = w }) , Events.onResize (\h w -> Resized { height = h, width = w })
] ]
|> Sub.map LoadedSpecific |> Sub.map LoadedSpecific

View File

@ -6,6 +6,7 @@ module Icons exposing
, circle , circle
, triangle , triangle
, square , square
, search
) )
import Html exposing (Html) import Html exposing (Html)
@ -76,3 +77,10 @@ square =
svgFeatherIcon "square" svgFeatherIcon "square"
[ Svg.rect [ Svg.Attributes.x "3", y "3", width "18", height "18", rx "2", ry "2" ] [] [ Svg.rect [ Svg.Attributes.x "3", y "3", width "18", height "18", rx "2", ry "2" ] []
] ]
search : Html msg
search =
svgFeatherIcon "search"
[ Svg.circle [ cx "11", cy "11", r "8" ] []
, Svg.line [ x1 "21", y1 "21", x2 "16.65", y2 "16.65" ] []
]

View File

@ -142,6 +142,15 @@ sortTable model =
] ]
|> Element.column (Grid.simple ++ Card.large ++ [Element.height <| Element.fill]) |> Element.column (Grid.simple ++ Card.large ++ [Element.height <| Element.fill])
scrollingNavCard : Element msg
scrollingNavCard =
[ Element.el Heading.h3 <| Element.text "Scrolling Nav"
, Element.text "Resize the screen and open the side-menu. Then start scrolling to see the scrolling navigation in action."
|> List.singleton
|> Element.paragraph []
]
|> Element.column (Grid.simple ++ Card.large ++ [Element.height <| Element.fill])
view : view :
{ addSnackbar : String -> msg { addSnackbar : String -> msg
@ -159,5 +168,6 @@ view { addSnackbar, msgMapper, model } =
, Element.wrappedRow (Grid.simple ++ [Element.height <| Element.shrink]) <| , Element.wrappedRow (Grid.simple ++ [Element.height <| Element.shrink]) <|
[ snackbar addSnackbar [ snackbar addSnackbar
, sortTable model |> Element.map msgMapper , sortTable model |> Element.map msgMapper
, scrollingNavCard
] ]
] ]

View File

@ -18,7 +18,7 @@ import Html exposing (Html)
import Html.Attributes as Attributes import Html.Attributes as Attributes
import Set exposing (Set) import Set exposing (Set)
import Widget import Widget
import Layout exposing (Direction(..)) import Layout exposing (Part(..))
type alias Model = type alias Model =
@ -242,7 +242,7 @@ tab model =
scrim : scrim :
{ showDialog : msg { showDialog : msg
, changedSheet : Maybe Direction -> msg , changedSheet : Maybe Part -> msg
} -> Model -> Element msg } -> Model -> Element msg
scrim {showDialog,changedSheet} model = scrim {showDialog,changedSheet} model =
[ Element.el Heading.h3 <| Element.text "Scrim" [ Element.el Heading.h3 <| Element.text "Scrim"
@ -251,11 +251,11 @@ scrim {showDialog,changedSheet} model =
, label = Element.text <| "Show dialog" , label = Element.text <| "Show dialog"
} }
, Input.button Button.simple , Input.button Button.simple
{ onPress = Just <| changedSheet <| Just Left { onPress = Just <| changedSheet <| Just LeftSheet
, label = Element.text <| "show left sheet" , label = Element.text <| "show left sheet"
} }
, Input.button Button.simple , Input.button Button.simple
{ onPress = Just <| changedSheet <| Just Right { onPress = Just <| changedSheet <| Just RightSheet
, label = Element.text <| "show right sheet" , label = Element.text <| "show right sheet"
} }
] ]
@ -301,7 +301,7 @@ carousel model =
view : view :
{ msgMapper : Msg -> msg { msgMapper : Msg -> msg
, showDialog : msg , showDialog : msg
, changedSheet : Maybe Direction -> msg , changedSheet : Maybe Part -> msg
} -> Model -> Element msg } -> Model -> Element msg
view { msgMapper, showDialog, changedSheet } model = view { msgMapper, showDialog, changedSheet } model =
Element.column (Grid.section ) Element.column (Grid.section )

View File

@ -1,4 +1,4 @@
module Core.Style exposing (Style,menuTabButtonSelected,menuTabButton, menuButton, menuButtonSelected, menuIconButton, sheetButton, sheetButtonSelected) module Core.Style exposing (Style, menuButton, menuButtonSelected, menuIconButton, menuTabButton, menuTabButtonSelected, sheetButton, sheetButtonSelected)
import Element exposing (Attribute, Element) import Element exposing (Attribute, Element)
import Element.Input as Input import Element.Input as Input
@ -19,10 +19,20 @@ type alias Style msg =
, menuIcon : Element Never , menuIcon : Element Never
, moreVerticalIcon : Element Never , moreVerticalIcon : Element Never
, spacing : Int , spacing : Int
, title : List (Attribute msg)
, searchIcon : Element Never
, search : List (Attribute msg)
} }
menuButtonSelected : Style msg -> { label : String, icon : Element Never, onPress : Maybe msg } -> Element msg type alias ButtonInfo msg =
{ label : String
, icon : Element Never
, onPress : Maybe msg
}
menuButtonSelected : Style msg -> ButtonInfo msg -> Element msg
menuButtonSelected config { label, icon, onPress } = menuButtonSelected config { label, icon, onPress } =
Input.button (config.menuButton ++ config.menuButtonSelected) Input.button (config.menuButton ++ config.menuButtonSelected)
{ onPress = onPress { onPress = onPress
@ -34,7 +44,7 @@ menuButtonSelected config { label, icon, onPress } =
} }
menuButton : Style msg -> { label : String, icon : Element Never, onPress : Maybe msg } -> Element msg menuButton : Style msg -> ButtonInfo msg -> Element msg
menuButton config { label, icon, onPress } = menuButton config { label, icon, onPress } =
Input.button config.menuButton Input.button config.menuButton
{ onPress = onPress { onPress = onPress
@ -46,7 +56,7 @@ menuButton config { label, icon, onPress } =
} }
menuIconButton : Style msg -> { label : String, icon : Element Never, onPress : Maybe msg } -> Element msg menuIconButton : Style msg -> ButtonInfo msg -> Element msg
menuIconButton config { label, icon, onPress } = menuIconButton config { label, icon, onPress } =
Input.button config.menuButton Input.button config.menuButton
{ onPress = onPress { onPress = onPress
@ -54,7 +64,7 @@ menuIconButton config { label, icon, onPress } =
} }
sheetButton : Style msg -> { label : String, icon : Element Never, onPress : Maybe msg } -> Element msg sheetButton : Style msg -> ButtonInfo msg -> Element msg
sheetButton config { label, icon, onPress } = sheetButton config { label, icon, onPress } =
Input.button config.sheetButton Input.button config.sheetButton
{ onPress = onPress { onPress = onPress
@ -66,7 +76,7 @@ sheetButton config { label, icon, onPress } =
} }
sheetButtonSelected : Style msg -> { label : String, icon : Element Never, onPress : Maybe msg } -> Element msg sheetButtonSelected : Style msg -> ButtonInfo msg -> Element msg
sheetButtonSelected config { label, icon, onPress } = sheetButtonSelected config { label, icon, onPress } =
Input.button (config.sheetButton ++ config.sheetButtonSelected) Input.button (config.sheetButton ++ config.sheetButtonSelected)
{ onPress = onPress { onPress = onPress
@ -77,7 +87,8 @@ sheetButtonSelected config { label, icon, onPress } =
] ]
} }
menuTabButton : Style msg -> { label : String, icon : Element Never, onPress : Maybe msg } -> Element msg
menuTabButton : Style msg -> ButtonInfo msg -> Element msg
menuTabButton config { label, icon, onPress } = menuTabButton config { label, icon, onPress } =
Input.button (config.menuButton ++ config.tabButton) Input.button (config.menuButton ++ config.tabButton)
{ onPress = onPress { onPress = onPress
@ -88,7 +99,8 @@ menuTabButton config { label, icon, onPress } =
] ]
} }
menuTabButtonSelected : Style msg -> { label : String, icon : Element Never, onPress : Maybe msg } -> Element msg
menuTabButtonSelected : Style msg -> ButtonInfo msg -> Element msg
menuTabButtonSelected config { label, icon, onPress } = menuTabButtonSelected config { label, icon, onPress } =
Input.button (config.menuButton ++ config.tabButton ++ config.tabButtonSelected) Input.button (config.menuButton ++ config.tabButton ++ config.tabButtonSelected)
{ onPress = onPress { onPress = onPress

View File

@ -1,5 +1,6 @@
module Layout exposing (Direction(..), Layout, init, queueMessage, setSidebar, timePassed, view) module Layout exposing (Layout, Part(..), activate, init, queueMessage, timePassed, view)
import Array
import Browser.Dom exposing (Viewport) import Browser.Dom exposing (Viewport)
import Core.Style as Style exposing (Style) import Core.Style as Style exposing (Style)
import Element exposing (Attribute, DeviceClass(..), Element) import Element exposing (Attribute, DeviceClass(..), Element)
@ -12,21 +13,22 @@ import Widget
import Widget.Snackbar as Snackbar import Widget.Snackbar as Snackbar
type Direction type Part
= Left = LeftSheet
| Right | RightSheet
| Search
type alias Layout = type alias Layout =
{ snackbar : Snackbar.Model String { snackbar : Snackbar.Model String
, sheet : Maybe Direction , active : Maybe Part
} }
init : Layout init : Layout
init = init =
{ snackbar = Snackbar.init { snackbar = Snackbar.init
, sheet = Nothing , active = Nothing
} }
@ -37,24 +39,27 @@ queueMessage message layout =
} }
setSidebar : Maybe Direction -> Layout -> Layout activate : Maybe Part -> Layout -> Layout
setSidebar direction layout = activate part layout =
{ layout { layout
| sheet = direction | active = part
} }
timePassed : Int -> Layout -> Layout timePassed : Int -> Layout -> Layout
timePassed sec layout = timePassed sec layout =
case layout.sheet of case layout.active of
Nothing -> Just LeftSheet ->
layout
Just RightSheet ->
layout
_ ->
{ layout { layout
| snackbar = layout.snackbar |> Snackbar.timePassed sec | snackbar = layout.snackbar |> Snackbar.timePassed sec
} }
_ ->
layout
view : view :
List (Attribute msg) List (Attribute msg)
@ -68,12 +73,18 @@ view :
{ selected : Int { selected : Int
, items : List { label : String, icon : Element Never, onPress : Maybe msg } , items : List { label : String, icon : Element Never, onPress : Maybe msg }
} }
, search :
Maybe
{ onChange : String -> msg
, text : String
, label : String
}
, actions : List { label : String, icon : Element Never, onPress : Maybe msg } , actions : List { label : String, icon : Element Never, onPress : Maybe msg }
, onChangedSidebar : Maybe Direction -> msg , onChangedSidebar : Maybe Part -> msg
, style : Style msg , style : Style msg
} }
-> Html msg -> Html msg
view attributes { title, onChangedSidebar, menu, actions, deviceClass, dialog, content, style, layout } = view attributes { search, title, onChangedSidebar, menu, actions, deviceClass, dialog, content, style, layout } =
let let
( primaryActions, moreActions ) = ( primaryActions, moreActions ) =
( if (actions |> List.length) > 4 then ( if (actions |> List.length) > 4 then
@ -107,10 +118,14 @@ view attributes { title, onChangedSidebar, menu, actions, deviceClass, dialog, c
|| ((menu.items |> List.length) > 5) || ((menu.items |> List.length) > 5)
then then
[ Input.button style.menuButton [ Input.button style.menuButton
{ onPress = Just <| onChangedSidebar <| Just Left { onPress = Just <| onChangedSidebar <| Just LeftSheet
, label = style.menuIcon |> Element.map never , label = style.menuIcon |> Element.map never
} }
, title , menu.items
|> Array.fromList
|> Array.get menu.selected
|> Maybe.map (.label >> Element.text >> Element.el style.title)
|> Maybe.withDefault title
] ]
else else
@ -133,7 +148,40 @@ view attributes { title, onChangedSidebar, menu, actions, deviceClass, dialog, c
[ Element.width <| Element.shrink [ Element.width <| Element.shrink
, Element.spacing 8 , Element.spacing 8
] ]
, [ primaryActions , if deviceClass == Phone then
Element.none
else
search
|> Maybe.map
(\{ onChange, text, label } ->
Input.text style.search
{ onChange = onChange
, text = text
, placeholder =
Just <|
Input.placeholder [] <|
Element.text label
, label = Input.labelHidden label
}
)
|> Maybe.withDefault Element.none
, [ if deviceClass == Phone then
search
|> Maybe.map
(\{ label } ->
[ Style.menuButton style
{ onPress = Just <| onChangedSidebar <| Just Search
, icon = style.searchIcon
, label = label
}
]
)
|> Maybe.withDefault []
else
[]
, primaryActions
|> List.map |> List.map
(if deviceClass == Phone then (if deviceClass == Phone then
Style.menuIconButton style Style.menuIconButton style
@ -146,7 +194,7 @@ view attributes { title, onChangedSidebar, menu, actions, deviceClass, dialog, c
else else
[ Style.menuButton style [ Style.menuButton style
{ onPress = Just <| onChangedSidebar <| Just Right { onPress = Just <| onChangedSidebar <| Just RightSheet
, icon = style.moreVerticalIcon , icon = style.moreVerticalIcon
, label = "" , label = ""
} }
@ -182,10 +230,13 @@ view attributes { title, onChangedSidebar, menu, actions, deviceClass, dialog, c
] ]
) )
|> Maybe.withDefault Element.none |> Maybe.withDefault Element.none
sheet = sheet =
case layout.sheet of case layout.active of
Just Left -> Just LeftSheet ->
menu.items [ [ title
]
, menu.items
|> List.indexedMap |> List.indexedMap
(\i -> (\i ->
if i == menu.selected then if i == menu.selected then
@ -194,6 +245,8 @@ view attributes { title, onChangedSidebar, menu, actions, deviceClass, dialog, c
else else
Style.sheetButton style Style.sheetButton style
) )
]
|> List.concat
|> Element.column [ Element.width <| Element.fill ] |> Element.column [ Element.width <| Element.fill ]
|> Element.el |> Element.el
(style.sheet (style.sheet
@ -202,7 +255,7 @@ view attributes { title, onChangedSidebar, menu, actions, deviceClass, dialog, c
] ]
) )
Just Right -> Just RightSheet ->
moreActions moreActions
|> List.map (Style.sheetButton style) |> List.map (Style.sheetButton style)
|> Element.column [ Element.width <| Element.fill ] |> Element.column [ Element.width <| Element.fill ]
@ -213,6 +266,26 @@ view attributes { title, onChangedSidebar, menu, actions, deviceClass, dialog, c
] ]
) )
Just Search ->
case search of
Just { onChange, text, label } ->
Input.text style.search
{ onChange = onChange
, text = text
, placeholder =
Just <|
Input.placeholder [] <|
Element.text label
, label = Input.labelHidden label
}
|> Element.el
[ Element.alignTop
, Element.width <| Element.fill
]
Nothing ->
Element.none
Nothing -> Nothing ->
Element.none Element.none
in in
@ -223,7 +296,7 @@ view attributes { title, onChangedSidebar, menu, actions, deviceClass, dialog, c
, [ Element.inFront nav , [ Element.inFront nav
, Element.inFront snackbar , Element.inFront snackbar
] ]
, if (layout.sheet /= Nothing) || (dialog /= Nothing) then , if (layout.active /= Nothing) || (dialog /= Nothing) then
Widget.scrim Widget.scrim
{ onDismiss = { onDismiss =
Just <| Just <|

View File

@ -1,7 +1,7 @@
module Widget.ScrollingNav exposing module Widget.ScrollingNav exposing
( Model, Msg, init, update, subscriptions, view, viewSections, current ( Model, init, view, viewSections, current
, jumpTo, syncPositions , jumpTo, syncPositions
, jumpToWithOffset , getPos, jumpToWithOffset, setPos
) )
{-| The Scrolling Nav is a navigation bar thats updates while you scroll through {-| The Scrolling Nav is a navigation bar thats updates while you scroll through
@ -24,8 +24,7 @@ import Element exposing (Attribute, Element)
import Framework.Grid as Grid import Framework.Grid as Grid
import Html.Attributes as Attributes import Html.Attributes as Attributes
import IntDict exposing (IntDict) import IntDict exposing (IntDict)
import Task import Task exposing (Task)
import Time
{-| -} {-| -}
@ -37,23 +36,15 @@ type alias Model section =
} }
{-| -}
type Msg section
= GotHeaderPos section (Result Dom.Error Int)
| ChangedViewport (Result Dom.Error ())
| SyncPosition Int
| JumpTo section
| TimePassed
{-| The intial state include the labels and the arrangement of the sections {-| The intial state include the labels and the arrangement of the sections
-} -}
init : init :
{ labels : section -> String { labels : section -> String
, arrangement : List section , arrangement : List section
, toMsg : Result Dom.Error (Model section -> Model section) -> msg
} }
-> ( Model section, Cmd (Msg section) ) -> ( Model section, Cmd msg )
init { labels, arrangement } = init { labels, arrangement, toMsg } =
{ labels = labels { labels = labels
, positions = IntDict.empty , positions = IntDict.empty
, arrangement = arrangement , arrangement = arrangement
@ -62,97 +53,91 @@ init { labels, arrangement } =
|> (\a -> |> (\a ->
( a ( a
, syncPositions a , syncPositions a
|> Task.attempt toMsg
) )
) )
{-| -} getPos : Task x (Model selection -> Model selection)
update : Msg section -> Model section -> ( Model section, Cmd (Msg section) ) getPos =
update msg model = Dom.getViewport
case msg of |> Task.map
GotHeaderPos label result -> (\int model ->
( case result of { model
Ok pos -> | scrollPos = int.viewport.y |> round
{ model }
| positions =
model.positions
|> IntDict.insert pos
(label |> model.labels)
}
Err _ ->
model
, Cmd.none
)
ChangedViewport _ ->
( model, Cmd.none )
SyncPosition pos ->
( { model
| scrollPos = pos
}
, Cmd.none
)
TimePassed ->
( model
, Dom.getViewport
|> Task.map (.viewport >> .y >> round)
|> Task.perform SyncPosition
)
JumpTo elem ->
( model
, model
|> jumpTo elem
) )
{-| -} setPos : Int -> Model section -> Model section
subscriptions : Sub (Msg msg) setPos pos model =
subscriptions = { model | scrollPos = pos }
Time.every 100 (always TimePassed)
{-| scrolls the screen to the respective section {-| scrolls the screen to the respective section
-} -}
jumpTo : section -> Model section -> Cmd (Msg msg) jumpTo :
jumpTo section { labels } = { section : section
, onChange : Result Dom.Error () -> msg
}
-> Model section
-> Cmd msg
jumpTo { section, onChange } { labels } =
Dom.getElement (section |> labels) Dom.getElement (section |> labels)
|> Task.andThen |> Task.andThen
(\{ element } -> (\{ element } ->
Dom.setViewport 0 (element.y) Dom.setViewport 0 element.y
) )
|> Task.attempt ChangedViewport |> Task.attempt onChange
{-| scrolls the screen to the respective section with some offset {-| scrolls the screen to the respective section with some offset
-} -}
jumpToWithOffset : Float -> section -> Model section -> Cmd (Msg msg) jumpToWithOffset :
jumpToWithOffset offset section { labels } = { offset : Float
, section : section
, onChange : Result Dom.Error () -> msg
}
-> Model section
-> Cmd msg
jumpToWithOffset { offset, section, onChange } { labels } =
Dom.getElement (section |> labels) Dom.getElement (section |> labels)
|> Task.andThen |> Task.andThen
(\{ element } -> (\{ element } ->
Dom.setViewport 0 (element.y - offset) Dom.setViewport 0 (element.y - offset)
) )
|> Task.attempt ChangedViewport |> Task.attempt onChange
{-| -} {-| -}
syncPositions : Model section -> Cmd (Msg section) syncPositions : Model section -> Task Dom.Error (Model section -> Model section)
syncPositions { labels, arrangement } = syncPositions { labels, arrangement } =
arrangement arrangement
|> List.map |> List.map
(\label -> (\label ->
Dom.getElement (labels label) Dom.getElement (labels label)
|> Task.map |> Task.map
(.element (\x ->
>> .y ( x.element.y |> round
>> round , label
)
) )
|> Task.attempt
(GotHeaderPos label)
) )
|> Cmd.batch |> Task.sequence
|> Task.map
(\list m ->
list
|> List.foldl
(\( pos, label ) model ->
{ model
| positions =
model.positions
|> IntDict.insert pos
(label |> model.labels)
}
)
m
)
{-| -} {-| -}
@ -170,7 +155,7 @@ current fromString { positions, scrollPos } =
viewSections : viewSections :
{ label : String -> Element msg { label : String -> Element msg
, fromString : String -> Maybe section , fromString : String -> Maybe section
, msgMapper : Msg section -> msg , onSelect : section -> msg
, attributes : Bool -> List (Attribute msg) , attributes : Bool -> List (Attribute msg)
} }
-> Model section -> Model section
@ -181,11 +166,11 @@ viewSections :
, onChange : section -> msg , onChange : section -> msg
, attributes : Bool -> List (Attribute msg) , attributes : Bool -> List (Attribute msg)
} }
viewSections { label, fromString, msgMapper, attributes } ({ arrangement, scrollPos, labels, positions } as model) = viewSections { label, fromString, onSelect, attributes } ({ arrangement, labels } as model) =
{ selected = model |> current fromString { selected = model |> current fromString
, options = arrangement , options = arrangement
, label = \elem -> label (elem |> labels) , label = \elem -> label (elem |> labels)
, onChange = JumpTo >> msgMapper , onChange = onSelect
, attributes = attributes , attributes = attributes
} }