Scroller.st
author Claus Gittinger <cg@exept.de>
Mon, 15 Jul 1996 12:09:19 +0200
changeset 786 8b301af1cdcc
parent 767 c96a1130b833
child 797 2f9cd56f48ee
permissions -rw-r--r--
remember and do not recompute the preferredExtent;

"
 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
		orientation thumbFrame thumbLevel scrolling pressOffset
		synchronousOperation shadowForm lightForm inset thumbShadowColor
		thumbLightColor thumbEdgeStyle thumbHalfShadowColor
		thumbHalfLightColor thumbEnteredColor thumbFrameSizeDifference
		tallyLevel tallyMarks fixThumbHeight frameBeforeMove ghostColor
		ghostFrameColor ghostLevel rangeStart rangeEnd rangeStep entered
		thumbActiveLevel'
	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 DefaultFullViewBackground
		DefaultThumbEnteredColor DefaultThumbActiveLevel'
	poolDictionaries:''
	category:'Views-Interactors'
!

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

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

    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.

  range:
    the value passed to the model or via the action blocks is scaled according
    to the min/maxRange instance variables.
    These default to 0..100 for percentage values.
    It does not make sense to change the range for scrollbar-scrollers,
    but may be useful with Sliders or in special applications.

  style stuff:

    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.

  [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).

    [author:]
	Claus Gittinger

    [see also:]
	ScrollBar
	ScrollableView HVScrollableView
"
!

examples
"
    basic scroller setup:
									[exBegin]
	|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'.     
	top open
									[exEnd]

    setting its thumb-height:
									[exBegin]
	|top s|

	top := StandardSystemView new extent:200@200.
	s := Scroller in:top.
	s origin:(0.0@0.0) corner:(20@1.0).
	s thumbHeight:50.  'percent'.     
	top open
									[exEnd]

    setting its thumb-origin:
									[exBegin]
	|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 thumbOrigin:30.  'percent'.     
	top open
									[exEnd]

    a scroller with action block (ST/X style):
									[exBegin]
	|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
									[exEnd]

    setting its range:
									[exBegin]
	|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].
	s start:0 stop:1.
	top open
									[exEnd]

    create a scroller in its default extent and have it positioned
    at the side; beside another view:
									[exBegin]
	|top s v|

	top := StandardSystemView new extent:200@200.
	s := Scroller in:top.
	s origin:(0.0@0.0) corner:(0.0@1.0).
	s rightInset:(s preferredExtent x negated).
	s thumbHeight:10.
	s level:1.

	v := View in:top.
	v origin:0.0@0.0 corner:1.0@1.0.
	v leftInset:(s preferredExtent x).
	v viewBackground:Color red.
	v level:2.

	top open
									[exEnd]

    using a model (ST-80 style):
									[exBegin]
	|top s m|

	m := 0 asValue.
	InspectorView openOn:m monitor:'value'.  '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
									[exEnd]

    using a different changeSelector:
									[exBegin]
	|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
									[exEnd]
"
! !

!Scroller  class methodsFor:'defaults'!

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
!

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
!

