2009-02-15 03:15:51 -05:00
|
|
|
! Copyright (C) 2008, 2009 Slava Pestov.
|
2008-12-22 06:40:38 -05:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2015-07-19 15:49:34 -04:00
|
|
|
USING: accessors colors.constants kernel models sequences
|
|
|
|
ui.gadgets ui.gadgets.books ui.gadgets.borders
|
|
|
|
ui.gadgets.buttons ui.gadgets.buttons.private ui.gadgets.icons
|
2016-05-15 13:50:30 -04:00
|
|
|
ui.gadgets.packs ui.gadgets.tracks ui.pens ui.theme.images ;
|
2008-12-22 06:40:38 -05:00
|
|
|
IN: ui.gadgets.tabbed
|
|
|
|
|
|
|
|
TUPLE: tabbed-gadget < track tabs book ;
|
|
|
|
|
2009-02-15 03:15:51 -05:00
|
|
|
<PRIVATE
|
|
|
|
|
|
|
|
: <lip> ( -- gadget )
|
2009-02-15 05:24:25 -05:00
|
|
|
"active-tab-lip" theme-image <icon> ;
|
2009-02-15 03:15:51 -05:00
|
|
|
|
2015-08-16 13:41:16 -04:00
|
|
|
CONSTANT: button-background COLOR: FactorTan
|
2015-07-19 15:49:34 -04:00
|
|
|
CONSTANT: active-tab-background COLOR: FactorDarkTan
|
2009-02-15 03:15:51 -05:00
|
|
|
|
|
|
|
: <tab-pen> ( -- pen )
|
|
|
|
"inactive-tab" button-background f <border-button-state-pen> dup dup
|
|
|
|
"active-tab" active-tab-background f <border-button-state-pen> dup
|
|
|
|
<button-pen> ;
|
|
|
|
|
|
|
|
: tab-theme ( gadget -- gadget )
|
|
|
|
horizontal >>orientation
|
|
|
|
<tab-pen> >>interior
|
|
|
|
dup dup interior>> pen-pref-dim >>min-dim
|
|
|
|
{ 30 0 } >>size ; inline
|
|
|
|
|
|
|
|
: <tab> ( value model label -- gadget )
|
|
|
|
<radio-control> tab-theme ;
|
2008-12-22 06:40:38 -05:00
|
|
|
|
|
|
|
: add-tab/book ( tabbed child -- tabbed )
|
|
|
|
[ dup book>> ] dip add-gadget drop ;
|
|
|
|
|
|
|
|
: add-tab/button ( tabbed label -- tabbed )
|
|
|
|
[ [ dup tabs>> dup children>> length ] [ model>> ] bi ] dip
|
2009-02-15 03:15:51 -05:00
|
|
|
<tab> add-gadget drop ;
|
|
|
|
|
|
|
|
PRIVATE>
|
|
|
|
|
|
|
|
: <tabbed-gadget> ( -- gadget )
|
|
|
|
vertical tabbed-gadget new-track
|
|
|
|
0 <model> >>model
|
|
|
|
<shelf> >>tabs
|
|
|
|
horizontal <track>
|
|
|
|
over tabs>> f track-add
|
|
|
|
<lip> 1 track-add
|
|
|
|
f track-add
|
|
|
|
dup model>> <empty-book> >>book
|
|
|
|
dup book>> { 3 3 } <filled-border> 1 track-add ;
|
2008-12-22 06:40:38 -05:00
|
|
|
|
|
|
|
: add-tab ( tabbed child label -- tabbed )
|
|
|
|
[ add-tab/book ] [ add-tab/button ] bi* ;
|