Scroller.st
changeset 205 6814c0bf8df8
parent 174 d80a6cc3f9b2
child 211 c96f57be68c6
--- a/Scroller.st	Thu Nov 23 18:48:50 1995 +0100
+++ b/Scroller.st	Thu Nov 23 19:19:24 1995 +0100
@@ -10,25 +10,23 @@
  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'
+                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
-		DefaultFixThumbHeight DefaultEdgeStyle DefaultFullViewBackground'
+                DefaultShadowColor DefaultLightColor DefaultThumbColor
+                DefaultThumbShadowColor DefaultThumbLightColor
+                DefaultThumbHalfShadowColor DefaultThumbHalfLightColor
+                DefaultHalfShadowColor DefaultHalfLightColor DefaultTallyMarks
+                DefaultTallyLevel DefaultLevel DefaultBorderWidth
+                DefaultThumbLevel DefaultInset DefaultThumbFrameColor
+                DefaultGhostColor DefaultGhostFrameColor DefaultGhostLevel
+                DefaultFixThumbHeight DefaultEdgeStyle DefaultFullViewBackground'
 	 poolDictionaries:''
 	 category:'Views-Interactors'
 !
@@ -49,10 +47,6 @@
 "
 !
 
-version
-    ^ '$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.29 1995-11-11 16:22:41 cg Exp $'
-!
-
 documentation
 "
     this class implements the scroller for scrollbars.
@@ -244,6 +238,60 @@
 
 !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
     DefaultViewBackground := StyleSheet colorAt:'scrollerViewBackground'.
     DefaultFullViewBackground := StyleSheet colorAt:'scrollerFullViewBackground'.
@@ -276,565 +324,249 @@
 	DefaultThumbFrameColor := Black.
 	DefaultInset := 1.
     ]
-!
+! !
 
-handleShadowFormOn:aDisplay
-    "answer the form used for the handles shadow area;
-     cache the one for Display for the next round"
-
-    |f|
+!Scroller methodsFor:'accessing'!
 
-    ((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
+action:aBlock
+    "for protocol compatibility; same as scrollAction:"
+
+    self scrollAction:aBlock
 !
 
-handleLightFormOn:aDisplay
-    "answer the form used for the handles light area;
-     cache the one for Display for the next round"
-
-    |f|
+asynchronousOperation
+    "set scroll-mode to be asynchronous - scroll action is performed after
+     scrolling, when mouse-button is finally released"
+     
+    synchronousOperation := false
+!
 
-    ((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
-! !
+is3D
+    styleSheet name = #mswindows ifTrue:[^ true].
+    ^ super is3D
+!
+
+orientation 
+    "return the scrollers orientation (#vertical or #horizontal)"
 
-!Scroller methodsFor:'private'!
-
-absFromPercent:percent
-    "given a percentage, compute number of pixels"
-
-    |fullSize|
+    ^ orientation
+!
 
-    (orientation == #vertical) ifTrue:[
-	fullSize := height
-    ] ifFalse:[
-	fullSize := width
-    ].
-"/    ^ ((percent * (fullSize - (margin * 2))) / 100) rounded
-"/ 20-apr-94
+scrollAction
+    "answer the scroll action block"
 
-    ^ ((percent * (fullSize - thumbFrameSizeDifference- (margin * 2))) / 100) rounded
+    ^ scrollAction
 !
 
-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."
+scrollAction:aBlock
+    "set the scroll action, aBlock which is evaluated when scrolled"
 
-    |newPos1 newPos2 newSize1 newSize2 nh nw ny nx 
-     computedSize minSz sz1 sz2|
+    scrollAction := aBlock
+!
 
-    "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
-    ].
+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"
+!
+
+setThumbFor:aView
+    "get contents and size info from aView and adjust thumb"
+
+    |percentSize percentOrigin contentsSize contentsPosition viewsSize|
 
     "
-     do we have to adjust the computed size ?
+     get the content's 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
+    aView isNil ifTrue:[
+	contentsSize := 0
     ] 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
+	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.
+	    ].
 	]
     ].
 
-    "
-     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]
-	    ]
-	  ]
+    (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
+"
 	]
     ].
-    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
+    (percentSize = thumbHeight) ifTrue:[
+	self thumbOrigin:percentOrigin
     ] 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.
