1 ! Copyright (C) 2006, 2007 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays ui.gadgets.buttons ui.gadgets.borders
4 ui.gadgets.labels ui.gadgets.panes ui.gadgets.scrollers
5 ui.gadgets.tracks ui.gadgets.theme ui.gadgets.frames
6 ui.gadgets.grids io kernel math models namespaces prettyprint
7 sequences sequences words classes.tuple ui.gadgets ui.render
9 IN: ui.gadgets.labelled
11 TUPLE: labelled-gadget < track content ;
13 : <labelled-gadget> ( gadget title -- newgadget )
14 { 0 1 } labelled-gadget new-track
15 swap <label> reverse-video-theme f track-add
17 dup content>> 1 track-add ;
19 M: labelled-gadget focusable-child* content>> ;
21 : <labelled-scroller> ( gadget title -- gadget )
22 >r <scroller> r> <labelled-gadget> ;
24 : <labelled-pane> ( model quot scrolls? title -- gadget )
25 >r >r <pane-control> r> >>scrolls? r>
28 : <close-box> ( quot -- button/f )
29 gray close-box <polygon-gadget> swap <bevel-button> ;
31 : title-theme ( gadget -- gadget )
34 T{ rgba f 0.65 0.65 1.0 1.0 }
35 T{ rgba f 0.65 0.45 1.0 1.0 }
38 : <title-label> ( text -- label ) <label> title-theme ;
40 : <title-bar> ( title quot -- gadget )
42 swap dup [ <close-box> @left grid-add ] [ drop ] if
43 swap <title-label> @center grid-add ;
45 TUPLE: closable-gadget < frame content ;
47 : find-closable-gadget ( parent -- child )
48 [ closable-gadget? ] find-parent ;
50 : <closable-gadget> ( gadget title quot -- gadget )
51 closable-gadget new-frame
52 -rot <title-bar> @top grid-add
54 dup content>> @center grid-add ;
56 M: closable-gadget focusable-child* content>> ;