view popupNav.ur @ 6:f17b869fbb71

Shifting some generic theme navigation menu code to the library.
author Karn Kallio <kkallio@eka>
date Tue, 26 Apr 2011 20:27:04 -0430
parents
children 48a4180171b0
line wrap: on
line source
datatype menuState = Open | Closed

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

val defaultFormat = {FormatMenu = fn ctl menu => <xml>{ctl}<ul>{menu}</ul></xml>,
                     OpenCtl = fn behaviour => <xml><button value="Open" onclick={behaviour}/></xml>,
                     CloseCtl = fn behaviour => <xml><button value="Close" onclick={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>{navBarToXml popup.NavBar}</xml>
                              | Closed => <xml/>)
                      }/>
        </xml>