"
 COPYRIGHT (c) 1989-93 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'
       classVariableNames:'defaultScrollUpForm 
                           defaultScrollDownForm'
       poolDictionaries:''
       category:'Views-Interactors'
!

ScrollBar comment:'

COPYRIGHT (c) 1989-93 by Claus Gittinger
              All Rights Reserved

this class implements vertical scrollbars with scroller and
2 step-scroll buttons. when moved or stepped, it performs a
predefined action.

$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.2 1993-10-13 01:03:34 claus Exp $

written spring/summer 89 by claus
'!

!ScrollBar class methodsFor:'defaults'!

scrollUpButtonForm:style
    "answer the form used for the scrollUp Button"

    defaultScrollUpForm isNil ifTrue:[
        defaultScrollUpForm := Form fromFile:(self classResources at:'SCROLL_UP_BUTTON_FORM_FILE'
                                                   default:(style == #mswindows
                                                                 ifTrue:['ScrollUp_win.xbm']
                                                                 ifFalse:['ScrollUp.xbm'])
                                             )
                                  resolution:100
    ].
    defaultScrollUpForm isNil ifTrue:[
        defaultScrollUpForm := Form width:16 height:16 
                                      fromArray:#(2r00000000 2r00000000
                                                  2r00000001 2r10000000
                                                  2r00000010 2r01000000
                                                  2r00000100 2r00100000
                                                  2r00001000 2r00010000
                                                  2r00010000 2r00001000
                                                  2r00100000 2r00000100
                                                  2r01000000 2r00000010
                                                  2r01111000 2r00011110
                                                  2r00001000 2r00010000
                                                  2r00001000 2r00010000
                                                  2r00001000 2r00010000
                                                  2r00001000 2r00010000
                                                  2r00001000 2r00010000
                                                  2r00001111 2r11110000
                                                  2r00000000 2r00000000)
    ].
    ^ defaultScrollUpForm
!

scrollDownButtonForm:style
    "retun the form used for the scrollDown Button"

    defaultScrollDownForm isNil ifTrue:[
        defaultScrollDownForm := Form fromFile:(self classResources at:'SCROLL_DOWN_BUTTON_FORM_FILE'
                                                    default:(style == #mswindows
                                                                 ifTrue:['ScrollDn_win.xbm']
                                                                 ifFalse:['ScrollDn.xbm'])
                                                )
                                    resolution:100
    ].
    defaultScrollDownForm isNil ifTrue:[
        defaultScrollDownForm := Form width:16 height:16 
                                      fromArray:#(2r00000000 2r00000000
                                                  2r00001111 2r11110000
                                                  2r00001000 2r00010000
                                                  2r00001000 2r00010000
                                                  2r00001000 2r00010000
                                                  2r00001000 2r00010000
                                                  2r00001000 2r00010000
                                                  2r01111000 2r00011110
                                                  2r01000000 2r00000010
                                                  2r00100000 2r00000100
                                                  2r00010000 2r00001000
                                                  2r00001000 2r00010000
                                                  2r00000100 2r00100000
                                                  2r00000010 2r01000000
                                                  2r00000001 2r10000000
                                                  2r00000000 2r00000000)
    ].
    ^ defaultScrollDownForm
! !

!ScrollBar class methodsFor:'style changes'!

styleChange
    defaultScrollUpForm := nil.
    defaultScrollDownForm := nil

    "ScrollBar styleChange"
! !

!ScrollBar methodsFor:'initialization'!

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

    |bwn sep w h upForm downForm c default|

    super initialize.

    "compute my extent from sub-components"

    upForm  := self class scrollUpButtonForm:style.
    downForm := self class scrollDownButtonForm:style.

    h := upForm height + downForm height +
         (1 "self defaultBorderWidth" * 2) + (Scroller defaultExtent y).
    w := (upForm width) max:(downForm width).
    self is3D ifTrue:[
        h := h + 4.
        w := w + 4
    ].
    self extent:w @ h.

    bwn := borderWidth negated + margin.
    self is3D ifTrue:[
        sep := 1
    ] ifFalse:[
        sep := 0
    ].

    button1 := "Button form:(self class scrollUpButtonForm:style) in:self."
               ArrowButton upIn:self.
    button1 name:'UpButton'.
    button1 borderWidth:borderWidth.
    button1 autoRepeat.

    thumb := Scroller in:self.
    style ~~ #next ifTrue:[
        thumb borderWidth:borderWidth.
    ].

    button2 := "Button form:(self class scrollDownButtonForm:style) in:self."
                ArrowButton downIn:self.
    button2 name:'DownButton'.
    button2 borderWidth:borderWidth.
    button2 autoRepeat.

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

    (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 + sep + sep)).
        thumb viewGravity:#North
    ] ifFalse:[
        (layout == #bottom) ifTrue:[
            button1 viewGravity:#North.
            button2 viewGravity:#North.
            thumb origin:(bwn @ bwn).
            thumb viewGravity:#North
        ] ifFalse:[
            button1 origin:(bwn @ bwn).
            button1 viewGravity:#North.
            button2 viewGravity:#North.
            thumb origin:(bwn @ (button1 height + sep)).
            thumb viewGravity:#North
        ]
    ]
!

initStyle
    |upForm downForm default|

    super initStyle.

    default := #bottom.
    ((style == #mswindows) or:[style == #motif]) ifTrue:[
        default := #around.
        style == #motif ifTrue:[
            self level:-1
        ]
    ].

    layout := resources at:'SCROLLBAR_LAYOUT' default:default.
! !

!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
    thumb thumbColor:aColor
!

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

    ^ thumb thumbOrigin
!

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

    ^ thumb thumbOrigin:newOrigin
!

thumbHeight
    "answer 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:'events'!

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

    |upHeight downHeight thumbHeight upAndDownHeight bwn sep 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.
    self is3D ifTrue:[
        sep := 1
    ] ifFalse:[
        sep := 0
    ].

    thumbHeight := height - upAndDownHeight - borderWidth - (sep * 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 hidden.
            button2 hidden.
            thumb hidden
        ]
    ] ifFalse:[
        shown ifTrue:[
            button1 shown ifFalse:[
                button1 show.
                button2 show.
                thumb show
            ]
        ]
    ].

    (thumbHeight < 10) ifTrue:[
        thumb shown ifTrue:[
            thumb hidden
        ]
    ] ifFalse:[
        thumb shown ifFalse:[
            button1 shown ifTrue:[
                thumb show
            ]
        ]
    ].

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

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

    sep2 := sep * 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"

    button1 origin:(bwn @ bwn).
    button2 origin:(bwn @ (upHeight + thumbHeight + sep2 "+ borderWidth")).
    thumb extent:(thumbWidth @ (thumbHeight + margin)).
    thumb origin:(bwn @ (upHeight - borderWidth + sep))
! !