"
 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:#ScrollBar
       instanceVariableNames:'thumb button1 button2 layout elementSpacing'
       classVariableNames:'DefaultButtonPositions DefaultLevel 
			   DefaultElementSpacing DefaultScrollerBordered'
       poolDictionaries:''
       category:'Views-Interactors'
!

ScrollBar comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.10 1995-02-06 00:53:13 claus Exp $
'!

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

version
"
$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.10 1995-02-06 00:53:13 claus Exp $
"
!

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

!ScrollBar class methodsFor:'style changes'!

updateStyleCache
    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]).
! !

!ScrollBar methodsFor:'initialization'!

initialize
    "setup; create the 2 buttons and a scroller"

    |clr|

    super initialize.

    self createElements.

    button1 autoRepeat.
    button2 autoRepeat.

    self computeInitialExtent.

    button1 borderWidth:borderWidth.
    DefaultScrollerBordered ifFalse:[
	thumb borderWidth:borderWidth.
    ].
    button2 borderWidth:borderWidth.

    ((StyleSheet name = #iris) and:[Display hasGreyscales]) ifTrue:[
	"have to change some of Buttons defaults"
	clr := (Color grey:25) on:device.
	button1 offLevel:2.
	button2 offLevel:2.
	button1 foregroundColor:clr.
	button1 activeForegroundColor:clr.
	button1 enteredForegroundColor:clr.
	button2 foregroundColor:clr.
	button2 activeForegroundColor:clr.
	button2 enteredForegroundColor:clr.
    ].

    self setElementPositions.

    StyleSheet name = #motif ifTrue:[
	clr := thumb thumbColor.
	button1 foregroundColor:clr.
	button2 foregroundColor:clr.

	clr := thumb viewBackground.
	button1 viewBackground:clr.
	button2 viewBackground:clr.
	button1 backgroundColor:clr.
	button2 backgroundColor:clr.
	button1 activeBackgroundColor:clr.
	button2 activeBackgroundColor:clr.
	device hasGreyscales ifFalse:[
	    button1 activeForegroundColor:Black.
	    button2 activeForegroundColor:Black.
	]
    ]
!

initStyle
    super initStyle.

    layout := DefaultButtonPositions.
    DefaultLevel notNil ifTrue:[
	self level:DefaultLevel
    ].
    elementSpacing := DefaultElementSpacing
!

reinitialize
    super reinitialize.
    self setElementPositions.
!

createElements
    button1 := ArrowButton upIn:self.
    button2 := ArrowButton downIn:self.
    thumb := Scroller in:self.
!

setElementPositions
    "position sub-components"

    |bwn|

    bwn := borderWidth negated + margin.

    (layout == #top) ifTrue:[
	button1 origin:(bwn @ bwn).
	button1 viewGravity:#North.
	button2 origin:(bwn @ (button1 height)).
	button2 viewGravity:#North.
	thumb origin:(bwn @ (button1 height 
			     + borderWidth 
			     + button2 height 
			     + elementSpacing 
			     + elementSpacing)).
	thumb viewGravity:#North.
	^ self
    ].
    (layout == #bottom) ifTrue:[
	device supportsViewGravity ifTrue:[
	    button1 viewGravity:#South. 
	    button2 viewGravity:#South. 
	    thumb viewGravity:#North.
	].
	thumb origin:(bwn @ bwn).
	^ self
    ].

    "layout == #around"
    button1 origin:(bwn @ bwn).
    button1 viewGravity:#North.
"/    button2 viewGravity:#North.
    thumb origin:(bwn @ (button1 height + elementSpacing)).
    thumb viewGravity:#North
!

computeInitialExtent
    "compute my extent from sub-components"

    |w h upForm downForm
     upHeight   "{ Class: SmallInteger }"
     downHeight "{ Class: SmallInteger }"
     upWidth downWidth|

    "need fix - this is a kludge;
     the if should not be needed ..."
    StyleSheet name == #mswindows ifTrue:[
	w := button1 width max:button2 width.
	h := button1 height + button2 height + (Scroller defaultExtent y).
    ] ifFalse:[
	upForm  := ArrowButton upArrowButtonForm:style on:device.
	downForm := ArrowButton downArrowButtonForm:style on:device.
	upForm isNil ifTrue:[
	    upHeight := upWidth := 16.
	] ifFalse:[
	    upHeight := upForm height.
	    upWidth := upForm width
	].
	downForm isNil ifTrue:[
	    downHeight := downWidth := 16
	] ifFalse:[
	    downHeight := downForm height.
	    downWidth := downForm width
	].
	h := upHeight + downHeight + (1 * 2) + (Scroller defaultExtent y).
	w := upWidth max:downWidth.
	StyleSheet name ~~ #normal ifTrue:[
	    h := h + 4.
	    w := w + 4
	].
    ].

    self extent:w @ h.
! !

