"{ Package: 'stx:libwidg2' }"

Button subclass:#LinkButton

	instanceVariableNames:'labelsAndActions'

	classVariableNames:'DefaultLinkColor'

	poolDictionaries:''

	category:'Views-Layout'

!

!LinkButton class methodsFor:'documentation'!

documentation

"

    Looks like a Label, but behaves like a button with individually clickable text components.

    Can be used to create html-page-look-alike links in a view.

    [author:]

        cg (cg@CG-VOSTRO)

    [instance variables:]

    [class variables:]

    [see also:]

"

!

examples

"

                                                                    [exBegin]

    |v l|

    v := StandardSystemView new.

    l := LinkButton in:v.

    l label:

        (('Hello' actionForAll:[ Transcript showCR:'Hello Clicked']) 

        , ' '

        , ('World' actionForAll:[ Transcript showCR:'World Clicked'])).

    v open

                                                                    [exEnd]

                                                                    [exBegin]

    |v l|

    v := StandardSystemView new.

    l := LinkButton in:v.

    l label:

        ((('Hello' actionForAll:[ Transcript showCR:'Hello Clicked']) colorizeAllWith:(Color blue)) 

        , ' '

        , ('World' actionForAll:[ Transcript showCR:'World Clicked'])).

    v open

                                                                    [exEnd]

                                                                    [exBegin]

    |v l|

    v := StandardSystemView new.

    l := LinkButton in:v.

    l labelsAndActions:{ 

                        'Hello' -> [ Transcript showCR:'Hello Clicked'].

                        ' ' -> nil.

                        'World' -> [ Transcript showCR:'World Clicked'].

                       }.

    l foregroundColor:Color blue.

    v open

                                                                    [exEnd]

                                                                    [exBegin]

    |v l|

    v := StandardSystemView new.

    l := LinkButton in:v.

    l labelsAndActions:{ 

                        'Hello' -> nil.

                        ' ' -> nil.

                        'World' -> [ Transcript showCR:'World Clicked'].

                       }.

    l foregroundColor:Color blue.

    v open

                                                                    [exEnd]

"

! !

!LinkButton class methodsFor:'defaults'!

updateStyleCache

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

    <resource: #style ( #'linkButton.linkColor' )>

    DefaultLinkColor := StyleSheet colorAt:#'linkButton.linkColor' default:Color blue.

! !

!LinkButton methodsFor:'accessing'!

labelsAndActions

    "returns the collection of label->action associations. 

     For display, the label strings are drawn as one concatenated string (add separating spaces, if you have to).

     When clicked on a string, the corresponding action is called"

    ^ labelsAndActions

!

labelsAndActions:aCollectionOfAssociations

    "set the collection of label->action associations. 

     For display, the label strings are drawn as one concatenated string (add separating spaces, if you have to).

     When clicked on a string, the corresponding action is called"

    labelsAndActions := aCollectionOfAssociations.

    self label:((aCollectionOfAssociations collect:[:assoc | assoc key]) asStringWith:'')

! !

!LinkButton methodsFor:'initialization'!

defaultControllerClass

    ^ LinkButtonController

!

initStyle

    super initStyle.

    level := enterLevel := leaveLevel := onLevel := offLevel := 0.

    DefaultLinkColor notNil ifTrue:[

        |color|

        self paint:(color := DefaultLinkColor onDevice:self graphicsDevice).

        self foreground:color.

    ].

    enteredFgColor := nil. "/ Color blue.

"/    activeFgColor := enteredFgColor := foreground.

"/    activeBgColor := enteredBgColor := viewBackground.

    "Modified: / 07-09-2011 / 04:29:29 / cg"

!

initialize

    super initialize.

    self enableMotionEvents

! !

!LinkButton methodsFor:'redrawing'!

