"      NAME     WheelWidget
       AUTHOR   bert@isg.cs.uni-magdeburg.de
       URL     	http://www.cs.uni-magdeburg.de/~bert/smalltalk.html
       FUNCTION Fully integrated widget for continuous data input
       ST-VERSIONS      VisualWorks 2.5, 3.0
       PREREQUISITES    (none)
       CONFLICTS        (none known)
       DISTRIBUTION     world
       VERSION  1.1
       DATE     30-Oct-97

SUMMARY
The famous SgThumbWheel widget (looks something like [IIIIIIII]) known from
Silicon Graphics workstations. It's used for continuaus data entry such as 
3d rotation or scaling. It can be adjusted horizontally or vertically.
  Finite mode: you provide a minimum and maximum limit and adjust the angle
     range this interval is mapped to
  Infinite mode: you determine the amount the value is changed by when the
     wheel performes a full rotation
The widget is fully integrated (appears in the Canvas Tool's Palette, can define 
a default model and has an own Properties Sheet)

                                Bert Schoenwaelder
"!


SimpleView subclass: #WheelView
	instanceVariableNames: 'horizontal phase currentValue min max angleRange unitsPerRotation '
	classVariableNames: 'Images '
	poolDictionaries: ''
	category: 'UI-Wheel'!

!WheelView methodsFor: 'initialize-release'!

initialize

	super initialize.
	phase := 1.
	currentValue := 0.0.
	min := 0.0.
	max := 100.0.
	angleRange := 110.0.
	unitsPerRotation := 360.0.
	self beHorizontal.! !

!WheelView methodsFor: 'accessing'!

angleRange

	^angleRange!

angleRange: aNumber
	"Specifies the angular range, in degrees, through
	which the thumb wheel is allowed to rotate."
	"This, in conjunction with maximum and minimum,
	controls the fineness or coarseness of the wheel
	control when it is not infinite. If set to zero,
	the thumb wheel has an infinite range.
		The default of 110 represents roughly the visible
	amount of the wheel. Thus clicking at one end of
	the wheel and dragging the mouse to the other end
	would give roughly the entire range from
	minimum to maximum."

	aNumber >= 0 ifTrue: [
		angleRange := aNumber]!

beHorizontal

	self horizontal: true!

beInfinite

	self angleRange: 0!

beVertical

	self horizontal: false!

horizontal

	^horizontal!

horizontal: aBoolean

	horizontal := aBoolean.
	self invalidate!

infinite

	^angleRange isZero or: [max = min].!

max

	^max!

min

	^min!

min: minimum max: maximum
	"Specifies the wheel's minimum and maximum value. Maximum must be greater than or equal to minimum. Setting maximum equal to minimum indicates an infinite range."

	min <= max ifTrue: [
		min := minimum.
		max := maximum
	]!

phase: aNumber
	"Display rotation of the wheel by choosing one of the 4 phases we have"
	
	| newPhase |
	newPhase := (aNumber asInteger) - 1 \\ 4 + 1.
	phase ~= newPhase ifTrue: [
		phase := newPhase.
		self displayOn: self graphicsContext]!

unitsPerRotation: aNumber
	"Specifies the change in value when the wheel is rotated one full turn around. This controls the fineness or coarseness of the wheel control when the range is infinite."

	aNumber >= 0 ifTrue: [
		unitsPerRotation := aNumber]! !

!WheelView methodsFor: 'updating'!

update: anAspectSymbol with: aParameter from: aSender

	"Do nothing"! !

!WheelView methodsFor: 'displaying'!

displayOn: aGraphicsContext

	self currentImage displayOn: aGraphicsContext! !

!WheelView methodsFor: 'display box accessing'!

preferredBounds

	^(0@0) corner: (self currentImage extent)! !

!WheelView methodsFor: 'controller accessing'!

defaultControllerClass

	^WheelController! !

!WheelView methodsFor: 'private'!

