"

 COPYRIGHT (c) 1992 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

'From Smalltalk/X, Version:2.10.5 on 30-apr-1995 at 1:46:33 am'!

Scroller subclass:#Slider

	 instanceVariableNames:'sliderHeight'

	 classVariableNames:''

	 poolDictionaries:''

	 category:'Views-Interactors'

!

!Slider class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1992 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

version

!

documentation

"

    this class implements sliders - which are simply scrollers

    with a constant thumbHeight. For details on actionBlocks and

    MVC operation, see the documentation in Scroller.

"

!

examples

"

    a slider with action block (ST/X style):

	|top s|

	top := StandardSystemView new extent:200@200.

	s := Slider in:top.

	s origin:(0.0@0.0) corner:(20@1.0).

	s scrollAction:[:percent | Transcript show:'moved to: '; showCr:percent asFloat].

	top open

    same, horizontal:

	|top s|

	top := StandardSystemView new extent:200@200.

	s := HorizontalSlider in:top.

	s origin:(0.0@0.0) corner:(1.0@20).

	s scrollAction:[:percent | Transcript show:'moved to: '; showCr:percent asFloat].

	top open

    with a range other than the default:

	|top s|

	top := StandardSystemView new extent:200@200.

	s := Slider in:top.

	s origin:(0.0@0.0) corner:(20@1.0).

	s scrollAction:[:percent | Transcript show:'moved to: '; showCr:percent asFloat].

	s start:-50 stop:50.

	top open

    using a model (ST-80 style):

    (see the changing value in the inspector)

	|top s m|

	m := 0 asValue.

	m inspect.

	top := StandardSystemView new extent:200@200.

	s := Slider in:top.

	s origin:(0.0@0.0) corner:(20@1.0).

	s model:m.

	top open

    reacting to changes from the model:

    (look at and/or change value using 'self value:' in the inspector).

	|top s m|

	m := 0 asValue.

	m inspect. 

	top := StandardSystemView new extent:200@200.

	s := Slider in:top.

	s origin:(0.0@0.0) corner:(20@1.0).

	s model:m.

	top open

    using a different changeSelector:

	|top s1 s2 m|

	m := Plug new.

	m respondTo:#value1: with:[:v | Transcript show:'scroller 1 moved to: '; showCr:v].

	m respondTo:#value2: with:[:v | Transcript show:'scroller 2 moved to: '; showCr:v].

	top := StandardSystemView new extent:200@200.

	s1 := Slider in:top.

	s1 origin:(0.0@0.0) corner:(20@1.0).

	s1 thumbHeight:10.  'percent'.     

	s1 model:m; change:#value1:.

	s2 := Slider in:top.

	s2 origin:(30@0.0) corner:(50@1.0).

	s2 thumbHeight:10.  'percent'.     

	s2 model:m; change:#value2:.

	top open

    another example:

	|top redVal greenVal blueVal 

	 colorVal upd s1 s2 s3 l|

	redVal := 0 asValue.

	greenVal := 0 asValue.

	blueVal := 0 asValue.

	upd := [colorVal value:(Color red:redVal value

				      green:greenVal value

				      blue:blueVal value)].

	colorVal := (Color red:0 green:0 blue:0) asValue.

	colorVal onChangeSend:#value to:[l backgroundColor:colorVal value].

	redVal onChangeSend:#value to:upd.

	greenVal onChangeSend:#value to:upd.

	blueVal onChangeSend:#value to:upd.

	top := StandardSystemView new extent:200@200.

	top label:'Color mixer'.

	s1 := Slider in:top.

	s1 origin:(0.0@0.0) corner:(20@1.0).

	s1 thumbHeight:10.  'percent'.     

	s1 model:redVal.

	s2 := Slider in:top.

	s2 origin:(30@0.0) corner:(50@1.0).

	s2 thumbHeight:10.  'percent'.     

	s2 model:greenVal.

	s3 := Slider in:top.

	s3 origin:(60@0.0) corner:(80@1.0).

	s3 thumbHeight:10.  'percent'.     

	s3 model:blueVal.

	l := Label in:top.

	l origin:90@0.0 corner:1.0@1.0.

	l backgroundColor:Color black.

	top open

    the same setup, using action blocks:

	|top red green blue

	 colorVal upd s1 s2 s3 labelModel l|

	red := green := blue := 0.

	top := StandardSystemView new extent:200@200.

	top label:'Color mixer'.

	s1 := Slider in:top.

	s1 origin:(0.0@0.0) corner:(20@1.0).

	s1 thumbHeight:10.  'percent'.     

	s1 action:[:percent | red := percent.

			      l backgroundColor:(Color red:red green:green blue:blue)].

	s2 := Slider in:top.

	s2 origin:(30@0.0) corner:(50@1.0).

	s2 thumbHeight:10.  'percent'.     

	s2 action:[:percent | green := percent.

			      l backgroundColor:(Color red:red green:green blue:blue)].

	s3 := Slider in:top.

	s3 origin:(60@0.0) corner:(80@1.0).

	s3 thumbHeight:10.  'percent'.     

	s3 action:[:percent | blue := percent.

			      l backgroundColor:(Color red:red green:green blue:blue)].

	l := Label in:top.

	l origin:90@0.0 corner:1.0@1.0.

	l backgroundColor:Color black.

	top open

