home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BURKS 2
/
BURKS_AUG97.ISO
/
BURKS
/
LANGUAGE
/
SMALTALK
/
TEXTBOOK
/
AP13.ST
(
.txt
)
< prev
next >
Wrap
Text File
|
1997-04-22
|
7KB
|
277 lines
'Smalltalk Textbook Appendix 13'!
EngiVariable subclass: #EngiGaugeModel
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Engi-Gauge'!
EngiGaugeModel comment:
'
Engi 0.04 (8 February 1994)
Copyright (C) 1994 by Atsushi Aoki
'!
!EngiGaugeModel methodsFor: 'initialize-release'!
initialize
self setValue: 0! !
!EngiGaugeModel methodsFor: 'accessing'!
value: aNumber
((aNumber isKindOf: Number)
and: [self value ~= aNumber])
ifTrue:
[self setValue: aNumber.
self changed: #value]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
EngiGaugeModel class
instanceVariableNames: ''!
!EngiGaugeModel class methodsFor: 'instance creation'!
new
^super new initialize! !
!EngiGaugeModel class methodsFor: 'examples'!
example1
"EngiGaugeModel example1."
| gaugeModel windowCreation |
gaugeModel := EngiGaugeModel new.
windowCreation :=
[| gaugeView edgeDecorator topWindow |
gaugeView := EngiGaugeView
on: gaugeModel
get: #value
put: #value:
valuesMinMaxDivideRound: #(-100 100 10 1 ).
edgeDecorator := LookPreferences edgeDecorator on: gaugeView.
edgeDecorator noMenuBar.
edgeDecorator noVerticalScrollBar.
edgeDecorator noHorizontalScrollBar.
topWindow := EngiTopView
model: nil
label: 'Gauge'
minimumSize: 100 @ 180.
topWindow add: edgeDecorator in: (0 @ 0 corner: 1 @ 1).
topWindow].
3 timesRepeat: [windowCreation value open].
gaugeModel inspect! !
View subclass: #EngiGaugeView
instanceVariableNames: 'getSelector putSelector minValue maxValue divideValue roundValue scalesLayout '
classVariableNames: ''
poolDictionaries: ''
category: 'Engi-Gauge'!
EngiGaugeView comment:
'
Engi 0.04 (8 February 1994)
Copyright (C) 1994 by Atsushi Aoki
'!
!EngiGaugeView methodsFor: 'accessing'!
gaugeBorder
| box x |
box := self bounds insetBy: self defaultMargin.
x := box left + self gaugeScalesExtent x + 13.
^(x @ box top corner: box corner) rounded!
gaugeScales
^self scalesLayout first!
gaugeScalesExtent
^self scalesLayout last! !
!EngiGaugeView methodsFor: 'controller accessing'!
defaultControllerClass
^EngiGaugeController! !
!EngiGaugeView methodsFor: 'displaying'!
displayBorderOn: graphicsContext
| border preferences |
border := self gaugeBorder.
preferences := LookPreferences defaultBorder.
graphicsContext lineWidth: preferences top.
graphicsContext paint: preferences topColor.
graphicsContext displayLineFrom: border bottomLeft to: border bottomRight.
graphicsContext lineWidth: preferences left.
graphicsContext paint: preferences leftColor.
graphicsContext displayLineFrom: border topRight to: border bottomRight.
graphicsContext lineWidth: preferences bottom.
graphicsContext paint: preferences bottomColor.
graphicsContext displayLineFrom: border topLeft to: border topRight.
graphicsContext lineWidth: preferences right.
graphicsContext paint: preferences rightColor.
graphicsContext displayLineFrom: border topLeft to: border bottomLeft!
displayOn: graphicsContext
self displayBorderOn: graphicsContext.
self displayScalesOn: graphicsContext.
self displayValueOn: graphicsContext!
displayScalesOn: graphicsContext
| box label location point extent |
box := self bounds insetBy: self defaultMargin.
extent := self gaugeScalesExtent.
self gaugeScales do:
[:assoc |
label := assoc key.
location := assoc value.
label := label printString asComposedText.
point := box height - (box height * location).
point := box left + (extent x - label bounds width) @ (point + box top).
point := point - (0 @ (label bounds height // 2)).
graphicsContext paint: self foregroundColor.
label displayOn: graphicsContext at: point.
point := box height - (box height * location).
point := (box left @ (point + box top) + (extent x @ 0)) rounded.
graphicsContext lineWidth: 1.
graphicsContext paint: self foregroundColor.
graphicsContext displayLineFrom: point + (3 @ 0) to: point + (7 @ 0)]!
displayValueOn: graphicsContext
| value border back fore |
value := self getValue - minValue / (maxValue - minValue).
border := self gaugeBorder insetBy: (1 @ 1 corner: 0 @ 0).
back := border origin extent: border width @ (border height - (border height * value)).
fore := back left @ back bottom corner: border corner.
graphicsContext paint: self selectionForegroundColor.
graphicsContext displayRectangle: (back rounded intersect: border).
graphicsContext paint: self selectionBackgroundColor.
graphicsContext displayRectangle: (fore rounded intersect: border)! !
!EngiGaugeView methodsFor: 'adaptor'!
getValue
^self model perform: getSelector!
putValue: aNumber
(roundValue isNil or: [roundValue = 0])
ifTrue: [self model perform: putSelector with: aNumber]
ifFalse: [self model perform: putSelector with: (aNumber roundTo: roundValue)]!
setValue: cursorPoint
| box value |
box := self gaugeBorder.
value := cursorPoint - box origin / box extent.
value := 1 - value y.
value := value * (maxValue - minValue) + minValue.
self putValue: value! !
!EngiGaugeView methodsFor: 'updating'!
update: aSymbol
aSymbol = getSelector ifTrue: [^self displayValueOn: self graphicsContext]! !
!EngiGaugeView methodsFor: 'defaults'!
defaultMargin
^Rectangle origin: (Point x: 10 y: 10)
corner: (Point x: 10 y: 10)! !
!EngiGaugeView methodsFor: 'private'!
on: aModel get: getSymbol put: putSymbol valuesMinMaxDivideRound: anArray
| min max div rnd |
min := anArray at: 1.
max := anArray at: 2.
div := anArray at: 3.
rnd := anArray at: 4.
self model: aModel.
getSelector := getSymbol.
putSelector := putSymbol.
minValue := min min: max.
maxValue := max max: min.
divideValue := div rounded max: 1.
roundValue := max - min min: (rnd max: 0).
self scalesLayout!
scalesLayout
scalesLayout isNil
ifTrue:
[| labels increment extent value location |
labels := OrderedCollection new.
increment := maxValue - minValue / divideValue.
labels add: minValue -> 0.
extent := minValue printString asComposedText bounds extent.
value := minValue.
location := 0.
divideValue - 1
timesRepeat:
[value := value + increment.
location := 1 / divideValue + location.
labels add: value -> location.
extent := extent max: value printString asComposedText bounds extent].
labels add: maxValue -> 1.
extent := extent max: maxValue printString asComposedText bounds extent.
scalesLayout := Array with: labels asArray with: extent].
^scalesLayout! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
EngiGaugeView class
instanceVariableNames: ''!
!EngiGaugeView class methodsFor: 'instance creation'!
on: aModel get: getSymbol put: putSymbol valuesMinMaxDivideRound: anArray
^self new
on: aModel
get: getSymbol
put: putSymbol
valuesMinMaxDivideRound: anArray! !
Controller subclass: #EngiGaugeController
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Engi-Gauge'!
EngiGaugeController comment:
'
Engi 0.04 (8 February 1994)
Copyright (C) 1994 by Atsushi Aoki
'!
!EngiGaugeController methodsFor: 'control defaults'!
controlActivity
| box block point |
box := view gaugeBorder.
block := [:p | box origin <= p and: [p <= box corner]].
[sensor redButtonPressed
and:
[point := sensor cursorPoint.
block value: point]]
whileTrue:
[view setValue: point.
self poll]! !