"

 COPYRIGHT (c) 1989 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:03 am'!

View subclass:#Scroller

	 instanceVariableNames:'thumbOrigin thumbHeight thumbColor thumbFrameColor scrollAction

		orientation thumbFrame thumbLevel scrolling pressOffset

		synchronousOperation shadowForm lightForm inset thumbShadowColor

		thumbLightColor thumbEdgeStyle thumbHalfShadowColor

		thumbHalfLightColor thumbFrameSizeDifference tallyLevel

		tallyMarks fixThumbHeight frameBeforeMove ghostColor

		ghostFrameColor ghostLevel rangeStart rangeEnd rangeStep'

	 classVariableNames:'HandleShadowForm HandleLightForm DefaultViewBackground

		DefaultShadowColor DefaultLightColor DefaultThumbColor

		DefaultThumbShadowColor DefaultThumbLightColor

		DefaultThumbHalfShadowColor DefaultThumbHalfLightColor

		DefaultHalfShadowColor DefaultHalfLightColor DefaultTallyMarks

		DefaultTallyLevel DefaultLevel DefaultBorderWidth

		DefaultThumbLevel DefaultInset DefaultThumbFrameColor

		DefaultGhostColor DefaultGhostFrameColor DefaultGhostLevel

	 poolDictionaries:''

	 category:'Views-Interactors'

!

Scroller comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

'!