actionAt:aPoint

    |pressAction emphasis|

    labelsAndActions isNil ifTrue:[

        "take action from logo, which is normally a text"

        emphasis := logo emphasisAtPoint:aPoint on:self.

        (emphasis isNil or:[emphasis isSymbol]) ifTrue:[

            ^ pressAction.

        ].

        emphasis isAssociation ifTrue:[

            emphasis key == #actionBlock ifTrue:[

                ^ emphasis value.

            ].

            ^ pressAction.

        ].

        emphasis do:[:eachElement|

            eachElement isAssociation ifTrue:[

                eachElement key == #actionBlock ifTrue:[

                    ^ eachElement value.

                ].

            ].

        ].

        ^ pressAction.

    ].

    self labelsAndActionsWithPositionsDo:[:lbl :action :leftX :rightX |

        (aPoint x between:leftX and:rightX) ifTrue:[

            ^ labelsAndActions notNil ifTrue:action ifFalse:pressAction

        ].

    ].

    ^ nil

!

actionEmphasisIn:aText atPoint:aPoint

    "check for a actionBlock emphasis in aString at aPoint.

     Answer an Array with the whole emphasis and the actionBlock,

     or nil"

    |emphasis|

    emphasis := aText emphasisAtPoint:aPoint on:self.

    (emphasis isNil or:[emphasis isSymbol]) ifTrue:[

        ^ #(nil nil).

    ].

    emphasis isAssociation ifTrue:[

        emphasis key == #actionBlock ifTrue:[

            ^ Array with:emphasis with:emphasis value.

        ].

        ^ #(nil nil).

    ].

    emphasis detect:[:eachElement|

        eachElement isAssociation ifTrue:[

            eachElement key == #actionBlock ifTrue:[

                ^ Array with:emphasis with:eachElement value.

            ].

        ].

    ] ifNone:[].

    ^ #(nil nil).

!

drawStringLogo:aString x:x y:y

    "redefined to draw the part under the mouse pointer with an underined emphasis"

    |str entered mousePoint start len emphasis|

    mousePoint := controller lastMousePoint.

    entered := controller entered.

    labelsAndActions isNil ifTrue:[

        (entered not or:[mousePoint isNil]) ifTrue:[

            self displayString:aString x:x y:y.

            ^ self.

        ].

        str := aString.

        emphasis := (self actionEmphasisIn:aString atPoint:mousePoint) first.

        emphasis notNil ifTrue:[

            start := 1.

            aString emphasisCollection runsDo:[:eachLen :eachEmphasis|

                len isNil ifTrue:[

                    eachEmphasis == emphasis ifTrue:[

                        len := eachLen.

                    ] ifFalse:[

                        start := start + eachLen.  

                    ].

                ].

            ].

            len notNil ifTrue:[

                str := str deepCopy.

                str emphasisFrom:start to:start+len-1 add:#underline.

                "/ str emphasisFrom:start to:start+len-1 add:(#color -> foreground).

            ].

        ].

        self displayString:str x:x y:y.

        ^ self.

    ].

    self labelsAndActionsWithPositionsDo:[:lbl :action :leftX :rightX |

        |l|

        l := lbl.

        action notNil ifTrue:[

            (entered and:[mousePoint notNil and:[mousePoint x between:leftX and:rightX]]) ifTrue:[

                l := l allUnderlined

            ].

        ].

        self displayString:l x:leftX y:y.

    ].

    "Modified: / 07-09-2011 / 04:47:13 / cg"

!

labelsAndActionsWithPositionsDo:aFourArgBlock

    |leftX rightX w|

    leftX := labelOriginX.

    labelsAndActions isNil ifTrue:[

        w := (self font widthOf:logo on:self graphicsDevice).

        rightX := leftX + w-1.

        aFourArgBlock 

            value:logo

            value:self pressAction

            value:leftX

            value:rightX.

        ^ self

    ].

    labelsAndActions do:[:assoc | 

        |lbl wEach|

        lbl := assoc key.

        wEach := (self font widthOf:lbl on:self graphicsDevice).

        rightX := leftX + wEach-1.

        aFourArgBlock 

            value:assoc key

            value:assoc value

            value:leftX

            value:rightX.

        leftX := rightX+1.

    ].

    ^ nil

! !

!LinkButton class methodsFor:'documentation'!

version

! !