Improve scroll>rect and scroll>caret so that the caret is always visible

db4
Slava Pestov 2008-11-19 17:13:39 -06:00
parent 6681d4bca3
commit 344657b93b
2 changed files with 9 additions and 8 deletions

View File

@ -120,9 +120,10 @@ M: editor ungraft*
: scroll>caret ( editor -- ) : scroll>caret ( editor -- )
dup graft-state>> second [ dup graft-state>> second [
dup caret-loc over caret-dim <rect> [
over scroll>rect [ caret-loc ] [ caret-dim { 1 0 } v+ ] bi <rect>
] when drop ; ] keep scroll>rect
] [ drop ] if ;
: draw-caret ( -- ) : draw-caret ( -- )
editor get focused?>> [ editor get focused?>> [

View File

@ -43,7 +43,7 @@ scroller H{
dup model>> dependencies>> second <y-slider> >>y dup y>> @right grid-add dup model>> dependencies>> second <y-slider> >>y dup y>> @right grid-add
tuck model>> <viewport> >>viewport tuck model>> <viewport> >>viewport
dup viewport>> @center grid-add ; dup viewport>> @center grid-add ; inline
: <scroller> ( gadget -- scroller ) scroller new-scroller ; : <scroller> ( gadget -- scroller ) scroller new-scroller ;
@ -54,18 +54,18 @@ scroller H{
] keep ] keep
2dup control-value = [ 2drop ] [ set-control-value ] if ; 2dup control-value = [ 2drop ] [ set-control-value ] if ;
: rect-min ( rect1 rect2 -- rect ) : rect-min ( rect dim -- rect' )
>r [ rect-loc ] keep r> [ rect-dim ] bi@ vmin <rect> ; [ [ loc>> ] [ dim>> ] bi ] dip vmin <rect> ;
: (scroll>rect) ( rect scroller -- ) : (scroll>rect) ( rect scroller -- )
[ [
scroller-value vneg offset-rect scroller-value vneg offset-rect
viewport-gap offset-rect viewport-gap offset-rect
] keep ] keep
[ viewport>> rect-min ] keep [ viewport>> dim>> rect-min ] keep
[ [
viewport>> 2rect-extent viewport>> 2rect-extent
>r >r v- { 0 0 } vmin r> r> v- { 0 0 } vmax v+ [ v- { 1 1 } v- { 0 0 } vmin ] [ v- { 0 0 } vmax ] 2bi* v+
] keep dup scroller-value rot v+ swap scroll ; ] keep dup scroller-value rot v+ swap scroll ;
: relative-scroll-rect ( rect gadget scroller -- newrect ) : relative-scroll-rect ( rect gadget scroller -- newrect )