module Material.Ripple where
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events
import Json.Decode as Json exposing ((:=), at)
import Effects exposing (Effects, tick, none)
import Material.Aux exposing (Rectangle, rectangleDecoder, effect)
-- MODEL
type alias Metrics =
{ rect : Rectangle
, x : Float
, y : Float
}
type Animation
= Frame Int -- There is only 0 and 1.
| Inert
type alias Model =
{ animation : Animation
, metrics : Maybe Metrics
}
model : Model
model =
{ animation = Inert
, metrics = Nothing
}
-- ACTION, UPDATE
type alias Geometry =
{ rect : Rectangle
, clientX : Maybe Float
, clientY : Maybe Float
, touchX : Maybe Float
, touchY : Maybe Float
}
geometryDecoder : Json.Decoder Geometry
geometryDecoder =
Json.object5 Geometry
rectangleDecoder
(Json.maybe ("clientX" := Json.float))
(Json.maybe ("clientY" := Json.float))
(Json.maybe (at ["touches", "0", "clientX"] Json.float))
(Json.maybe (at ["touches", "0", "clientY"] Json.float))
computeMetrics : Geometry -> Metrics
computeMetrics g =
let
rect = g.rect
set x y = (x - rect.left, y - rect.top)
(x,y) = case (g.clientX, g.clientY, g.touchX, g.touchY) of
(Just 0.0, Just 0.0, _, _) ->
(rect.width / 2.0, rect.height / 2.0)
(Just x, Just y, _, _) ->
set x y
(_, _, Just x, Just y) ->
set x y
_ ->
Debug.crash "Impossible value from geometryDecoder"
in
{ rect = rect
, x = x
, y = y
}
type Action
= Down Geometry
| Up
| Tick
update : Action -> Model -> (Model, Effects Action)
update action model =
case action of
Down geometry ->
{ model
| animation = Frame 0
, metrics = computeMetrics geometry |> Just
}
|> effect (tick <| \_ -> Tick)
Up ->
{ model
| animation = Inert
}
|> effect none
Tick ->
{ model
| animation = Frame 1
}
|> effect none
-- VIEW
downOn : String -> Signal.Address Action -> Attribute
downOn name addr =
Material.Aux.on
name
{ preventDefault = False
, stopPropagation = False
, withGeometry = True
}
geometryDecoder
(Down >> Signal.message addr)
upOn : String -> Signal.Address Action -> Attribute
upOn name addr =
Html.Events.on
name
(Json.succeed ())
((\_ -> Up) >> Signal.message addr)
styles : Metrics -> Int -> List (String, String)
styles m frame =
let
scale = if frame == 0 then "scale(0.0001, 0.0001)" else ""
toPx k = (toString (round k)) ++ "px"
offset = "translate(" ++ toPx m.x ++ ", " ++ toPx m.y ++ ")"
transformString = "translate(-50%, -50%) " ++ offset ++ scale
r = m.rect
rippleSize = sqrt (r.width * r.width + r.height * r.height) * 2 + 2 |> toPx
in
[ ("width", rippleSize)
, ("height", rippleSize)
, ("-webkit-transform", transformString)
, ("-ms-transform", transformString)
, ("transform", transformString)
]
view : Signal.Address Action -> List Attribute -> Model -> Html
view addr attrs model =
let
styling =
case (model.metrics, model.animation) of
(Just metrics, Frame frame) -> styles metrics frame
(Just metrics, Inert) -> styles metrics 1 -- Hack.
_ -> []
in
span
( downOn "mousedown" addr
:: downOn "touchstart" addr
:: upOn "mouseup" addr
:: upOn "mouseleave" addr
:: upOn "touchend" addr
:: upOn "blur" addr
:: attrs
)
[ span
[ classList
[ ("mdl-ripple", True)
, ("is-animating", model.animation /= Frame 0)
, ("is-visible", model.animation /= Inert)
]
, style styling
]
[]
]