view popupNav.ur @ 31:b5432d74841a

Update for key/mouse handler change
author Adam Chlipala <adam@chlipala.net>
date Sat, 21 Jul 2012 10:15:14 -0400
parents 48a4180171b0
children
line wrap: on
line source
datatype menuState = Open | Closed

type formatCtl = {FormatMenu : xbody -> xbody -> xbody,
                  WrapMenu : xbody -> xbody,
                  OpenCtl : transaction unit -> xbody,
                  CloseCtl : transaction unit -> xbody}

val defaultFormat = {FormatMenu = fn ctl menu => <xml>{ctl}{menu}</xml>,
                     WrapMenu = fn menu => <xml><ul>{menu}</ul></xml>,
                     OpenCtl = fn behaviour => <xml><button value="Open" onclick={fn _ => behaviour}/></xml>,
                     CloseCtl = fn behaviour => <xml><button value="Close" onclick={fn _ => behaviour}/></xml>}

open Navbar

con popupNav t = {MenuState : source menuState,
                  FormatCtl : formatCtl,
                  NavBar : navBar t}

fun create [t ::: Type] (f : formatCtl) (m : mode t) (bar : navBar t) : transaction (popupNav t) =
    state <- source Closed;

    return {MenuState = state,
            FormatCtl = f,
            NavBar = bar}

fun render [t ::: Type] (m : mode t) (popup : popupNav t) =
    popup.FormatCtl.FormatMenu
        <xml>
          <dyn signal={c <- signal popup.MenuState;
                       return
                           (case c of
                                Open => <xml>{popup.FormatCtl.CloseCtl (set popup.MenuState Closed)}</xml>
                              | Closed => <xml>{popup.FormatCtl.OpenCtl (set popup.MenuState Open)}</xml>)
                      }/>
        </xml>

        <xml>
          <dyn signal={c <- signal popup.MenuState;
                       return
                           (case c of
                                Open => <xml>{popup.FormatCtl.WrapMenu (navBarToXml popup.NavBar)}</xml>
                              | Closed => <xml/>)
                      }/>
        </xml>