ui.gadgets.debug: some gadgets for testing purposes

diff --git a/basis/ui/gadgets/debug/authors.txt b/basis/ui/gadgets/debug/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
+++ b/basis/ui/gadgets/debug/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file

diff --git a/basis/ui/gadgets/debug/debug-tests.factor b/basis/ui/gadgets/debug/debug-tests.factor
new file mode 100644 (file)
index 0000000..064f7ab
--- /dev/null
+++ b/basis/ui/gadgets/debug/debug-tests.factor
@@ -0,0 +1,4 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test ui.gadgets.debug ;
+IN: ui.gadgets.debug.tests

diff --git a/basis/ui/gadgets/debug/debug.factor b/basis/ui/gadgets/debug/debug.factor
new file mode 100644 (file)
index 0000000..ccdb0f9
--- /dev/null
+++ b/basis/ui/gadgets/debug/debug.factor
@@ -0,0 +1,33 @@
+! Copyright (C) 2008, 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors ui ui.gadgets ui.gadgets.buttons ui.render ;
+IN: ui.gadgets.debug
+
+TUPLE: baseline-gadget < gadget baseline ;
+
+M: baseline-gadget baseline baseline>> ;
+
+: <baseline-gadget> ( baseline dim -- gadget )
+    baseline-gadget new-gadget
+        swap >>dim
+        swap >>baseline ;
+
+! An intentionally broken gadget -- used to test UI error handling,
+! make sure that one bad gadget doesn't bring the whole system down
+
+: <bad-button> ( -- button )
+    "Click me if you dare"
+    [ "Haha" throw ]
+    <bevel-button> ;
+
+TUPLE: bad-gadget < gadget ;
+
+M: bad-gadget draw-gadget* "Lulz" throw ;
+
+M: bad-gadget pref-dim* drop { 100 100 } ;
+
+: <bad-gadget> ( -- gadget ) bad-gadget new-gadget ;
+
+: bad-gadget-test ( -- )
+    <bad-button> "Test 1" open-window
+    <bad-gadget> "Test 2" open-window ;