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 -- )
dup graft-state>> second [
dup caret-loc over caret-dim <rect>
over scroll>rect
] when drop ;
[
[ caret-loc ] [ caret-dim { 1 0 } v+ ] bi <rect>
] keep scroll>rect
] [ drop ] if ;
: draw-caret ( -- )
editor get focused?>> [

View File

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