diff --git a/basis/math/rectangles/positioning/positioning-tests.factor b/basis/math/rectangles/positioning/positioning-tests.factor index 42ebe9d7c7..a292775494 100644 --- a/basis/math/rectangles/positioning/positioning-tests.factor +++ b/basis/math/rectangles/positioning/positioning-tests.factor @@ -3,44 +3,51 @@ USING: tools.test math.rectangles math.rectangles.positioning ; IN: math.rectangles.positioning.tests -[ { 0 1 } ] [ +[ T{ rect f { 0 1 } { 30 30 } } ] [ { 0 0 } { 1 1 } { 30 30 } { 100 100 } - popup-loc + popup-rect ] unit-test -[ { 10 21 } ] [ +[ T{ rect f { 10 21 } { 30 30 } } ] [ { 10 20 } { 1 1 } { 30 30 } { 100 100 } - popup-loc + popup-rect ] unit-test -[ { 10 30 } ] [ +[ T{ rect f { 10 30 } { 30 30 } } ] [ { 10 20 } { 1 10 } { 30 30 } { 100 100 } - popup-loc + popup-rect ] unit-test -[ { 20 20 } ] [ +[ T{ rect f { 20 20 } { 80 30 } } ] [ { 40 10 } { 1 10 } { 80 30 } { 100 100 } - popup-loc + popup-rect ] unit-test -[ { 50 20 } ] [ +[ T{ rect f { 50 20 } { 50 50 } } ] [ { 50 70 } { 0 0 } { 50 50 } { 100 100 } - popup-loc + popup-rect ] unit-test -[ { 0 20 } ] [ +[ T{ rect f { 0 20 } { 50 50 } } ] [ { -50 70 } { 0 0 } { 50 50 } { 100 100 } - popup-loc + popup-rect +] unit-test + +[ T{ rect f { 0 50 } { 50 50 } } ] [ + { 0 50 } { 0 0 } + { 50 60 } + { 100 100 } + popup-rect ] unit-test \ No newline at end of file diff --git a/basis/math/rectangles/positioning/positioning.factor b/basis/math/rectangles/positioning/positioning.factor index 37b10b357d..4b1a60a627 100644 --- a/basis/math/rectangles/positioning/positioning.factor +++ b/basis/math/rectangles/positioning/positioning.factor @@ -1,6 +1,8 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: sequences kernel accessors math math.order arrays ; +USING: sequences kernel accessors math math.vectors +math.rectangles math.order arrays locals +combinators.short-circuit ; IN: math.rectangles.positioning ! Some geometry code for positioning popups and menus @@ -15,11 +17,21 @@ IN: math.rectangles.positioning : alternate-y ( visible-rect popup-dim -- y ) [ loc>> ] dip [ second ] bi@ - ; -: popup-fits? ( visible-rect popup-dim screen-dim -- ? ) +: preferred-fit? ( visible-rect popup-dim screen-dim -- ? ) [ [ preferred-y ] [ second ] bi* + ] dip second < ; +: alternate-fit? ( visible-rect popup-dim -- ? ) + alternate-y 0 >= ; + : popup-y ( visible-rect popup-dim screen-dim -- y ) - 3dup popup-fits? [ 2drop preferred-y ] [ drop alternate-y ] if ; + 3dup { [ preferred-fit? not ] [ drop alternate-fit? ] } 3&& + [ drop alternate-y ] [ 2drop preferred-y ] if ; : popup-loc ( visible-rect popup-dim screen-dim -- loc ) [ popup-x ] [ popup-y ] 3bi 2array ; + +:: popup-dim ( loc popup-dim screen-dim -- dim ) + screen-dim loc v- popup-dim vmin ; + +: popup-rect ( visible-rect popup-dim screen-dim -- rect ) + [ popup-loc dup ] 2keep popup-dim ; \ No newline at end of file