"

 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.

"

SimpleView subclass:#ScrollBar

	instanceVariableNames:'thumb button1 button2 buttonLayout elementSpacing'

	classVariableNames:'DefaultButtonPositions DefaultLevel DefaultElementSpacing

		DefaultScrollerBordered'

	poolDictionaries:''

	category:'Views-Interactors'

!

!ScrollBar 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 vertical scrollbars with scroller and

    2 step-scroll buttons. when moved or stepped, it performs a

    predefined action.

    The action is specified by:                 the block to be evaluated for step-up

	aScrollBar scrollUpAction:aBlock 

	(scrollLeftAction for hor-Scrollbars)

	aScrollBar scrollDownAction:aBlock      the block to be evaluated for step-down

	(scrollRightAction for hor-Scrollbars)

	aScrollbar scrollAction:aBlock          the block to be evaluated for scroll

						passing percentage as argument.

    Scrollbars can scroll syncronous (i.e. every movement is notified immediately via the

    scrollAction) or asynchronous (i.e. only one notification takes place at the end of the movement).

    The choice is up to the user of the scrollbar (typically, views which are complicated to redraw,

    will set it to asynchronous.)

    Most often scrollbars are used hidden with ScrollableView or HVScrollableView (i.e. you

    dont have to care for all the details).

    The scrollBars and scrollers protocols have been made similar enough to

    allow transparent use of either a scroller or a scrollBar in applications.

"

! !

!ScrollBar class methodsFor:'style changes'!

updateStyleCache

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

    <resource: #style (#scrollBarButtonPositions #scrollBarLevel

		       #scrollBarScrollerBordered #scrollBarElementSpacing)>

    DefaultButtonPositions := StyleSheet at:'scrollBarButtonPositions' default:#bottom.

    DefaultLevel := StyleSheet at:'scrollBarLevel'.

    DefaultScrollerBordered := StyleSheet at:'scrollBarScrollerBordered' default:false.

    DefaultElementSpacing := StyleSheet at:'scrollBarElementSpacing' 

					default:(StyleSheet is3D ifTrue:[1] ifFalse:[0]).

    "Modified: 1.3.1996 / 13:46:29 / cg"

! !

!ScrollBar methodsFor:'accessing'!

thumbHeight

    "return height of thumb in percent"

    ^ thumb thumbHeight

!

thumbHeight:newHeight

    "set height of thumb in percent"

    thumb thumbHeight:newHeight.

    self enableDisableButtons

!

thumbOrigin

    "return position of (top of) thumb in percent"

    ^ thumb thumbOrigin

!

thumbOrigin:newOrigin

    "set position of (top of) thumb in percent"

    thumb thumbOrigin:newOrigin.

    self enableDisableButtons

!

thumbOrigin:newOrigin thumbHeight:newHeight

    "set origin and height of thumb (both in percent)"

    thumb thumbOrigin:newOrigin thumbHeight:newHeight.

    self enableDisableButtons

! !

!ScrollBar methodsFor:'accessing-behavior'!

asynchronousOperation

    "set asynchronous-mode - scroll action is performed after movement

     of scroller (i.e. when mouse-button is finally released).

     This is forwarded to the scroller here."

    thumb asynchronousOperation

!

scrollAction:aBlock

    "set the action, aBlock to be performed when the scroller is moved.

     This is forwarded to the scroller here."

    thumb scrollAction:aBlock

!

scrollDownAction:aBlock

    "set the action, aBlock to be performed when the down-button is pressed."

    button2 action:aBlock

!

scrollUpAction:aBlock

    "set the action, aBlock to be performed when the up-button is pressed."

    button1 action:aBlock

!

synchronousOperation

    "set synchronous-mode - scroll action is performed for every movement

     of scroller.

     This is forwarded to the scroller here."

    thumb synchronousOperation

! !

!ScrollBar methodsFor:'accessing-components'!

downButton

    "return the down-button

     (Please: only use this direct access for special applications)"

    ^ button2

    "

     |v|

     v := ScrollableView for:EditTextView.

     v scrolledView contents:('/etc/passwd' asFilename contentsOfEntireFile).

     v scrollBar upButton activeForegroundColor:Color red.

     v scrollBar downButton activeForegroundColor:Color red.

     v open

    "

!

thumb 

    "return the thumb (i.e. the scroller subview)

     (Please: only use this direct access for special applications)"

    ^ thumb

    "

     |v|

     v := ScrollableView for:EditTextView.

     v scrolledView contents:('/etc/passwd' asFilename contentsOfEntireFile).

     v scrollBar thumb thumbColor:(Color red).

     v open

    "

    "Modified: 1.3.1996 / 19:15:50 / cg"

