chapter 5: Implement sliders and filters

The application communicates back and forth with JavaScript using ports
and subscriptions. It also receives initial data from JavaScript by
passing 'flags' to the init function.
This commit is contained in:
Alexander Kobjolke 2023-12-14 11:22:01 +01:00
parent 5f80082567
commit 43971bd268
6 changed files with 3249 additions and 260 deletions

View file

@ -1,12 +1,13 @@
module PhotoGroove exposing (main)
port module PhotoGroove exposing (main)
import Browser
import Html exposing (Html, button, div, h1, h3, img, input, label, text)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Html exposing (Attribute, Html, button, canvas, div, h1, h3, img, input, label, node, text)
import Html.Attributes as Attr exposing (..)
import Html.Events exposing (on, onClick)
import Http
import Json.Decode as D exposing (Decoder)
import Json.Decode.Pipeline as D
import Json.Encode
import Random
@ -16,9 +17,30 @@ type Status
| Errored String
type alias FilterValues =
{ hue : Int
, ripple : Int
, noise : Int
}
type alias FilterOptions =
{ url : String
, filters : List { name : String, amount : Float }
}
port setFilters : FilterOptions -> Cmd msg
port activityChanges : (String -> msg) -> Sub msg
type alias Model =
{ status : Status
, chosenSize : ThumbnailSize
, filterValues : FilterValues
, activity : String
}
@ -46,7 +68,9 @@ type ThumbnailSize
initialModel : Model
initialModel =
{ status = Loading
, chosenSize = Large
, chosenSize = Medium
, filterValues = { hue = 0, ripple = 0, noise = 0 }
, activity = ""
}
@ -66,25 +90,32 @@ view model =
[]
Loaded photos selected ->
viewLoaded photos selected model.chosenSize
viewLoaded model photos selected
Errored error ->
[ text ("Error: " ++ error) ]
viewLoaded : List Photo -> String -> ThumbnailSize -> List (Html Message)
viewLoaded photos selected size =
viewLoaded : Model -> List Photo -> String -> List (Html Message)
viewLoaded model photos selected =
[ h1 [] [ text "Photo Groove" ]
, button [ onClick ClickedSurpriseMe ] [ text "Surprise me!" ]
, div [ class "activity" ] [ text model.activity ]
, div [ class "filters" ]
[ viewFilter Hue model.filterValues.hue
, viewFilter Ripple model.filterValues.ripple
, viewFilter Noise model.filterValues.noise
]
, h3 [] [ text "Thumbnail Size:" ]
, div [ id "choose-size" ]
(List.map viewSizeChooser [ Small, Medium, Large ])
, div
[ id "thumbnails"
, class (sizeToClass size)
, class (sizeToClass model.chosenSize)
]
(List.map (viewThumbnail selected) photos)
, img [ class "large", src (urlPrefix ++ "large/" ++ selected) ] []
, canvas [ id "canvas-main", class "large" ] []
]
@ -112,6 +143,22 @@ viewSizeChooser size =
]
viewFilter : FilterType -> Int -> Html Message
viewFilter filterType magnitude =
div
[ class "filter-slider"
]
[ label [] [ text <| filterTypeToName filterType ]
, rangeSlider
[ Attr.max "11"
, property "val" (Json.Encode.int magnitude)
, onSlide (ChangedFilter filterType)
]
[]
, label [] [ text (String.fromInt magnitude) ]
]
sizeToString : ThumbnailSize -> String
sizeToString size =
case size of
@ -142,15 +189,36 @@ type Message
= ClickedThumbnail String
| ClickedSurpriseMe
| ClickedSize ThumbnailSize
| ChangedFilter FilterType Int
| GotRandomPhoto Photo
| GotPhotos (Result Http.Error (List Photo))
| GotActivity String
type FilterType
= Hue
| Ripple
| Noise
filterTypeToName : FilterType -> String
filterTypeToName t =
case t of
Hue ->
"Hue"
Ripple ->
"Ripple"
Noise ->
"Noise"
update : Message -> Model -> ( Model, Cmd Message )
update msg model =
case msg of
ClickedThumbnail thumb ->
( { model | status = selectUrl thumb model.status }, Cmd.none )
applyFilters { model | status = selectUrl thumb model.status }
ClickedSurpriseMe ->
case model.status of
@ -171,11 +239,14 @@ update msg model =
ClickedSize size ->
( { model | chosenSize = size }, Cmd.none )
ChangedFilter f val ->
applyFilters { model | filterValues = setFilterValue f val model.filterValues }
GotRandomPhoto photo ->
( { model | status = selectUrl photo.url model.status }, Cmd.none )
applyFilters { model | status = selectUrl photo.url model.status }
GotPhotos (Ok ((firstPhoto :: _) as photos)) ->
( { model | status = Loaded photos firstPhoto.url }, Cmd.none )
applyFilters { model | status = Loaded photos firstPhoto.url }
GotPhotos (Ok []) ->
( { model | status = Errored "No photos!" }, Cmd.none )
@ -183,6 +254,62 @@ update msg model =
GotPhotos (Err httpError) ->
( { model | status = Errored <| ("Failed to load photos: " ++ httpErrorToString httpError) }, Cmd.none )
GotActivity activity ->
( { model | activity = activity }, Cmd.none )
subscriptions : Model -> Sub Message
subscriptions _ =
activityChanges GotActivity
init : Float -> ( Model, Cmd Message )
init flags =
let
activity =
"Initializing Pasta v" ++ String.fromFloat flags
in
( { initialModel | activity = activity }, initialCommand )
setFilterValue : FilterType -> Int -> FilterValues -> FilterValues
setFilterValue filterType val values =
case filterType of
Hue ->
{ values | hue = val }
Ripple ->
{ values | ripple = val }
Noise ->
{ values | noise = val }
applyFilters : Model -> ( Model, Cmd msg )
applyFilters model =
case model.status of
Loaded photos selectedUrl ->
let
inPecent v =
toFloat v / 11
filters =
[ { name = filterTypeToName Hue, amount = inPecent model.filterValues.hue }
, { name = filterTypeToName Ripple, amount = inPecent model.filterValues.ripple }
, { name = filterTypeToName Noise, amount = inPecent model.filterValues.noise }
]
url =
urlPrefix ++ "large/" ++ selectedUrl
in
( model, setFilters { url = url, filters = filters } )
Loading ->
( model, Cmd.none )
Errored _ ->
( model, Cmd.none )
selectUrl : String -> Status -> Status
selectUrl url status =
@ -221,11 +348,23 @@ urlPrefix =
"http://elm-in-action.com/"
main : Program () Model Message
main : Program Float Model Message
main =
Browser.element
{ init = \_ -> ( initialModel, initialCommand )
, subscriptions = \_ -> Sub.none
{ init = init
, subscriptions = subscriptions
, view = view
, update = update
}
rangeSlider : List (Html.Attribute msg) -> List (Html msg) -> Html msg
rangeSlider =
node "range-slider"
onSlide : (Int -> msg) -> Attribute msg
onSlide toMsg =
D.at [ "detail", "userSlidTo" ] D.int
|> D.map toMsg
|> on "slide"