diff -r d2888811c664 -r 01f3cbb8e20e Label.st --- 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 -! !