diff --git a/extra/ui/gadgets/borders/borders.factor b/extra/ui/gadgets/borders/borders.factor index a0dc545807..f0099e2f91 100644 --- a/extra/ui/gadgets/borders/borders.factor +++ b/extra/ui/gadgets/borders/borders.factor @@ -4,23 +4,41 @@ USING: arrays ui.gadgets generic hashtables kernel math namespaces vectors sequences math.vectors ; IN: ui.gadgets.borders -TUPLE: border size ; +TUPLE: border size fill ; : ( child gap -- border ) - border construct-gadget - [ >r dup 2array r> set-border-size ] keep - [ add-gadget ] keep ; - -: layout-border-loc ( border -- ) - dup rect-dim swap gadget-child - [ pref-dim v- 2 v/n [ >fixnum ] map ] keep set-rect-loc ; + dup 2array { 0 0 } border construct-boa + over set-delegate + tuck add-gadget ; M: border pref-dim* [ border-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- ; + +: border-minor-rect ( major border -- rect ) + gadget-child pref-dim + [ >r rect-bounds r> v- 2 v/n v+ ] keep ; + +: scale-rect ( rect vec -- loc dim ) + [ v* ] curry >r rect-bounds r> 2apply ; + +: average-rects ( rect1 rect2 weight -- rect ) + tuck >r >r scale-rect r> r> { 1 1 } swap v- scale-rect + swapd v+ >r v+ r> ; + +: border-child-rect ( border -- rect ) + dup border-major-rect + dup pick border-minor-rect + rot border-fill + average-rects ; + M: border layout* - dup layout-border-loc gadget-child prefer ; + dup border-child-rect swap gadget-child + over rect-loc over set-rect-loc + swap rect-dim swap set-layout-dim ; M: border focusable-child* gadget-child ;