computeValueFrom: oldValue movement: aNumber

	| newValue scale infinite |
	InputState default ctrlDown ifTrue: [self halt].
	scale := (infinite := self infinite)
		ifTrue: [360 / unitsPerRotation]
		ifFalse: [(max - min) / angleRange].
	newValue := oldValue + (scale * aNumber).
	infinite ifFalse: [newValue := (newValue max: min) min: max].
	newValue ~= currentValue ifTrue: [
		newValue < currentValue 
			ifTrue: [self phase: phase - 1]
			ifFalse: [self phase: phase + 1].
		currentValue := newValue.
	].
	^newValue!

currentImage

	^Images at: (horizontal ifTrue: [phase + 4] ifFalse: [phase])! !

!WheelView class methodsFor: 'initialize-release'!

initialize
	"WheelView initialize"

	self initImages!

initImages
	"WheelView initImages"
	
	Images := Array new: 8.
	1 to: 4 do: [:i | 
		| im |
		im := self perform: (#image, (5-i) printString) asSymbol.
		Images at: i put: (CachedImage on: im).
		Images at: 9-i put: (CachedImage on: (im rotatedByQuadrants: 1) reflectedInX)].! !

!WheelView class methodsFor: 'instance creation'!

horizontal

	^self new beHorizontal!

vertical

	^self new beVertical! !

!WheelView class methodsFor: 'resources'!

image1
	"UIMaskEditor new openOnClass: self andSelector: #image1"

	<resource: #image>
	^(Image extent: 20@126 depth: 3 bitsPerPixel: 4 palette: (MappedPalette withColors: ((Array new: 7) at: 1 put: ColorValue black; at: 2 put: (ColorValue scaledRed: 1638 scaledGreen: 1638 scaledBlue: 1638); at: 3 put: (ColorValue scaledRed: 3276 scaledGreen: 3276 scaledBlue: 3276); at: 4 put: (ColorValue scaledRed: 7645 scaledGreen: 7645 scaledBlue: 7645); at: 5 put: (ColorValue scaledRed: 6007 scaledGreen: 6007 scaledBlue: 6007); at: 6 put: (ColorValue scaledRed: 4369 scaledGreen: 4369 scaledBlue: 4369); at: 7 put: (ColorValue scaledRed: 7099 scaledGreen: 7099 scaledBlue: 7099); yourself)) usingBits: (ByteArray fromPackedString: 'H"H"H"H"H"H"H @@H3L3L3L3L3L3LP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4PP@@@@@@ADHP@@H4PPH"H"H ADHP@@H4PP@@@@@@ADHP@@H4PPH"H"H ADHP@@H4PPQDQDQ@ADHP@@H4PP@@@@@@ADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRH"H"H"ADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PUDQDQDUADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUY&Y&Y%ADHP@@H4PUH"H"H%ADHP@@H4PUQDQDQEADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTY&Y&Y$ADHP@@H4PTH"H"H$ADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTL3L3L4ADHP@@H4PVH"H"H&ADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVL3L3L6ADHP@@H4PVH"H"H&ADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSL3L3L3ADHP@@H4PSL3L3L3ADHP@@H4PSH"H"H#ADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSL3L3L3ADHP@@H4PSL3L3L3ADHP@@H4PSH"H"H#ADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSL3L3L3ADHP@@H4PSL3L3L3ADHP@@H4PSH"H"H#ADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVL3L3L6ADHP@@H4PVL3L3L6ADHP@@H4PVH"H"H&ADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PTQDQDQDADHP@@H4PTL3L3L4ADHP@@H4PTH"H"H$ADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTL3L3L4ADHP@@H4PTH"H"H$ADHP@@H4PTQDQDQDADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUY&Y&Y%ADHP@@H4PUH"H"H%ADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRY&Y&Y"ADHP@@H4PRH"H"H"ADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PPQDQDQ@ADHP@@H4PP@@@@@@ADHP@@H4PPQDQDQ@ADHP@@H4PPH"H"H ADHP@@H4PP@@@@@@ADHP@@H4PPH"H"H ADHP@@H4PP@@@@@@ADHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H2H"H"H"H"H"HP@@HQDQDQDQDQDQDP@@'))!

image2
	"UIMaskEditor new openOnClass: self andSelector: #image2"

	<resource: #image>
	^(Image extent: 20@126 depth: 3 bitsPerPixel: 4 palette: (MappedPalette withColors: ((Array new: 7) at: 1 put: ColorValue black; at: 2 put: (ColorValue scaledRed: 1638 scaledGreen: 1638 scaledBlue: 1638); at: 3 put: (ColorValue scaledRed: 3276 scaledGreen: 3276 scaledBlue: 3276); at: 4 put: (ColorValue scaledRed: 7645 scaledGreen: 7645 scaledBlue: 7645); at: 5 put: (ColorValue scaledRed: 6007 scaledGreen: 6007 scaledBlue: 6007); at: 6 put: (ColorValue scaledRed: 4369 scaledGreen: 4369 scaledBlue: 4369); at: 7 put: (ColorValue scaledRed: 7099 scaledGreen: 7099 scaledBlue: 7099); yourself)) usingBits: (ByteArray fromPackedString: 'H"H"H"H"H"H"H @@H3L3L3L3L3L3LP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4PP@@@@@@ADHP@@H4PPH"H"H ADHP@@H4PP@@@@@@ADHP@@H4PPH"H"H ADHP@@H4PPQDQDQ@ADHP@@H4PP@@@@@@ADHP@@H4PRQDQDQBADHP@@H4PRDQDQDRADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRY&Y&Y"ADHP@@H4PUH"H"H%ADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUY&Y&Y%ADHP@@H4PUH"H"H%ADHP@@H4PUQDQDQEADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTL3L3L4ADHP@@H4PTH"H"H$ADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PVL3L3L6ADHP@@H4PVH"H"H&ADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVL3L3L6ADHP@@H4PVL3L3L6ADHP@@H4PVH"H"H&ADHP@@H4PVQDQDQFADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSL3L3L3ADHP@@H4PSL3L3L3ADHP@@H4PSH"H"H#ADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSL3L3L3ADHP@@H4PSL3L3L3ADHP@@H4PSH"H"H#ADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSL3L3L3ADHP@@H4PSL3L3L3ADHP@@H4PSH"H"H#ADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVL3L3L6ADHP@@H4PVH"H"H&ADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTL3L3L4ADHP@@H4PTH"H"H$ADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTY&Y&Y$ADHP@@H4PTH"H"H$ADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUY&Y&Y%ADHP@@H4PUH"H"H%ADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRDQDQDRADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRH"H"H"ADHP@@H4PRQDQDQBADHP@@H4PPQDQDQ@ADHP@@H4PP@@@@@@ADHP@@H4PPQDQDQ@ADHP@@H4PPH"H"H ADHP@@H4PP@@@@@@ADHP@@H4PPH"H"H ADHP@@H4PP@@@@@@ADHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H2H"H"H"H"H"HP@@HQDQDQDQDQDQDP@@'))!

image3
	"UIMaskEditor new openOnClass: self andSelector: #image3"

	<resource: #image>
	^(Image extent: 20@126 depth: 3 bitsPerPixel: 4 palette: (MappedPalette withColors: ((Array new: 7) at: 1 put: ColorValue black; at: 2 put: (ColorValue scaledRed: 1638 scaledGreen: 1638 scaledBlue: 1638); at: 3 put: (ColorValue scaledRed: 3276 scaledGreen: 3276 scaledBlue: 3276); at: 4 put: (ColorValue scaledRed: 7645 scaledGreen: 7645 scaledBlue: 7645); at: 5 put: (ColorValue scaledRed: 6007 scaledGreen: 6007 scaledBlue: 6007); at: 6 put: (ColorValue scaledRed: 4369 scaledGreen: 4369 scaledBlue: 4369); at: 7 put: (ColorValue scaledRed: 7099 scaledGreen: 7099 scaledBlue: 7099); yourself)) usingBits: (ByteArray fromPackedString: 'H"H"H"H"H"H"H @@H3L3L3L3L3L3LP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4PP@@@@@@ADHP@@H4PPH"H"H ADHP@@H4PP@@@@@@ADHP@@H4PPH"H"H ADHP@@H4PPQDQDQ@ADHP@@H4PP@@@@@@ADHP@@H4PRH"H"H"ADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRDQDQDRADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PUQDQDQEADHP@@H4PUY&Y&Y%ADHP@@H4PUH"H"H%ADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUY&Y&Y%ADHP@@H4PTH"H"H$ADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTL3L3L4ADHP@@H4PTH"H"H$ADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVL3L3L6ADHP@@H4PVH"H"H&ADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVL3L3L6ADHP@@H4PVL3L3L6ADHP@@H4PSH"H"H#ADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSL3L3L3ADHP@@H4PSL3L3L3ADHP@@H4PSH"H"H#ADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSL3L3L3ADHP@@H4PSL3L3L3ADHP@@H4PSH"H"H#ADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSL3L3L3ADHP@@H4PVL3L3L6ADHP@@H4PVH"H"H&ADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVL3L3L6ADHP@@H4PVH"H"H&ADHP@@H4PVQDQDQFADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTL3L3L4ADHP@@H4PTH"H"H$ADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PUY&Y&Y%ADHP@@H4PUH"H"H%ADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUY&Y&Y%ADHP@@H4PUH"H"H%ADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRDQDQDRADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PPH"H"H ADHP@@H4PP@@@@@@ADHP@@H4PPQDQDQ@ADHP@@H4PPH"H"H ADHP@@H4PP@@@@@@ADHP@@H4PPH"H"H ADHP@@H4PP@@@@@@ADHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H2H"H"H"H"H"HP@@HQDQDQDQDQDQDP@@'))!

image4
	"UIMaskEditor new openOnClass: self andSelector: #image4"

	<resource: #image>
	^(Image extent: 20@126 depth: 3 bitsPerPixel: 4 palette: (MappedPalette withColors: ((Array new: 7) at: 1 put: ColorValue black; at: 2 put: (ColorValue scaledRed: 1638 scaledGreen: 1638 scaledBlue: 1638); at: 3 put: (ColorValue scaledRed: 3276 scaledGreen: 3276 scaledBlue: 3276); at: 4 put: (ColorValue scaledRed: 7645 scaledGreen: 7645 scaledBlue: 7645); at: 5 put: (ColorValue scaledRed: 6007 scaledGreen: 6007 scaledBlue: 6007); at: 6 put: (ColorValue scaledRed: 4369 scaledGreen: 4369 scaledBlue: 4369); at: 7 put: (ColorValue scaledRed: 7099 scaledGreen: 7099 scaledBlue: 7099); yourself)) usingBits: (ByteArray fromPackedString: 'H"H"H"H"H"H"H @@H3L3L3L3L3L3LP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4PP@@@@@@ADHP@@H4PPH"H"H ADHP@@H4PP@@@@@@ADHP@@H4PPH"H"H ADHP@@H4PPQDQDQ@ADHP@@H4PP@@@@@@ADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRH"H"H"ADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRDQDQDRADHP@@H4PRQDQDQBADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUY&Y&Y%ADHP@@H4PUH"H"H%ADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PTQDQDQDADHP@@H4PTY&Y&Y$ADHP@@H4PTH"H"H$ADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTL3L3L4ADHP@@H4PTH"H"H$ADHP@@H4PTQDQDQDADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVL3L3L6ADHP@@H4PVH"H"H&ADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PSL3L3L3ADHP@@H4PSL3L3L3ADHP@@H4PSH"H"H#ADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSL3L3L3ADHP@@H4PSL3L3L3ADHP@@H4PSH"H"H#ADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSL3L3L3ADHP@@H4PSL3L3L3ADHP@@H4PSH"H"H#ADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PSQDQDQCADHP@@H4PVQDQDQFADHP@@H4PVL3L3L6ADHP@@H4PVL3L3L6ADHP@@H4PVH"H"H&ADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVQDQDQFADHP@@H4PVL3L3L6ADHP@@H4PTH"H"H$ADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTL3L3L4ADHP@@H4PTH"H"H$ADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PTQDQDQDADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUY&Y&Y%ADHP@@H4PUH"H"H%ADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PUQDQDQEADHP@@H4PRY&Y&Y"ADHP@@H4PRH"H"H"ADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRQDQDQBADHP@@H4PRDQDQDRADHP@@H4PPQDQDQ@ADHP@@H4PP@@@@@@ADHP@@H4PPQDQDQ@ADHP@@H4PPH"H"H ADHP@@H4PP@@@@@@ADHP@@H4PPH"H"H ADHP@@H4PP@@@@@@ADHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H4QDQDQDQDQDHP@@H2H"H"H"H"H"HP@@HQDQDQDQDQDQDP@@'))!

images

	Images isNil ifTrue: [self initImages].
	^Images! !

!WheelView class methodsFor: 'examples'!

example
	"WheelView example"

	WheelExample example! !

!WheelView class methodsFor: 'doc'!

sgThumbWheel

	"From man pages..."
      "XmNmaximum
		Specifies the thumb wheel's maximum value.
		XmNmaximum must be greater than or equal to
		XmNminimum.  Setting XmNmaximum equal to
		XmNminimum indicates an infinite range.

	XmNminimum
		Specifies the thumb wheel's minimum value.
		XmNmaximum must be greater than or equal to
		XmNminimum.  Setting XmNmaximum equal to
		XmNminimum indicates an infinite range.

	SgNangleRange
		Specifies the angular range, in degrees, through
		which the thumb wheel is allowed to rotate.  This,
		in conjunction with XmNmaximum and XmNminimum,
		controls the fineness or coarseness of the wheel
		control when it is not infinite.  If set to zero,
		the thumb wheel has an infinite range.

		The default of 150 represents roughly the visible
		amount of the wheel.  Thus clicking at one end of
		the wheel and dragging the mouse to the other end
		would give roughly the entire range from
		XmNminimum to XmNmaximum.

	SgNunitsPerRotation
		Specifies the change in XmNvalue when the wheel is
		rotated one full turn around.  This controls the
		fineness or coarseness of the wheel control when
		the range is infinite.
"! !

ApplicationModel subclass: #WheelExample
	instanceVariableNames: 'x y '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'UI-Wheel'!

!WheelExample methodsFor: 'aspects'!

x
	"This method was generated by UIDefiner.  Any edits made here
	may be lost whenever methods are automatically defined.  The
	initialization provided below may have been preempted by an
	initialize method."

	^x isNil
		ifTrue:
			[x := 50.0 asValue]
		ifFalse:
			[x]!

y
	"This method was generated by UIDefiner.  Any edits made here
	may be lost whenever methods are automatically defined.  The
	initialization provided below may have been preempted by an
	initialize method."

	^y isNil
		ifTrue:
			[y := 50.0 asValue]
		ifFalse:
			[y]! !

!WheelExample class methodsFor: 'interface specs'!

windowSpec
	"UIPainter new openOnClass: self andSelector: #windowSpec"

	<resource: #canvas>
	^#(#FullSpec 
		#window: 
		#(#WindowSpec 
			#label: 'Unlabeled Canvas' 
			#bounds: #(#Rectangle 387 406 581 589 ) ) 
		#component: 
		#(#SpecCollection 
			#collection: #(
				#(#WheelSpec 
					#layout: #(#Point 28 150 ) 
					#isOpaque: true 
					#model: #x 
					#horizontal: true 
					#min: 0.0 
					#max: 100.0 
					#angleRange: 110.0 
					#infinite: true 
					#unitsPerRotation: 240.0 ) 
				#(#WheelSpec 
					#layout: #(#Point 158 21 ) 
					#isOpaque: true 
					#model: #y 
					#horizontal: false 
					#min: 0.0 
					#max: 100.0 
					#angleRange: 110.0 
					#unitsPerRotation: 360.0 ) 
				#(#InputFieldSpec 
					#layout: #(#Rectangle 48 30 128 64 ) 
					#model: #x 
					#alignment: #center 
					#style: #large 
					#isReadOnly: true 
					#type: #number ) 
				#(#LabelSpec 
					#layout: #(#Point 15 34 ) 
					#label: 'x:' ) 
				#(#LabelSpec 
					#layout: #(#Point 16 80 ) 
					#label: 'y:' ) 
				#(#InputFieldSpec 
					#layout: #(#Rectangle 48 80 128 112 ) 
					#model: #y 
					#alignment: #center 
					#style: #large 
					#isReadOnly: true 
					#type: #number ) ) ) )! !

!WheelExample class methodsFor: 'examples'!

example
	"WheelExample example"

	WheelExample open! !

SelectController subclass: #WheelController
	instanceVariableNames: 'downPoint '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'UI-Wheel'!

!WheelController methodsFor: 'mouse tracking'!

mouseMovedTo: aPoint
	"Selection continues at relative point aPoint."

	self requestValueChange ifTrue: [
		model value: (self computeValueFromMovement: aPoint - downPoint).
		downPoint := aPoint.
		self valueChange]!

selectDownAt: aPoint
	"Begin selection at the relative point aPoint."

	downPoint := aPoint.! !

!WheelController methodsFor: 'event driven'!

      redButtonPressedEvent: event
              self selectDownAt: event point.
              self startDraggingAt: downPoint! !

!WheelController methodsFor: 'private'!

computeValueFromMovement: aPoint

	| diff downValue |
	downValue := self model value.
	diff := view horizontal ifTrue: [aPoint x] ifFalse: [aPoint y negated].
	diff = 0 ifTrue: [^downValue].
	^view computeValueFrom: downValue movement: diff.! !

WidgetSpec subclass: #WheelSpec
	instanceVariableNames: 'horizontal min max angleRange infinite unitsPerRotation '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'UI-Wheel'!
WheelSpec comment:
'This class is the Spec for the WheelView.

Instance Variables:
	direction		<Symbol> #horizontal, #vertical
'!

!WheelSpec methodsFor: 'accessing'!

angleRange

	infinite == true ifFalse: [^angleRange].
	^0!

angleRange: aValue

	aValue >= 0 ifTrue: [
		angleRange := aValue.
		self setInfinite]!

direction

	horizontal ifTrue: [^#horizontal].
	^#vertical!

direction: aDirection

	horizontal := aDirection = #horizontal!

horizontal
	^horizontal!

horizontal: aBoolean
	horizontal := aBoolean!

infinite

	^infinite!

infinite: aBoolean

	infinite ~~ aBoolean ifTrue: [
		infinite := aBoolean.
		self setInfinite]!

max

	^max!

max: aValue

	aValue >= min ifTrue: [
		max := aValue.
		self setInfinite.]!

min

	^min!

min: aValue

	aValue <=max ifTrue: [
		min := aValue.
		self setInfinite]!

unitsPerRotation

	^unitsPerRotation!

unitsPerRotation: aValue

	aValue > 0 ifTrue:
		[unitsPerRotation := aValue]! !

!WheelSpec methodsFor: 'initialize'!

initialize
	super initialize.
	horizontal := true.
	isOpaque := true.
	min := 0.0.
	max := 100.0.
	angleRange := 110.0.
	unitsPerRotation := 360.0.! !

!WheelSpec methodsFor: 'private'!

defaultModel
	^ValueHolder with: 50.0!

dispatchTo: policy with: builder 
	^policy wheel: self into: builder!

setInfinite

	self infinite: (self angleRange isZero or: [min = max]).! !

!WheelSpec class methodsFor: 'class initialization'!

initialize
	"Put me into UIPalette's list of Specs"

	(UIPalette activeSpecsList includes: #WheelSpec)
		ifFalse: [UIPalette activeSpecsList add: #WheelSpec]! !

!WheelSpec class methodsFor: 'interface specs'!

basicsEditSpec
	"UIPainter new openOnClass: self andSelector: #basicsEditSpec"

	<resource: #canvas>
	^#(#FullSpec 
		#window: 
		#(#WindowSpec 
			#label: ' ' 
			#min: #(#Point 300 243 ) 
			#max: #(#Point 329 316 ) 
			#bounds: #(#Rectangle 137 395 466 711 ) ) 
		#component: 
		#(#SpecCollection 
			#collection: #(
				#(#LabelSpec 
					#layout: #(#AlignmentOrigin 0 0.5 4 0 0.5 0 ) 
					#label: 'Wheel' ) 
				#(#LabelSpec 
					#layout: #(#AlignmentOrigin 12 0 55 0 0 1 ) 
					#label: 'Aspect:' ) 
				#(#LabelSpec 
					#layout: #(#AlignmentOrigin 12 0 87 0 0 1 ) 
					#label: 'ID:' ) 
				#(#InputFieldSpec 
					#layout: #(#LayoutFrame 86 0 28 0 -10 1 53 0 ) 
					#model: #model 
					#menu: #fieldMenu 
					#type: #string ) 
				#(#InputFieldSpec 
					#layout: #(#LayoutFrame 87 0 61 0 -9 1 86 0 ) 
					#model: #name 
					#menu: #fieldMenu ) 
				#(#RadioButtonSpec 
					#layout: #(#Point 212 109 ) 
					#model: #direction 
					#label: 'Horizontal' 
					#select: #horizontal ) 
				#(#RadioButtonSpec 
					#layout: #(#Point 212 142 ) 
					#model: #direction 
					#label: 'Vertical' 
					#select: #vertical ) 
				#(#InputFieldSpec 
					#layout: #(#Rectangle 105 107 171 133 ) 
					#model: #min 
					#alignment: #right 
					#type: #number ) 
				#(#InputFieldSpec 
					#layout: #(#Rectangle 105 140 171 166 ) 
					#model: #max 
					#alignment: #right 
					#type: #number ) 
				#(#InputFieldSpec 
					#layout: #(#Rectangle 105 173 171 199 ) 
					#model: #angleRange 
					#alignment: #right 
					#type: #number ) 
				#(#InputFieldSpec 
					#layout: #(#Rectangle 241 218 307 244 ) 
					#model: #unitsPerRotation 
					#alignment: #right 
					#type: #number ) 
				#(#LabelSpec 
					#layout: #(#Point 10 108 ) 
					#label: 'Minimum:' ) 
				#(#LabelSpec 
					#layout: #(#Point 10 140 ) 
					#label: 'Maximum:' ) 
				#(#LabelSpec 
					#layout: #(#Point 10 172 ) 
					#label: 'Angle range:' ) 
				#(#LabelSpec 
					#layout: #(#Point 97 219 ) 
					#label: 'Units per rotation:' ) 
				#(#CheckBoxSpec 
					#layout: #(#Point 15 220 ) 
					#model: #infinite 
					#label: 'Infinite' ) 
				#(#GroupBoxSpec 
					#layout: #(#Rectangle 4 210 318 253 ) ) 
				#(#GroupBoxSpec 
					#layout: #(#Rectangle 200 103 320 172 ) ) ) ) )! !

!WheelSpec class methodsFor: 'resources'!

paletteIcon
	"UIMaskEditor new openOnClass: self andSelector: #paletteIcon"

	<resource: #image>
	^CachedImage on: (Image extent: 26@26 depth: 3 bitsPerPixel: 4 palette: (MappedPalette withColors: ((Array new: 6) at: 1 put: ColorValue black; at: 2 put: (ColorValue scaledRed: 5548 scaledGreen: 5548 scaledBlue: 5548); at: 3 put: ColorValue white; at: 4 put: (ColorValue scaledRed: 6605 scaledGreen: 6605 scaledBlue: 6605); at: 5 put: (ColorValue scaledRed: 3699 scaledGreen: 3699 scaledBlue: 3699); at: 6 put: (ColorValue scaledRed: 4227 scaledGreen: 4227 scaledBlue: 4227); yourself)) usingBits: (ByteArray fromPackedString: '@@@@@@@@@@@@@@@@@@@@@@H"H"H"H"H"H"H"H$@@@@@BL3L3L3L3L3L3L3M@@@@@@#L3L3L3L3L3L3L3P@@@@@H3L3L3L3L3L3L3L4@@@@@BL3L3L3L3L3L3L3M@@@@@@#L3L3L3L3L3L3L3P@@@@@H5UUUUUUUUUUTCL4@@@@@BMRH"H"H"H"H"@3M@@@@@@#T!!DQDQDQDQDPL3P@@@@@H5HUUUUUUUUPDCL4@@@@@BMREUIQIRTRTA@3M@@@@@@#T!!URTRT%D%@PL3P@@@@@H5HUT%D%IQIPDCL4@@@@@BMREUIQIRTRTA@3M@@@@@@#T!!@@@@@@@@@PL3P@@@@@H5HQDQDQDQDQDCL4@@@@@BL@@@@@@@@@@@@3M@@@@@@#L3L3L3L3L3L3L3P@@@@@H3L3L3L3L3L3L3L4@@@@@BL3L3L3L3L3L3L3M@@@@@@#L3L3L3L3L3L3L3P@@@@@H3L3L3L3L3L3L3L4@@@@@BL3L3L3L3L3L3L3M@@@@@ADQDQDQDQDQDQDQDP@@@@@@@@@@@@@@@@@@@@@@@@@@b'))!

paletteMonoIcon
	"UIMaskEditor new openOnClass: self andSelector: #paletteMonoIcon"

	<resource: #image>
	^CachedImage on: (Image extent: 26@26 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: #[0 0 0 0 127 255 255 0 127 255 255 0 127 255 255 0 127 255 255 0 127 255 255 0 127 255 255 0 96 0 7 0 111 255 247 0 111 255 247 0 108 0 23 0 108 181 151 0 108 181 151 0 108 181 151 0 108 181 151 0 108 0 23 0 111 255 247 0 96 0 7 0 127 255 255 0 127 255 255 0 127 255 255 0 127 255 255 0 127 255 255 0 127 255 255 0 0 0 0 0 0 0 0 0])! !

!WheelSpec class methodsFor: 'private-interface building'!

addBindingsTo: env for: inst channel: aChannel 
	| aspects updateBlock |
	super
		addBindingsTo: env
		for: inst
		channel: aChannel.
	env at: #direction put: (self
		adapt: inst
		forAspect: #direction
		channel: aChannel).
	env at: #unitsPerRotation put: (
		(PluggableAdaptor on: inst)
			getBlock: [:m | m unitsPerRotation]
			putBlock: [:m :v | m unitsPerRotation: v.
				(env at: #unitsPerRotation) changed: #value]
			updateBlock: [:m :a :p | true]).
	aspects := #(angleRange min max infinite).
	updateBlock := [aspects do: [:aspect | (env at: aspect) changed: #value]].
	aspects do: [:aspect |
		env at: aspect put: (
			(PluggableAdaptor on: inst)
				getBlock: [:m | m perform: aspect]
				putBlock: [:m :v | m perform: (aspect copyWith: $:) asSymbol with: v.
					 updateBlock value]
				updateBlock: [:m :a :p | true])].!

componentName
	^'Wheel'!

placementExtentBlock

	^nil!

slices
	^#(	(Basics basicsEditSpec)	 
		(Position propSpec PositionToolModel) )!

specGenerationBlock

	^[:ctrlr :point | WheelSpec new layout: (ctrlr gridPoint: point)]! !

!UILookPolicy methodsFor: 'building'!

wheel: wheelSpec into: builder 
	| component mdl |
	mdl := wheelSpec modelInBuilder: builder.
	component := WheelView new model: mdl.
	component
		horizontal: wheelSpec horizontal;
		min: wheelSpec min max: wheelSpec max;
		angleRange: wheelSpec angleRange;
		unitsPerRotation: wheelSpec unitsPerRotation.
	builder component: component.
	self
		setDispatcherOf: component
		fromSpec: wheelSpec
		builder: builder.
	builder wrapWith: (self simpleWrapperFor: wheelSpec).
	builder applyLayout: wheelSpec layout.
	builder wrapWith: (self simpleWidgetWrapperOn: builder spec: wheelSpec)! !

WheelView initialize!

WheelSpec initialize!


Transcript cr; show: 'To see an example, do: "WheelExample open"'!