"
 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.
"

View subclass:#Scroller
       instanceVariableNames:'thumbOrigin thumbHeight thumbColor thumbFrameColor
			      scrollAction moveDirection
			      thumbFrame thumbLevel
			      scrolling pressOffset
			      synchronousOperation
			      shadowForm lightForm inset
			      thumbShadowColor thumbLightColor
			      thumbEdgeStyle
			      thumbHalfShadowColor thumbHalfLightColor
			      thumbFrameSizeDifference
			      tallyLevel tallyMarks
			      fixThumbHeight frameBeforeMove 
			      ghostColor ghostFrameColor ghostLevel'
       classVariableNames:   'HandleShadowForm HandleLightForm
			      DefaultViewBackground
			      DefaultShadowColor DefaultLightColor DefaultThumbColor 
			      DefaultThumbShadowColor DefaultThumbLightColor
			      DefaultThumbHalfShadowColor DefaultThumbHalfLightColor
			      DefaultHalfShadowColor DefaultHalfLightColor
			      DefaultTallyMarks DefaultTallyLevel
			      DefaultLevel DefaultBorderWidth DefaultThumbLevel 
			      DefaultInset DefaultThumbFrameColor 
			      DefaultGhostColor DefaultGhostFrameColor DefaultGhostLevel
			      DefaultFixThumbHeight DefaultEdgeStyle'
       poolDictionaries:''
       category:'Views-Interactors'
!

Scroller comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.11 1994-11-21 16:46:30 claus Exp $
'!

!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
"
$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.11 1994-11-21 16:46:30 claus Exp $
"
!

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 changeSymbol.

    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.

  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)
    moveDirection               <Symbol>        #x or #y
    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


  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).
"
! !

!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:'initialization'!

initialize
    "initialize - setup instvars from defaults"

    super initialize.
    self computeInitialExtent.
    moveDirection := #y.

    scrolling := false.
    synchronousOperation := true.

    thumbOrigin := 0.
    thumbHeight := 100.
    thumbFrameSizeDifference := 0.

"/    inset := 1.

"/    self computeThumbFrame
!

computeInitialExtent
    ^ self
!

initStyle
    "initialize style dep. stuff"

    super initStyle.

    DefaultViewBackground notNil ifTrue:[
	viewBackground := DefaultViewBackground on:device.
    ].
    DefaultShadowColor notNil ifTrue:[
	shadowColor := DefaultShadowColor on:device.
    ].
    DefaultLightColor notNil ifTrue:[
	lightColor := DefaultLightColor on:device.
    ].

    tallyMarks := DefaultTallyMarks.
    tallyLevel := DefaultTallyLevel.
    DefaultLevel ~~ level ifTrue:[
	self level:DefaultLevel.
    ].
    DefaultBorderWidth ~~ borderWidth ifTrue:[
	self borderWidth:DefaultBorderWidth.
    ].
    thumbLevel := DefaultThumbLevel.
    inset := DefaultInset.
    fixThumbHeight := DefaultFixThumbHeight.
    thumbEdgeStyle := DefaultEdgeStyle.

    DefaultGhostColor notNil ifTrue:[
	ghostColor := DefaultGhostColor on:device.
    ].
    DefaultGhostFrameColor notNil ifTrue:[
	ghostFrameColor := DefaultGhostFrameColor on:device.
    ].
    ghostLevel := DefaultGhostLevel.

    DefaultThumbFrameColor notNil ifTrue:[
	thumbFrameColor := DefaultThumbFrameColor on:device.
    ].
    DefaultThumbShadowColor notNil ifTrue:[
	thumbShadowColor := DefaultThumbShadowColor
    ] ifFalse:[
	thumbShadowColor := shadowColor.
    ].
    DefaultThumbLightColor notNil ifTrue:[
	thumbLightColor := DefaultThumbLightColor
    ] ifFalse:[
	thumbLightColor := lightColor.
    ].

    thumbEdgeStyle notNil ifTrue:[
	DefaultThumbHalfShadowColor notNil ifTrue:[
	    thumbHalfShadowColor := DefaultThumbHalfShadowColor
	].
	DefaultThumbHalfLightColor notNil ifTrue:[
	    thumbHalfLightColor := DefaultThumbHalfLightColor
	].
    ].

    device hasGreyscales ifFalse:[
	thumbEdgeStyle notNil ifTrue:[
	    thumbHalfShadowColor := Color darkGrey.
	    thumbHalfLightColor := White
	].

	thumbShadowColor := Black.
"/        thumbLightColor := White.

	StyleSheet name = #motif ifTrue:[
	    DefaultThumbColor isNil ifTrue:[
		thumbColor := White .
	    ].
	]
    ].

    DefaultThumbColor notNil ifTrue:[
	thumbColor := DefaultThumbColor on:device
    ] ifFalse:[
	thumbColor := White.
	StyleSheet name ~= #normal ifTrue:[
	    device hasGreyscales ifFalse:[
		thumbColor := Color grey
	    ].
	].
    ].

    thumbColor := thumbColor on:device.
    thumbShadowColor notNil ifTrue:[
	thumbShadowColor := thumbShadowColor on:device.
    ].
    thumbLightColor notNil ifTrue:[
	thumbLightColor := thumbLightColor on:device.
    ].
    thumbHalfShadowColor notNil ifTrue:[
	thumbHalfShadowColor := thumbHalfShadowColor on:device.
    ].
    thumbHalfLightColor notNil ifTrue:[
	thumbHalfLightColor := thumbHalfLightColor on:device.
    ].
    thumbEdgeStyle notNil ifTrue:[
	thumbHalfShadowColor isNil ifTrue:[
	    thumbHalfShadowColor := thumbShadowColor lightened on:device
	]
    ].

    StyleSheet name = #next ifTrue:[
	shadowForm := self class handleShadowFormOn:device.
	lightForm := self class handleLightFormOn:device
    ] ifFalse:[
	shadowForm := lightForm := nil
    ].

    drawableId notNil ifTrue:[
	self computeThumbFrame
    ]