!ScrollBar methodsFor:'accessing'!

scrollAction:aBlock
    "set the action, aBlock to be performed when the scroller is moved"
 
    thumb scrollAction:aBlock
!

scrollUpAction:aBlock
    "set the action, aBlock to be performed when the up-button is pressed"
 
    button1 action:aBlock
!

scrollDownAction:aBlock
    "set the action, aBlock to be performed when the down-button is pressed"
 
    button2 action:aBlock
!

thumbColor:aColor
    "set the thumbs color"

    thumb thumbColor:aColor
!

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

    ^ thumb thumbOrigin
!

thumbOrigin:newOrigin
    "set position of (top of) thumb in percent"

    ^ thumb thumbOrigin:newOrigin
!

thumbHeight
    "return height of thumb in percent"

    ^ thumb thumbHeight
!

thumbHeight:newHeight
    "set height of thumb in percent"

    ^ thumb thumbHeight:newHeight
!

thumbOrigin:newOrigin thumbHeight:newHeight
    "set origin and height of thumb in percent"

    ^ thumb thumbOrigin:newOrigin thumbHeight:newHeight
!

setThumbFor:aView
    "adjust thumb for aView"

    thumb setThumbFor:aView
!

setThumbHeightFor:aView
    "adjust thumbs height for aView"

    thumb setThumbHeightFor:aView
!

setThumbOriginFor:aView
    "adjust thumbs origin for aView"

    thumb setThumbOriginFor:aView
!

asynchronousOperation
    "set asynchronous-mode - scroll action is performed after movement
     of scroller (i.e. when mouse-button is finally released)"

    thumb asynchronousOperation
!

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

    thumb synchronousOperation
! !

!ScrollBar methodsFor:'forced scroll'!

pageUp
    "page up/left"

    thumb pageUp
!

pageDown
    "page down/right"

    thumb pageDown
! !


!ScrollBar methodsFor:'events'!

sizeChanged:how
    "when my size changes, I have to resize/reposition the subviews"

    |upHeight downHeight thumbHeight upAndDownHeight bwn sep2
     thumbWidth w|

    button1 isNil ifTrue:[^ self].
    thumb isNil ifTrue:[^ self].
    button2 isNil ifTrue:[^ self].

    upHeight := button1 height + borderWidth.
    downHeight := button2 height + borderWidth.
    upAndDownHeight := upHeight + downHeight.
    bwn := borderWidth negated + margin.

    thumbHeight := height - upAndDownHeight - borderWidth - (elementSpacing * 3).
"
    ((layout ~~ #top) and:[layout ~~ #bottom]) ifTrue:[
	thumbHeight := thumbHeight - borderWidth
    ].
"
    layout == #around ifTrue:[
	thumbHeight := thumbHeight + borderWidth
    ].

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

    height < (upHeight + downHeight) ifTrue:[
	button1 shown ifTrue:[
	    button1 unrealize.
	    button2 unrealize.
	    thumb unrealize
	]
    ] ifFalse:[
	shown ifTrue:[
	    button1 shown ifFalse:[
		button1 realize.
		button2 realize.
		thumb realize
	    ]
	]
    ].

    (thumbHeight < 10) ifTrue:[
	thumb shown ifTrue:[
	    thumb unrealize
	]
    ] ifFalse:[
	thumb shown ifFalse:[
	    button1 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.
    StyleSheet name == #next ifTrue:[
	thumbWidth := thumbWidth - (thumb borderWidth * 2).
	thumbHeight := thumbHeight - 1
    ].
    StyleSheet name == #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
    ].

    (layout == #top) ifTrue:[
	"buttons at top"
	thumb extent:(thumbWidth @ thumbHeight).
	^ self
    ].

    sep2 := elementSpacing * 2.
    (layout == #bottom) ifTrue:[
	"buttons at bottom"
	thumbHeight := thumbHeight + borderWidth.
	(how == #smaller) ifTrue:[
	    thumb extent:(thumbWidth @ thumbHeight).
"/            button1 origin:(bwn @ (thumbHeight + sep2)).
"/            button2 origin:(bwn @ (thumbHeight + sep2 + upHeight))
	] ifFalse:[
	    button1 origin:(bwn @ (thumbHeight + sep2)).
	    button2 origin:(bwn @ (thumbHeight + sep2 + upHeight)).
	    thumb extent:(thumbWidth @ thumbHeight)
	].
	^ self
    ].
    "buttons around thumb"

StyleSheet name == #motif ifTrue:[
    sep2 := sep2 + 1
].
    button1 origin:(bwn @ bwn).
    button2 origin:(bwn @ (upHeight + thumbHeight + sep2 - (margin // 2) "+ borderWidth")).
    thumb extent:(thumbWidth @ (thumbHeight + margin - (margin // 2))).
    thumb origin:(bwn @ (upHeight - borderWidth + elementSpacing))
! !