updateStyleCache
    "extract values from the styleSheet and cache them in class variables"

    <resource: #style (#scrollerViewBackground #scrollerFullViewBackground
		       #scrollerThumbColor 
		       #scrollerShadowColor #scrollerLightColor
		       #scrollerThumbShadowColor #scrollerThumbLightColor
		       #scrollerThumbHalfShadowColor #scrollerThumbHalfLightColor
		       #scrollerThumbFrameColor #scrollerGhostColor
		       #scrollerGhostLevel #scrollerGhostFrameColor
		       #scrollerNTallyMarks #scrollerTallyLevel
		       #scrollerLevel #scrollerBorderWidth
		       #scrollerThumbLevel #scrollerThumbInset
		       #scrollerThumbFixHeight #scrollerThumbEdgeStyle
		       #scrollerThumbEnteredColor #scrollerThumbActiveLevel )>

    DefaultViewBackground := StyleSheet colorAt:'scrollerViewBackground'.
    DefaultFullViewBackground := StyleSheet colorAt:'scrollerFullViewBackground'.
    DefaultThumbColor := StyleSheet colorAt:'scrollerThumbColor'.
    DefaultThumbEnteredColor := StyleSheet colorAt:'scrollerThumbEnteredColor'.
    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.
    DefaultThumbActiveLevel := StyleSheet at:'scrollerThumbActiveLevel' default:DefaultThumbLevel.
    DefaultInset := StyleSheet at:'scrollerThumbInset' default:0.
    DefaultFixThumbHeight := StyleSheet at:'scrollerThumbFixHeight' default:false.
    DefaultEdgeStyle := StyleSheet at:'scrollerThumbEdgeStyle'.

    StyleSheet fileReadFailed ifTrue:[
	DefaultViewBackground := Grey.
	DefaultThumbColor := White.
	DefaultThumbFrameColor := Black.
	DefaultInset := 1.
    ]

    "Modified: 20.3.1996 / 16:26:44 / cg"
! !

!Scroller methodsFor:'accessing'!

start 
    "return the scrollers range min.
     (not used with Scrollers, but provided for subclasses)"

    ^ rangeStart
!

start:start
    "set the scrollers range min.
     (not used with Scrollers, but provided for subclasses)"

    self start:start stop:rangeEnd.

    "Modified: 25.5.1996 / 11:28:22 / cg"
!

start:start stop:stop
    "set the range.
     (not used with Scrollers, but provided for subclasses)"

    |org|

    org := self thumbOrigin.

    rangeStart := start.
    rangeEnd := stop.

    org < rangeStart ifTrue:[
        org := rangeStart
    ] ifFalse:[
        org > rangeEnd ifTrue:[
            org := rangeEnd
        ]
    ].
    self thumbOrigin:org.

    "Modified: 25.5.1996 / 11:34:56 / cg"
!

start:start stop:stop step:step
    "set the range.
     (not used with Scrollers, but provided for subclasses)"

    self start:start stop:stop.
    rangeStep := step.

    "Created: 25.5.1996 / 11:24:09 / cg"
    "Modified: 25.5.1996 / 11:27:43 / cg"
!

step
    "return the scrollers range step.
     (not used with Scrollers, but provided for subclasses)"

    ^ rangeStep
!

step:step
    "set the scrollers range step.
     (not used with Scrollers, but provided for subclasses)"

    rangeStep := step
!

stop
    "return the scrollers range max.
     (not used with Scrollers, but provided for subclasses)"

    ^ rangeEnd
!

stop:stop
    "set the scrollers range max.
     (not used with Scrollers, but provided for subclasses)"

    self start:rangeStart stop:stop.

    "Modified: 25.5.1996 / 11:28:35 / cg"
!

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
!

thumbHeight
    "answer the thumbs height (in percent by default)"

    ^ thumbHeight * (rangeEnd - rangeStart) / 100
!

thumbHeight:aNumber 
    "set the thumbs height (in percent by default)"

    |newHeight realNewHeight oldFrame nBg|

    newHeight := aNumber / (rangeEnd - rangeStart / 100).

    (newHeight > 100) ifTrue:[
	realNewHeight := 100
    ] ifFalse:[
	realNewHeight := newHeight
    ].
    ((realNewHeight ~= thumbHeight) or:[thumbFrame isNil]) ifTrue:[
	thumbHeight := realNewHeight.

	(DefaultFullViewBackground notNil
	and:[DefaultViewBackground notNil
	and:[DefaultFullViewBackground ~~ DefaultViewBackground]]) ifTrue:[
	    realNewHeight >= 100 ifTrue:[
		nBg := DefaultFullViewBackground.
	    ] ifFalse:[
		nBg := DefaultViewBackground
	    ].
	    nBg := nBg on:device.
	    nBg ~~ viewBackground ifTrue:[
		self viewBackground:nBg.
		shown ifTrue:[self clear].
	    ]
	].

	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
	    ]
	] ifFalse:[
	    thumbFrame := nil
	]
    ]