!

upButton

    "return the up-button

     (Please: only use this direct access for special applications)"

    ^ button1

    "

     |v|

     v := ScrollableView for:EditTextView.

     v scrolledView contents:('/etc/passwd' asFilename contentsOfEntireFile).

     v scrollBar upButton foregroundColor:(Color red).

     v scrollBar upButton enteredForegroundColor:(Color red lightened).

     v scrollBar downButton foregroundColor:(Color green).

     v scrollBar downButton enteredForegroundColor:(Color green lightened).

     v open

    "

! !

!ScrollBar methodsFor:'accessing-look'!

thumbColor:aColor

    "set the thumbs color"

    thumb thumbColor:aColor

!

upButtonLabel:label1 downButtonLabel:label2

    "set the labels shown in the buttons.

     Because of the fixed button sizes, this only makes sense with 

     single-character strings or small bitmaps."

    button1 label:label1.

    button2 label:label2.

    self setElementPositions.

    "not bad:

     |v|

     v := ScrollableView for:EditTextView.

     v scrolledView contents:('/etc/passwd' asFilename contentsOfEntireFile).

     v scrollBar upButtonLabel:'+' downButtonLabel:'-'.

     v open

    "

    "also possible :

     |v|

     v := ScrollableView for:EditTextView.

     v scrolledView contents:('/etc/passwd' asFilename contentsOfEntireFile).

     v scrollBar upButtonLabel:'u' downButtonLabel:'d'.

     v open

    "

    "BAD example:

     |v|

     v := ScrollableView for:EditTextView.

     v scrolledView contents:('/etc/passwd' asFilename contentsOfEntireFile).

     v scrollBar upButtonLabel:'up' downButtonLabel:'down'.

     v open

    "

    "Modified: 1.3.1996 / 19:06:50 / cg"

! !

!ScrollBar methodsFor:'change & update'!

update:something with:aParameter from:changedObject

    changedObject == thumb ifTrue:[

	self enableDisableButtons

    ]

! !

!ScrollBar methodsFor:'events'!

keyPress:key x:x y:y

    (key == #BeginOfText) ifTrue:[

        self scrollToBeginning.

        ^ self

    ].

    (key == #EndOfText) ifTrue:[

        self scrollToEnd.

        ^ self

    ].

    super keyPress:key x:x y:y

    "Created: 6.3.1996 / 17:58:02 / cg"

    "Modified: 6.3.1996 / 17:59:05 / cg"

!

sizeChanged:how

    "when my size changes, I have to resize/reposition the subviews.

     Also, if I became too small, hide thumb/buttons."

    |upHeight downHeight thumbHeight upAndDownHeight bwn sep2

     thumbWidth w style b1Hidden b2Hidden thumbHidden bY|

    button1 isNil ifTrue:[^ self].

    thumb isNil ifTrue:[^ self].

    button2 isNil ifTrue:[^ self].

    style := styleSheet name.

    upHeight := button1 height + borderWidth.

    downHeight := button2 height + borderWidth.

    upAndDownHeight := upHeight + downHeight.

    bwn := borderWidth negated + margin.

    thumbHeight := height - upAndDownHeight - borderWidth - (elementSpacing * 3).

