diff --git a/basis/ui/gadgets/debug/authors.txt b/basis/ui/gadgets/debug/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /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 index 0000000000..064f7ab6e2 --- /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 index 0000000000..ccdb0f9337 --- /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 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 + +: ( -- button ) + "Click me if you dare" + [ "Haha" throw ] + ; + +TUPLE: bad-gadget < gadget ; + +M: bad-gadget draw-gadget* "Lulz" throw ; + +M: bad-gadget pref-dim* drop { 100 100 } ; + +: ( -- gadget ) bad-gadget new-gadget ; + +: bad-gadget-test ( -- ) + "Test 1" open-window + "Test 2" open-window ;