New look for tabbed gadgets

basis/ui/gadgets/buttons/buttons.factor

@@ -231,13 +231,6 @@ PRIVATE>
         [ <radio-button> ] <radio-controls>
         { 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-string swap ] keep '[ _ _ invoke-command drop ] <border-button> ;
 
@@ -246,8 +239,9 @@ PRIVATE>
         1 >>fill
         { 5 5 } >>gap
         swap
-        [ [ "toolbar" ] dip class command-map commands>> ] keep
-        '[ [ _ ] 2dip <command-button> add-gadget ] assoc-each ;
+        [ [ "toolbar" ] dip class command-map commands>> ]
+        [ '[ [ _ ] 2dip <command-button> add-gadget ] ]
+        bi assoc-each ;
 
 : add-toolbar ( track -- track )
     dup <toolbar> { 3 3 } <border> align-left f track-add ;

basis/ui/gadgets/tabbed/tabbed.factor

@@ -1,25 +1,61 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: ui.gadgets.tracks ui.gadgets.buttons ui.gadgets.books
-ui.gadgets.packs ui.gadgets sequences models accessors kernel ;
+USING: ui.pens ui.gadgets.tracks ui.gadgets.buttons
+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
 
 TUPLE: tabbed-gadget < track tabs book ;
 
-: <tabbed-gadget> ( -- gadget )
-    vertical tabbed-gadget new-track
-        0 <model> >>model
-        <shelf> >>tabs
-        dup tabs>> f track-add
-        dup model>> <empty-book> >>book
-        dup book>> 1 track-add ;
+<PRIVATE
+
+: <lip> ( -- gadget )
+    "active-tab-lip" theme-image <icon>
+    dup interior>> t >>fill? drop ;
+
+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 )
     [ dup book>> ] dip add-gadget drop ;
 
 : add-tab/button ( tabbed label -- tabbed )
     [ [ 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/book ] [ add-tab/button ] bi* ;

basis/ui/pens/image/image.factor

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

basis/ui/tools/profiler/profiler.factor

@@ -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.labeled ui.gadgets.buttons ui.gadgets.packs
 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.compose => <compose> ;
 IN: ui.tools.profiler
@@ -98,18 +98,23 @@ M: method-renderer row-value drop first ;
     } ;
 
 : <sort-options> ( model -- gadget )
-    sort-options <radio-buttons> horizontal >>orientation ;
-
-: <profiler-tool-bar> ( profiler -- gadget )
     <shelf>
         +baseline+ >>align
         { 5 5 } >>gap
-        over <toolbar> 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 )
     horizontal <track>
+        { 3 3 } >>gap
         profiler vocabs>> <profiler-table>
             profiler vocab>> >>selected-value
             vocab-renderer >>renderer
@@ -122,7 +127,9 @@ M: method-renderer row-value drop first ;
 
 :: <methods-tab> ( profiler -- gadget )
     vertical <track>
+        { 3 3 } >>gap
         horizontal <track>
+            { 3 3 } >>gap
             profiler <generic-model> <profiler-table>
                 profiler generic>> >>selected-value
                 word-renderer >>renderer
@@ -143,6 +150,7 @@ M: method-renderer row-value drop first ;
 
 : <profiler-gadget> ( -- profiler )
     vertical profiler-gadget new-track
+        { 5 5 } >>gap
         [ [ first ] compare ] <model> >>sort
         all-words counters <model> >>words
         <selection-model> >>vocab
@@ -150,7 +158,7 @@ M: method-renderer row-value drop first ;
         <selection-model> >>generic
         <selection-model> >>class
         dup <methods-model> >>methods
-        dup <profiler-tool-bar> f track-add
+        dup <profiler-tool-bar> { 3 3 } <filled-border> f track-add
         <tabbed-gadget>
             over <words-tab> "Words" add-tab
             over <methods-tab> "Methods" add-tab