Mercurial > gui
view popupNav.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 | b5432d74841a |
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>