New look for tabbed gadgets

db4
Slava Pestov 2009-02-15 02:15:51 -06:00
parent 53eb92a967
commit 78353dd1b6
4 changed files with 66 additions and 28 deletions

View File

@ -231,13 +231,6 @@ PRIVATE>
[ <radio-button> ] <radio-controls> [ <radio-button> ] <radio-controls>
{ 5 5 } >>gap ; { 5 5 } >>gap ;
: <toggle-button> ( value model label -- gadget )
<radio-control> border-button-theme ;
: <toggle-buttons> ( model assoc -- gadget )
<shelf>
[ <toggle-button> ] <radio-controls> ;
: <command-button> ( target gesture command -- button ) : <command-button> ( target gesture command -- button )
[ command-string swap ] keep '[ _ _ invoke-command drop ] <border-button> ; [ command-string swap ] keep '[ _ _ invoke-command drop ] <border-button> ;
@ -246,8 +239,9 @@ PRIVATE>
1 >>fill 1 >>fill
{ 5 5 } >>gap { 5 5 } >>gap
swap swap
[ [ "toolbar" ] dip class command-map commands>> ] keep [ [ "toolbar" ] dip class command-map commands>> ]
'[ [ _ ] 2dip <command-button> add-gadget ] assoc-each ; [ '[ [ _ ] 2dip <command-button> add-gadget ] ]
bi assoc-each ;
: add-toolbar ( track -- track ) : add-toolbar ( track -- track )
dup <toolbar> { 3 3 } <border> align-left f track-add ; dup <toolbar> { 3 3 } <border> align-left f track-add ;

View File

@ -1,25 +1,61 @@
! Copyright (C) 2008 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: ui.gadgets.tracks ui.gadgets.buttons ui.gadgets.books USING: ui.pens ui.gadgets.tracks ui.gadgets.buttons
ui.gadgets.packs ui.gadgets sequences models accessors kernel ; ui.gadgets.buttons.private ui.gadgets.books ui.gadgets.packs
ui.gadgets.borders ui.gadgets.icons ui.gadgets.theme ui.gadgets
sequences models accessors kernel colors colors.constants ;
IN: ui.gadgets.tabbed IN: ui.gadgets.tabbed
TUPLE: tabbed-gadget < track tabs book ; TUPLE: tabbed-gadget < track tabs book ;
: <tabbed-gadget> ( -- gadget ) <PRIVATE
vertical tabbed-gadget new-track
0 <model> >>model : <lip> ( -- gadget )
<shelf> >>tabs "active-tab-lip" theme-image <icon>
dup tabs>> f track-add dup interior>> t >>fill? drop ;
dup model>> <empty-book> >>book
dup book>> 1 track-add ; CONSTANT: active-tab-background
T{ rgba
f
0.6745098039215687
0.6549019607843137
0.5764705882352941
1.0
}
: <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 ;
: add-tab/book ( tabbed child -- tabbed ) : add-tab/book ( tabbed child -- tabbed )
[ dup book>> ] dip add-gadget drop ; [ dup book>> ] dip add-gadget drop ;
: add-tab/button ( tabbed label -- tabbed ) : add-tab/button ( tabbed label -- tabbed )
[ [ dup tabs>> dup children>> length ] [ model>> ] bi ] dip [ [ dup tabs>> dup children>> length ] [ model>> ] bi ] dip
<toggle-button> add-gadget drop ; <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 ;
: add-tab ( tabbed child label -- tabbed ) : add-tab ( tabbed child label -- tabbed )
[ add-tab/book ] [ add-tab/button ] bi* ; [ add-tab/book ] [ add-tab/button ] bi* ;

View File

@ -12,7 +12,7 @@ TUPLE: image-pen image fill? ;
M: image-pen draw-interior M: image-pen draw-interior
[ dim>> ] [ [ image>> ] [ fill?>> ] bi ] bi* [ dim>> ] [ [ image>> ] [ fill?>> ] bi ] bi*
[ draw-scaled-image ] [ [ draw-scaled-image ] [
[ image-dim [ - 2/ ] 2map ] keep [ image-dim [ - 2 /i ] 2map ] keep
'[ _ draw-image ] with-translation '[ _ draw-image ] with-translation
] if ; ] if ;

