! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays colors.constants combinators kernel opengl sequences ui ui.baseline-alignment ui.gadgets ui.gadgets.buttons ui.gadgets.labels ui.pens ui.render ui.text ; IN: ui.gadgets.debug TUPLE: baseline-gadget < gadget baseline cap-height ; M: baseline-gadget baseline baseline>> ; M: baseline-gadget cap-height cap-height>> ; : ( baseline cap-height dim -- gadget ) baseline-gadget new swap >>dim swap >>cap-height 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 ; : bad-gadget-test ( -- ) "Test 1" open-window "Test 2" open-window ; SINGLETON: metrics-paint M: metrics-paint draw-boundary drop COLOR: red gl-color [ dim>> ] [ >label< line-metrics ] bi [ [ first ] [ ascent>> ] bi* [ nip 0 swap 2array ] [ 2array ] 2bi gl-line ] [ drop gl-rect ] 2bi ; : ( text font -- gadget ) [