--- a/Label.st Thu Nov 23 11:44:18 1995 +0100
+++ b/Label.st Thu Nov 23 15:37:40 1995 +0100
@@ -10,12 +10,10 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:13:27 am'!
-
View subclass:#Label
instanceVariableNames:'logo labelWidth labelHeight labelOriginX labelOriginY adjust
- hSpace vSpace bgColor fgColor fixSize labelMsg converter
- labelChannel foregroundChannel backgroundChannel'
+ hSpace vSpace bgColor fgColor fixSize labelMsg converter
+ labelChannel foregroundChannel backgroundChannel'
classVariableNames:'DefaultFont DefaultForegroundColor DefaultBackgroundColor'
poolDictionaries:''
category:'Views-Layout'
@@ -37,10 +35,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Label.st,v 1.34 1995-11-16 15:21:04 cg Exp $'
-!
-
documentation
"
This class implements labels, which are views to display a string or image.
@@ -678,6 +672,10 @@
model value:#('oneone' 'twotwo' 'threethree').
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/Label.st,v 1.35 1995-11-23 14:36:21 cg Exp $'
! !
!Label class methodsFor:'instance creation'!
@@ -724,29 +722,15 @@
"
! !
-!Label methodsFor:'event handling'!
+!Label methodsFor:'accessing-channels'!
-sizeChanged:how
- "sent whenever size is changed by someone else - recompute the
- logos position within the View."
-
- |prevPosition|
+backgroundChannel:aValueHolder
+ |prev|
- super sizeChanged:how.
- prevPosition := labelOriginX.
- self computeLabelOrigin
- shown ifTrue:[
- (adjust == #fit
- or:[labelOriginX ~~ prevPosition
- or:[how ~~ #smaller]]) ifTrue:[
- "/ self clear.
- self redraw.
- self redrawEdges
- ]
- ]
-! !
-
-!Label methodsFor:'accessing-channels'!
+ prev := backgroundChannel.
+ backgroundChannel := aValueHolder.
+ self setupChannel:aValueHolder for:#backgroundChannelChanged withOld:prev
+!
foregroundChannel:aValueHolder
|prev|
@@ -756,14 +740,6 @@
self setupChannel:aValueHolder for:#foregroundChannelChanged withOld:prev
!
-backgroundChannel:aValueHolder
- |prev|
-
- prev := backgroundChannel.
- backgroundChannel := aValueHolder.
- self setupChannel:aValueHolder for:#backgroundChannelChanged withOld:prev
-!
-
labelChannel:aValueHolder
|prev|
@@ -772,53 +748,18 @@
self setupChannel:aValueHolder for:#labelChannelChanged withOld:prev
! !
-!Label methodsFor:'accessing-mvc'!
-
-model:aModel
- super model:aModel.
- self getLabelFromModel.
-!
+!Label methodsFor:'accessing-colors'!
-labelMessage
- "return the symbol used to aquire the labelString/image from the model
- when the aspect changes.
- The default is nil, which means: leave the label unchanged."
+backgroundColor
+ "return the background color"
- ^ labelMsg
+ ^ bgColor
!
-labelMessage:aSymbol
- "set the symbol used to aquire the labelString/image from the model.
- The default is nil, which means: leave the label unchanged."
-
- labelMsg ~~ aSymbol ifTrue:[
- labelMsg := aSymbol.
- self getLabelFromModel
- ]
-!
-
-addModelInterfaceTo:aDictionary
- "see comment in View>>modelInterface"
+backgroundColor:aColor
+ "set the background color"
- super addModelInterfaceTo:aDictionary.
- aDictionary at:#labelMessage put:labelMsg
-!
-
-converter:aConverter
- "set the printConverter;
- that one is asked to convert the models value to a printed
- representation (if non-nil). If nil, the model is supposed to
- return a string or bitmap image."
-
- converter := aConverter
-! !
-
-!Label methodsFor:'accessing-colors'!
-
-foregroundColor:aColor
- "set the foreground color"
-
- fgColor := aColor on:device.
+ bgColor := aColor on:device.
shown ifTrue:[self redraw]
!
@@ -828,19 +769,13 @@
^ fgColor
!
-backgroundColor:aColor
- "set the background color"
+foregroundColor:aColor
+ "set the foreground color"
- bgColor := aColor on:device.
+ fgColor := aColor on:device.
shown ifTrue:[self redraw]
!
-backgroundColor
- "return the background color"
-
- ^ bgColor
-!
-
foregroundColor:fg backgroundColor:bg
"set the colors to be used for drawing"
@@ -851,11 +786,17 @@
!Label methodsFor:'accessing-contents'!
-labelString:aString
- "for ST-80 compatibility: same as #label:
- set the label-string; adjust extent if not already realized and not fixedSize"
+form:aForm
+ "set the labels form; adjust extent if not already realized.
+ OBSOLETE: you should now use #label: for both strings and images"
- self label:aString
+ self label:aForm
+!
+
+label
+ "return the labels string or image"
+
+ ^ logo
!
label:aStringOrFormOrImage
@@ -886,11 +827,17 @@
]
!
-form:aForm
- "set the labels form; adjust extent if not already realized.
- OBSOLETE: you should now use #label: for both strings and images"
+labelString:aString
+ "for ST-80 compatibility: same as #label:
+ set the label-string; adjust extent if not already realized and not fixedSize"
- self label:aForm
+ self label:aString
+!
+
+labelWidth
+ "return the logos width in pixels"
+
+ ^ labelWidth
!
logo:something
@@ -899,61 +846,14 @@
you should now use #label: for any."
self label:something
-!
-
-label
- "return the labels string or image"
-
- ^ logo
-!
-
-labelWidth
- "return the logos width in pixels"
-
- ^ labelWidth
! !
!Label methodsFor:'accessing-layout'!
-sizeFixed:aBoolean
- "set/clear the fix-size attribute.
- If true, the receiver will not change its size when the labelString/logo
- changes. If false (the default), it will resize itself to make the logo
- fit."
-
- fixSize := aBoolean
-!
-
-sizeFixed
- "return the fix-size attribute"
-
- ^ fixSize
-!
+adjust
+ "return the adjust symbol"
-layout:something
- "OBSOLETE compatibility interface. Will vanish.
- for protocol compatibility: alias for #adjust:.
- Please use #adjust:, since #layout: conflicts with a method
- in VW (which has a completely different meaning).
- In future versions of ST/X, #layout: will behave the VW way.
- In the meantime, try to figure out what is meant ... a kludge"
-
- something isLayout ifTrue:[^ super layout:something].
-
- self obsoleteMethodWarning:'use #adjust:'.
- self adjust:something
-
- "Modified: 31.8.1995 / 23:08:13 / claus"
-!
-
-layout
- "for protocol compatibility: alias for #adjust.
- Please use #adjust, since #layout conflicts with a method
- in VW (which has a completely different meaning).
- In future versions of ST/X, #layout will behave the VW way."
-
- self obsoleteMethodWarning:'use #adjust'.
- ^ self adjust
+ ^ adjust
!
adjust:how
@@ -976,18 +876,13 @@
]
!
-adjust
- "return the adjust symbol"
-
- ^ adjust
-!
+font:aFont
+ "set the font - if I'm not realized and not fixedSize, adjust my size"
-verticalSpace:aNumber
- "set the number of pixels by which the logo
- is vertically inset from the border"
-
- vSpace := aNumber.
- self newLayout
+ (aFont ~~ font) ifTrue:[
+ super font:(aFont on:device).
+ self newLayout
+ ]
!
horizontalSpace:aNumber
@@ -998,12 +893,141 @@
self newLayout
!
-font:aFont
- "set the font - if I'm not realized and not fixedSize, adjust my size"
+layout
+ "for protocol compatibility: alias for #adjust.
+ Please use #adjust, since #layout conflicts with a method
+ in VW (which has a completely different meaning).
+ In future versions of ST/X, #layout will behave the VW way."
+
+ self obsoleteMethodWarning:'use #adjust'.
+ ^ self adjust
+!
+
+layout:something
+ "OBSOLETE compatibility interface. Will vanish.
+ for protocol compatibility: alias for #adjust:.
+ Please use #adjust:, since #layout: conflicts with a method
+ in VW (which has a completely different meaning).
+ In future versions of ST/X, #layout: will behave the VW way.
+ In the meantime, try to figure out what is meant ... a kludge"
+
+ something isLayout ifTrue:[^ super layout:something].
+
+ self obsoleteMethodWarning:'use #adjust:'.
+ self adjust:something
+
+ "Modified: 31.8.1995 / 23:08:13 / claus"
+!
+
+sizeFixed
+ "return the fix-size attribute"
+
+ ^ fixSize
+!
+
+sizeFixed:aBoolean
+ "set/clear the fix-size attribute.
+ If true, the receiver will not change its size when the labelString/logo
+ changes. If false (the default), it will resize itself to make the logo
+ fit."
+
+ fixSize := aBoolean
+!
+
+verticalSpace:aNumber
+ "set the number of pixels by which the logo
+ is vertically inset from the border"
+
+ vSpace := aNumber.
+ self newLayout
+! !
+
+!Label methodsFor:'accessing-mvc'!
+
+addModelInterfaceTo:aDictionary
+ "see comment in View>>modelInterface"
+
+ super addModelInterfaceTo:aDictionary.
+ aDictionary at:#labelMessage put:labelMsg
+!
+
+converter:aConverter
+ "set the printConverter;
+ that one is asked to convert the models value to a printed
+ representation (if non-nil). If nil, the model is supposed to
+ return a string or bitmap image."
+
+ converter := aConverter
+!
- (aFont ~~ font) ifTrue:[
- super font:(aFont on:device).
- self newLayout
+labelMessage
+ "return the symbol used to aquire the labelString/image from the model
+ when the aspect changes.
+ The default is nil, which means: leave the label unchanged."
+
+ ^ labelMsg
+!
+
+labelMessage:aSymbol
+ "set the symbol used to aquire the labelString/image from the model.
+ The default is nil, which means: leave the label unchanged."
+
+ labelMsg ~~ aSymbol ifTrue:[
+ labelMsg := aSymbol.
+ self getLabelFromModel
+ ]
+!
+
+model:aModel
+ super model:aModel.
+ self getLabelFromModel.
+! !
+
+!Label methodsFor:'change & update'!
+
+backgroundChannelChanged
+ self backgroundColor:(backgroundChannel value)
+!
+
+foregroundChannelChanged
+ self foregroundColor:(foregroundChannel value)
+!
+
+labelChannelChanged
+ self label:(labelChannel value)
+!
+
+update:something with:aParameter from:changedObject
+ "the MVC way of changing the label ..."
+
+ changedObject == model ifTrue:[
+ something == aspectMsg ifTrue:[
+ self getLabelFromModel.
+ ^ self.
+ ]
+ ].
+ ^ super update:something with:aParameter from:changedObject
+! !
+
+!Label methodsFor:'event handling'!
+
+sizeChanged:how
+ "sent whenever size is changed by someone else - recompute the
+ logos position within the View."
+
+ |prevPosition|
+
+ super sizeChanged:how.
+ prevPosition := labelOriginX.
+ self computeLabelOrigin
+ shown ifTrue:[
+ (adjust == #fit
+ or:[labelOriginX ~~ prevPosition
+ or:[how ~~ #smaller]]) ifTrue:[
+ "/ self clear.
+ self redraw.
+ self redrawEdges
+ ]
]
! !
@@ -1049,6 +1073,144 @@
self computeLabelOrigin
! !
+!Label methodsFor:'private'!
+
+computeLabelOrigin
+ "(re)compute the origin of the label whenever label or font changes"
+
+ |x y|
+
+ labelHeight isNil ifTrue:[^ self].
+
+ adjust == #fit ifTrue:[
+ labelOriginX := labelOriginY := margin.
+ ^ self
+ ].
+
+ "if it does not fit, should we make the origin visible,
+ or the center (for text, the center seems better. For images,
+ I dont really know ehich is better ...
+ The commented code below makes the origin visible
+ "
+"/ (labelHeight < height) ifTrue:[
+"/ y := (height - labelHeight) // 2
+"/ ] ifFalse:[
+"/ y := 0
+"/ ].
+
+ "always center vertically"
+ y := (height - labelHeight) // 2.
+
+ labelOriginY := y.
+
+ (((adjust == #center)
+ or:[adjust == #centerRight])
+ or:[adjust == #centerLeft]) ifTrue:[
+ " center text/form in button "
+ x := (width - labelWidth) // 2.
+ (width < labelWidth) ifTrue:[
+ "no fit"
+ (adjust == #centerLeft) ifTrue:[
+ x := margin
+ ] ifFalse:[
+ (adjust == #centerRight) ifTrue:[
+ x := width - labelWidth - margin
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ (adjust == #left) ifTrue:[
+ x := margin
+ ] ifFalse:[
+ x := width - labelWidth - margin
+ ]
+ ].
+ labelOriginX := x
+!
+
+computeLabelSize
+ "compute the extent needed to hold the label; aForm or aString"
+
+ |numberOfLines textHeight textWidth|
+
+ logo isNil ifTrue:[^ self].
+
+ logo isImageOrForm ifTrue:[
+ labelWidth := logo width.
+ labelHeight := logo height.
+ ^ self
+ ].
+
+ "must be a String or collection of strings"
+ logo isString ifTrue:[
+ numberOfLines := 1 + (logo occurrencesOf:(Character cr)).
+ (numberOfLines ~~ 1) ifTrue:[
+ logo := logo asStringCollection
+ ]
+ ] ifFalse:[
+ numberOfLines := logo size.
+ (numberOfLines <= 1) ifTrue:[
+ logo := logo asString
+ ]
+ ].
+
+"/ textHeight := font height * numberOfLines + font descent.
+ textHeight := font height * numberOfLines.
+ textWidth := font widthOf:logo.
+ labelWidth := textWidth + (hSpace * 2) .
+ labelHeight := textHeight + (vSpace * 2)
+!
+
+getLabelFromModel
+ "ask my model for the label to show.
+ Here, we use labelMsg (instead of aspectMsg).
+ This allows multiple labels to react on the same aspect,
+ but show different labels when changed
+ (also, since labelMsg defaults to nil, constant labels
+ which have a nil labelMsg will not try to aquire a labelString)."
+
+ |val|
+
+ (model notNil
+ and:[labelMsg notNil]) ifTrue:[
+ val := model perform:labelMsg.
+ converter notNil ifTrue:[
+ val := converter printStringFor:val
+ ].
+ self label:val.
+ ].
+!
+
+newLayout
+ "recompute position/size after a change
+ - helper for form:/font: etc."
+
+ self computeLabelSize.
+ fixSize ifFalse:[
+ self resize
+ ] ifTrue:[
+ self computeLabelOrigin
+ ].
+ shown ifTrue:[
+ self redraw
+ ]
+! !
+
+!Label methodsFor:'queries'!
+
+preferredExtent
+ "return my preferred extent - this is the minimum size I would like to have"
+
+ |extra|
+
+ logo notNil ifTrue:[
+ extra := margin * 2.
+ ^ (labelWidth + extra + hSpace) @ (labelHeight + extra + vSpace)
+ ].
+
+ ^ super preferredExtent
+! !
+
!Label methodsFor:'redrawing'!
clearInsideWith:bg
@@ -1156,129 +1318,6 @@
]
! !
-!Label methodsFor:'private'!
-
-getLabelFromModel
- "ask my model for the label to show.
- Here, we use labelMsg (instead of aspectMsg).
- This allows multiple labels to react on the same aspect,
- but show different labels when changed
- (also, since labelMsg defaults to nil, constant labels
- which have a nil labelMsg will not try to aquire a labelString)."
-
- |val|
-
- (model notNil
- and:[labelMsg notNil]) ifTrue:[
- val := model perform:labelMsg.
- converter notNil ifTrue:[
- val := converter printStringFor:val
- ].
- self label:val.
- ].
-!
-
-newLayout
- "recompute position/size after a change
- - helper for form:/font: etc."
-
- self computeLabelSize.
- fixSize ifFalse:[
- self resize
- ] ifTrue:[
- self computeLabelOrigin
- ].
- shown ifTrue:[
- self redraw
- ]
-!
-
-computeLabelOrigin
- "(re)compute the origin of the label whenever label or font changes"
-
- |x y|
-
- labelHeight isNil ifTrue:[^ self].
-
- adjust == #fit ifTrue:[
- labelOriginX := labelOriginY := margin.
- ^ self
- ].
-
- "if it does not fit, should we make the origin visible,
- or the center (for text, the center seems better. For images,
- I dont really know ehich is better ...
- The commented code below makes the origin visible
- "
-"/ (labelHeight < height) ifTrue:[
-"/ y := (height - labelHeight) // 2
-"/ ] ifFalse:[
-"/ y := 0
-"/ ].
-
- "always center vertically"
- y := (height - labelHeight) // 2.
-
- labelOriginY := y.
-
- (((adjust == #center)
- or:[adjust == #centerRight])
- or:[adjust == #centerLeft]) ifTrue:[
- " center text/form in button "
- x := (width - labelWidth) // 2.
- (width < labelWidth) ifTrue:[
- "no fit"
- (adjust == #centerLeft) ifTrue:[
- x := margin
- ] ifFalse:[
- (adjust == #centerRight) ifTrue:[
- x := width - labelWidth - margin
- ]
- ]
- ]
- ] ifFalse:[
- (adjust == #left) ifTrue:[
- x := margin
- ] ifFalse:[
- x := width - labelWidth - margin
- ]
- ].
- labelOriginX := x
-!
-
-computeLabelSize
- "compute the extent needed to hold the label; aForm or aString"
-
- |numberOfLines textHeight textWidth|
-
- logo isNil ifTrue:[^ self].
-
- logo isImageOrForm ifTrue:[
- labelWidth := logo width.
- labelHeight := logo height.
- ^ self
- ].
-
- "must be a String or collection of strings"
- logo isString ifTrue:[
- numberOfLines := 1 + (logo occurrencesOf:(Character cr)).
- (numberOfLines ~~ 1) ifTrue:[
- logo := logo asStringCollection
- ]
- ] ifFalse:[
- numberOfLines := logo size.
- (numberOfLines <= 1) ifTrue:[
- logo := logo asString
- ]
- ].
-
-"/ textHeight := font height * numberOfLines + font descent.
- textHeight := font height * numberOfLines.
- textWidth := font widthOf:logo.
- labelWidth := textWidth + (hSpace * 2) .
- labelHeight := textHeight + (vSpace * 2)
-! !
-
!Label methodsFor:'resizing'!
forceResize
@@ -1308,43 +1347,3 @@
]
! !
-!Label methodsFor:'change & update'!
-
-foregroundChannelChanged
- self foregroundColor:(foregroundChannel value)
-!
-
-backgroundChannelChanged
- self backgroundColor:(backgroundChannel value)
-!
-
-labelChannelChanged
- self label:(labelChannel value)
-!
-
-update:something with:aParameter from:changedObject
- "the MVC way of changing the label ..."
-
- changedObject == model ifTrue:[
- something == aspectMsg ifTrue:[
- self getLabelFromModel.
- ^ self.
- ]
- ].
- ^ super update:something with:aParameter from:changedObject
-! !
-
-!Label methodsFor:'queries'!
-
-preferredExtent
- "return my preferred extent - this is the minimum size I would like to have"
-
- |extra|
-
- logo notNil ifTrue:[
- extra := margin * 2.
- ^ (labelWidth + extra + hSpace) @ (labelHeight + extra + vSpace)
- ].
-
- ^ super preferredExtent
-! !