cvs
Slava Pestov 2005-03-12 02:41:46 +00:00
parent 544b2fa434
commit a22b04d2b6
7 changed files with 17 additions and 24 deletions

View File

@ -6,14 +6,12 @@
+ ui:
- fix up initial layout of slider
- resizing a gadget should probably relayout children
- resizing: drag relative to initial click pos
- mouse enter onto overlapping with interior, but not child, gadget
- menu dragging
- auto-updating inspector
- fix up the min thumb size hack
- console: scroll to bottom
- faster layout
- faster repaint
- check broken

View File

@ -9,7 +9,7 @@ default-cli-args
parse-command-line
! Dummy defs for mini bootstrap
IN: compiler : compile-all ; : compile drop ;
IN: compiler : compile-all ; : compile drop ; : supported-cpu? f ;
IN: assembler : init-assembler ;
IN: alien : add-library 3drop ;
@ -54,7 +54,7 @@ cpu "x86" = "mini" get not and [
"/library/compiler/x86/fixnum.factor"
] pull-in
"compile" get [
"compile" get supported-cpu? and [
init-assembler
\ car compile
\ = compile

View File

@ -3,11 +3,11 @@
IN: gadgets
USING: generic kernel lists math namespaces sdl ;
: check-size 7 ;
: check-size 8 ;
: <check> ( -- cross )
0 0 check-size dup <line> <gadget>
>r check-size 0 check-size neg check-size <line> <gadget> r>
>r check-size 1 - 0 check-size neg check-size <line> <gadget> r>
2list <stack> ;
TUPLE: checkbox bevel selected? ;

View File

@ -87,7 +87,7 @@ C: editor ( text -- )
M: editor user-input* ( ch field -- ? )
[ [ insert-char ] with-editor ] keep
[ scroll>bottom ] swap handle-gesture drop t ;
scroll>bottom t ;
M: editor layout* ( field -- )
dup [ editor-text shape-size ] keep resize-gadget

View File

@ -72,7 +72,7 @@ M: pane stream-readln ( stream -- line )
[ swap set-pane-continuation (yield) ] callcc1 nip ;
M: pane stream-write-attr ( string style stream -- )
nip swap "\n" split pane-write ;
[ nip swap "\n" split pane-write ] keep scroll>bottom ;
M: pane stream-close ( stream -- ) drop ;

View File

@ -15,14 +15,12 @@ TUPLE: viewport x y ;
dup shape-h swap viewport-h - max 0 min ;
: scroll-viewport ( y viewport -- )
#! y is a number between 0 and 1.
#! y is a number between -1 and 0..
[ viewport-h * >fixnum ] keep
[ adjust-scroll ] keep
[ set-viewport-y ] keep
relayout ;
: scroll>bottom ( viewport -- ) 1 swap scroll-viewport ;
C: viewport ( content -- viewport )
[ <empty-gadget> swap set-delegate ] keep
[ add-gadget ] keep
@ -32,11 +30,8 @@ C: viewport ( content -- viewport )
M: viewport pref-size gadget-child pref-size ;
M: viewport layout* ( viewport -- )
dup gadget-children [
[
>r dup viewport-x swap viewport-y r> move-gadget
] keep prefer
] each-with ;
dup gadget-child dup prefer
>r dup viewport-x swap viewport-y r> move-gadget ;
! A slider scrolls a viewport.
@ -111,13 +106,16 @@ TUPLE: scroller viewport slider ;
: add-viewport 2dup set-scroller-viewport add-center ;
: add-slider 2dup set-scroller-slider add-right ;
: viewport>bottom 1 swap scroll-viewport ;
: scroll>bottom ( scroller -- )
dup scroller-slider relayout
scroller-viewport viewport>bottom ;
: viewport>bottom -1 swap scroll-viewport ;
: (scroll>bottom) ( scroller -- )
dup scroller-viewport viewport>bottom
scroller-slider relayout ;
: scroller-actions ( scroller -- )
[ scroll>bottom ] [ scroll>bottom ] set-action ;
[ (scroll>bottom) ] [ scroll>bottom ] set-action ;
: scroll>bottom ( gadget -- )
[ scroll>bottom ] swap handle-gesture drop ;
C: scroller ( gadget -- scroller )
#! Wrap a scrolling pane around the gadget.

View File

@ -37,11 +37,8 @@ USING: generic kernel math namespaces ;
dup t reverse-video set-paint-prop
dup caption-actions ;
DEFER: inspect
: tile-actions ( tile -- )
dup [ unparent ] [ close-tile ] set-action
dup [ inspect ] [ inspect-tile ] set-action
dup [ raise ] [ raise ] set-action
[ drag-tile ] [ drag-tile ] set-action ;