!Scroller class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 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 the scroller for scrollbars.

    it can also be used by itself for scrollbars without step-buttons.

    When moved, either a predefined action is performed (scrollAction),

    or a model is informed via the changeMsg (which is #value: by default).

    Beside the obvious 3D rectangle, a scroller may draw a know-form

    (as in NeXT) or little tally marks (as on SGI) in itself.

    These are controlled by the shadowForm, lightForm, tallyLevel and tallyMarks

    instance variables.

    The scroller can work synchronous (i.e. every move leads to an immediate evaluation

    of the action, or asynchronous (i.e. perform action on end-of move).

    By default, scrollers are synchronous. Asynchronous operation makes sense, 

    if the scroll operation (redraw) is expensive and takes a long time.

    This class is used both for concrete instances (vertical scrollers)

    and as an abstract superclass for horizontalScrollers, sliders and

    miniScrollers.

  Instance variables:

    thumbOrigin                 <Number>        origin of thumb (in percent)

    thumbHeight                 <Number>        height of thumb (in percent)

    thumbColor                  <Color>         color of thumb

    thumbFrameColor             <Color>         color of the frame around the thumb

    scrollAction                <Block>         1 arg block to be evaluated when scrolled

						(arg is position in percent)

    orientation                 <Symbol>        #horizontal or #vertical

    thumbFrame                  <Rectangle>     frame of thumb in pixels (cached)

    thumbLevel                  <Number>        level of thumb if 3d

    scrolling                   <Boolean>       true during scroll

    pressOffset                 <Number>        temporary (offset into frame when move started)

    synchronousOperation        <Boolean>       true if synchronous (i.e. dont wait till release

						to perform action)

    shadowForm                  <Form>          bitmap of knob if any (shadow part)

    lightForm                   <Form>          bitmap of knob if any (light part)

    inset                       <Integer>       number of pixels to inset thumb from view borders

    thumbShadowColor            <Color>         color do draw dark parts of thumb

    thumblightColor             <Color>         color to draw light parts of thumb

    thumbEdgeStyle              <SymbolOrNil>   #soft or nil

    thumbHalfShadowColor        <Color>         used to draw smooth edges

    thumbHalfLightColor         <Color>         used to draw smooth edges

    thumbFrameSizeDifference    <Integer>       number of pixels the thumb is larger than 

						it should be (can be negative for mswin-style)

    tallyLevel                  <Integer>       if not zero, specifies if tally-marks should

						go into or out of the display (actually only <0/>0 is checked)

						I dont know of a better word for these ...

    tallyMarks                  <Integer>       number of tally marks

    fixThumbHeight              <Boolean>       perform 'wrong' height computation a la mswindows

    rangeStart                  <Number>        the range of the scroller

    rangeEnd                                    (defaults to 0..100)

    rangeStep                                   not currently implemented

  style settings:

    scrollerLevel               <Integer>       the level of the scroller w.r.t. its enclosing view

    scrollerBorderWidth         <Integer>       the borderWidth (ignored for 3D styles)

    scrollerViewBackground      <Color>         the viewBackground (color or image)

    scrollerShadowColor         <Color>         the color of 3D shadowed edges (ignored in 2D styles)

    scrollerLightColor          <Color>         the color of 3D lighted edges (ignored in 2D styles)

    scrollerThumbColor          <Color>         the thumbs color (color or image)

    scrollerThumbShadowColor    <Color>         the color of the thumbs shadowed edges (ignored in 2D styles)

    scrollerThumbLightColor     <Color>         the color of the thumbs shadowed edges (ignored in 2D styles)

    scrollerThumbEdgeStyle      <Symbol>        the edge style for the thumb (#soft or nil)

    scrollerThumbLevel          <Integer>       the 3D height of the thumb

    scrollerThumbHalfShadowColor<Color>         the halfShadow for soft edged thumbs

    scrollerThumbHalfLightColor <Color>         the halfLight for soft edged thumbs

    scrollerThumbFrameColor     <Color>         if non-nil, a rectangle is drawn around the thumb is this color

    scrollerThumbInset          <Integer>       inset of thumb from the scrollers boundary

    scrollerThumbFixHeight      <Boolean>       if true, use a fix thumb height (as in mswindows)

    scrollerGhostColor          <Color>         the color in which a ghost-rectangle is drawn

    scrollerGhostFrameColor     <Color>         if non-nil, a rectangle is drawn around the ghost is this color

    scrollerGhostLevel          <Color>         the 3D level of the ghost rectangle

    scrollerNTallyMarks         <Integer>       number of tally-marks to draw on the thumb

    scrollerTallyLevel.         <Integer>       the 3D level of any tally marks

    notice: for mswindows style, we force a WRONG thumb-frame

    computation, to make the thumb have constant size; 

    if you dont like that (I do not :-), set scrollerThumbFixHeight to false (in the StyleSheet).

"

!

examples

"

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

	|top s|

	top := StandardSystemView new extent:200@200.

	s := Scroller in:top.

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

	s thumbHeight:10.  'percent'.     

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

	top open

    using a model (ST-80 style):

	|top s m|

	m := 0 asValue.

	m inspect. 'look at value'.

	top := StandardSystemView new extent:200@200.

	s := Scroller in:top.

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

	s thumbHeight:10.  'percent'.     

	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 := Scroller in:top.

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

	s1 thumbHeight:10.  'percent'.     

	s1 model:m; change:#value1:.

	s2 := Scroller in:top.

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

	s2 thumbHeight:10.  'percent'.     

	s2 model:m; change:#value2:.

	top open

"

! !

!Scroller class methodsFor:'defaults'!

updateStyleCache

    DefaultViewBackground := StyleSheet colorAt:'scrollerViewBackground'.

    DefaultThumbColor := StyleSheet colorAt:'scrollerThumbColor'.

    DefaultShadowColor := StyleSheet colorAt:'scrollerShadowColor'.

    DefaultLightColor := StyleSheet colorAt:'scrollerLightColor'.

    DefaultThumbShadowColor := StyleSheet colorAt:'scrollerThumbShadowColor'.

    DefaultThumbLightColor := StyleSheet colorAt:'scrollerThumbLightColor'.

    DefaultThumbHalfShadowColor := StyleSheet colorAt:'scrollerThumbHalfShadowColor'.

    DefaultThumbHalfLightColor := StyleSheet colorAt:'scrollerThumbHalfLightColor'.

    DefaultThumbFrameColor := StyleSheet colorAt:'scrollerThumbFrameColor'.

    DefaultGhostColor := StyleSheet colorAt:'scrollerGhostColor' default:nil.

    DefaultGhostFrameColor := StyleSheet colorAt:'scrollerGhostFrameColor' default:nil.

    DefaultGhostLevel := StyleSheet at:'scrollerGhostLevel' default:0.

    DefaultTallyMarks := StyleSheet at:'scrollerNTallyMarks' default:0.

    DefaultTallyLevel := 0.

    DefaultTallyMarks ~~ 0 ifTrue:[

	DefaultTallyLevel := StyleSheet at:'scrollerTallyLevel' default:1.

    ].

    DefaultLevel := StyleSheet at:'scrollerLevel' default:0.

    DefaultBorderWidth := StyleSheet at:'scrollerBorderWidth' default:(StyleSheet at:'borderWidth').

    DefaultThumbLevel := StyleSheet at:'scrollerThumbLevel' default:0.

    DefaultInset := StyleSheet at:'scrollerThumbInset' default:0.

    DefaultFixThumbHeight := StyleSheet at:'scrollerThumbFixHeight' default:false.

    DefaultEdgeStyle := StyleSheet at:'scrollerThumbEdgeStyle'.

!

handleShadowFormOn:aDisplay

    "answer the form used for the handles shadow area;

     cache the one for Display for the next round"

    |f|

    ((aDisplay == Display) and:[HandleShadowForm notNil]) ifTrue:[

	^ HandleShadowForm

    ].

    f := Form fromFile:'HandleShadow.xbm' resolution:100 on:aDisplay.

    f isNil ifTrue:[

	f := Form width:8 height:8 fromArray:#[2r00111100

					       2r01100000

					       2r11000000

					       2r11000000

					       2r11000000

					       2r11000000

					       2r01000000

					       2r00000000]

					   on:aDisplay

    ].

    (aDisplay == Display) ifTrue:[

	HandleShadowForm := f

    ].

    ^ f

!

handleLightFormOn:aDisplay

    "answer the form used for the handles light area;

     cache the one for Display for the next round"

    |f|

    ((aDisplay == Display) and:[HandleLightForm notNil]) ifTrue:[

	^ HandleLightForm

    ].

    f := Form fromFile:'HandleLight.xbm' resolution:100 on:aDisplay.

    f isNil ifTrue:[

	f := Form width:8 height:8 fromArray:#[2r00000000

					       2r00000010

					       2r00000011

					       2r00000011

					       2r00000011

					       2r00000011

					       2r00000110

					       2r00111100]

					      on:aDisplay

    ].

    (aDisplay == Display) ifTrue:[

	HandleLightForm := f

    ].

    ^ f

! !

!Scroller methodsFor:'private'!

absFromPercent:percent

    "given a percentage, compute number of pixels"

    |fullSize|

    (orientation == #vertical) ifTrue:[

	fullSize := height

    ] ifFalse:[

	fullSize := width

    ].

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

"/ 20-apr-94

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

!

computeThumbFrame

    "compute the thumbs frame (a rectangle) whenever thumb is moved, 

     changed height or the scrollers size has changed.

     We take care, that the thumb will not become too small (i.e.

     invisible or uncatchable).

     Also, for mswindows style, its height/width is constant."

    |newPos1 newPos2 newSize1 newSize2 nh nw ny nx 

     computedSize minSz sz1 sz2|

    "compute position & size"

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

    newSize1 := computedSize := self absFromPercent:thumbHeight.

    (orientation == #vertical) ifTrue:[

	sz1 := height.

	sz2 := width

    ] ifFalse:[

	sz1 := width.

	sz2 := height

    ].

    "

     do we have to adjust the computed size ?

    "

    newPos2 := margin + inset.     

    newSize2 := sz2 - (2 * newPos2).

"/    (style ~~ #normal) ifTrue:[

    thumbLevel ~~ 0 ifTrue:[

	"

	 do not make thumb too small (for handle & to be catchable)

	"

	minSz := 10 + (2 * thumbLevel)

    ] ifFalse:[

	"

	 do not make thumb too small (uncatchable)

	"

	minSz := 4

    ].

    (newSize1 < minSz) ifTrue:[

	newSize1 := minSz.

	thumbFrameSizeDifference := newSize1 - computedSize

    ] ifFalse:[

	thumbFrameSizeDifference := 0.

    ].

    fixThumbHeight ifTrue:[

	"have a fix-size thumb (i.e. mswindows style)"

	newSize1 := sz2 - (2 * inset).   "make it square"

	thumbFrameSizeDifference := newSize1 - computedSize.

    ].

    "

     oops - if height does not relect real visibible area, we have to adjust the origin

    "

    (thumbFrameSizeDifference == 0) ifFalse:[

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

"/        newPos1 := ((thumbOrigin * (sz1 - thumbFrameSizeDifference - (margin * 2))) / 100) rounded + margin

    ].

    (orientation == #vertical) ifTrue:[

	ny := newPos1.

	nx := newPos2.

	nh := newSize1.

	nw := newSize2.

	ny + nh + margin > height ifTrue:[

	    ny := height - margin - nh

	]

    ] ifFalse:[

	nx := newPos1.

	ny := newPos2.

	nw := newSize1.

	nh := newSize2.

	nx + nw + margin > width ifTrue:[

	    nx := width - margin - nw

	]

    ].

    "

     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

!

percentFromAbs:absValue

    "given a number of pixels, compute percentage"

    |fullSize val|

    (orientation == #vertical) ifTrue:[

	fullSize := height

    ] ifFalse:[

	fullSize := width

    ].

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

    val := val + rangeStart.

    val < rangeStart ifTrue:[^ rangeStart].

    val > rangeEnd ifTrue:[^ rangeEnd].

    ^ val

! !

!Scroller methodsFor:'drawing'!

drawThumbBackgroundInX:x y:y width:w height:h

    "draw part of the thumbs background; defined as a separate

     method, to allow drawing of arbitrary patterns under thumb 

     (see ColorSlider)."

    shown ifTrue:[

	self clearRectangleX:x y:y width:w height:h.

	frameBeforeMove notNil ifTrue:[

	    self clippedTo:(Rectangle left:x top:y width:w height:h) do:[

		|gX gY gW gH|

		gX := frameBeforeMove left.

		gY := frameBeforeMove top.

		gW := frameBeforeMove width.

		gH := frameBeforeMove height.

		(ghostLevel ~~ 0) ifTrue:[

		    self drawEdgesForX:gX y:gY width:gW height:gH level:ghostLevel

		].

		ghostFrameColor notNil ifTrue:[

		    self paint:ghostFrameColor.

		    self displayRectangleX:gX y:gY width:gW height:gH

		]

	    ]

	]

    ]

!

drawThumb

    "draw the thumb"

    |handleX handleY l t 

     w "{ Class: SmallInteger }"

     h "{ Class: SmallInteger }"

     x "{ Class: SmallInteger }"

     y "{ Class: SmallInteger }"

     mm xL xR yT yB color1 color2|

    (thumbHeight >= 100) ifTrue:[^ self].

    orientation == #vertical ifTrue:[

	thumbFrame height >= height ifTrue:[^ self].

    ] ifFalse:[

	thumbFrame width >= width ifTrue:[^ self].

    ].

    l := thumbFrame left.

    t := thumbFrame top.

    w := thumbFrame width.

    h := thumbFrame height.

    self paint:thumbColor.

    self fillRectangleX:l y:t width:w-1 height:h.

    thumbLevel == 0 ifTrue:[

	thumbFrameColor notNil ifTrue:[

	    self paint:thumbFrameColor.

	    self displayRectangle:thumbFrame.

	].

	^ self

    ].

    "what a kludge - must be a parameter to drawEdge..."

    self drawEdgesForX:l y:t width:w height:h level:thumbLevel

		shadow:thumbShadowColor light:thumbLightColor

		halfShadow:thumbHalfShadowColor halfLight:thumbHalfLightColor

		style:thumbEdgeStyle.

    thumbFrameColor notNil ifTrue:[

	self paint:thumbFrameColor.

	orientation == #vertical ifTrue:[

	    self displayRectangleX:l y:t width:w"-1" height:h.

	] ifFalse:[

	    self displayRectangleX:l y:t width:w height:h"-1".

	]

    ].