diff togglePanel.ur @ 8:90be8b8917d5

Add a widget that opens and closes a panel.
author Karn Kallio <kkallio@eka>
date Fri, 17 Jun 2011 10:12:05 -0430
parents
children 16447dc6a68c
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/togglePanel.ur	Fri Jun 17 10:12:05 2011 -0430
@@ -0,0 +1,51 @@
+datatype panelState = Open | Closed
+
+type formatCtl = {FormatPanel : xbody -> xbody -> xbody,
+                  OpenCtl : transaction unit -> xbody,
+                  CloseCtl : transaction unit -> xbody}
+
+val defaultFormat = {FormatPanel = fn ctl panel => <xml>{ctl}{panel}</xml>,
+                     OpenCtl = fn behaviour => <xml><button value="Open" onclick={behaviour}/></xml>,
+                     CloseCtl = fn behaviour => <xml><button value="Close" onclick={behaviour}/></xml>}
+                    
+con togglePanel t = {PanelState : source panelState,
+                     FormatCtl : formatCtl,
+                     Content : t}
+
+open Gui
+
+fun create [t ::: Type] (toXml : gui t) (f : formatCtl) (content : t) (startOpen : bool) : transaction (togglePanel t) =
+    state <- source (if startOpen then Open else Closed);
+
+    return {PanelState = state,
+            FormatCtl = f,
+            Content = content}
+
+fun render [t ::: Type] (_ : gui t) (panel : togglePanel t) =
+    let
+        val openCtl = panel.FormatCtl.CloseCtl (set panel.PanelState Closed)
+        val closeCtl = panel.FormatCtl.OpenCtl (set panel.PanelState Open)
+
+        val content = toXml panel.Content
+    in
+        panel.FormatCtl.FormatPanel
+            <xml>
+              <dyn signal={c <- signal panel.PanelState;
+                           return
+                               (case c of
+                                    Open => <xml>{openCtl}</xml>
+                                  | Closed => <xml>{closeCtl}</xml>)
+                          }/>
+            </xml>
+
+            <xml>
+              <dyn signal={c <- signal panel.PanelState;
+                           return
+                               (case c of
+                                    Open => <xml>{content}</xml>
+                                  | Closed => <xml/>)
+                          }/>
+            </xml>
+    end
+
+fun gui_togglePanel [t ::: Type] (_ : gui t) = mkGui render