"

! !

!Slider methodsFor:'private'!

percentFromAbs:absValue

    "given a number of pixels, compute percentage"

    |fullSize val|

    (orientation == #vertical) ifTrue:[

	fullSize := height

    ] ifFalse:[

	fullSize := width

    ].

    val := absValue / (fullSize - sliderHeight - (margin * 2)) * (rangeEnd - rangeStart).

    val := val + rangeStart.

    val < rangeStart ifTrue:[^ rangeStart].

    val > rangeEnd ifTrue:[^ rangeEnd].

    ^ val

!

absFromPercent:percent

    "given a percentage, compute number of pixels"

    |fullSize|

    (orientation == #vertical) ifTrue:[

	fullSize := height

    ] ifFalse:[

	fullSize := width

    ].

    ^ ((percent * (fullSize - sliderHeight - (margin * 2))) / 100) rounded

!

computeThumbFrame

    "redefined, since the thumb-height stays constant"

    |nh nw ny nx sz m|

    thumbHeight := 0.

    sz := (self absFromPercent:thumbOrigin) + margin.

    m := margin + inset.

    (orientation == #vertical) ifTrue:[

	ny := sz.

	nh := sliderHeight.

	nx := m.     

	nw := width - (2 * nx).

    ] ifFalse:[

	nx := sz.

	nw := sliderHeight.

	ny := m.     

	nh := height - (2 * ny).

    ].

    "

     do not create new Rectangle if its the same anyway

    "

    thumbFrame notNil ifTrue:[

	(ny == thumbFrame top) ifTrue:[

	  (nx == thumbFrame left) ifTrue:[

	    (nh == thumbFrame height) ifTrue:[

	      (nw == thumbFrame width) ifTrue:[ ^ self]

	    ]

	  ]

	]

    ].

    thumbFrame := Rectangle left:nx top:ny width:nw height:nh

! !

!Slider methodsFor:'initialization'!

initStyle

    super initStyle.

    tallyMarks := StyleSheet at:'sliderNTallyMarks' default:1.

    tallyLevel := StyleSheet at:'sliderTallyLevel' default:-1.    

!

initialize

    sliderHeight := (self verticalPixelPerMillimeter:10) rounded.

    super initialize.

    thumbHeight := 0.

! !

!Slider methodsFor:'forced scroll'!

pageUp

    "ignored - a slider has no concept of page-wise scrolling"

    ^ self

!

pageDown

    "ignored - a slider has no concept of page-wise scrolling"

    ^ self

! !

!Slider methodsFor:'accessing'!

thumbHeight

    "redefined since a slider has no height - just origin"

    ^ nil

! !