49 lines
1.2 KiB
Factor
49 lines
1.2 KiB
Factor
! Copyright (C) 2006 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
IN: gadgets-tabs
|
|
USING: arrays gadgets gadgets-buttons gadgets-frames
|
|
gadgets-grids gadgets-labels gadgets-panes gadgets-scrolling
|
|
gadgets-theme kernel sequences ;
|
|
|
|
TUPLE: book page pages ;
|
|
|
|
: show-page ( n book -- )
|
|
dup book-page unparent
|
|
[ book-pages nth ] keep
|
|
[ set-book-page ] 2keep
|
|
add-gadget ;
|
|
|
|
C: book ( pages -- book )
|
|
dup delegate>gadget
|
|
[ set-book-pages ] keep
|
|
0 over show-page ;
|
|
|
|
M: book pref-dim* ( book -- dim ) book-page pref-dim ;
|
|
|
|
M: book layout* ( book -- )
|
|
dup rect-dim swap book-page set-gadget-dim ;
|
|
|
|
: <tab> ( name n book -- button )
|
|
[ show-page drop ] curry curry
|
|
>r <label> r> <bevel-button> ;
|
|
|
|
: make-tabs ( book names -- gadget )
|
|
dup length [ pick <tab> ] 2map make-shelf
|
|
dup highlight-theme nip ;
|
|
|
|
TUPLE: tabs buttons book ;
|
|
|
|
C: tabs dup delegate>frame ;
|
|
|
|
: set-tabs ( names pages tabs -- )
|
|
{
|
|
{ [ <book> tuck ] set-tabs-book @center }
|
|
{ [ make-tabs ] set-tabs-buttons @top }
|
|
} build-grid ;
|
|
|
|
: set-pages ( obj assoc tabs -- )
|
|
>r flip first2 swapd [ make-pane <scroller> ] map-with
|
|
r> set-tabs ;
|
|
|
|
: <pages> ( obj assoc -- tabs ) <tabs> [ set-pages ] keep ;
|