!

thumbOrigin
    "answer the thumbs origin (in percent by default)"

    ^ thumbOrigin * (rangeEnd - rangeStart) / 100 + rangeStart
!

thumbOrigin:aNumber 
    "set the thumbs origin (in percent by default)"

    |newOrigin realNewOrigin 
     oldFrame oldTop oldBot oldLeft oldRight
     thumbTop thumbBot thumbLeft thumbRight
     tH "{ Class: SmallInteger }"
     tW 
     delta needFullDraw 
     bgLeft bgTop bgWidth bgHeight|

    newOrigin := (aNumber - rangeStart) asFloat / (rangeEnd - rangeStart / 100).

    ((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:[
		"/ full: don't draw
		^ self
	    ].

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

		oldTop := oldFrame top.
		oldBot := oldTop + tH.
		oldLeft := oldFrame left.
		oldRight := oldLeft + tW.

		thumbTop := thumbFrame top.
		thumbBot := thumbTop + tH.
		thumbLeft := thumbFrame left.
		thumbRight := thumbLeft + tW.

		needFullDraw := self exposeEventPending
				or:[((orientation == #vertical) and:[oldBot >= height])
				or:[((orientation ~~ #vertical) and:[oldRight >= width])]].

		needFullDraw ifTrue:[
		    "
		     cannot copy since thumb was below the end
		     or may be not available for the copy
		    "
		    (orientation == #vertical) ifTrue:[
			self drawThumbBackgroundInX:thumbLeft y:oldTop
					      width:tW height:(height - oldTop).
		    ] ifFalse:[
			self drawThumbBackgroundInX:oldLeft y:thumbTop
					      width:(width - oldLeft) height:tH.
		    ].
		    self drawThumb.
		    ^ self
		].

		self catchExpose.
		"
		 copy the thumbs pixels
		"
		(orientation == #vertical) ifTrue:[
		    self copyFrom:self x:thumbLeft y:oldTop
				     toX:thumbLeft y:thumbTop
				   width:tW height:tH.
		] ifFalse:[
		    self copyFrom:self x:oldLeft y:thumbTop
				     toX:thumbLeft y:thumbTop
				   width:tW height:tH.
		].

		"
		 clear some of the previous thumbs area to background
		"
		(orientation == #vertical) ifTrue:[
		    bgLeft := thumbLeft.
		    bgWidth := tW.
		    oldTop > thumbTop ifTrue:[
			delta := oldTop - thumbTop.
			oldTop > thumbBot ifTrue:[
			    bgTop := oldTop.
			    bgHeight := tH + 1
			] ifFalse:[
			    bgTop := thumbBot.
			    bgHeight := delta
			]
		    ] ifFalse:[
			delta := thumbTop - oldTop.
			oldBot < thumbTop ifTrue:[
			    bgTop := oldTop.
			    bgHeight := tH + 1
			] ifFalse:[
			    bgTop := oldTop.
			    bgHeight := delta
			]
		    ].
		] ifFalse:[
		    bgTop := thumbTop.
		    bgHeight := tH.
		    oldLeft > thumbLeft ifTrue:[
			delta := oldLeft - thumbLeft.
			oldLeft > thumbRight ifTrue:[
			    bgLeft := oldLeft.
			    bgWidth := tW + 1.
			] ifFalse:[
			    bgLeft := thumbRight.
			    bgWidth := delta.
			]
		    ] ifFalse:[
			delta := thumbLeft - oldLeft.
			oldRight < thumbLeft ifTrue:[
			    bgLeft := oldLeft.
			    bgWidth := tW + 1.
			] ifFalse:[
			    bgLeft := oldLeft.
			    bgWidth := delta.
			]
		    ].
		].
		self drawThumbBackgroundInX:bgLeft y:bgTop width:bgWidth height:bgHeight.
		self waitForExpose
	    ]
	] ifFalse:[
	    thumbFrame := nil
	]
    ]
!

thumbOrigin:originNumber thumbHeight:heightNumber
    "set both thumbs height and origin (in percent by default)"

    |newHeight newOrigin realNewOrigin realNewHeight old new changed nBg|

    newOrigin := originNumber - rangeStart / (rangeEnd - rangeStart / 100).
    newHeight := heightNumber / (rangeEnd - rangeStart / 100).

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

	    (DefaultFullViewBackground notNil
	    and:[DefaultViewBackground notNil
	    and:[DefaultFullViewBackground ~~ DefaultViewBackground]]) ifTrue:[
		realNewHeight >= 100 ifTrue:[
		    nBg := DefaultFullViewBackground.
		] ifFalse:[
		    nBg := DefaultViewBackground
		].
		nBg := nBg on:device.
		nBg ~~ viewBackground ifTrue:[
		    self viewBackground:nBg.
		    shown ifTrue:[self clear].
		]
	    ].

	    shown ifTrue:[
		thumbFrame notNil ifTrue:[
		    self drawThumbBackgroundInX:(thumbFrame left)
					      y:(thumbFrame top) 
					  width:(thumbFrame width) 
					 height:(thumbFrame height).
		].
		self computeThumbFrame.
		self drawThumb
	    ] ifFalse:[
		thumbFrame := nil
	    ]
	]
    ]
! !

!Scroller methodsFor:'accessing-behavior'!

action:aBlock
    "for protocol compatibility; same as scrollAction:"

    self scrollAction:aBlock
!

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

scrollAction
    "answer the scroll action block"

    ^ scrollAction
!

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

    scrollAction := aBlock
!

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

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

!Scroller methodsFor:'accessing-look'!

is3D
    <resource: #style (#name)>

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

    "Modified: 12.6.1996 / 15:00:10 / cg"
!

orientation 
    "return the scrollers orientation (#vertical or #horizontal)"

    ^ orientation
!

thumb
    "for compatibility with scrollBars, return the receiver"

    ^ self

    "Created: 26.5.1996 / 12:21:12 / cg"
!

thumbColor
    "return the thumbs color"

    ^ thumbColor
!

thumbColor:aColor
    "change the color of the thumb"

    <resource: #style (#name)>

    thumbColor := aColor on:device.
    (styleSheet name ~~ #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 invalidate
    ]

    "Modified: 12.6.1996 / 15:00:15 / cg"
! !

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

drawThumb
    "draw the thumb"

    |handleX handleY l t lvl
     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:(entered ifTrue:[thumbEnteredColor] ifFalse:[thumbColor]).
    self fillRectangleX:l y:t width:w-1 height:h.

    lvl := thumbLevel.
    scrolling ifTrue:[
	lvl := thumbActiveLevel
    ].

    lvl == 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:lvl
		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".
	]
    ].

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

    (orientation == #vertical) ifTrue:[
	self paint:color1.
	y := t + (h // 2) - 1.
	xL := l + lvl - 1.
	xR := l + w - lvl "+ 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 + lvl - 1.
	yB := t + h - lvl "+ 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
	    ]
	]
    ]

    "Modified: 20.3.1996 / 10:55:29 / cg"