!

initCursor
    "set the cursor - a hand"

    cursor := Cursor hand
!

initEvents
    self enableButtonEvents.
    self enableButtonMotionEvents
! !

!Scroller methodsFor:'accessing'!

is3D
    StyleSheet name = #mswindows ifTrue:[^ true].
    ^ super is3D
!

asynchronousOperation
    "set scroll-mode to be asynchronous - scroll action is performed after
     scrolling, when mouse-button is finally released"
     
    synchronousOperation := false
!

synchronousOperation
    "set scroll-mode to be synchronous - scroll action is performed for 
     every movement of thumb"
     
    synchronousOperation := true
!

scrollAction:aBlock
    "set the scroll action, aBlock which is evaluated when scrolled"

    scrollAction := aBlock
!

scrollAction
    "answer the scroll action block"

    ^ scrollAction
!

scrollDownAction:aBlock
    "ignored -
     but implemented, so that scroller can be used in place of a scrollbar"
!

scrollUpAction:aBlock
    "ignored -
     but implemented, so that scroller can be used in place of a scrollbar"
!

thumbOrigin
    "answer the thumbs origin (in percent)"

    ^ thumbOrigin
!

thumbOrigin:newOrigin
    "set the thumbs origin (in percent)"

    |realNewOrigin oldFrame oldTop oldBot thumbTop thumbBot
     tH "{ Class: SmallInteger }"
     tW delta left|

    ((newOrigin + thumbHeight) > 100) ifTrue:[
	realNewOrigin := 100 - thumbHeight
    ] ifFalse: [
	realNewOrigin := newOrigin
    ].
    (realNewOrigin > 100) ifTrue:[
	realNewOrigin := 100
    ] ifFalse: [
	(realNewOrigin < 0) ifTrue:[
	    realNewOrigin := 0
	]
    ].
    ((realNewOrigin ~= thumbOrigin) or:[thumbFrame isNil]) ifTrue:[
	thumbOrigin := realNewOrigin.

	shown ifTrue:[
	    oldFrame := thumbFrame.
	    self computeThumbFrame.
	    (thumbHeight = 100) ifTrue:[^ self].

	    (thumbFrame ~~ oldFrame) ifTrue:[
		oldFrame isNil ifTrue:[
		    self drawThumb.
		    ^ self
		].
		tH := thumbFrame height.
		tW := thumbFrame width.
		oldTop := oldFrame top.
		oldBot := oldTop + tH.

		thumbTop := thumbFrame top.
		thumbBot := thumbTop + tH.

		left := thumbFrame left.

		(oldBot >= height) ifTrue:[
		    "cannot copy - thumb was below end"
		    self drawThumbBackgroundInX:left y:oldTop
					  width:tW height:(height - oldTop).
		    self drawThumb.
		    ^ self
		].

		self catchExpose.
		self copyFrom:self x:left y:oldTop
				 toX:left y:thumbTop
			       width:tW height:tH.

		oldTop > thumbTop ifTrue:[
		    delta := oldTop - thumbTop.
		    oldTop > thumbBot ifTrue:[
			self drawThumbBackgroundInX:left y:oldTop
					      width:tW height:(tH + 1)
		    ] ifFalse:[
			self drawThumbBackgroundInX:left y:thumbBot 
					      width:tW height:delta
		    ]
		] ifFalse:[
		    delta := thumbTop - oldTop.
		    oldBot < thumbTop ifTrue:[
			self drawThumbBackgroundInX:left y:oldTop
					      width:tW height:(tH + 1)
		    ] ifFalse:[
			self drawThumbBackgroundInX:left y:oldTop 
					      width:tW height:delta
		    ]
		].
		self waitForExpose
	    ]
	]
    ]