-                
-		ghostColor notNil ifTrue:[
-		    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
-		]
-	    ]
+	(percentOrigin = thumbOrigin) ifTrue:[
+	    self thumbHeight:percentSize
+	] ifFalse:[
+	    self thumbOrigin:percentOrigin thumbHeight:percentSize
 	]
     ]
 !
 
-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|
+setThumbHeightFor:aView
+    "get contents and size info from aView and adjust thumb height"
 
-    (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
-    ].
+    |percent total viewsSize|
 
-    "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".
-	]
+    (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
+!
 
-    (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
-    ].
+setThumbOriginFor:aView
+    "get contents and size info from aView and adjust thumb origin"
 
-    "iris style - draw tallys"
-
-    tallyLevel > 0 ifTrue:[
-	color1 := thumbLightColor.
-	color2 := thumbShadowColor.
-    ] ifFalse:[
-	color1 := thumbShadowColor.
-	color2 := thumbLightColor.
-    ].
-
-    "draw tally marks"
+    |percent total contentsPosition|
 
     (orientation == #vertical) 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
-	    ]
-	]
+	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:[
-	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.
+	contentsPosition := (orientation == #vertical) ifTrue:[aView yOriginOfContents]
+						  ifFalse:[aView xOriginOfContents].
+	percent := contentsPosition * 100.0 / total
+    ].
+    self thumbOrigin:percent
+!
 
-	tallyMarks > 1 ifTrue:[
-	    "dont draw other marks if there is not enough space"
+start 
+    "return the scrollers range min"
+    ^ rangeStart
+!
 
-	    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.
+start:start
+    "set the scrollers range start"
+
+    rangeStart := start.
+!
 
-		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
-	    ]
-	]
-    ]
+start:start stop:stop
+    "set the scrollers range"
+
+    rangeStart := start.
+    rangeEnd := stop
+!
+
+step
+    "return the scrollers range step"
+    ^ rangeStep
 !
 
-drawHandleFormAtX:x y:y
-    thumbShadowColor := thumbShadowColor on:device.
-    thumbLightColor := thumbLightColor on:device.
+step:step
+    "set the scrollers range step"
+
+    rangeStep := step
+!
 
-    self paint:thumbShadowColor.
-    self displayForm:shadowForm x:x y:y.
-    self paint:thumbLightColor.
-    self displayForm:lightForm x:x y:y.
-! !
+stop
+    "return the scrollers range max"
+    ^ rangeEnd
+!
 
-!Scroller methodsFor:'event handling'!
+stop:stop
+    "set the scrollers range stop"
+
+    rangeEnd := stop
+!
 
-redrawX:x y:y width:w height:h
+synchronousOperation
+    "set scroll-mode to be synchronous - scroll action is performed for 
+     every movement of thumb"
+     
+    synchronousOperation := true
+!
+
+thumbColor
+    "return the thumbs color"
+
+    ^ thumbColor
+!
+
+thumbColor:aColor
+    "change the color of the thumb"
+
+    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:[
-	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
+	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|
-
-    shown ifFalse:[^ self].
-
-    (orientation == #vertical) ifTrue:[
-	curr := y.
-	limit1 := thumbFrame top.
-	limit2 := thumbFrame bottom
-    ] ifFalse:[
-	curr := x.
-	limit1 := thumbFrame left.
-	limit2 := thumbFrame right
-    ].
+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)"
 
-    (curr < limit1) ifTrue:[
-	"page up/left"
-	self pageUp
-    ] ifFalse:[
-	(curr > limit2) ifTrue:[
-	    "page down/right"
-	    self pageDown
-	] ifFalse:[
-	    pressOffset := curr - limit1.
-	    scrolling := true
-	]
-    ]
-!
-
-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: [
-	    self tellOthers.
-	]
-    ]
+    thumbFrame isNil ifTrue:[ self computeThumbFrame].
+    ^ thumbFrame
 !
 
-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|
-
-    scrolling ifFalse: [^ self].              "should not happen"
-
-    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.
-	]
-    ]
-!
-
-sizeChanged:how
-    "size of scroller changed - recompute thumbs frame and redraw it"
-
-    shown ifTrue:[
-	self computeThumbFrame.
-	self sensor notNil ifTrue:[
-	    self redraw.
-	    self sensor flushExposeEventsFor:self 
-	]
-    ]
-!
-
-update:something with:aParameter from:changedObject
-    "handle update from a model (if any)"
+thumbHeight
+    "answer the thumbs height (in percent by default)"
 