View File

@ -8,7 +8,7 @@ ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks ui.gestures
ui.gadgets.buttons ui.gadgets.tables ui.gadgets.search-tables ui.gadgets.buttons ui.gadgets.tables ui.gadgets.search-tables
ui.gadgets.labeled ui.gadgets.buttons ui.gadgets.packs ui.gadgets.labeled ui.gadgets.buttons ui.gadgets.packs
ui.gadgets.labels ui.gadgets.tabbed ui.gadgets.status-bar ui.gadgets.labels ui.gadgets.tabbed ui.gadgets.status-bar
ui.tools.browser ui.tools.common ; ui.gadgets.borders ui.tools.browser ui.tools.common ;
FROM: models.filter => <filter> ; FROM: models.filter => <filter> ;
FROM: models.compose => <compose> ; FROM: models.compose => <compose> ;
IN: ui.tools.profiler IN: ui.tools.profiler
@ -98,18 +98,23 @@ M: method-renderer row-value drop first ;
} ; } ;
: <sort-options> ( model -- gadget ) : <sort-options> ( model -- gadget )
sort-options <radio-buttons> horizontal >>orientation ;
: <profiler-tool-bar> ( profiler -- gadget )
<shelf> <shelf>
+baseline+ >>align +baseline+ >>align
{ 5 5 } >>gap { 5 5 } >>gap
over <toolbar> add-gadget
"Sort by:" <label> add-gadget "Sort by:" <label> add-gadget
swap sort>> <sort-options> add-gadget ; swap sort-options <radio-buttons> horizontal >>orientation add-gadget ;
: <profiler-tool-bar> ( profiler -- gadget )
<shelf>
1/2 >>align
{ 5 5 } >>gap
swap
[ <toolbar> add-gadget ]
[ sort>> <sort-options> add-gadget ] bi ;
:: <words-tab> ( profiler -- gadget ) :: <words-tab> ( profiler -- gadget )
horizontal <track> horizontal <track>
{ 3 3 } >>gap
profiler vocabs>> <profiler-table> profiler vocabs>> <profiler-table>
profiler vocab>> >>selected-value profiler vocab>> >>selected-value
vocab-renderer >>renderer vocab-renderer >>renderer
@ -122,7 +127,9 @@ M: method-renderer row-value drop first ;
:: <methods-tab> ( profiler -- gadget ) :: <methods-tab> ( profiler -- gadget )
vertical <track> vertical <track>
{ 3 3 } >>gap
horizontal <track> horizontal <track>
{ 3 3 } >>gap
profiler <generic-model> <profiler-table> profiler <generic-model> <profiler-table>
profiler generic>> >>selected-value profiler generic>> >>selected-value
word-renderer >>renderer word-renderer >>renderer
@ -143,6 +150,7 @@ M: method-renderer row-value drop first ;
: <profiler-gadget> ( -- profiler ) : <profiler-gadget> ( -- profiler )
vertical profiler-gadget new-track vertical profiler-gadget new-track
{ 5 5 } >>gap
[ [ first ] compare ] <model> >>sort [ [ first ] compare ] <model> >>sort
all-words counters <model> >>words all-words counters <model> >>words
<selection-model> >>vocab <selection-model> >>vocab
@ -150,7 +158,7 @@ M: method-renderer row-value drop first ;
<selection-model> >>generic <selection-model> >>generic
<selection-model> >>class <selection-model> >>class
dup <methods-model> >>methods dup <methods-model> >>methods
dup <profiler-tool-bar> f track-add dup <profiler-tool-bar> { 3 3 } <filled-border> f track-add
<tabbed-gadget> <tabbed-gadget>
over <words-tab> "Words" add-tab over <words-tab> "Words" add-tab
over <methods-tab> "Methods" add-tab over <methods-tab> "Methods" add-tab