!

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

    |oldClip gX gY gW gH|

    shown ifTrue:[
        self clearRectangleX:x y:y width:w height:h.
        frameBeforeMove notNil ifTrue:[
            oldClip := self clippingRectangleOrNil.
            self clippingRectangle:(Rectangle left:x top:y width:w height:h).

            gX := frameBeforeMove left.
            gY := frameBeforeMove top.
            gW := frameBeforeMove width.
            gH := frameBeforeMove height.
            
            ghostColor notNil ifTrue:[
                self paint:ghostColor.
                self fillRectangle:frameBeforeMove.
            ].
            (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
            ].
            self clippingRectangle:oldClip
        ]
    ]

    "Modified: 28.5.1996 / 19:53:40 / cg"
! !

!Scroller methodsFor:'event handling'!

buttonMotion:state 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 prevOrigin newOrigin in|

    scrolling ifFalse: [
	self highlightThumbForPointerX:x y:y.
	^ self              
    ].              

    entered := true.
    frameBeforeMove isNil ifTrue:[
	(ghostColor notNil 
	or:[ghostFrameColor notNil
	or:[ghostLevel ~~ 0]]) ifTrue:[
	    frameBeforeMove := thumbFrame insetBy:1@1
	]
    ].

    (orientation == #vertical) 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
	]
    ].

    prevOrigin := self thumbOrigin.
    newOrigin := self percentFromAbs:(pos - pressOffset).
    prevOrigin ~= newOrigin ifTrue:[
	self thumbOrigin:newOrigin.

	synchronousOperation ifTrue: [
	    self tellOthers.
	]
    ]

    "Modified: 6.3.1996 / 17:35:26 / cg"
