Beef up borders, fix roll button apperance

db4
Slava Pestov 2008-07-11 01:33:20 -05:00
parent f0420e8abb
commit c4e3482783
3 changed files with 47 additions and 24 deletions

View File

@ -0,0 +1,25 @@
IN: ui.gadgets.borders.tests
USING: tools.test accessors namespaces kernel
ui.gadgets ui.gadgets.borders ;
[ { 110 210 } ] [ <gadget> { 100 200 } >>dim 5 <border> pref-dim ] unit-test
[ ] [ <gadget> { 100 200 } >>dim "g" set ] unit-test
[ ] [ "g" get 0 <border> { 100 200 } >>dim "b" set ] unit-test
[ T{ rect f { 0 0 } { 100 200 } } ] [ "b" get border-child-rect ] unit-test
[ ] [ "g" get 5 <border> { 210 210 } >>dim "b" set ] unit-test
[ T{ rect f { 55 5 } { 100 200 } } ] [ "b" get border-child-rect ] unit-test
[ ] [ "b" get { 0 0 } >>align drop ] unit-test
[ { 5 5 } ] [ "b" get { 100 200 } border-loc ] unit-test
[ T{ rect f { 5 5 } { 100 200 } } ] [ "b" get border-child-rect ] unit-test
[ ] [ "b" get { 1 1 } >>fill drop ] unit-test
[ T{ rect f { 5 5 } { 200 200 } } ] [ "b" get border-child-rect ] unit-test

View File

@ -4,47 +4,44 @@ USING: accessors arrays ui.gadgets kernel math
namespaces vectors sequences math.vectors ;
IN: ui.gadgets.borders
TUPLE: border < gadget size fill ;
TUPLE: border < gadget
{ size initial: { 0 0 } }
{ fill initial: { 0 0 } }
{ align initial: { 1/2 1/2 } } ;
: new-border ( child class -- border )
new-gadget
{ 0 0 } >>size
{ 0 0 } >>fill
[ add-gadget ] keep ; inline
new-gadget [ add-gadget ] keep ; inline
: <border> ( child gap -- border )
swap border new-border
swap dup 2array >>size ;
M: border pref-dim*
[ border-size 2 v*n ] keep
[ size>> 2 v*n ] keep
gadget-child pref-dim v+ ;
: border-major-rect ( border -- rect )
dup border-size swap rect-dim over 2 v*n v- <rect> ;
: border-major-dim ( border -- dim )
[ dim>> ] [ size>> 2 v*n ] bi v- ;
: border-minor-rect ( major border -- rect )
gadget-child pref-dim
[ >r rect-bounds r> v- [ 2 / >fixnum ] map v+ ] keep
<rect> ;
: border-minor-dim ( border -- dim )
gadget-child pref-dim ;
: scale-rect ( rect vec -- loc dim )
[ v* ] curry >r rect-bounds r> bi@ ;
: scale ( a b s -- c )
tuck { 1 1 } swap v- [ v* ] 2bi@ v+ ;
: average-rects ( rect1 rect2 weight -- rect )
tuck >r >r scale-rect r> r> { 1 1 } swap v- scale-rect
swapd v+ >r v+ r> <rect> ;
: border-dim ( border -- dim )
[ border-major-dim ] [ border-minor-dim ] [ fill>> ] tri scale ;
: border-loc ( border dim -- loc )
[ [ size>> ] [ align>> ] [ border-major-dim ] tri ] dip v- v* v+ ;
: border-child-rect ( border -- rect )
dup border-major-rect
dup pick border-minor-rect
rot border-fill
average-rects ;
dup border-dim [ border-loc ] keep <rect> ;
M: border layout*
dup border-child-rect swap gadget-child
over rect-loc over set-rect-loc
swap rect-dim swap set-layout-dim ;
over loc>> over set-rect-loc
swap dim>> swap set-layout-dim ;
M: border focusable-child*
gadget-child ;

View File

@ -68,7 +68,8 @@ M: button-paint draw-boundary
button-paint draw-boundary ;
: roll-button-theme ( button -- button )
f black <solid> dup f <button-paint> >>boundary ; inline
f black <solid> dup f <button-paint> >>boundary
{ 0 1/2 } >>align ; inline
: <roll-button> ( label quot -- button )
<button> roll-button-theme ;