diff options
Diffstat (limited to 'material/material.ur')
| -rw-r--r-- | material/material.ur | 129 |
1 files changed, 85 insertions, 44 deletions
diff --git a/material/material.ur b/material/material.ur index 72a3e98..f63bec0 100644 --- a/material/material.ur +++ b/material/material.ur @@ -12,13 +12,52 @@ under the License is distributed on an “AS IS” BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. *) +style materialIcon style stackingContext +fun icon s = <xml><i class={materialIcon}>{[s]}</i></xml> + fun inNewStackingContext x = <xml><div class={stackingContext}>{x}</div></xml> +structure Ripple : sig + val inkAnimation : int -> int -> source (option {X : int, Y : int}) -> xbody +end = struct + style ink + + fun inkStyle width height xy = + let + fun p a b = value (property a) (atom (show b ^ "px")) + in + oneProperty + (oneProperty + (oneProperty + (oneProperty noStyle + (p "width" width)) + (p "height" height)) + (p "left" (xy.X - width / 2))) + (p "top" (xy.Y - height / 2)) + end + + fun inkAnimation width height s = + <xml> + <dyn + signal={ + v <- signal s; + return (case v of + None => <xml></xml> + | Some xy => <xml> + <span class={ink} style={inkStyle width height xy}> + </span> + </xml>) + } + /> + </xml> +end + (* TODO(bbaren): Support attributes in the arguments. *) fun page p = <xml> <head> + <link rel="stylesheet" href="https://fonts.googleapis.com/icon?family=Material+Icons" /> <link rel="stylesheet" href="/material.css" /> <meta name="viewport" content="width=device-width, initial-scale=1.0" /> @@ -49,63 +88,65 @@ structure Checkbox = struct style checkbox style checked style container - style ink (* Pixel dimensions of the checkbox. If you update these, you must also update the CSS file. *) val width = 24 val height = 24 - fun centeredAtXY x y : css_style = - let - val x' = x - width / 2 - val y' = y - width / 2 - in - oneProperty (oneProperty - noStyle - (value (property "left") (atom (show x' ^ "px")))) - (value (property "top") (atom (show y' ^ "px"))) - end - - fun inkAnimation (s : source (option {X : int, Y : int})) = - <xml> - <dyn - signal={ - v <- signal s; - return (case v of - None => <xml></xml> - | Some xy => <xml> - <span class={ink} style={centeredAtXY xy.X xy.Y}></span> - </xml>) - } - /> - </xml> - val make c onChange = s <- source c; inkCenter <- source None; return (inNewStackingContext <xml> - {inkAnimation inkCenter} - <span - dynClass={ - c <- signal s; - return (classes checkbox (if c then checked else null)) - } - onclick={fn click => - set inkCenter (Some {X = click.ClientX, Y = click.ClientY}); - c <- get s; - let - val c' = not c - in - set s c'; - onChange c' - end - } - > - </span> + <div class={container}> + {Ripple.inkAnimation width height inkCenter} + <span + dynClass={ + c <- signal s; + return (classes checkbox (if c then checked else null)) + } + onclick={fn click => + set inkCenter (Some {X = click.ClientX, Y = click.ClientY}); + c <- get s; + let + val c' = not c + in + set s c'; + onChange c' + end + } + > + </span> + </div> </xml>) end +structure FloatingActionButton = struct + style container + style element + + (* Pixel dimensions of the button. If you update these, you must also + update the CSS file. *) + val width = 56 + val height = 56 + + fun make s = + inkCenter <- source None; + return <xml> + <div class={container}> + <button + class={element} + onclick={fn click => + set inkCenter (Some {X = click.ClientX, Y = click.ClientY}) + } + > + {icon s} + </button> + {Ripple.inkAnimation width height inkCenter} + </div> + </xml> +end + structure List = struct structure SingleLine = struct style element |