steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Scrolling fixes

slava 2006-08-04 00:05:54 +00:00
parent de985de385
commit 5d7d152792
4 changed files with 19 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
library/compiler/inference/known-words.factor
View File

@ -270,7 +270,7 @@ sequences strings vectors words prettyprint ;
\ getenv [ [ fixnum ] [ object ] ] "infer-effect" set-word-prop \ getenv [ [ fixnum ] [ object ] ] "infer-effect" set-word-prop
\ setenv [ [ object fixnum ] [ ] ] "infer-effect" set-word-prop \ setenv [ [ object fixnum ] [ ] ] "infer-effect" set-word-prop
\ stat [ [ string ] [ array ] ] "infer-effect" set-word-prop \ stat [ [ string ] [ object ] ] "infer-effect" set-word-prop
\ (directory) [ [ string ] [ array ] ] "infer-effect" set-word-prop \ (directory) [ [ string ] [ array ] ] "infer-effect" set-word-prop
\ gc [ [ integer ] [ ] ] "infer-effect" set-word-prop \ gc [ [ integer ] [ ] ] "infer-effect" set-word-prop
\ gc-time [ [ ] [ integer ] ] "infer-effect" set-word-prop \ gc-time [ [ ] [ integer ] ] "infer-effect" set-word-prop

3
library/ui/gadgets.factor
View File

@ -23,6 +23,9 @@ M: array rect-dim drop { 0 0 } ;
: <extent-rect> ( loc ext -- rect ) dupd swap [v-] <rect> ; : <extent-rect> ( loc ext -- rect ) dupd swap [v-] <rect> ;
: offset-rect ( loc rect -- rect )
rect-bounds >r origin get v+ r> <rect> ;
: >absolute ( rect -- rect ) : >absolute ( rect -- rect )
rect-bounds >r origin get v+ r> <rect> ; rect-bounds >r origin get v+ r> <rect> ;

19
library/ui/gadgets/scrolling.factor
View File

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

7
library/ui/text/editor.factor
View File

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