--- a/Scroller.st Thu Nov 17 15:34:12 1994 +0100
+++ b/Scroller.st Thu Nov 17 15:38:53 1994 +0100
@@ -18,17 +18,23 @@
synchronousOperation
shadowForm lightForm inset
thumbShadowColor thumbLightColor
- thumbSoftEdge
+ thumbEdgeStyle
thumbHalfShadowColor thumbHalfLightColor
thumbFrameSizeDifference
tallyLevel tallyMarks
- fixThumbHeight'
+ fixThumbHeight frameBeforeMove
+ ghostColor ghostFrameColor ghostLevel'
classVariableNames: 'HandleShadowForm HandleLightForm
DefaultViewBackground
- DefaultThumbColor DefaultTallyMarks DefaultTallyLevel
+ DefaultShadowColor DefaultLightColor DefaultThumbColor
+ DefaultThumbShadowColor DefaultThumbLightColor
+ DefaultThumbHalfShadowColor DefaultThumbHalfLightColor
+ DefaultHalfShadowColor DefaultHalfLightColor
+ DefaultTallyMarks DefaultTallyLevel
DefaultLevel DefaultBorderWidth DefaultThumbLevel
- DefaultInset DefaultThumbFrameColor
- DefaultFixThumbHeight DefaultSoftEdge'
+ DefaultInset DefaultThumbFrameColor
+ DefaultGhostColor DefaultGhostFrameColor DefaultGhostLevel
+ DefaultFixThumbHeight DefaultEdgeStyle'
poolDictionaries:''
category:'Views-Interactors'
!
@@ -37,7 +43,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.9 1994-10-28 03:25:23 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.10 1994-11-17 14:38:34 claus Exp $
'!
!Scroller class methodsFor:'documentation'!
@@ -58,7 +64,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.9 1994-10-28 03:25:23 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.10 1994-11-17 14:38:34 claus Exp $
"
!
@@ -66,17 +72,20 @@
"
this class implements the scroller for scrollbars.
it can also be used by itself for scrollbars without step-buttons.
- When moved, a predefined action is performed.
+ 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 makes sense, if the scroll
- operation (redraw) is expensive.
+ By default, scrollers are synchronous. Asynchronous operation makes sense,
+ if the scroll operation (redraw) is expensive and takes a long time.
- Instance variables:
+ Instance variables:
thumbOrigin <Number> origin of thumb (in percent)
thumbHeight <Number> height of thumb (in percent)
@@ -96,7 +105,7 @@
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
- thumbSoftEdge <Boolean> true if edges of thumb are to appear smooth
+ 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
@@ -107,9 +116,35 @@
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 fixThumbHeight to false (in initStyle).
+ if you dont like that (I do not :-), set scrollerThumbFixHeight to false (in the StyleSheet).
"
! !
@@ -118,7 +153,16 @@
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:[
@@ -129,7 +173,7 @@
DefaultThumbLevel := StyleSheet at:'scrollerThumbLevel' default:0.
DefaultInset := StyleSheet at:'scrollerThumbInset' default:0.
DefaultFixThumbHeight := StyleSheet at:'scrollerThumbFixHeight' default:false.
- DefaultSoftEdge := StyleSheet at:'scrollerThumbSoftEdge' default:false.
+ DefaultEdgeStyle := StyleSheet at:'scrollerThumbEdgeStyle'.
!
handleShadowFormOn:aDisplay
@@ -219,6 +263,12 @@
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.
@@ -231,25 +281,51 @@
thumbLevel := DefaultThumbLevel.
inset := DefaultInset.
fixThumbHeight := DefaultFixThumbHeight.
- thumbSoftEdge := DefaultSoftEdge.
+ thumbEdgeStyle := DefaultEdgeStyle.
+
+ DefaultGhostColor notNil ifTrue:[
+ ghostColor := DefaultGhostColor on:device.
+ ].
+ DefaultGhostFrameColor notNil ifTrue:[
+ ghostFrameColor := DefaultGhostFrameColor on:device.
+ ].
+ ghostLevel := DefaultGhostLevel.
- thumbShadowColor := shadowColor.
- thumbLightColor := lightColor.
- thumbSoftEdge ifTrue:[
- device hasGreyscales ifTrue:[
- thumbHalfShadowColor := halfShadowColor.
- thumbHalfLightColor := halfLightColor
- ] ifFalse:[
+ 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
- ]
- ].
- device hasGreyscales ifFalse:[
+ ].
+
thumbShadowColor := Black.
"/ thumbLightColor := White.
+
StyleSheet name = #motif ifTrue:[
DefaultThumbColor isNil ifTrue:[
- thumbColor := White "Color grey".
+ thumbColor := White .
].
]
].
@@ -265,8 +341,23 @@
].
].
- DefaultThumbFrameColor notNil ifTrue:[
- thumbFrameColor := DefaultThumbFrameColor on:device.
+ 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:[
@@ -396,8 +487,6 @@
toX:left y:thumbTop
width:tW height:tH.
-"/ self catchExpose.
-
oldTop > thumbTop ifTrue:[
delta := oldTop - thumbTop.
oldTop > thumbBot ifTrue:[
@@ -757,9 +846,31 @@
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)."
+ 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|
- self clearRectangleX:x y:y width:w height:h.
+ 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
@@ -770,7 +881,7 @@
h "{ Class: SmallInteger }"
x "{ Class: SmallInteger }"
y "{ Class: SmallInteger }"
- mm xL xR yT yB color1 color2 savEdge|
+ mm xL xR yT yB color1 color2|
(thumbHeight >= 100) ifTrue:[^ self].
moveDirection == #y ifTrue:[
@@ -795,12 +906,10 @@
].
"what a kludge - must be a parameter to drawEdge..."
- savEdge := softEdge.
- softEdge := thumbSoftEdge.
self drawEdgesForX:l y:t width:w height:h level:thumbLevel
shadow:thumbShadowColor light:thumbLightColor
- halfShadow:thumbHalfShadowColor halfLight:thumbHalfLightColor.
- softEdge := savEdge.
+ halfShadow:thumbHalfShadowColor halfLight:thumbHalfLightColor
+ style:thumbEdgeStyle.
thumbFrameColor notNil ifTrue:[
self paint:thumbFrameColor.
@@ -987,7 +1096,7 @@
buttonShiftPress:button x:x y:y
"mouse-click with shift - jump to position"
- |pos newThumbOrigin curr limit org|
+ |pos curr limit org|
(moveDirection == #y) ifTrue:[
curr := y.
@@ -1009,11 +1118,23 @@
]
].
- newThumbOrigin := self percentFromAbs:pos.
- self thumbOrigin:newThumbOrigin.
+ 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
!
@@ -1023,9 +1144,15 @@
redraw thumb at its new position and, if scroll-mode is asynchronous,
the scroll action is performed"
- |pos newThumbOrigin curr limit|
+ |pos curr limit|
+
+ scrolling ifFalse: [^ self]. "should not happen"
- scrolling ifFalse: [ ^ self ]. "should not happen"
+ frameBeforeMove isNil ifTrue:[
+ ghostColor notNil ifTrue:[
+ frameBeforeMove := thumbFrame insetBy:1@1
+ ]
+ ].
(moveDirection == #y) ifTrue:[
curr := y.
@@ -1045,13 +1172,24 @@
]
].
- newThumbOrigin := self percentFromAbs:(pos - pressOffset).
+ self thumbOrigin:(self percentFromAbs:(pos - pressOffset)).
- self thumbOrigin:newThumbOrigin.
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.
]
!
@@ -1059,12 +1197,38 @@
"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.
]
]
! !