Merge branch 'master' into new_ui

db4
Slava Pestov 2008-12-19 02:26:01 -06:00
commit d330ff31b5
4 changed files with 34 additions and 8 deletions

View File

@ -16,6 +16,9 @@ TUPLE: border < gadget
swap border new-border
swap dup 2array >>size ;
: <filled-border> ( child gap -- border )
<border> { 1 1 } >>fill ;
M: border pref-dim*
[ size>> 2 v*n ] keep
gadget-child pref-dim v+ ;

View File

@ -21,3 +21,20 @@ IN: ui.gadgets.tracks.tests
<gadget> { 10 10 } >>dim 0 track-add
pref-dim
] unit-test
[ { 10 30 } ] [
{ 0 1 } <track>
<gadget> { 10 10 } >>dim f track-add
<gadget> { 10 10 } >>dim f track-add
<gadget> { 10 10 } >>dim f track-add
pref-dim
] unit-test
[ { 10 40 } ] [
{ 0 1 } <track>
{ 5 5 } >>gap
<gadget> { 10 10 } >>dim f track-add
<gadget> { 10 10 } >>dim f track-add
<gadget> { 10 10 } >>dim f track-add
pref-dim
] unit-test

View File

@ -27,10 +27,15 @@ TUPLE: track < pack sizes ;
[ children>> ] [ sizes>> ] bi { 0 0 }
[ [ drop { 0 0 } ] [ pref-dim ] if v+ ] 2reduce ;
: available-dim ( track -- dim ) [ dim>> ] [ alloted-dim ] bi v- ;
: gap-dim ( track -- dim )
[ gap>> ] [ children>> length 1 [-] ] bi v*n ;
: available-dim ( track -- dim )
[ dim>> ] [ alloted-dim ] bi v- ;
: track-layout ( track -- sizes )
[ available-dim ] [ children>> ] [ normalized-sizes ] tri
[ [ available-dim ] [ gap-dim ] bi v- ]
[ children>> ] [ normalized-sizes ] tri
[ [ over n*v ] [ pref-dim ] ?if ] 2map nip ;
M: track layout* ( track -- ) dup track-layout pack-layout ;
@ -41,11 +46,9 @@ M: track layout* ( track -- ) dup track-layout pack-layout ;
: track-pref-dims-2 ( track -- dim )
[
[ children>> pref-dims ] [ normalized-sizes ] bi
[ dup { 0 f } memq? [ drop ] [ v/n ] if ] 2map
[ dup { 0 f } member? [ 2drop { 0 0 } ] [ v/n ] if ] 2map
max-dim [ >fixnum ] map
]
[ [ gap>> ] [ children>> length 1 [-] ] bi v*n ] bi
v+ ;
] [ gap-dim ] bi v+ ;
M: track pref-dim* ( gadget -- dim )
[ track-pref-dims-1 ]

View File

@ -2,7 +2,7 @@ USING: ui.tools ui.tools.interactor ui.tools.listener
ui.tools.search ui.tools.workspace kernel models namespaces
sequences tools.test ui.gadgets ui.gadgets.buttons
ui.gadgets.labelled ui.gadgets.presentations
ui.gadgets.scrollers vocabs tools.test.ui ui accessors ;
ui.gadgets.menus ui.gadgets.scrollers vocabs tools.test.ui ui accessors ;
IN: ui.tools.tests
[ f ]
@ -40,7 +40,10 @@ IN: ui.tools.tests
[ t ] [ "p" get presentation? ] unit-test
[ ] [ "p" get <operations-menu> gadget-child gadget-child "c" set ] unit-test
[ ] [
"p" get [ object>> ] [ dup hook>> curry ] bi
<operations-menu> gadget-child gadget-child "c" set
] unit-test
[ ] [ notify-queued ] unit-test