"
COPYRIGHT (c) 1989 by 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.
"
View subclass:#Label
instanceVariableNames:'logo labelWidth labelHeight labelOriginX labelOriginY adjust
hSpace vSpace bgColor fgColor fixSize labelMsg converter
labelChannel foregroundChannel backgroundChannel'
classVariableNames:'DefaultFont DefaultForegroundColor DefaultBackgroundColor'
poolDictionaries:''
category:'Views-Layout'
!
!Label class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1989 by 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
"
This class implements labels, which are views to display a string or image.
The Label will try to do its best to make its contents fit into the
view. The contents can be a String, a collection of Strings (i.e.
a StringCollection) or a Form/Image.
The contents is drawn in fgColor/bgColor, which can be changed using:
aLabel foregroundColor:aColor
aLabel backgroundColor:aColor
When a label is assigned a contents, it will resize itself to fit
the required size. This resizing can be suppressed by setting the
fixsize attribute to true using:
aLabel sizeFixed:true
This can be used, if resizing of the label is not wanted.
However, in this case you have to make certain that the size is big enough
to hold any changed logos later. (usually, you create the label first with
the longest string first to have it compute its size, then set the fixSize
attribute to avoid resizing later).
Be careful when placing self-resizing labels into panels - by default,
panels do not react on the size change - leading to ugly looking geometry.
(but you can tell the panel to watch for changes with #elementsCHangeSize:)
The placement of the contents within the label is controlled by
the adjust attribute, it can be set with:
aLabel adjust:how
where how is one of the symbols left, #right, #center, #centerLeft or
#centerRight (see the comment in Label>>adjust:). The default is #center.
model-less operation (ok for static labels):
if no model is set, the labels contents is set with:
aLabel label:aStringOrImage
and stays constant unless changed by new calls to #label:.
model operation (ST-80 style):
labels with a model, aspectMsg and labelMsg react to
changes of the aspect, and send a labelMsg-message
to the model in order to aquire a new labelString or image.
The model should send 'self changed:aspectMsg' if it thinks the label
should change and return a string or image from the labelMsg-message.
label model:aModel.
label aspect:aspectSymbol.
label labelMessage:labelSymbol.
model sends #changed:aspectSymbol
---> label will redraw its label from value of model perform:labelSymbol
Having a labelSymbol different from the aspectSymbol allows for two labels
to react on the same aspect-change, but use different messages when asking
the model for a new label contents. By default, the labelMsg is nil,
so the label does NOT update its shown contents.
The aspectMsg defaults to #value.
channel operation (new ST/X style):
the label will react on changes of the token found in the
channels: foregroundChannel, backgroundChannel and labelChannel.
These are valueHolders and can be shared between labels.
Instance variables:
logo <Object> the logo, can be a Form, String or Text
labelWidth <Integer> the width of the logo in device units
labelHeight <Integer> the height of the logo in device units
labelOriginX <Integer> the x-position of the logo withing the Label
labelOriginY <Integer> the y-position of the logo withing the Label
adjust <Symbol> controls how the logo is positioned within the
label. Can be one of:#left,#right,#center,
#centerLeft or #centerRight (see comment in adjust:)
hSpace <Integer> number of horizontal pixels around logo
vSpace <Integer> number of vertical pixels around logo
bgColor <Color> background color
fgColor <Color> foreground color
fixSize <Boolean> if true, a change of the logo change will not
resize the label; otherwise, its size is adjusted.
default:false.
labelMsg <Symbol> if non-nil, this is sent to the model to
aquire the labelString or labelImage.
If nil, the label stays as is
styleSheet parameters:
labelForegroundColor <Color> color to draw foreground pixels (i.e. the string)
labelBackgroundColor <Color> color to draw background pixels
labelFont <Font> font to use for textual labels
"
!
examples
"
Notice, that Buttons and others inherit from Label;
therefore, the following geometry examples apply to all subclasses too.
simple (default position is 0@0):
|top l|
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label in:top.
l label:'hello world'.
top open
there is also a creation message which sets the label:
|top l|
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label label:'hello world' in:top.
top open
placement:
|top l|
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label in:top.
l label:'hello world'.
l origin:50@100.
top open
level:
|top l|
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label in:top.
l level:5.
l label:'hello world'.
l origin:50@100.
top open
another level:
|top l|
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label in:top.
l level:-1.
l label:'hello world'.
l origin:50@100.
top open
colors & font:
|top l|
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label in:top.
l level:-1.
l font:(Font family:'Times' size:18).
l foregroundColor:Color yellow.
l backgroundColor:Color red.
l label:'hello world'.
l origin:50@100.
top open
border & colors:
|top l|
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label in:top.
l level:0.
l borderWidth:1.
l borderColor:Color red.
l foregroundColor:Color green darkened.
l backgroundColor:Color green lightened.
l label:'hello world'.
l origin:50@100.
top open
adjust (resize to see):
|top l|
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label in:top.
l borderWidth:1.
l label:'default - centered'.
l origin:0.0@40.
l width:1.0.
l := Label in:top.
l borderWidth:1.
l adjust:#left.
l label:'left adjust'.
l origin:0.0@70.
l width:1.0.
l := Label in:top.
l borderWidth:1.
l adjust:#centerLeft.
l label:'centerLeft adjust and a bit too long'.
l origin:0.0@100.
l width:1.0.
l := Label in:top.
l borderWidth:1.
l adjust:#right.
l label:'right adjust'.
l origin:0.0@130.
l width:1.0.
l := Label in:top.
l borderWidth:1.
l adjust:#centerRight.
l label:'centerRight adjust and a bit too long'.
l origin:0.0@160.
l width:1.0.
top open
fitting-adjust (resize to see):
Warning: #fit is experimental and should not be used.
|top l|
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label origin:0.25 @ 0.25 corner:0.75@0.75 in:top.
l label:'stretch'.
l level:-1.
l adjust:#fit.
top open
or:
Warning: #fit is experimental and should not be used.
|top l|
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label origin:0.25 @ 0.25 corner:0.75@0.75 in:top.
l label:(Image fromFile:'bitmaps/SBrowser.xbm').
l level:-1.
l adjust:#fit.
top open
just a reminder, that instead of doing placement manually
as in ...:
|top l|
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label in:top.
l borderWidth:1.
l label:'default - centered'.
l origin:0.1@70.
l width:0.8.
l := Label in:top.
l borderWidth:1.
l adjust:#left.
l label:'left adjust'.
l origin:0.1@100.
l width:0.8.
l := Label in:top.
l borderWidth:1.
l adjust:#right.
l label:'right adjust'.
l origin:0.1@130.
l width:0.8.
top open
... it is much easier, to use a geometry handler, such as
a VerticalPanel. Try:
|top panel l|
top := StandardSystemView new.
top extent:(200 @ 200).
panel := VerticalPanelView
origin:0.0 @ 0.0
corner:1.0 @ 1.0
in:top.
panel horizontalLayout:#fit.
panel verticalLayout:#center.
l := Label in:panel.
l borderWidth:1.
l label:'default - centered'.
l := Label in:panel.
l borderWidth:1.
l adjust:#left.
l label:'left adjust'.
l := Label in:panel.
l borderWidth:1.
l adjust:#right.
l label:'right adjust'.
top open
labels with bitmaps or images:
|top l|
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label in:top.
l level:-1.
l label:((Image fromFile:'bitmaps/garfield.gif') magnifyBy:0.2 @ 0.2).
l origin:50@100.
top open
Channel operation
-----------------
|top panel logoChannel fgChannel bgChannel l b|
top := StandardSystemView new.
top extent:(450 @ 200).
panel := HorizontalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
l := Label in:panel.
l level:-1.
l label:'change my colors'.
l origin:50@100.
l sizeFixed:true.
fgChannel := Color blue asValue.
bgChannel := Color grey asValue.
logoChannel := 'change me' asValue.
b := Toggle label:'change fg' in:panel. b showLamp:false; onLevel:-2.
b pressAction:[fgChannel value:Color red].
b releaseAction:[fgChannel value:Color blue].
b := Toggle label:'change bg' in:panel.
b pressAction:[bgChannel value:Color yellow].
b releaseAction:[bgChannel value:Color grey].
b := Toggle label:'change text' in:panel.
b pressAction:[logoChannel value:'wow'].
b releaseAction:[logoChannel value:'not bad' ].
l labelChannel:logoChannel.
l foregroundChannel:fgChannel.
l backgroundChannel:bgChannel.
top open
multiple labels on one channel:
|l1 l2 b conv|
l1 := Label label:'label1'.
l2 := Label label:'label2'.
b := Button label:'change'.
conv := (ConvertedValue new
conversion:[:input |
input ifTrue:[
Color red
] ifFalse:[
Color blue
]]).
conv value:false.
b controller pressChannel:conv.
l1 foregroundChannel:conv.
l2 foregroundColor:Color white; backgroundChannel:conv.
b open.
l1 open.
l2 open.
MVC operation
-------------
model provides the label):
(have to use a plug to simulate a model which responds to
the #someAspect message):
|top l model|
model := Plug new.
model respondTo:#someAspect with:['models labelString'].
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label in:top.
l model:model; labelMessage:#someAspect.
top open
...
model changed:#someAspect
...
concrete example (track a counters value):
(here, the default aspect #value is used both to notify the label about
changes and to aquire a new value from the model).
|top l model|
model := ValueHolder new.
model value:0.
[
1 to:20 do:[:i |
(Delay forSeconds:1) wait.
model value:i
].
top destroy
] fork.
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label in:top.
l level:-1.
l model:model; labelMessage:#value.
top open
with a printConverter:
|top l model|
model := Date today asValue.
[
1 to:50 do:[:i |
(Delay forSeconds:1) wait.
model value:(model value addDays:1)
].
top destroy
] fork.
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label in:top.
l level:-1.
l converter:(PrintConverter new initForDate).
l model:model; labelMessage:#value.
top open
model changes aspect after a while; two labels on the same model:
|top l model|
model := Plug new.
model respondTo:#labelValue1 with:['models labelString1'].
model respondTo:#labelValue2 with:['models labelString2'].
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label origin:0.0@0.0 corner:1.0@0.5 in:top.
l model:model; aspect:#someAspect; labelMessage:#labelValue1.
l := Label origin:0.0@0.5 corner:1.0@1.0 in:top.
l model:model; aspect:#someAspect; labelMessage:#labelValue2.
top open.
(Delay forSeconds:5) wait.
model respondTo:#labelValue1 with:['new string1'].
model respondTo:#labelValue2 with:['new string2'].
model changed:#someAspect
plugged MVC operation (getBlock returns the label):
|top l model|
model := PluggableAdaptor new
getBlock:[:m | 'hello']
putBlock:nil
updateBlock:nil.
top := StandardSystemView new.
top extent:(200 @ 200).
l := Label origin:0.0@0.0 corner:1.0@0.5 in:top.
l model:model; labelMessage:#value.
top open.
use different label-selectors to access fields of a complex model:
|top panel model|
model := Plug new.
model respondTo:#field1 with:['value1'].
model respondTo:#field2 with:['value2'].
model respondTo:#field3 with:['value3'].
model respondTo:#field4 with:['value4'].
top := StandardSystemView new.
panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
panel elementsChangeSize:true.
panel addSubView:((Label on:model) labelMessage:#field1).
panel addSubView:((Label on:model) labelMessage:#field2).
panel addSubView:((Label on:model) labelMessage:#field3).
panel addSubView:((Label on:model) labelMessage:#field4).
top extent:(200 @ 200).
top open.
(Delay forSeconds:5) wait.
model respondTo:#field2 with:['new value2'].
model changed:#value
same as above, using default aspects in the label, and an adaptor
to translate aspects:
|top panel model v1|
model := Plug new.
model respondTo:#field1 with:[v1].
model respondTo:#field1: with:[:arg | v1 := arg. model changed:#field1].
model respondTo:#field2 with:['value2'].
model respondTo:#field2: with:[:arg |].
model respondTo:#field3 with:['value3'].
model respondTo:#field3: with:[:arg |].
model respondTo:#field4 with:['value4'].
model respondTo:#field4: with:[:arg |].
top := StandardSystemView new.
panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
panel elementsChangeSize:true.
panel addSubView:((Label on:((AspectAdaptor subject:model) forAspect:#field1)) labelMessage:#value).
panel addSubView:((Label on:((AspectAdaptor subject:model) forAspect:#field2)) labelMessage:#value).
panel addSubView:((Label on:((AspectAdaptor subject:model) forAspect:#field3)) labelMessage:#value).
panel addSubView:((Label on:((AspectAdaptor subject:model) forAspect:#field4)) labelMessage:#value).
top extent:(200 @ 200).
top open.
(Delay forSeconds:5) wait.
model field1:'new value1'.
use an adapter to access fields of a complex model:
|top l panel model|
model := #('one' 'two' 'three') asValue.
top := StandardSystemView new.
panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
panel elementsChangeSize:true.
panel addSubView:((Label on:(ProtocolAdaptor
subjectChannel:model
accessPath:#(1))) labelMessage:#value).
panel addSubView:((Label on:(ProtocolAdaptor
subjectChannel:model
accessPath:#(2))) labelMessage:#value).
panel addSubView:((Label on:(ProtocolAdaptor
subjectChannel:model
accessPath:#(3))) labelMessage:#value).
top extent:(200 @ 200).
top open.
(Delay forSeconds:5) wait.
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'!
form:aForm
"return a new Label showing a form.
OBSOLETE: you should now use #label: for both text and bitmap labels."
^ (self on:Screen current) form:aForm
!
form:aForm in:aView
"return a new Label showing a form.
OBSOLETE: you should now use #label:in: for both text and bitmap labels."
^ (self in:aView) form:aForm
! !
!Label class methodsFor:'defaults'!
defaultExtent
"return default extent"
^ 16 @ 16
!
defaultFont
^ DefaultFont notNil ifTrue:[DefaultFont] ifFalse:[super defaultFont]
!
updateStyleCache
DefaultForegroundColor := StyleSheet colorAt:'labelForegroundColor'.
DefaultForegroundColor isNil ifTrue:[
DefaultForegroundColor := StyleSheet colorAt:'foregroundColor' default:Black.
].
DefaultBackgroundColor := StyleSheet colorAt:'labelBackgroundColor'.
DefaultBackgroundColor isNil ifTrue:[
DefaultForegroundColor := StyleSheet colorAt:'backgroundColor'.
].
DefaultFont := StyleSheet fontAt:'labelFont'.
"
self updateStyleCache
"
! !
!Label methodsFor:'accessing-channels'!
backgroundChannel:aValueHolder
|prev|
prev := backgroundChannel.
backgroundChannel := aValueHolder.
self setupChannel:aValueHolder for:#backgroundChannelChanged withOld:prev
!
foregroundChannel:aValueHolder
|prev|
prev := foregroundChannel.
foregroundChannel := aValueHolder.
self setupChannel:aValueHolder for:#foregroundChannelChanged withOld:prev
!
labelChannel:aValueHolder
|prev|
prev := labelChannel.
labelChannel := aValueHolder.
self setupChannel:aValueHolder for:#labelChannelChanged withOld:prev
! !
!Label methodsFor:'accessing-colors'!
backgroundColor
"return the background color"
^ bgColor
!
backgroundColor:aColor
"set the background color"
bgColor := aColor on:device.
shown ifTrue:[self redraw]
!
foregroundColor
"return the foreground color"
^ fgColor
!
foregroundColor:aColor
"set the foreground color"
fgColor := aColor on:device.
shown ifTrue:[self redraw]
!
foregroundColor:fg backgroundColor:bg
"set the colors to be used for drawing"
fgColor := fg on:device.
bgColor := bg on:device.
shown ifTrue:[self redraw]
! !
!Label methodsFor:'accessing-contents'!
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:aForm
!
label
"return the labels string or image"
^ logo
!
label:aStringOrFormOrImage
"set the labelString or image; adjust extent if not already realized and
not fixedSize"
(aStringOrFormOrImage ~~ logo) ifTrue:[
"/
"/ avoid recompute of size, if its an image with
"/ the same size
"/
aStringOrFormOrImage isImageOrForm ifTrue:[
logo notNil ifTrue:[
logo isImageOrForm ifTrue:[
logo extent = aStringOrFormOrImage extent ifTrue:[
logo := aStringOrFormOrImage.
^ self
]
]
]
] ifFalse:[
(logo = aStringOrFormOrImage) ifTrue:[
^ self
]
].
logo := aStringOrFormOrImage.
self newLayout
]
!
labelString:aString
"for ST-80 compatibility: same as #label:
set the label-string; adjust extent if not already realized and not fixedSize"
self label:aString
!
labelWidth
"return the logos width in pixels"
^ labelWidth
!
logo:something
"set the labels form or string.
OBSOLETE: the old version used #form: for images and #label: for strings.
you should now use #label: for any."
self label:something
! !
!Label methodsFor:'accessing-layout'!
adjust
"return the adjust symbol"
^ adjust
!
adjust:how
"set the adjust, how which must be one of
#left -> left adjust logo
#right -> right adjust logo
#center -> center logo
#centerRight -> center logo; if no fit, right adjust
(use with filenames, where the interresting part is
at the right if the label is too small)
#centerLeft -> center logo; if it does not fit, left adjust it
(use with strings where the interresting part is at the
left if the label is too small)
"
(adjust ~~ how) ifTrue:[
adjust := how.
self newLayout
]
!
font:aFont
"set the font - if I'm not realized and not fixedSize, adjust my size"
(aFont ~~ font) ifTrue:[
super font:(aFont on:device).
self newLayout
]
!
horizontalSpace:aNumber
"set the number of pixels by which the logo
is horizontally inset from the border"
hSpace := aNumber.
self newLayout
!
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
!
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
]
]
! !
!Label methodsFor:'initialization'!
initStyle
super initStyle.
DefaultFont notNil ifTrue:[font := DefaultFont on:device].
DefaultBackgroundColor notNil ifTrue:[
bgColor := DefaultBackgroundColor on:device
] ifFalse:[
bgColor := viewBackground on:device.
].
DefaultForegroundColor notNil ifTrue:[
fgColor := DefaultForegroundColor on:device
] ifFalse:[
fgColor := Black on:device.
]
!
initialize
super initialize.
font := font on:device.
self height:(font height + font descent).
adjust := #center.
labelOriginX := labelOriginY := 0.
labelWidth := labelHeight := 0.
logo := nil.
fixSize := false.
hSpace := (self horizontalPixelPerMillimeter:0.5) rounded.
vSpace := (self verticalPixelPerMillimeter:0.25) rounded
!
recreate
"after snapin, labels dimensions may have changed due to
different font parameters"
super recreate.
font := font on:device.
self computeLabelSize.
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
|cutOff mustClear|
cutOff := margin * 2.
mustClear := true.
(logo notNil and:[logo isImageOrForm]) ifTrue:[
(labelOriginX == 0 and:[labelOriginY == 0]) ifTrue:[
logo width >= (width - cutOff) ifTrue:[
logo height >= (height - cutOff) ifTrue:[
"no need to clear before - avoid flicker"
mustClear := false
]
]
].
].
mustClear ifTrue:[
self paint:bg.
self fillRectangleX:margin y:margin
width:(width - cutOff)
height:(height - cutOff).
].
!
drawWith:fg and:bg
"redraw my label with fg/bg - this generic method is also used by subclasses
(especially Button) to redraw the logo in different colors."
|x y scaleH scaleV nW nH hSep vSep m2|
self clearInsideWith:bg.
logo notNil ifTrue:[
self paint:fg on:bg.
m2 := margin * 2.
hSep := (hSpace*2).
vSep := (vSpace*2).
logo isImageOrForm ifTrue:[
x := labelOriginX.
y := labelOriginY.
adjust == #fit ifTrue:[
scaleH := ((width - hSep) / (logo width)) asFloat.
scaleV := ((height - vSep) / (logo height)) asFloat.
self scale:(scaleH @ scaleV).
x := transformation applyInverseScaleX:x.
y := transformation applyInverseScaleY:y.
].
logo := logo on:device.
"/ self background:bg.
self displayOpaqueForm:logo x:x y:y
] ifFalse:[
x := labelOriginX + hSpace.
y := labelOriginY + (font ascent) + vSpace.
adjust == #fit ifTrue:[
scaleH := ((width - m2 - hSep) / (labelWidth - hSpace)) asFloat.
scaleV := ((height - m2 - vSep) / (labelHeight - vSpace)) asFloat.
self scale:(scaleH min: scaleV).
x := transformation applyInverseScaleX:x.
y := y - font ascent + (transformation applyScaleY:font ascent).
y := transformation applyInverseScaleY:y.
scaleH < scaleV ifTrue:[
nH := labelHeight * scaleH.
"/ now, center vertically
y := y + ((height - nH - m2 - vSep) / scaleH / 2).
].
scaleV < scaleH ifTrue:[
"/ now, center horizontally
nW := labelWidth * scaleV.
x := x + ((width - nW - m2 - hSep) / scaleV / 2)
].
].
logo isString ifTrue:[
self displayString:logo x:x y:y
] ifFalse:[
logo do:[ :line |
self displayString:(line printString) x:x y:y.
y := y + (font height)
]
].
].
adjust == #fit ifTrue:[
self scale:1
].
]
!
redraw
"redraw my label"
shown ifTrue:[
self drawWith:fgColor and:bgColor
]
! !
!Label methodsFor:'resizing'!
forceResize
"resize myself to make text fit into myself. Here, this is done even if
fixSize is set."
logo notNil ifTrue:[
self extent:self preferredExtent.
self computeLabelOrigin
]
!
resize
"resize myself to make text fit into myself.
but only do so, if I am not fixedSize and I have NOT been
given a relative extent or an extend computation block."
(logo notNil
and:[fixSize not
and:[relativeExtent isNil
and:[extentRule isNil
and:[relativeCorner isNil
and:[cornerRule isNil]]]]]) ifTrue:[
self forceResize
] ifFalse:[
self computeLabelOrigin
]
! !