diff --git a/basis/ui/gadgets/scrollers/scrollers.factor b/basis/ui/gadgets/scrollers/scrollers.factor index 37f6e83e0c..93f6b8bb40 100644 --- a/basis/ui/gadgets/scrollers/scrollers.factor +++ b/basis/ui/gadgets/scrollers/scrollers.factor @@ -37,13 +37,14 @@ scroller H{ new-frame t >>root? >>model - faint-boundary - dup model>> dependencies>> first >>x dup x>> @bottom grid-add - dup model>> dependencies>> second >>y dup y>> @right grid-add + dup model>> dependencies>> + [ first [ >>x ] [ @bottom grid-add ] bi ] + [ second [ >>y ] [ @right grid-add ] bi ] bi - tuck model>> >>viewport - dup viewport>> @center grid-add ; inline + tuck model>> [ >>viewport ] [ @center grid-add ] bi + + faint-boundary ; inline : ( gadget -- scroller ) scroller new-scroller ; diff --git a/basis/ui/gadgets/viewports/viewports.factor b/basis/ui/gadgets/viewports/viewports.factor index f01ef3bf42..73782a1e3d 100644 --- a/basis/ui/gadgets/viewports/viewports.factor +++ b/basis/ui/gadgets/viewports/viewports.factor @@ -1,18 +1,23 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -IN: ui.gadgets.viewports USING: accessors arrays ui.gadgets ui.gadgets.borders -kernel math namespaces sequences models math.vectors math.geometry.rect ; +kernel math namespaces sequences models math.vectors +math.geometry.rect ; +IN: ui.gadgets.viewports -: viewport-gap { 3 3 } ; inline +CONSTANT: viewport-gap { 3 3 } +CONSTANT: scroller-border { 1 1 } TUPLE: viewport < gadget ; : find-viewport ( gadget -- viewport ) [ viewport? ] find-parent ; +: viewport-padding ( -- padding ) + viewport-gap 2 v*n scroller-border v+ ; + : viewport-dim ( viewport -- dim ) - gadget-child pref-dim viewport-gap 2 v*n v+ ; + gadget-child pref-dim viewport-padding v+ ; : ( content model -- viewport ) viewport new-gadget @@ -21,11 +26,11 @@ TUPLE: viewport < gadget ; swap add-gadget ; M: viewport layout* - [ - [ rect-dim viewport-gap 2 v*n v- ] + [ gadget-child ] [ + [ dim>> viewport-padding v- ] [ gadget-child pref-dim ] bi vmax - ] [ gadget-child ] bi (>>dim) ; + ] bi >>dim drop ; M: viewport focusable-child* gadget-child ; @@ -37,13 +42,17 @@ M: viewport pref-dim* viewport-dim ; M: viewport model-changed nip - dup relayout-1 - dup scroller-value - vneg viewport-gap v+ - swap gadget-child (>>loc) ; + [ relayout-1 ] + [ + [ gadget-child ] + [ + scroller-value vneg + viewport-gap v+ + scroller-border v+ + ] bi + >>loc drop + ] bi ; : visible-dim ( gadget -- dim ) dup parent>> viewport? - [ parent>> rect-dim viewport-gap 2 v*n v- ] - [ rect-dim ] - if ; + [ parent>> rect-dim viewport-gap 2 v*n v- ] [ dim>> ] if ;