"

    ((buttonLayout ~~ #top) and:[buttonLayout ~~ #bottom]) ifTrue:[

	thumbHeight := thumbHeight - borderWidth

    ].

"

    buttonLayout == #around ifTrue:[

	thumbHeight := thumbHeight + borderWidth

    ].

    "if I become too small, hide buttons and thumb"

    height < upAndDownHeight ifTrue:[

	b1Hidden := b2Hidden := thumbHidden := true.

    ] ifFalse:[

	b1Hidden := b2Hidden := thumbHidden := false.

    ].

    (thumbHeight < 10) ifTrue:[

	thumbHidden := true.

    ] ifFalse:[

	thumbHidden := false.

    ].

    button1 hiddenOnRealize:b1Hidden.

    b1Hidden ifTrue:[

	button1 unrealize

    ] ifFalse:[

	shown ifTrue:[button1 realize]

    ].

    button2 hiddenOnRealize:b1Hidden.

    b2Hidden ifTrue:[

	button2 unrealize

    ] ifFalse:[

	shown ifTrue:[button2 realize]

    ].

    thumb hiddenOnRealize:thumbHidden.

    thumbHidden ifTrue:[

	thumb unrealize

    ] ifFalse:[

	shown ifTrue:[thumb realize]

    ].

    "width of buttons is always my width"

    w := width - (margin * 2).

    (w ~~ button1 width) ifTrue:[

	button1 width:w.

	button2 width:w

    ].

    thumbWidth := w.

    style == #next ifTrue:[

	thumbWidth := thumbWidth - (thumb borderWidth * 2).

	thumbHeight := thumbHeight - 1

    ].

    style == #motif ifTrue:[

	thumbHeight := thumbHeight - margin

    ].

    "

     a kludge: views with width or height of 0 are illegal

     avoid error from view-creation (it will be hidden anyway)

    "

    thumbHeight <= 0 ifTrue:[

	thumbHeight := 1

    ].

    (buttonLayout == #top) ifTrue:[

	"buttons at top"

	thumb extent:(thumbWidth @ thumbHeight).

	^ self

    ].

    sep2 := elementSpacing * 2.

    (buttonLayout == #bottom) ifTrue:[

	"buttons at bottom"

"/

"/ XX: I thought, that viewGravity shuld fix things automatically

"/ XX: it seems not to do it (or I misused it ;-)

"/ XX: anyway, viewGravity is an X special feature which is probably

"/ XX: not available with other windowing systems. Therefore,

"/ XX: the viewGravity depending code below is disabled.

"/ XX: resize is somewhat slower, though.

	thumbHeight := thumbHeight + borderWidth.

"/ XX        thumbHidden ifTrue:[

"/ XX           bY := elementSpacing

"/ XX       ] ifFalse:[

	    bY := thumbHeight + sep2.

"/ XX       ].

"XX"            button1 viewGravity:#North. 

"XX"            button2 viewGravity:#North. 

	(how == #smaller) ifTrue:[

	    thumb extent:(thumbWidth @ thumbHeight).

"XX"            button1 origin:(bwn @ (thumbHeight + sep2)).

"XX"            button2 origin:(bwn @ (thumbHeight + sep2 + upHeight))

	] ifFalse:[

	    button1 origin:(bwn @ bY).

	    button2 origin:(bwn @ (bY + upHeight)).

	    thumb extent:(thumbWidth @ thumbHeight)

	].

	^ self

    ].

    "buttons around thumb"

    style == #motif ifTrue:[

	sep2 := sep2 + 1

    ].

    button1 origin:(bwn @ bwn).

    style == #os2 ifTrue:[

	button2 origin:(bwn @ (upHeight + thumbHeight + sep2 - margin "+ borderWidth")).

	thumb extent:(thumbWidth @ (thumbHeight - margin - margin "+ margin - (margin // 2)")).

	thumb origin:(bwn @ (upHeight - borderWidth + elementSpacing + margin))

    ] ifFalse:[

	button2 origin:(bwn @ (upHeight + thumbHeight + sep2 - (margin // 2) "+ borderWidth")).

	thumb extent:(thumbWidth @ (thumbHeight + margin - (margin // 2))).

	thumb origin:(bwn @ (upHeight - borderWidth + elementSpacing))

    ].

! !

!ScrollBar methodsFor:'forced scroll'!

pageDown

    "page down/right"

    thumb pageDown

!

pageUp

    "page up/left"

    thumb pageUp

!

scrollToBeginning

    "to top"

    thumb scrollToBeginning

    "Modified: 6.3.1996 / 17:54:45 / cg"

!

scrollToEnd

    "to end"

    thumb scrollToEnd

    "Created: 6.3.1996 / 17:54:28 / cg"

    "Modified: 6.3.1996 / 17:54:49 / cg"

! !

!ScrollBar methodsFor:'initialization'!

createElements

    button1 := ArrowButton upIn:self.

    button2 := ArrowButton downIn:self.

    thumb := Scroller in:self.

!

defaultExtent

    "compute my extent from sub-components"

    ^ self preferredExtent

    "Created: 1.3.1996 / 19:22:11 / cg"

!

initStyle

    super initStyle.

    buttonLayout := DefaultButtonPositions.

    DefaultLevel notNil ifTrue:[

	self level:DefaultLevel

    ].

    elementSpacing := DefaultElementSpacing

!

initialize

    "setup; create the 2 buttons and a scroller"

    |clr style|

    super initialize.

    self createElements.

    (styleSheet at:'scrollBarDisableButtons' default:false) ifTrue:[

	thumb addDependent:self

    ].