!

thumbHeight
    "answer the thumbs height (in percent)"

    ^ thumbHeight
!

thumbHeight:newHeight
    "set the thumbs height (in percent)"

    |realNewHeight oldFrame|

    (newHeight > 100) ifTrue:[
	realNewHeight := 100
    ] ifFalse:[
	realNewHeight := newHeight
    ].
    ((realNewHeight ~= thumbHeight) or:[thumbFrame isNil]) ifTrue:[
	thumbHeight := realNewHeight.
	shown ifTrue:[
	    oldFrame := thumbFrame.
	    self computeThumbFrame.
	    (fixThumbHeight or:[oldFrame ~~ thumbFrame]) ifTrue:[
		oldFrame notNil ifTrue:[
		    self drawThumbBackgroundInX:(oldFrame left)
					      y:(oldFrame top) 
					  width:(oldFrame width) 
					 height:(oldFrame height).
		].
		self drawThumb
	    ]
	]
    ]
!

thumbOrigin:newOrigin thumbHeight:newHeight
    "set both thumbs height and origin (in percent)"

    |realNewOrigin realNewHeight old new changed|

    (newHeight > 100) ifTrue:[
	realNewHeight := 100
    ] ifFalse:[
	realNewHeight := newHeight
    ].
    ((newOrigin + realNewHeight) > 100) ifTrue:[
	realNewOrigin := 100 - realNewHeight
    ] ifFalse: [
	realNewOrigin := newOrigin
    ].
    (realNewOrigin < 0) ifTrue: [
	realNewOrigin := 0
    ].

    changed := (realNewHeight ~= thumbHeight) or:[realNewOrigin ~= thumbOrigin].
    (changed or:[thumbFrame isNil]) ifTrue:[
	old := self absFromPercent:thumbOrigin.
	new := self absFromPercent:realNewOrigin.
	changed := old ~~ new.
	changed ifFalse:[
	    old := self absFromPercent:thumbHeight.
	    new := self absFromPercent:realNewHeight.
	    changed := (old ~~ new)
	].
	(changed or:[thumbFrame isNil]) ifTrue:[
	    thumbOrigin := realNewOrigin.
	    thumbHeight := realNewHeight.
	    shown ifTrue:[
		thumbFrame notNil ifTrue:[
		    self drawThumbBackgroundInX:(thumbFrame left)
					      y:(thumbFrame top) 
					  width:(thumbFrame width) 
					 height:(thumbFrame height).
		].
		self computeThumbFrame.
		self drawThumb
	    ]
	]
    ]
!

