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

    [author:]
        Claus Gittinger

    [see also:]
        Scroller Slider
        ScrollableView
"
! !

!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

    <resource: #keyboard (#BeginOfText #EndOfText)>

    (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: 7.3.1996 / 13:18:19 / 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 unmap
    ] ifFalse:[
        shown ifTrue:[button1 realize]
    ].
    button2 hiddenOnRealize:b1Hidden.
    b2Hidden ifTrue:[
        button2 unmap
    ] ifFalse:[
        shown ifTrue:[button2 realize]
    ].
    thumb hiddenOnRealize:thumbHidden.
    thumbHidden ifTrue:[
        thumb unmap
    ] 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))
    ].

    "Modified: 3.5.1996 / 23:49:02 / stefan"
! !

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

    button1 autoRepeat:true.
    button2 autoRepeat:true.

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

    style := styleSheet name.
    ((style = #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.

    style = #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.
	]
    ]

    "Modified: 9.2.1996 / 22:42:16 / cg"
!

reinitialize
    super reinitialize.
    self setElementPositions.
!

setElementPositions
    "position sub-components"

    |bwn|

    bwn := borderWidth negated + margin.

    (buttonLayout == #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
    ].
    (buttonLayout == #bottom) ifTrue:[
	device supportsViewGravity ifTrue:[
	    button1 viewGravity:#South. 
	    button2 viewGravity:#South. 
	    thumb viewGravity:#North.
	].
	thumb origin:(bwn @ bwn).
	^ self
    ].

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

!ScrollBar methodsFor:'private'!

enableDisableButtons
    "only used with styles which disable their buttons if the
     thumb is at either end. Check where the thumb is and enable/disable
     as appropriate."

    |e1 e2 th to|

    (styleSheet at:'scrollBarDisableButtons' default:false) ifFalse:[^ self].

    e1 := e2 := true.
    (th := thumb thumbHeight) notNil ifTrue:[
	(th >= (thumb stop)) ifTrue:[
	    e1 := false.
	    e2 := false
	]
    ].
    ((to := thumb thumbOrigin) <= thumb start) ifTrue:[
	e1 := false
    ] ifFalse:[
	th isNil ifTrue:[th := 0].
	(to + th) >= thumb stop ifTrue:[
	    e2 := false
	]
    ].
    e1 ifTrue:[button1 enable] ifFalse:[button1 disable].
    e2 ifTrue:[button2 enable] ifFalse:[button2 disable].
! !

!ScrollBar methodsFor:'private scrollview interface'!

setThumbFor:aView
    "adjust thumb for aView 
     (i.e. adjust thumbs origin & size for views size & views contents).
     This is forwarded to the scroller here."

    thumb setThumbFor:aView.
    self enableDisableButtons
!

setThumbHeightFor:aView
    "adjust thumbs height for aViews size & contents.
     This is forwarded to the scroller here."

    thumb setThumbHeightFor:aView.
    self enableDisableButtons
!

setThumbOriginFor:aView
    "adjust thumbs origin for aViews size & contents.
     This is forwarded to the scroller here."

    thumb setThumbOriginFor:aView.
    self enableDisableButtons
! !

!ScrollBar methodsFor:'queries'!

preferredExtent
    "compute my extent from sub-components"

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

    "
     need fix - this is a kludge;
     the if should not be needed ...
    "
    style := styleSheet name.
    style == #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.
	style ~~ #normal ifTrue:[
	    h := h + 4.
	    w := w + 4
	].
    ].

    ^ w @ h.
! !

!ScrollBar class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.30 1996-05-03 23:12:39 stefan Exp $'
! !