window-controls-demo for testing/showing off window controls

diff --git a/extra/window-controls-demo/authors.txt b/extra/window-controls-demo/authors.txt
new file mode 100755 (executable)
index 0000000..f13c9c1
--- /dev/null
+++ b/extra/window-controls-demo/authors.txt
@@ -0,0 +1 @@
+Joe Groff

diff --git a/extra/window-controls-demo/summary.txt b/extra/window-controls-demo/summary.txt
new file mode 100755 (executable)
index 0000000..e84535a
--- /dev/null
+++ b/extra/window-controls-demo/summary.txt
@@ -0,0 +1 @@
+Open windows with different control sets

diff --git a/extra/window-controls-demo/window-controls-demo.factor b/extra/window-controls-demo/window-controls-demo.factor
new file mode 100755 (executable)
index 0000000..70000c8
--- /dev/null
+++ b/extra/window-controls-demo/window-controls-demo.factor
@@ -0,0 +1,42 @@
+! (c)2009 Joe Groff bsd license
+USING: accessors assocs kernel locals sequences ui
+ui.gadgets.worlds ;
+IN: window-controls-demo
+
+CONSTANT: window-control-sets-to-test
+    H{
+        { "No controls" { } }
+        { "Normal title bar" { normal-title-bar } }
+        { "Small title bar" { small-title-bar } }
+        { "Close button" { normal-title-bar close-button } }
+        { "Close and minimize buttons" { normal-title-bar close-button minimize-button } }
+        { "Close, minimize, and maximize buttons" { normal-title-bar close-button minimize-button maximize-button } }
+        { "Resizable" { normal-title-bar close-button minimize-button maximize-button resize-handles } }
+    }
+
+TUPLE: window-controls-demo-world < world
+    windows ;
+
+M: window-controls-demo-world end-world
+    windows>> [ close-window ] each ;
+
+M: window-controls-demo-world pref-dim*
+    drop { 400 400 } ;
+
+: attributes-template ( -- x )
+    T{ world-attributes
+        { world-class window-controls-demo-world }
+    } clone ;
+
+: window-controls-demo ( -- )
+    attributes-template V{ } clone window-control-sets-to-test
+    [| title attributes windows controls |
+        f attributes
+            title >>title
+            controls >>window-controls
+        open-window*
+            windows >>windows
+            windows push
+    ] with with assoc-each ;
+
+MAIN: window-controls-demo