make sliders work when range min isn't zero

db4
Joe Groff 2009-06-18 21:20:34 -05:00
parent 037ed45339
commit 3514e5fb47
1 changed files with 14 additions and 5 deletions

View File

@ -9,11 +9,15 @@ IN: ui.gadgets.sliders
TUPLE: slider < track elevator thumb saved line ;
: slider-value ( gadget -- n ) model>> range-value >fixnum ;
: slider-value ( gadget -- n ) model>> range-value ;
: slider-page ( gadget -- n ) model>> range-page-value ;
: slider-min ( gadget -- n ) model>> range-min-value ;
: slider-max ( gadget -- n ) model>> range-max-value ;
: slider-max* ( gadget -- n ) model>> range-max-value* ;
: slider-length ( gadget -- n ) [ slider-max ] [ slider-min ] bi - ;
: slider-length* ( gadget -- n ) [ slider-max* ] [ slider-min ] bi - ;
: slide-by ( amount slider -- ) model>> move-by ;
: slide-by-page ( amount slider -- ) model>> move-by-page ;
@ -34,7 +38,9 @@ CONSTANT: elevator-padding 4
CONSTANT: min-thumb-dim 30
: visible-portion ( slider -- n )
[ slider-page ] [ slider-max 1 max ] bi / 1 min ;
[ slider-page ]
[ slider-length 1 max ]
bi / 1 min ;
: thumb-dim ( slider -- h )
[
@ -48,7 +54,7 @@ CONSTANT: min-thumb-dim 30
#! x*n is the screen position of the thumb, and conversely
#! for x/n. The '1 max' calls avoid division by zero.
[ [ elevator-length ] [ thumb-dim ] bi - 1 max ]
[ slider-max* 1 max ]
[ slider-length* 1 max ]
bi / ;
: slider>screen ( m slider -- n ) slider-scale * ;
@ -131,7 +137,9 @@ elevator H{
swap >>orientation ;
: thumb-loc ( slider -- loc )
[ slider-value ] keep slider>screen elevator-padding + ;
[ slider-value ]
[ slider-min - ]
[ slider>screen elevator-padding + ] tri ;
: layout-thumb-loc ( thumb slider -- )
[ thumb-loc ] [ orientation>> ] bi n*v
@ -236,3 +244,4 @@ PRIVATE>
[ <down-button> f track-add ]
[ drop <gadget> { 1 1 } >>dim f track-add ]
} cleave ;