"

 COPYRIGHT (c) 1996 by eXept Software AG / 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.

"

"{ Package: 'stx:libwidg2' }"

"{ NameSpace: Smalltalk }"

View subclass:#ThumbWheel

	instanceVariableNames:'orientation synchronousOperation thumbPosition thumbColor

		thumbShadowColor thumbLightColor thumbEnteredColor tallyLevel

		tallyAngle rangeStart rangeEnd rangeStep angleRange

		unitsPerRotation entered press pressPos scrollAction

		endlessRotation startMoveAction endMoveAction keyboardStep'

	classVariableNames:'DefaultViewBackground DefaultThumbColor DefaultThumbShadowColor

		DefaultThumbLightColor DefaultTallyMarks DefaultTallyLevel

		DefaultLevel DefaultBorderWidth'

	poolDictionaries:''

	category:'Views-Interactors'

!

!ThumbWheel class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1996 by eXept Software AG / 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

"

    A thumbWheel is like a slider, but looks different ...

    ThumbWheels are useful with 3D applications, to control

    things like rotation, translation and magnification.

    [author:]

	Claus Gittinger

    [see also:]

	Slider ScrollBar StepSlider

"

!

examples

"

  basic setup:

							[exBegin]

    |top wheel|

    top := StandardSystemView new.

    top extent:200@200.

    wheel := ThumbWheel in:top.

    wheel orientation:#vertical.

    wheel level:1.

    wheel origin:0.0@0.0; extent:(wheel preferredExtent).

    top open.

							[exEnd]

  two of them:

							[exBegin]

    |top wheel1 wheel2|

    top := StandardSystemView new.

    top extent:200@200.

    wheel1 := ThumbWheel in:top.

    wheel1 orientation:#vertical.

    wheel1 level:1.

    wheel1 origin:0.0@0.0; extent:(wheel1 preferredExtent).

    wheel2 := ThumbWheel in:top.

    wheel2 orientation:#horizontal.

    wheel2 level:1.

    wheel2 origin:0.0@1.0; extent:(wheel2 preferredExtent).

    wheel2 topInset:(wheel2 preferredExtent y negated).

    wheel2 bottomInset:(wheel2 preferredExtent y).

    top open.

							[exEnd]

  performing an action:

							[exBegin]

    |top wheel|

    top := StandardSystemView new.

    top extent:200@200.

    wheel := ThumbWheel in:top.

    wheel orientation:#vertical.

    wheel level:1.

    wheel origin:0.0@0.0; extent:(wheel preferredExtent).

    wheel scrollAction:[:value | Transcript showCR:value rounded].

    top open.

							[exEnd]

  operating on a model:

							[exBegin]

    |top wheel model|

    model := ValueHolder new.

    model

	onChangeSend:#value

	to:[Transcript show:'value now: '; showCR:model value rounded].

    top := StandardSystemView new.

    top extent:200@200.

    wheel := ThumbWheel in:top.

    wheel orientation:#vertical.

    wheel level:1.

    wheel origin:0.0@0.0; extent:(wheel preferredExtent).

    wheel model:model.

    top open.

							[exEnd]

  endless rotation:

							[exBegin]

    |top wheel model|

    model := ValueHolder new.

    model

	onChangeSend:#value

	to:[Transcript show:'value now: '; showCR:model value rounded].

    top := StandardSystemView new.

    top extent:200@200.

    wheel := ThumbWheel in:top.

    wheel orientation:#vertical.

    wheel level:1.

    wheel endlessRotation:true.

    wheel origin:0.0@0.0; extent:(wheel preferredExtent).

    wheel model:model.

    top open.

							[exEnd]

  concrete example:

							[exBegin]

    |top wheel1 wheel2 image magX magY hHolder vHolder imageView|

    magX := magY := 1.

    hHolder := ValueHolder new.

    hHolder

	onChangeSend:#value

	to:[

	    magX := hHolder value * 2 / 360.

	    magX = 0 ifTrue:[magX := 0.01].

	    Transcript show:'magX now '; showCR:magX.

	    imageView clear.

	    imageView magnification:magX@magY].

    vHolder := ValueHolder new.

    vHolder

	onChangeSend:#value

	to:[

	    magY := vHolder value * 2 / 360.

	    magY = 0 ifTrue:[magY := 0.01].

	    Transcript show:'magY now '; showCR:magY.

	    imageView clear.

	    imageView magnification:magX@magY].

    top := StandardSystemView new.

    top extent:200@200.

    wheel1 := ThumbWheel in:top.

    wheel1 orientation:#vertical.

    wheel1 level:1.

    wheel1 origin:0.0@0.0; extent:(wheel1 preferredExtent).

    wheel1 model:vHolder.

    wheel2 := ThumbWheel in:top.

    wheel2 orientation:#horizontal.

    wheel2 level:1.

    wheel2 origin:0.0@1.0; extent:(wheel2 preferredExtent).

    wheel2 topInset:(wheel2 preferredExtent y negated).

    wheel2 bottomInset:(wheel2 preferredExtent y).

    wheel2 model:hHolder.

    imageView := ImageEditView in:top.

    imageView level:1.

    imageView origin:0.0@0.0 corner:1.0@1.0.

    imageView leftInset:(wheel1 preferredExtent x).

    imageView bottomInset:(wheel2 preferredExtent y).

    imageView image:(Image fromFile:'bitmaps/garfield.gif').

    top open.

							[exEnd]