!

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

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|

    shown ifFalse:[^ self].

    (orientation == #vertical) 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
	]
    ].
    self highlightThumbForPointerX:x y:y

    "Modified: 6.3.1996 / 17:34:01 / cg"
!

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

    |rect mustDrawThumb|

    scrolling ifTrue:[
	thumbFrame notNil ifTrue:[
	    mustDrawThumb := false.
	    scrolling := false.

	    frameBeforeMove notNil ifTrue:[
		rect := frameBeforeMove.
		frameBeforeMove := nil.
		self drawThumbBackgroundInX:rect left
					  y:rect top
				      width:rect width 
				     height:rect height.

		(rect intersects:thumbFrame) ifTrue:[
		    mustDrawThumb := true.
		]
	    ].
	    thumbLevel ~~ thumbActiveLevel ifTrue:[
		mustDrawThumb := true
	    ].
	    mustDrawThumb ifTrue:[
		self drawThumb
	    ].    

"/            scrolling := false.
	    synchronousOperation ifFalse: [
		self tellOthers.
	    ]
	]
    ]

    "Modified: 20.3.1996 / 10:58:25 / cg"
!

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

    |pos curr curr2 limit1 limit2|

    (orientation == #vertical) ifTrue:[
	curr := y.
	curr2 := y - (thumbFrame height // 2).
	limit1 := height.
	limit2 := thumbFrame top
    ] ifFalse:[
	curr := x.
	curr2 := x - (thumbFrame width // 2).
	limit1 := width.
	limit2 := thumbFrame left
    ].

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

    frameBeforeMove := thumbFrame insetBy:1@1.

    self thumbOrigin:(self percentFromAbs:pos).
    self tellOthers.

    (orientation == #vertical) ifTrue:[
	limit2 := thumbFrame top
    ] ifFalse:[
	limit2 := thumbFrame left
    ].
    pressOffset := curr - limit2.
    scrolling := true
!

highlightThumbForPointerX:x y:y
    "if x/y is within the thumb frame, highlight it"

    |in|

    in := self thumbFrame containsPoint:(x@y).
    (in ~~ entered 
    or:[thumbLevel ~~ thumbActiveLevel]) ifTrue:[
	entered := in.
	(thumbColor ~~ thumbEnteredColor 
	or:[thumbLevel ~~ thumbActiveLevel]) ifTrue: [
	    self drawThumb
	].
    ].

    "Created: 6.3.1996 / 17:35:07 / cg"
    "Modified: 20.3.1996 / 10:59:59 / cg"
!

pointerLeave:state
    "mouse-button left view
     redraw thumb if enteredColor ~~ thumbColor"

    (entered and:[(state bitAnd:(device anyButtonMotionMask)) == 0]) ifTrue: [
        entered := false.
        self drawThumb
    ].

    "Created: 6.3.1996 / 17:31:16 / cg"
    "Modified: 10.6.1996 / 14:01:33 / cg"
!

redraw
    "redraw"

    self redrawX:0 y:0 width:width height:height.
    self redrawEdges
!

redrawX:x y:y width:w height:h
    shown ifTrue:[
        thumbFrame isNil ifTrue:[self computeThumbFrame].
        self drawThumbBackgroundInX:x y:y width:w height:h.

        orientation == #vertical ifTrue:[
            (y > thumbFrame bottom) ifTrue:[
                ^ self
            ].
            ((y + h) < thumbFrame top) ifTrue:[
                ^ self
            ].
        ] ifFalse:[
            (x > thumbFrame right) ifTrue:[
                ^ self
            ].
            ((x + w) < thumbFrame left) ifTrue:[
                ^ self
            ].
        ].

        self drawThumb
    ]

    "Modified: 15.6.1996 / 10:24:55 / cg"
!

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

    |sensor|

    shown ifTrue:[
        self computeThumbFrame.
        (sensor := self sensor) notNil ifTrue:[
            sensor flushExposeEventsFor:self.
            self invalidate.
        ]
    ]

    "Modified: 29.5.1996 / 16:21:36 / cg"
!

update:something with:aParameter from:changedObject
    "handle update from a model (if any)"

    (changedObject == model 
    "and:[something == aspectMsg]") ifTrue:[
	self thumbOrigin:(model value).
	^ self
    ].
    super update:something with:aParameter from:changedObject
! !

!Scroller methodsFor:'forced scroll'!

pageDown
    "page down/right"

    self thumbOrigin:(thumbOrigin + thumbHeight).
    self tellOthers
!

pageUp
    "page up/left"

    self thumbOrigin:(thumbOrigin - thumbHeight).
    self tellOthers
!

scrollToBeginning
    "scroll to the beginning"

    self thumbOrigin:rangeStart.
    self tellOthers

    "Created: 6.3.1996 / 17:55:13 / cg"
!

scrollToEnd
    "scroll to the end"

    self thumbOrigin:rangeEnd.
    self tellOthers

    "Created: 6.3.1996 / 17:55:25 / cg"
! !

!Scroller methodsFor:'forwarding changed origin'!

tellOthers
    |org|

    org := self thumbOrigin.
    "
     the ST/X way of notifying scrolls
    "
    scrollAction notNil ifTrue:[
	scrollAction value:org 
    ].
    "
     the ST-80 way of notifying scrolls
    "
    self sendChangeMessageWith:org.
    self changed:#scrollerPosition.
! !

!Scroller methodsFor:'initialization'!

defaultExtent
    "compute my extent from sub-components"

    ^ self preferredExtent

    "Modified: 22.4.1996 / 23:37:53 / cg"
!

initCursor
    "set the cursor - a hand"

    cursor := Cursor hand
!

initStyle
    "initialize style dep. stuff"

    <resource: #style (#name)>

    |nm|

    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.
    thumbActiveLevel := DefaultThumbActiveLevel.
    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
        ].
    ].

    nm := styleSheet name.

    device hasGrayscales ifFalse:[
        thumbEdgeStyle notNil ifTrue:[
            thumbHalfShadowColor := Color darkGray.
            thumbHalfLightColor := White
        ].

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

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

    DefaultThumbColor notNil ifTrue:[
        thumbColor := DefaultThumbColor on:device
    ] ifFalse:[
        thumbColor := White.
        nm ~= #normal ifTrue:[
            device hasGrayscales 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
        ]
    ].

    DefaultThumbEnteredColor notNil ifTrue:[
        thumbEnteredColor := DefaultThumbEnteredColor on:device.
        self enableMotionEvents.
        self enableEnterLeaveEvents.
    ] ifFalse:[
        thumbEnteredColor := thumbColor.
    ].

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

    drawableId notNil ifTrue:[
        self computeThumbFrame
    ]

    "Modified: 12.6.1996 / 14:59:54 / cg"
