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>