"

! !

!ThumbWheel methodsFor:'accessing'!

keyboardStep

    "return the scrollers keyboard step. If non-nil,

     that's the stepping value used with cursorUp/cursorDown keys.

     (not used with Scrollers, but provided for subclasses)"

    ^ keyboardStep

!

keyboardStep:aNumber

    "set the scrollers keyboard step. If non-nil,

     that's the stepping value used with cursorUp/cursorDown keys.

     (not used with Scrollers, but provided for subclasses)"

    keyboardStep := aNumber

!

start

    "return the wheels range minimum."

    ^ rangeStart

    "Created: 1.4.1997 / 12:30:04 / cg"

    "Modified: 1.4.1997 / 12:52:31 / cg"

!

start:aNumber

    "set the wheels range minimum."

    rangeStart := aNumber

    "Created: 1.4.1997 / 12:30:54 / cg"

    "Modified: 1.4.1997 / 12:52:36 / cg"

!

start:start stop:stop

    "set the wheels range minimum."

    rangeStart := start.

    rangeEnd := stop.

    "Modified: / 1.4.1997 / 12:52:36 / cg"

    "Created: / 23.1.1998 / 15:06:04 / cg"

!

step

    "return the wheels range step."

    ^ rangeStep

    "Created: 1.4.1997 / 12:30:15 / cg"

    "Modified: 1.4.1997 / 12:53:05 / cg"

!

step:aNumber

    "set the wheels range step."

    rangeStep := aNumber

    "Created: 1.4.1997 / 12:30:32 / cg"

    "Modified: 1.4.1997 / 12:52:49 / cg"

!

stop

    "return the wheels range end."

    ^ rangeEnd

    "Created: 1.4.1997 / 12:30:09 / cg"

    "Modified: 1.4.1997 / 12:52:59 / cg"

!

stop:aNumber

    "set the wheels range end."

    rangeEnd := aNumber

    "Created: 1.4.1997 / 12:30:47 / cg"

    "Modified: 1.4.1997 / 12:52:54 / cg"

!

thumbOrigin:pos

    "same as thumbPosition (for protocol compatibility with sliders)"

    self thumbPosition:pos

    "Created: / 21.4.1998 / 20:57:20 / cg"

    "Modified: / 21.4.1998 / 20:58:43 / cg"

!

thumbPosition

    "sreturn the position"

    ^ thumbPosition

    "Created: / 21.4.1998 / 20:58:15 / cg"

!

thumbPosition:pos

    "set the wheels position; the argument should be in the start..stop

     interval."

    |newPos delta|

    delta := (rangeEnd-rangeStart).

    newPos := pos.

    endlessRotation ifTrue:[

	[newPos < rangeStart] whileTrue:[

	    newPos := newPos + delta

	].

	[newPos > rangeEnd] whileTrue:[

	    newPos := newPos - delta

	].

    ].

    newPos := (newPos max:rangeStart) min:rangeEnd.

    rangeStep notNil ifTrue:[

	newPos := newPos roundTo:rangeStep.

	rangeStep isInteger ifTrue:[

	    newPos := newPos asInteger

	]

    ].

    newPos ~= thumbPosition ifTrue:[

	thumbPosition := newPos.

	shown ifTrue:[

	    self invalidate.

	]

    ].

    "Created: / 27.9.1996 / 18:10:57 / cg"

    "Modified: / 6.6.1998 / 23:29:28 / cg"

! !

!ThumbWheel methodsFor:'accessing-behavior'!

endMoveAction

    "set the endMoveAction, a block which is evaluated when the wheel

     stops to move (i.e. the user releases the mouse).

     The default is nil (i.e. no action)"

    ^ endMoveAction

    "Created: / 18.8.1998 / 16:29:40 / cg"

    "Modified: / 18.8.1998 / 16:31:41 / cg"

!

endMoveAction:aBlock

    "set the endMoveAction, a block which is evaluated when the wheel

     stops to move (i.e. the user releases the mouse)."

    endMoveAction := aBlock.

    "Created: / 18.8.1998 / 16:30:40 / cg"

!

