Mercurial > gui
diff 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 diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/popupNav.ur Tue Apr 26 20:27:04 2011 -0430 @@ -0,0 +1,42 @@ +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>