diff -r 7cc1e330da47 -r f4eaf04d1eaf Scroller.st --- 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 origin of thumb (in percent) thumbHeight height of thumb (in percent) @@ -96,7 +105,7 @@ inset number of pixels to inset thumb from view borders thumbShadowColor color do draw dark parts of thumb thumblightColor color to draw light parts of thumb - thumbSoftEdge true if edges of thumb are to appear smooth + thumbEdgeStyle #soft or nil thumbHalfShadowColor used to draw smooth edges thumbHalfLightColor used to draw smooth edges thumbFrameSizeDifference number of pixels the thumb is larger than @@ -107,9 +116,35 @@ tallyMarks number of tally marks fixThumbHeight perform 'wrong' height computation a la mswindows + + style settings: + + scrollerLevel the level of the scroller w.r.t. its enclosing view + scrollerBorderWidth the borderWidth (ignored for 3D styles) + + scrollerViewBackground the viewBackground (color or image) + scrollerShadowColor the color of 3D shadowed edges (ignored in 2D styles) + scrollerLightColor the color of 3D lighted edges (ignored in 2D styles) + + scrollerThumbColor the thumbs color (color or image) + scrollerThumbShadowColor the color of the thumbs shadowed edges (ignored in 2D styles) + scrollerThumbLightColor the color of the thumbs shadowed edges (ignored in 2D styles) + scrollerThumbEdgeStyle the edge style for the thumb (#soft or nil) + scrollerThumbLevel the 3D height of the thumb + scrollerThumbHalfShadowColor the halfShadow for soft edged thumbs + scrollerThumbHalfLightColor the halfLight for soft edged thumbs + scrollerThumbFrameColor if non-nil, a rectangle is drawn around the thumb is this color + scrollerThumbInset inset of thumb from the scrollers boundary + scrollerThumbFixHeight if true, use a fix thumb height (as in mswindows) + scrollerGhostColor the color in which a ghost-rectangle is drawn + scrollerGhostFrameColor if non-nil, a rectangle is drawn around the ghost is this color + scrollerGhostLevel the 3D level of the ghost rectangle + scrollerNTallyMarks number of tally-marks to draw on the thumb + scrollerTallyLevel. 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. ] ] ! !