!

initialize
    "initialize - setup instvars from defaults"

    super initialize.

    orientation isNil ifTrue:[orientation := #vertical].

    scrolling := false.
    entered := false.
    synchronousOperation := true.

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

    rangeStart := 0.
    rangeEnd := 100.
    rangeStep := nil.   "/ meaning: arbitrary precision
"/    inset := 1.

"/    self computeThumbFrame

    "Modified: 6.3.1996 / 17:25:59 / cg"
!

realize
    super realize.
    model notNil ifTrue:[
	self thumbOrigin:(model value).
    ].
! !

!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 t|

    (orientation == #vertical) ifTrue:[
	fullSize := height
    ] ifFalse:[
	fullSize := width
    ].

    t := fullSize - thumbFrameSizeDifference - (margin * 2).
    t = 0 ifTrue:[
	"/ in rare cases, this happens ...
	val := 0
    ] ifFalse:[
	val := absValue / t * (rangeEnd - rangeStart).
    ].
    val := val + rangeStart.

    val < rangeStart ifTrue:[^ rangeStart].
    val > rangeEnd ifTrue:[^ rangeEnd].
    ^ val

! !

!Scroller methodsFor:'private scrollbar & scrollview interface'!

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:[
	orientation == #vertical ifTrue:[
	    contentsSize := aView heightOfContents.
	    aView transformation notNil ifTrue:[
		contentsSize := aView transformation applyScaleY:contentsSize.
	    ].
	] ifFalse:[
	    contentsSize := aView widthOfContents.
	    aView transformation notNil ifTrue:[
		contentsSize := aView transformation applyScaleX:contentsSize.
	    ].
	]
    ].

    (contentsSize = 0) ifTrue:[
	percentSize := 100.
	percentOrigin := 100
    ] ifFalse:[
	(orientation == #vertical) 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 total viewsSize|

    (orientation == #vertical) ifTrue:[
	total := aView heightOfContents.
	aView transformation notNil ifTrue:[
	    total := aView transformation applyScaleY:total.
	].
    ] ifFalse:[
	total := aView widthOfContents.
	aView transformation notNil ifTrue:[
	    total := aView transformation applyScaleX:total.
	].
    ].
    (total = 0) ifTrue:[
	percent := 100
    ] ifFalse:[
	viewsSize := (orientation == #vertical) ifTrue:[aView innerHeight]
					   ifFalse:[aView innerWidth].
	percent := viewsSize * 100.0 / total
    ].
    self thumbHeight:percent
!

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

    |percent total contentsPosition|

    (orientation == #vertical) ifTrue:[
	total := aView heightOfContents.
	aView transformation notNil ifTrue:[
	    total := aView transformation applyScaleY:total.
	].
    ] ifFalse:[
	total := aView widthOfContents.
	aView transformation notNil ifTrue:[
	    total := aView transformation applyScaleX:total.
	].
    ].
    (total = 0) ifTrue:[
	percent := 100
    ] ifFalse:[
	contentsPosition := (orientation == #vertical) ifTrue:[aView yOriginOfContents]
						  ifFalse:[aView xOriginOfContents].
	percent := contentsPosition * 100.0 / total
    ].
    self thumbOrigin:percent
! !

!Scroller methodsFor:'queries'!

preferredExtent
    "return my preferredExtent"

    |defExt w h|

    preferredExtent notNil ifTrue:[
        ^ preferredExtent
    ].

    defExt := self class defaultExtent.

    orientation == #vertical ifTrue:[
        h := defExt y.
        w := (device horizontalPixelPerMillimeter asFloat * 6) rounded.
    ] ifFalse:[
        w := defExt x.
        h := (device verticalPixelPerMillimeter asFloat * 6) rounded.
    ].

    preferredExtent := w @ h.
    ^ preferredExtent.

    "Modified: 15.7.1996 / 09:56:07 / cg"
! !

!Scroller  class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.63 1996-07-15 10:08:11 cg Exp $'
! !