steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add baseline debugging gadget

db4
Slava Pestov 2009-02-28 20:32:51 -06:00
parent 25a877e50b
commit fe1d6a0e13
1 changed files with 16 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
basis/ui/gadgets/debug/debug.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2008, 2009 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors sequences ui ui.gadgets ui.gadgets.buttons USING: accessors arrays colors.constants combinators kernel
ui.baseline-alignment ui.render ; opengl sequences ui ui.baseline-alignment ui.gadgets
ui.gadgets.buttons ui.gadgets.labels ui.pens ui.render ui.text ;
IN: ui.gadgets.debug IN: ui.gadgets.debug
TUPLE: baseline-gadget < gadget baseline cap-height ; TUPLE: baseline-gadget < gadget baseline cap-height ;
@ -35,3 +36,16 @@ M: bad-gadget pref-dim* drop { 100 100 } ;
: bad-gadget-test ( -- ) : bad-gadget-test ( -- )
<bad-button> "Test 1" open-window <bad-button> "Test 1" open-window
<bad-gadget> "Test 2" open-window ; <bad-gadget> "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 ;
: <metrics-gadget> ( text font -- gadget )
[ <label> ] dip >>font metrics-paint >>boundary ;