-    (changedObject == model 
-    "and:[something == aspectMsg]") ifTrue:[
-	self thumbOrigin:(model value).
-	^ self
-    ].
-    super update:something with:aParameter from:changedObject
-!
-
-redraw
-    "redraw"
-
-    self redrawX:0 y:0 width:width height:height.
-    self redrawEdges
-!
-
-buttonMultiPress:button x:x y:y
-    ^ self buttonPress:button x:x y:y
+    ^ thumbHeight * (rangeEnd - rangeStart) / 100
 !
 
-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
-! !
-
-!Scroller methodsFor:'accessing'!
-
 thumbHeight:aNumber 
     "set the thumbs height (in percent by default)"
 
@@ -883,6 +615,12 @@
     ]
 !
 
+thumbOrigin
+    "answer the thumbs origin (in percent by default)"
+
+    ^ thumbOrigin * (rangeEnd - rangeStart) / 100 + rangeStart
+!
+
 thumbOrigin:aNumber 
     "set the thumbs origin (in percent by default)"
 
@@ -1093,265 +831,418 @@
 	    ]
 	]
     ]
-!
+! !
 
-is3D
-    styleSheet name = #mswindows ifTrue:[^ true].
-    ^ super is3D
-!
-
-setThumbOriginFor:aView
-    "get contents and size info from aView and adjust thumb origin"
-
-    |percent total contentsPosition|
+!Scroller methodsFor:'drawing'!
 
-    (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
+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.
 !
 
-thumbOrigin
-    "answer the thumbs origin (in percent by default)"
-
-    ^ thumbOrigin * (rangeEnd - rangeStart) / 100 + rangeStart
-!
+drawThumb
+    "draw the thumb"
 
-scrollAction:aBlock
-    "set the scroll action, aBlock which is evaluated when scrolled"
+    |handleX handleY l t 
+     w "{ Class: SmallInteger }"
+     h "{ Class: SmallInteger }"
+     x "{ Class: SmallInteger }"
+     y "{ Class: SmallInteger }"
+     mm xL xR yT yB color1 color2|
 
-    scrollAction := aBlock
-!
-
-setThumbFor:aView
-    "get contents and size info from aView and adjust thumb"
-
-    |percentSize percentOrigin contentsSize contentsPosition viewsSize|
+    (thumbHeight >= 100) ifTrue:[^ self].
+    orientation == #vertical ifTrue:[
+	thumbFrame height >= height ifTrue:[^ self].
+    ] ifFalse:[
+	thumbFrame width >= width ifTrue:[^ self].
+    ].
 
-    "
-     get the content's size
-    "
-    aView isNil ifTrue:[
-	contentsSize := 0
-    ] ifFalse:[
+    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:[
-	    contentsSize := aView heightOfContents.
-	    aView transformation notNil ifTrue:[
-		contentsSize := aView transformation applyScaleY:contentsSize.
-	    ].
+	    self displayRectangleX:l y:t width:w"-1" height:h.
 	] ifFalse:[
-	    contentsSize := aView widthOfContents.
-	    aView transformation notNil ifTrue:[
-		contentsSize := aView transformation applyScaleX:contentsSize.
-	    ].
+	    self displayRectangleX:l y:t width:w height:h"-1".
 	]
     ].
 
-    (contentsSize = 0) ifTrue:[
-	percentSize := 100.
-	percentOrigin := 100
+    (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:[
-	(orientation == #vertical) ifTrue:[
-	    viewsSize := aView innerHeight.
-	    contentsPosition := aView yOriginOfContents.
-	] ifFalse:[
-	    viewsSize := aView innerWidth.
-	    contentsPosition := aView xOriginOfContents
-	].
+	color1 := thumbShadowColor.
+	color2 := thumbLightColor.
+    ].
+
+    "draw tally marks"
+
+    (orientation == #vertical) 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"
 
-	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
-"
+	    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
+	    ]
 	]
-    ].
-    (percentSize = thumbHeight) ifTrue:[
-	self thumbOrigin:percentOrigin
     ] ifFalse:[
-	(percentOrigin = thumbOrigin) ifTrue:[
-	    self thumbHeight:percentSize
-	] ifFalse:[
-	    self thumbOrigin:percentOrigin thumbHeight:percentSize
+	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
+	    ]
 	]
     ]
 !
 
-setThumbHeightFor:aView
-    "get contents and size info from aView and adjust thumb height"
+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|
 