setThumbFor:aView
    "get contents and size info from aView and adjust thumb"

    |percentSize percentOrigin contentsSize contentsPosition viewsSize|

    "
     get the content's size
    "
    aView isNil ifTrue:[
	contentsSize := 0
    ] ifFalse:[
	moveDirection == #y ifTrue:[
	    contentsSize := aView heightOfContents
	] ifFalse:[
	    contentsSize := aView widthOfContents
	]
    ].

    (contentsSize = 0) ifTrue:[
	percentSize := 100.
	percentOrigin := 100
    ] ifFalse:[
	(moveDirection == #y) ifTrue:[
	    viewsSize := aView innerHeight.
	    contentsPosition := aView yOriginOfContents.
	] ifFalse:[
	    viewsSize := aView innerWidth.
	    contentsPosition := aView xOriginOfContents
	].

	percentSize := viewsSize * 100.0 / contentsSize.
	percentOrigin := contentsPosition * 100.0 / contentsSize.
	percentOrigin + percentSize > 100.0 ifTrue:[
	    "actually showing stuff below contents of view"
"
	    contentsSize := contentsPosition + aView innerHeight.
	    percentSize := viewsSize * 100.0 / contentsSize.
	    percentOrigin := contentsPosition * 100.0 / contentsSize
"
	]
    ].
    (percentSize = thumbHeight) ifTrue:[
	self thumbOrigin:percentOrigin
    ] ifFalse:[
	(percentOrigin = thumbOrigin) ifTrue:[
	    self thumbHeight:percentSize
	] ifFalse:[
	    self thumbOrigin:percentOrigin thumbHeight:percentSize
	]
    ]
!

