view waitbox.ur @ 32:d32fb0f7b137

Update for Ur/Web's new type class handling
author Adam Chlipala <adam@chlipala.net>
date Sun, 29 Jul 2012 12:28:46 -0400
parents 37eefd0a2ed4
children
line wrap: on
line source
type t = {Milliseconds : int,
          Action : source (string -> transaction {}),
          Timer : source (option Timer.t),
          Text : source string}

fun create n =
    s <- source "";
    tmO <- source None;
    f <- source (fn _ => return ());

    return {Milliseconds = n, Action = f, Timer = tmO, Text = s}

fun setAction r v = set r.Action v

fun tickle r =
    last <- get r.Timer;
    (case last of
         None => return ()
       | Some tm => Timer.cancel tm);
    tm <- Timer.create {Milliseconds = r.Milliseconds,
                        Action = (set r.Timer None;
                                  s <- get r.Text;
                                  f <- get r.Action;
                                  f s)};
    set r.Timer (Some tm)

fun render r = <xml>
  <ctextbox source={r.Text}
            onkeyup={fn _ => tickle r}/>
</xml>

fun clear r = (set r.Text "";
               tm <- get r.Timer;
               (case tm of
                    None => return ()
                  | Some tm => Timer.cancel tm);
               set r.Timer None)

fun trigger r =
    last <- get r.Timer;
    (case last of
         None => return ()
       | Some tm => Timer.cancel tm);
    set r.Timer None;
    s <- get r.Text;
    f <- get r.Action;
    f s