-    |percent total viewsSize|
+		gX := frameBeforeMove left.
+		gY := frameBeforeMove top.
+		gW := frameBeforeMove width.
+		gH := frameBeforeMove height.
+                
+		ghostColor notNil ifTrue:[
+		    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
+		]
+	    ]
+	]
+    ]
+! !
+
+!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|
+
+    scrolling ifFalse: [^ self].              "should not happen"
+
+    frameBeforeMove isNil ifTrue:[
+	(ghostColor notNil 
+	or:[ghostFrameColor notNil
+	or:[ghostLevel ~~ 0]]) ifTrue:[
+	    frameBeforeMove := thumbFrame insetBy:1@1
+	]
+    ].
 
     (orientation == #vertical) ifTrue:[
-	total := aView heightOfContents.
-	aView transformation notNil ifTrue:[
-	    total := aView transformation applyScaleY:total.
-	].
+	curr := y.
+	limit := height
     ] ifFalse:[
-	total := aView widthOfContents.
-	aView transformation notNil ifTrue:[
-	    total := aView transformation applyScaleX:total.
-	].
+	curr := x.
+	limit := width
     ].
-    (total = 0) ifTrue:[
-	percent := 100
+
+    (curr < 0) ifTrue:[                        "check against limits"
+	pos := 0
     ] ifFalse:[
-	viewsSize := (orientation == #vertical) ifTrue:[aView innerHeight]
-					   ifFalse:[aView innerWidth].
-	percent := viewsSize * 100.0 / total
+	(curr > limit) ifTrue:[
+	    pos := limit
+	] ifFalse:[
+	    pos := curr
+	]
     ].
-    self thumbHeight:percent
-!
 
-action:aBlock
-    "for protocol compatibility; same as scrollAction:"
-
-    self scrollAction:aBlock
-!
+    prevOrigin := self thumbOrigin.
+    newOrigin := self percentFromAbs:(pos - pressOffset).
+    prevOrigin ~= newOrigin ifTrue:[
+	self thumbOrigin:newOrigin.
 
-asynchronousOperation
-    "set scroll-mode to be asynchronous - scroll action is performed after
-     scrolling, when mouse-button is finally released"
-     
-    synchronousOperation := false
+	synchronousOperation ifTrue: [
+	    self tellOthers.
+	]
+    ]
 !
 
-synchronousOperation
-    "set scroll-mode to be synchronous - scroll action is performed for 
-     every movement of thumb"
-     
-    synchronousOperation := true
-!
-
-scrollAction
-    "answer the scroll action block"
-
-    ^ scrollAction
-!
-
-scrollDownAction:aBlock
-    "ignored -
-     but implemented, so that scroller can be used in place of a scrollbar"
+buttonMultiPress:button x:x y:y
+    ^ self buttonPress:button x:x y:y
 !
 
-scrollUpAction:aBlock
-    "ignored -
-     but implemented, so that scroller can be used in place of a scrollbar"
-!
+buttonPress:button x:x y:y
+    "button was pressed - if above thumb, page up; if below thumb, page down;
+     otherwise start scrolling"
 
-thumbHeight
-    "answer the thumbs height (in percent by default)"
+    |curr limit1 limit2|
 
-    ^ thumbHeight * (rangeEnd - rangeStart) / 100
-!
+    shown ifFalse:[^ self].
 
-thumbColor:aColor
-    "change the color of the thumb"
+    (orientation == #vertical) ifTrue:[
+	curr := y.
+	limit1 := thumbFrame top.
+	limit2 := thumbFrame bottom
+    ] ifFalse:[
+	curr := x.
+	limit1 := thumbFrame left.
+	limit2 := thumbFrame right
+    ].
 
-    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 redraw
+    (curr < limit1) ifTrue:[
+	"page up/left"
+	self pageUp
+    ] ifFalse:[
+	(curr > limit2) ifTrue:[
+	    "page down/right"
+	    self pageDown
+	] ifFalse:[
+	    pressOffset := curr - limit1.
+	    scrolling := true
+	]
     ]
 !
 
-thumbColor
-    "return the thumbs color"
+buttonRelease:button x:x y:y
+    "mouse-button was released - if scroll-mode is asynchronous, the scroll
+     action is now performed"
 
-    ^ thumbColor
-!
+    |rect|
 
-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)"
+    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
+	    ]
+	].
 
