Scrolling cleanup

slava 2006-08-03 21:17:22 +00:00
parent 7517e389e0
commit 89fbc32ef3
2 changed files with 21 additions and 11 deletions

View File

@ -66,22 +66,31 @@ C: scroller ( gadget -- scroller )
[ rect-extent v+ ] 2apply v-
] keep dup scroller-origin rot v+ scroll ;
: scroll>rect ( rect gadget -- )
: (scroll>rect) ( rect scroller -- )
#! First ensure top left is visible, then bottom right.
find-scroller
over rect-loc over scroll>point
swap rect-extent swap scroll>point ;
>r rect-extent r> tuck
>r >r scroll>point r> r> scroll>point ;
: scroll>rect ( rect gadget -- )
find-scroller dup [ set-scroller-follows ] [ 2drop ] if ;
: scroll>bottom ( gadget -- )
find-scroller [ t swap set-scroller-follows ] when* ;
t swap scroll>rect ;
: (scroll>bottom) ( scroller -- )
dup scroller-viewport viewport-dim { 0 1 } v* scroll ;
: update-scroller ( scroller -- )
dup dup scroller-follows [
f over set-scroller-follows
scroller-viewport viewport-dim { 0 1 } v*
dup scroller-follows dup [
f pick set-scroller-follows
dup t eq? [
drop (scroll>bottom)
] [
swap (scroll>rect)
] if
] [
scroller-origin
] if scroll ;
drop dup scroller-origin scroll
] if ;
M: scroller layout* ( scroller -- )
dup delegate layout*

View File

@ -122,7 +122,8 @@ M: editor model-changed ( editor -- )
dup caret-loc swap caret-dim <rect> ;
M: loc-monitor model-changed ( obj -- )
loc-monitor-editor ( dup caret-rect swap scroll>rect ) control-self relayout-1 ;
loc-monitor-editor dup caret-rect over scroll>rect
control-self relayout-1 ;
: draw-caret ( -- )
editor get