setThumbHeightFor:aView
    "get contents and size info from aView and adjust thumb height"

    |percent totalHeight viewsSize|

    totalHeight := (moveDirection == #y) ifTrue:[aView heightOfContents]
					 ifFalse:[aView widthOfContents].
    (totalHeight = 0) ifTrue:[
	percent := 100
    ] ifFalse:[
	viewsSize := (moveDirection == #y) ifTrue:[aView innerHeight]
					   ifFalse:[aView innerWidth].
	percent := viewsSize * 100.0 / totalHeight
    ].
    self thumbHeight:percent
!

setThumbOriginFor:aView
    "get contents and size info from aView and adjust thumb origin"

    |percent totalHeight contentsPosition|

    totalHeight := (moveDirection == #y) ifTrue:[aView heightOfContents]
					 ifFalse:[aView widthOfContents].
    (totalHeight = 0) ifTrue:[
	percent := 100
    ] ifFalse:[
	contentsPosition := (moveDirection == #y) ifTrue:[aView yOriginOfContents]
						  ifFalse:[aView xOriginOfContents].
	percent := contentsPosition * 100.0 / totalHeight
    ].
    self thumbOrigin:percent
!

thumbColor:aColor
    "change the color of the thumb"

    thumbColor := aColor on:device.
    (style ~~ #normal) ifTrue:[
	thumbShadowColor := aColor darkened on:device.
	thumbLightColor := aColor lightened on:device.
	thumbHalfShadowColor := thumbShadowColor darkened on:device.
	thumbHalfLightColor := thumbLightColor lightened on:device.
    ].
    shown ifTrue:[
	self redraw
    ]
!

thumbColor
    "return the thumbs color"

    ^ thumbColor
!

thumbFrame
    "return the area used by the thumbFrame (in device coordinates).
     Allows access to the thumbs physical screen position, for
     example to position a label below (see Slider-Examples)"

    thumbFrame isNil ifTrue:[ self computeThumbFrame].
    ^ thumbFrame
! !

!Scroller methodsFor:'private'!

absFromPercent:percent
    "given a percentage, compute number of pixels"

    |fullSize|

    (moveDirection == #y) ifTrue:[
	fullSize := height
    ] ifFalse:[
	fullSize := width
    ].
"/    ^ ((percent * (fullSize - (margin * 2))) / 100) rounded
"/ 20-apr-94
    ^ ((percent * (fullSize - thumbFrameSizeDifference- (margin * 2))) / 100) rounded
!

percentFromAbs:absValue
    "given a number of pixels, compute percentage"

    |fullSize val|

    (moveDirection == #y) ifTrue:[
	fullSize := height
    ] ifFalse:[
	fullSize := width
    ].

    val := absValue / (fullSize - thumbFrameSizeDifference - (margin * 2)) * 100.
    val < 0 ifTrue:[^ 0].
    val > 100 ifTrue:[^ 100].
    ^ val
!

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.
    (moveDirection == #y) 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
    ].

    (moveDirection == #y) 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
! !

!Scroller methodsFor:'drawing'!

drawHandleFormAtX:x y:y
    thumbShadowColor := thumbShadowColor on:device.
    thumbLightColor := thumbLightColor on:device.

    self paint:thumbShadowColor.
    self displayForm:shadowForm x:x y:y.
    self paint:thumbLightColor.
    self displayForm:lightForm x:x y:y.
!

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.
                
		self fillRectangle:frameBeforeMove with:ghostColor.
		(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].
    moveDirection == #y 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.
	moveDirection == #y ifTrue:[
	    self displayRectangleX:l y:t width:w"-1" height:h.
	] ifFalse:[
	    self displayRectangleX:l y:t width:w height:h"-1".
	]
    ].

    (tallyLevel == 0 or:[tallyMarks == 0]) ifTrue:[
	shadowForm notNil ifTrue:[
	    handleX := l + ((w - 8) // 2).
	    handleY := t + ((h - 8) // 2).
	    self drawHandleFormAtX:handleX y:handleY
	].
	^ self
    ].

    "iris style - draw tallys"

    tallyLevel > 0 ifTrue:[
	color1 := thumbLightColor.
	color2 := thumbShadowColor.
    ] ifFalse:[
	color1 := thumbShadowColor.
	color2 := thumbLightColor.
    ].

    "draw tally marks"

    (moveDirection == #y) ifTrue:[
	self paint:color1.
	y := t + (h // 2) - 1.
	xL := l + thumbLevel - 1.
	xR := l + w - thumbLevel "+ 1".
	self displayLineFromX:xL y:y toX:xR y:y.
	y := y + 1.
	self paint:color2.
	self displayLineFromX:xL y:y toX:xR y:y.

	tallyMarks > 1 ifTrue:[
	    "dont draw other marks if there is not enough space"

	    mm := device verticalPixelPerMillimeter rounded.
	    h > (mm * (tallyMarks * 2)) ifTrue:[
		y := y - 1 - mm.
		self paint:color1.
		self displayLineFromX:xL y:y toX:xR y:y.
		y := y + 1.
		self paint:color2.
		self displayLineFromX:xL y:y toX:xR y:y.

		y := y - 1 + mm + mm.
		self paint:color1.
		self displayLineFromX:xL y:y toX:xR y:y.
		y := y + 1.
		self paint:color2.
		self displayLineFromX:xL y:y toX:xR y:y
	    ]
	]
    ] ifFalse:[
	x := l + (w // 2) - 1.
	yT := t + thumbLevel - 1.
	yB := t + h - thumbLevel "+ 1".
	self paint:color1.
	self displayLineFromX:x y:yT toX:x y:yB.
	self paint:color2.
	x := x + 1.
	self displayLineFromX:x y:yT toX:x y:yB.

	tallyMarks > 1 ifTrue:[
	    "dont draw other marks if there is not enough space"

	    mm := device horizontalPixelPerMillimeter rounded.
	    w > (mm * (tallyMarks * 2)) ifTrue:[
		x := x - 1 - mm.
		self paint:color1.
		self displayLineFromX:x y:yT toX:x y:yB.
		x := x + 1.
		self paint:color2.
		self displayLineFromX:x y:yT toX:x y:yB.

		x := x - 1 + mm + mm.
		self paint:color1.
		self displayLineFromX:x y:yT toX:x y:yB.
		x := x + 1.
		self paint:color2.
		self displayLineFromX:x y:yT toX:x y:yB
	    ]
	]
    ]
! !

!Scroller methodsFor:'forced scroll'!

pageUp
    "page up/left"

    self thumbOrigin:(thumbOrigin - thumbHeight).
    scrollAction notNil ifTrue:[
	scrollAction value:thumbOrigin
    ]
!

pageDown
    "page down/right"

    self thumbOrigin:(thumbOrigin + thumbHeight).
    scrollAction notNil ifTrue:[
	scrollAction value:thumbOrigin
    ]
! !

!Scroller methodsFor:'events'!

redrawX:x y:y width:w height:h
    shown ifTrue:[
	thumbFrame isNil ifTrue:[self computeThumbFrame].
	self drawThumbBackgroundInX:x y:y width:w height:h.
	(y > thumbFrame bottom) ifTrue:[
	    ^ self
	].
	((y + h) < thumbFrame top) ifTrue:[
	    ^ self
	].
	self drawThumb
    ]
!

redraw
    "redraw"

    shown ifTrue:[
	thumbFrame isNil ifTrue:[self computeThumbFrame].
	self drawThumbBackgroundInX:0 y:0 width:width height:height.
	self drawThumb
    ]
!

sizeChanged:how
    "size of scroller changed - recompute thumbs frame and redraw it"

    shown ifTrue:[
	self computeThumbFrame.
	self redraw
    ]
!

buttonPress:button x:x y:y
    "button was pressed - if above thumb, page up; if below thumb, page down;
     otherwise start scrolling"

    |curr limit1 limit2|

    (moveDirection == #y) ifTrue:[
	curr := y.
	limit1 := thumbFrame top.
	limit2 := thumbFrame bottom
    ] ifFalse:[
	curr := x.
	limit1 := thumbFrame left.
	limit2 := thumbFrame right
    ].

    (curr < limit1) ifTrue:[
	"page up/left"
	self pageUp
    ] ifFalse:[
	(curr > limit2) ifTrue:[
	    "page down/right"
	    self pageDown
	] ifFalse:[
	    pressOffset := curr - limit1.
	    scrolling := true
	]
    ]
!

buttonMultiPress:button x:x y:y
    ^ self buttonPress:button x:x y:y
!

buttonShiftPress:button x:x y:y
    "mouse-click with shift - jump to position"

    |pos curr limit org|

    (moveDirection == #y) ifTrue:[
	curr := y.
	limit := height.
	org := thumbFrame top
    ] ifFalse:[
	curr := x.
	limit := width.
	org := thumbFrame left
    ].

    (curr < 0) ifTrue:[                        "check against limits"
	pos := 0
    ] ifFalse:[
	(curr > limit) ifTrue:[
	    pos := limit
	] ifFalse:[
	    pos := curr
	]
    ].

    self thumbOrigin:(self percentFromAbs:pos).
    "
     the ST/X way of notifying scrolls
    "
    scrollAction notNil ifTrue:[
	scrollAction value:thumbOrigin
    ].
    "
     the ST-80 way of notifying scrolls
    "
    (model notNil
    and:[changeSymbol notNil])
    ifTrue:[
	model perform:changeSymbol
    ].
    self changed:#scrollerPosition.

    pressOffset := curr - org.
    scrolling := true
!

buttonMotion:button x:x y:y
    "mouse-button was moved while pressed;
     redraw thumb at its new position and, if scroll-mode is asynchronous, 
     the scroll action is performed"

    |pos curr limit|

    scrolling ifFalse: [^ self].              "should not happen"

    frameBeforeMove isNil ifTrue:[
	ghostColor notNil ifTrue:[
	    frameBeforeMove := thumbFrame insetBy:1@1
	]
    ].

    (moveDirection == #y) ifTrue:[
	curr := y.
	limit := height
    ] ifFalse:[
	curr := x.
	limit := width
    ].

    (curr < 0) ifTrue:[                        "check against limits"
	pos := 0
    ] ifFalse:[
	(curr > limit) ifTrue:[
	    pos := limit
	] ifFalse:[
	    pos := curr
	]
    ].

    self thumbOrigin:(self percentFromAbs:(pos - pressOffset)).

    synchronousOperation ifTrue: [
	"
	 the ST/X way of notifying scrolls
	"
	scrollAction notNil ifTrue:[
	    scrollAction value:thumbOrigin
	].
	"
	 the ST-80 way of notifying scrolls
	"
	(model notNil
	and:[changeSymbol notNil])
	ifTrue:[
	    model perform:changeSymbol
	].
	self changed:#scrollerPosition.
    ]
!

buttonRelease:button x:x y:y
    "mouse-button was released - if scroll-mode is asynchronous, the scroll
     action is now performed"

    |rect|

    scrolling ifTrue:[
	frameBeforeMove notNil ifTrue:[
	    rect := frameBeforeMove.
	    frameBeforeMove := nil.
	    self drawThumbBackgroundInX:rect left
				      y:rect top
				  width:rect width 
				 height:rect height.
	    (rect intersects:thumbFrame) ifTrue:[
		self drawThumb
	    ]
	].

	scrolling := false.
	synchronousOperation ifFalse: [
	    "
	     the ST/X way of notifying scrolls
	    "
	    scrollAction notNil ifTrue:[
		scrollAction value:thumbOrigin
	    ].
	    "
	     the ST-80 way of notifying scrolls
	    "
	    (model notNil
	    and:[changeSymbol notNil])
	    ifTrue:[
		model perform:changeSymbol
	    ].
	    self changed:#scrollerPosition.
	]
    ]
! !