-    thumbFrame isNil ifTrue:[ self computeThumbFrame].
-    ^ thumbFrame
+	scrolling := false.
+	synchronousOperation ifFalse: [
+	    self tellOthers.
+	]
+    ]
 !
 
-start:start stop:stop
-    "set the scrollers range"
+buttonShiftPress:button x:x y:y
+    "mouse-click with shift - jump to position"
+
+    |pos curr curr2 limit1 limit2|
 
-    rangeStart := start.
-    rangeEnd := stop
-!
+    (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
+    ].
 
-start:start
-    "set the scrollers range start"
+    (curr2 < 0) ifTrue:[                        "check against limits"
+	pos := 0
+    ] ifFalse:[
+	(curr2 > limit1) ifTrue:[
+	    pos := limit1
+	] ifFalse:[
+	    pos := curr2
+	]
+    ].
 
-    rangeStart := start.
-!
+    frameBeforeMove := thumbFrame insetBy:1@1.
+
+    self thumbOrigin:(self percentFromAbs:pos).
+    self tellOthers.
 
-stop:stop
-    "set the scrollers range stop"
-
-    rangeEnd := stop
+    (orientation == #vertical) ifTrue:[
+	limit2 := thumbFrame top
+    ] ifFalse:[
+	limit2 := thumbFrame left
+    ].
+    pressOffset := curr - limit2.
+    scrolling := true
 !
 
-step:step
-    "set the scrollers range step"
+redraw
+    "redraw"
 
-    rangeStep := step
+    self redrawX:0 y:0 width:width height:height.
+    self redrawEdges
 !
 
-start 
-    "return the scrollers range min"
-    ^ rangeStart
+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
+    ]
 !
 
-stop
-    "return the scrollers range max"
-    ^ rangeEnd
+sizeChanged:how
+    "size of scroller changed - recompute thumbs frame and redraw it"
+
+    shown ifTrue:[
+	self computeThumbFrame.
+	self sensor notNil ifTrue:[
+	    self redraw.
+	    self sensor flushExposeEventsFor:self 
+	]
+    ]
 !
 
-step
-    "return the scrollers range step"
-    ^ rangeStep
+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
 !
 
-orientation 
-    "return the scrollers orientation (#vertical or #horizontal)"
+pageUp
+    "page up/left"
 
-    ^ orientation
+    self thumbOrigin:(thumbOrigin - thumbHeight).
+    self tellOthers
 ! !
 
-!Scroller methodsFor:'queries'!
+!Scroller methodsFor:'forwarding changed origin'!
+
+tellOthers
+    |org|
 
-preferredExtent
-    |w h|
-
-    h := self class defaultExtent y.
-    w := (device horizontalPixelPerMillimeter asFloat * 6) rounded.
-    ^ w @ h.
+    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'!
 
+computeInitialExtent
+    self extent:self preferredExtent
+!
+
 initCursor
     "set the cursor - a hand"
 
@@ -1475,10 +1366,6 @@
     ]
 !
 
-computeInitialExtent
-    self extent:self preferredExtent
-!
-
 initialize
     "initialize - setup instvars from defaults"
 
@@ -1508,37 +1395,150 @@
     ].
 ! !
 
-!Scroller methodsFor:'forwarding changed origin'!
+!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
+!
 
-tellOthers
-    |org|
+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|
 
-    org := self thumbOrigin.
+    "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
+    ].
+
     "
-     the ST/X way of notifying scrolls
+     do we have to adjust the computed size ?
     "
-    scrollAction notNil ifTrue:[
-	scrollAction value:org 
+    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
     "
-     the ST-80 way of notifying scrolls
+    (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
     "
-    self sendChangeMessageWith:org.
-    self changed:#scrollerPosition.
+    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:'forced scroll'!
+!Scroller methodsFor:'queries'!
 
-pageDown
-    "page down/right"
+preferredExtent
+    |w h|
 
-    self thumbOrigin:(thumbOrigin + thumbHeight).
-    self tellOthers
-!
+    h := self class defaultExtent y.
+    w := (device horizontalPixelPerMillimeter asFloat * 6) rounded.
+    ^ w @ h.
+! !
 
-pageUp
-    "page up/left"
+!Scroller class methodsFor:'documentation'!
 
-    self thumbOrigin:(thumbOrigin - thumbHeight).
-    self tellOthers
+version
+    ^ '$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.30 1995-11-23 18:18:10 cg Exp $'
 ! !