endlessRotation:aBoolean

    "if true, rotation wraps and endless rotation is permitted.

     If false (the default), rotation ends at rangeStart/rangeEnd."

    endlessRotation := aBoolean

    "Created: / 5.2.1998 / 22:20:28 / cg"

!

scrollAction

    "return the scrollAction, a block which is evaluated when the wheel

     is turned (i.e. for every change)."

    ^ scrollAction

    "Modified: / 18.8.1998 / 16:31:59 / cg"

!

scrollAction:aBlock

    "set the scrollAction, a block which is evaluated when the wheel

     is turned (i.e. for every change)."

    scrollAction := aBlock.

    "Modified: / 18.8.1998 / 16:31:52 / cg"

!

startMoveAction

    "return the startMoveAction, a block which is evaluated when the wheel

     starts to turn (i.e. the user clicks on it).

     The default is nil (i.e. no action)"

    ^ startMoveAction

    "Created: / 18.8.1998 / 16:29:36 / cg"

    "Modified: / 18.8.1998 / 16:31:16 / cg"

!

startMoveAction:aBlock

    "set the startMoveAction, a block which is evaluated when the wheel

     starts to turn (i.e. the user clicks on it)."

    startMoveAction := aBlock.

    "Modified: / 18.8.1998 / 16:30:53 / cg"

! !

!ThumbWheel methodsFor:'accessing-look'!

orientation

    "return the wheels orientation; #horizontal or #vertical"

    ^ orientation

    "Created: 1.4.1997 / 12:29:46 / cg"

!

orientation:aSymbol

    "set the wheels orientation; the argument may be one of

     #horizontal or #vertical"

    orientation := aSymbol.

    shown ifTrue:[

	self invalidate

    ]

    "Created: 27.9.1996 / 16:02:14 / cg"

    "Modified: 1.4.1997 / 12:50:22 / cg"

! !

!ThumbWheel methodsFor:'drawing'!

redrawX:x y:y width:w height:h

    "redraw the thumbWheel.

     Q: is it worth the effort - or should we simply use some bitmap ?"

    |halfHeight y0 y1 halfWidth x0 x1 thumbColor|

    halfHeight := height // 2.

    halfWidth := width // 2.

    y0 := 4.

    y1 := height - 4.

    x0 := 4.

    x1 := width - 4.

    gc paint:viewBackground. "/ View defaultViewBackgroundColor.

    gc fillRectangleX:x y:y width:w height:h.

    thumbColor := View defaultViewBackgroundColor.

    thumbColor ~= viewBackground ifTrue:[

        gc paint:thumbColor.

        orientation == #vertical ifTrue:[

            gc fillRectangleX:3 y:y0 width:width-6 height:height-8.

        ] ifFalse:[

            gc fillRectangleX:x0 y:3 width:width-8 height:height-6.

        ]

    ].

    ((thumbPosition truncateTo:tallyAngle))

    to:((thumbPosition + angleRange truncateTo:tallyAngle)+tallyAngle) by:tallyAngle do:[:a |

        |yT pA xT d|

        pA := a - thumbPosition.

        d := (pA degreesToRadians cos).

        yT := halfHeight + (d * (halfHeight - 4)) - 1.

        xT := halfWidth + (d * (halfWidth - 4)) - 1.

        xT := xT min:x1.

        yT := yT min:y1.

        (pA > (angleRange * 7 // 8)) ifTrue:[

            gc paint:shadowColor

        ] ifFalse:[

            gc paint:self blackColor.

        ].

        orientation == #vertical ifTrue:[

            gc displayLineFromX:3 y:yT toX:width-4 y:yT.

        ] ifFalse:[

            gc displayLineFromX:xT y:3 toX:xT y:height-4.

        ].

        (pA between:(angleRange * 4 // 8) and:(angleRange * 7 // 8)) ifTrue:[

            gc paint:self whiteColor.

            orientation == #vertical ifTrue:[

                gc displayLineFromX:3 y:yT-1 toX:width-5 y:yT-1.

            ] ifFalse:[

                gc displayLineFromX:xT-1 y:3 toX:xT-1 y:height-5.

            ].

            (pA between:(angleRange * 4 // 8) and:(angleRange * 6 // 8)) ifTrue:[

                gc paint:self whiteColor.

                orientation == #vertical ifTrue:[

                    gc displayLineFromX:3 y:yT-2 toX:width-5 y:yT-2.

                ] ifFalse:[

                    gc displayLineFromX:xT-2 y:3 toX:xT-2 y:height-5.

                ]

            ]

        ]

    ].

    gc paint:self whiteColor. "/lightColor.

    orientation == #vertical ifTrue:[

        gc displayLineFromX:2 y:y0 toX:2 y:y1.

    ] ifFalse:[

        gc displayLineFromX:x0 y:2 toX:x1 y:2.

    ].

    gc paint:shadowColor.

    orientation == #vertical ifTrue:[