[squeak-dev] The Trunk: Morphic-mt.1427.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun May 6 13:04:12 UTC 2018
Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.1427.mcz
==================== Summary ====================
Name: Morphic-mt.1427
Author: mt
Time: 6 May 2018, 3:03:37.219836 pm
UUID: 5d8b170c-c236-574f-b8e6-b541ccf29d48
Ancestors: Morphic-mt.1426
Refactoring of BorderedMorph to make use of BorderStyle like regular morphs do. Maybe, in the future, we can get rid of BorderedMorph.
It covers:
- No instVar access to borderColor and borderWidth but message sends.
- No #inset or #raised anymore when asking a morph for its #borderColor. Just colors.
- Copying the prototypical border styles from the UI theme when used in morphs.
- A post-load script that updates all your morphs in the image. Not that important but good for keeping your current tools opened.
Note that there is no support for rounded raised/inset boarders at the moment.
=============== Diff against Morphic-mt.1426 ===============
Item was changed:
----- Method: BorderStyle class>>borderStyleForSymbol: (in category 'instance creation') -----
borderStyleForSymbol: sym
"Answer a border style corresponding to the given symbol"
| aSymbol |
aSymbol := sym == #none ifTrue: [#simple] ifFalse: [sym].
+ ^ (self borderStyleChoices includes: aSymbol)
+ ifTrue: [self perform: aSymbol]
+ ifFalse: [nil]
- ^ self perform: aSymbol
"
| aSymbol selector |
aSymbol := sym == #none ifTrue: [#simple] ifFalse: [sym].
selector := Vocabulary eToyVocabulary translationKeyFor: aSymbol.
selector isNil ifTrue: [selector := aSymbol].
^ self perform: selector
"
!
Item was removed:
- ----- Method: BorderStyle>>colorsAtCorners (in category 'accessing') -----
- colorsAtCorners
- ^Array new: 4 withAll: self color!
Item was removed:
- ----- Method: BorderStyle>>dotOfSize:forDirection: (in category 'accessing') -----
- dotOfSize: diameter forDirection: aDirection
- | form |
- form := Form extent: diameter at diameter depth: Display depth.
- form getCanvas fillOval: form boundingBox color: self color.
- ^form!
Item was removed:
- ----- Method: BorderStyle>>widthForRounding (in category 'accessing') -----
- widthForRounding
- ^self width!
Item was changed:
----- Method: BorderedMorph>>acquireBorderWidth: (in category 'geometry') -----
acquireBorderWidth: aBorderWidth
"Gracefully acquire the new border width, keeping the interior area intact and not seeming to shift"
| delta |
(delta := aBorderWidth- self borderWidth) = 0 ifTrue: [^ self].
self bounds: ((self bounds origin - (delta @ delta)) corner: (self bounds corner + (delta @ delta))).
+ self borderWidth: aBorderWidth.!
- self borderWidth: aBorderWidth.
- self layoutChanged!
Item was removed:
- ----- Method: BorderedMorph>>borderColor (in category 'accessing') -----
- borderColor
- ^ borderColor!
Item was changed:
----- Method: BorderedMorph>>borderColor: (in category 'accessing') -----
+ borderColor: aColorOrSymbolOrNil
+
+ super borderColor: aColorOrSymbolOrNil.
+
+ self flag: #compatibility. "mt: For older code, update the instance variables. Should be removed in the future."
+ borderColor := self borderStyle color.!
- borderColor: colorOrSymbolOrNil
- self doesBevels ifFalse:[
- colorOrSymbolOrNil isColor ifFalse:[^self]].
- borderColor = colorOrSymbolOrNil ifFalse: [
- borderColor := colorOrSymbolOrNil.
- self changed].
- !
Item was changed:
----- Method: BorderedMorph>>borderInitialize (in category 'initialization') -----
borderInitialize
"initialize the receiver state related to border"
+
+ self borderStyle: (
+ self defaultBorderStyle
+ baseColor: self defaultBorderColor;
+ width: self defaultBorderWidth;
+ trackColorFrom: self;
+ yourself).!
- borderColor:= self defaultBorderColor.
- borderWidth := self defaultBorderWidth!
Item was changed:
+ ----- Method: BorderedMorph>>borderInset (in category 'initialization') -----
- ----- Method: BorderedMorph>>borderInset (in category 'accessing') -----
borderInset
+ "Change border to inset. Preserve width and color."
+
+ self borderStyle: (
+ BorderStyle inset
+ width: self borderStyle width;
+ baseColor: Color transparent;
+ trackColorFrom: self;
+ yourself).!
- self borderColor: #inset!
Item was changed:
+ ----- Method: BorderedMorph>>borderRaised (in category 'initialization') -----
- ----- Method: BorderedMorph>>borderRaised (in category 'accessing') -----
borderRaised
+ "Change border to inset. Preserve width and color."
+
+ self borderStyle: (
+ BorderStyle raised
+ width: self borderStyle width;
+ baseColor: Color transparent;
+ trackColorFrom: self;
+ yourself).!
- self borderColor: #raised!
Item was added:
+ ----- Method: BorderedMorph>>borderSimple (in category 'initialization') -----
+ borderSimple
+ "Change border to simple. Preserve width and color."
+
+ self borderStyle: (
+ BorderStyle simple
+ width: self borderStyle width;
+ baseColor: self borderStyle color; "Override any raised/inset specials."
+ trackColorFrom: self;
+ yourself).!
Item was removed:
- ----- Method: BorderedMorph>>borderStyle (in category 'accessing') -----
- borderStyle
- "Work around the borderWidth/borderColor pair"
-
- | style |
- borderColor ifNil: [^BorderStyle default].
- borderWidth isZero ifTrue: [^BorderStyle default].
- style := self valueOfProperty: #borderStyle ifAbsent: [BorderStyle default].
- (borderWidth = style width and:
- ["Hah!! Try understanding this..."
-
- borderColor == style style or:
- ["#raised/#inset etc"
-
- #simple == style style and: [borderColor = style color]]])
- ifFalse:
- [style := borderColor isColor
- ifTrue: [BorderStyle width: borderWidth color: borderColor]
- ifFalse: [(BorderStyle perform: borderColor) width: borderWidth "argh."].
- self setProperty: #borderStyle toValue: style].
- ^style trackColorFrom: self!
Item was changed:
----- Method: BorderedMorph>>borderStyle: (in category 'accessing') -----
borderStyle: aBorderStyle
- "Work around the borderWidth/borderColor pair"
+ super borderStyle: aBorderStyle.
- aBorderStyle = self borderStyle ifTrue: [^self].
- "secure against invalid border styles"
- (self canDrawBorder: aBorderStyle)
- ifFalse:
- ["Replace the suggested border with a simple one"
+ self flag: #compatibility. "mt: For older code, update the instance variables. Should be removed in the future."
- ^self borderStyle: (BorderStyle width: aBorderStyle width
- color: (aBorderStyle trackColorFrom: self) color)].
- aBorderStyle width = self borderStyle width ifFalse: [self changed].
- (aBorderStyle isNil or: [aBorderStyle == BorderStyle default])
- ifTrue:
- [self removeProperty: #borderStyle.
- borderWidth := 0.
- ^self changed].
- self setProperty: #borderStyle toValue: aBorderStyle.
borderWidth := aBorderStyle width.
+ borderColor := aBorderStyle color.!
- borderColor := aBorderStyle style == #simple
- ifTrue: [aBorderStyle color]
- ifFalse: [aBorderStyle style].
- self changed!
Item was removed:
- ----- Method: BorderedMorph>>borderWidth (in category 'accessing') -----
- borderWidth
- ^ borderWidth!
Item was changed:
----- Method: BorderedMorph>>borderWidth: (in category 'accessing') -----
borderWidth: anInteger
+
+ super borderWidth: anInteger.
+
+ self flag: #compatibility. "mt: For older code, update the instance variables. Should be removed in the future."
+ borderWidth := self borderStyle width.!
- borderColor ifNil: [borderColor := Color black].
- borderWidth := anInteger max: 0.
- self changed!
Item was changed:
----- Method: BorderedMorph>>changeBorderWidth: (in category 'menu') -----
changeBorderWidth: evt
| handle origin aHand newWidth oldWidth |
aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand].
origin := aHand position.
+ oldWidth := self borderWidth.
- oldWidth := borderWidth.
(handle := HandleMorph new)
forEachPointDo:
[:newPoint | handle removeAllMorphs.
handle addMorph:
(LineMorph from: origin to: newPoint color: Color black width: 1).
newWidth := (newPoint - origin) r asInteger // 5.
self borderWidth: newWidth]
lastPointDo:
[:newPoint | handle deleteBalloon.
self halo ifNotNil: [:halo | halo addHandles].
self rememberCommand:
(Command new cmdWording: 'border change' translated;
undoTarget: self selector: #borderWidth: argument: oldWidth;
redoTarget: self selector: #borderWidth: argument: newWidth)].
aHand attachMorph: handle.
handle setProperty: #helpAtCenter toValue: true.
handle showBalloon:
'Move cursor farther from
this point to increase border width.
Click when done.' translated hand: evt hand.
handle startStepping!
Item was added:
+ ----- Method: BorderedMorph>>defaultBorderStyle (in category 'initialization') -----
+ defaultBorderStyle
+ ^ BorderStyle simple!
Item was removed:
- ----- Method: BorderedMorph>>doesBevels (in category 'accessing') -----
- doesBevels
- "To return true means that this object can show bevelled borders, and
- therefore can accept, eg, #raised or #inset as valid borderColors.
- Must be overridden by subclasses that do not support bevelled borders."
-
- ^ true!
Item was changed:
----- Method: BorderedMorph>>hasTranslucentColor (in category 'accessing') -----
hasTranslucentColor
"Answer true if this any of this morph is translucent but not transparent."
+ (self color isColor and: [self color isTranslucentColor]) ifTrue: [^ true].
+ (self borderColor isColor and: [self borderColor isTranslucentColor]) ifTrue: [^ true].
- (color isColor and: [color isTranslucentColor]) ifTrue: [^ true].
- (borderColor isColor and: [borderColor isTranslucentColor]) ifTrue: [^ true].
^ false
!
Item was changed:
----- Method: Canvas>>frameAndFillRoundRect:radius:fillStyle:borderStyle: (in category 'drawing-rectangles') -----
frameAndFillRoundRect: aRectangle radius: cornerRadius fillStyle: fillStyle borderStyle: borderStyle
self
+ frameAndFillRoundRect: aRectangle
+ radius: cornerRadius
+ fillStyle: fillStyle asColor
- frameAndFillRectangle: aRectangle
- fillColor: fillStyle asColor
borderWidth: borderStyle width
borderColor: borderStyle color.!
Item was added:
+ ----- Method: Canvas>>frameRoundRect:radius:borderStyle: (in category 'drawing-rectangles') -----
+ frameRoundRect: aRectangle radius: radius borderStyle: borderStyle
+
+ self
+ frameRoundRect: aRectangle
+ radius: radius
+ width: borderStyle width
+ color: borderStyle color.!
Item was removed:
- ----- Method: ComplexBorder>>widthForRounding (in category 'accessing') -----
- widthForRounding
- ^0!
Item was changed:
----- Method: DialogWindow>>setDefaultParameters (in category 'initialization') -----
setDefaultParameters
"change the receiver's appareance parameters"
self
color: (self userInterfaceTheme color ifNil: [Color white]);
+ borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle simple]) copy;
- borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]);
borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]);
borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]);
layoutInset: ((self class roundedDialogCorners and: [self class gradientDialog])
"This check compensates a bug in balloon."
ifTrue: [0] ifFalse: [self borderWidth negated asPoint]).
Preferences menuAppearance3d ifTrue: [self addDropShadow].!
Item was changed:
----- Method: DialogWindow>>setTitleParameters (in category 'initialization') -----
setTitleParameters
(self submorphNamed: #title) ifNotNil: [:title |
title
fillStyle: (self class gradientDialog
ifFalse: [SolidFillStyle color: (self userInterfaceTheme titleColor ifNil: [Color r: 0.658 g: 0.678 b: 0.78])]
ifTrue: [self titleGradientFor: title from: (self userInterfaceTheme titleColor ifNil: [Color r: 0.658 g: 0.678 b: 0.78])]);
+ borderStyle: (self userInterfaceTheme titleBorderStyle ifNil: [BorderStyle simple]) copy;
- borderStyle: (self userInterfaceTheme titleBorderStyle ifNil: [BorderStyle default]);
borderColor: (self userInterfaceTheme titleBorderColor ifNil: [Color r: 0.6 g: 0.7 b: 1]);
borderWidth: (self userInterfaceTheme titleBorderWidth ifNil: [0]);
cornerStyle: (self wantsRoundedCorners ifTrue: [#rounded] ifFalse: [#square]);
vResizing: #shrinkWrap;
hResizing: #spaceFill;
wrapCentering: #center;
cellPositioning: #center;
cellInset: 0;
layoutInset: (5 at 3 corner: 5@ (2+(self wantsRoundedCorners ifFalse: [0] ifTrue: [self cornerRadius])))].
titleMorph ifNotNil: [
| fontToUse colorToUse |
fontToUse := self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont].
colorToUse := self userInterfaceTheme titleTextColor ifNil: [Color black].
"Temporary HACK for 64-bit CI build. Can be removed in the future."
titleMorph contents isText ifFalse: [^ self].
titleMorph contents
addAttribute: (TextFontReference toFont: fontToUse);
addAttribute: (TextColor color: colorToUse).
titleMorph releaseParagraph; changed].!
Item was changed:
----- Method: DockingBarMorph>>applyUserInterfaceTheme (in category 'update') -----
applyUserInterfaceTheme
| colorToUse |
gradientRamp := nil.
super applyUserInterfaceTheme.
self setDefaultParameters.
"Update properties of separating lines."
colorToUse := self userInterfaceTheme lineColor ifNil: [Color gray: 0.9].
self submorphs
select: [:ea | ea knownName = #line]
thenDo: [:line |
line
color: colorToUse;
extent: (self userInterfaceTheme lineWidth ifNil: [2]) asPoint;
+ borderStyle: (self userInterfaceTheme lineStyle ifNil: [BorderStyle inset]) copy;
- borderStyle: (self userInterfaceTheme lineStyle ifNil: [BorderStyle inset]);
borderColor: colorToUse].!
Item was changed:
----- Method: DockingBarMorph>>setDefaultParameters (in category 'initialize-release') -----
setDefaultParameters
"private - set the default parameter using Preferences as the inspiration source"
self
color: (self userInterfaceTheme color ifNil: [Color r: 0.9 g: 0.9 b: 0.9]);
+ borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle simple]) copy;
- borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]);
borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]);
borderWidth: (self userInterfaceTheme borderWidth ifNil: [0]).
self extent: (Preferences standardMenuFont height asPoint).!
Item was removed:
- ----- Method: EllipseMorph>>doesBevels (in category 'accessing') -----
- doesBevels
- ^ false!
Item was changed:
----- Method: EllipseMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
aCanvas isShadowDrawing
+ ifTrue: [^ aCanvas fillOval: self bounds fillStyle: self fillStyle borderWidth: 0 borderColor: nil].
+ aCanvas fillOval: self bounds fillStyle: self fillStyle borderWidth: self borderWidth borderColor: self borderColor.
- ifTrue: [^ aCanvas fillOval: bounds fillStyle: self fillStyle borderWidth: 0 borderColor: nil].
- aCanvas fillOval: bounds fillStyle: self fillStyle borderWidth: borderWidth borderColor: borderColor.
!
Item was changed:
----- Method: GradientEditor>>initialize (in category 'initialization') -----
initialize
super initialize.
self myLayout.
self extent: 500 @ 200.
row := RectangleMorph new extent: self width @ 100;
color: Color transparent;
+ borderStyle: BorderStyle inset.
- borderColor: #inset.
row addMorph: (gradientDisplay := GradientDisplayMorph new position: 20 @ 20;
extent: self width - 40 @ 40).
gradientDisplay fillStyle direction: gradientDisplay width @ 0.
self addMorph: row.
self addButtonRow.
self addMorph: self colorRampExpressionMorph!
Item was removed:
- ----- Method: IconicButton>>borderInset (in category 'accessing') -----
- borderInset
- self borderStyle: (BorderStyle inset width: 2).!
Item was removed:
- ----- Method: IconicButton>>borderRaised (in category 'accessing') -----
- borderRaised
- self borderStyle: (BorderStyle raised width: 2).!
Item was added:
+ ----- Method: IconicButton>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ ^ 2!
Item was changed:
----- Method: IconicButton>>labelGraphic: (in category 'as yet unclassified') -----
labelGraphic: aForm
| oldLabel graphicalMorph |
(oldLabel := self findA: SketchMorph)
ifNotNil: [oldLabel delete].
graphicalMorph := SketchMorph withForm: aForm.
+ self extent: graphicalMorph extent + (self borderWidth + 6).
- self extent: graphicalMorph extent + (borderWidth + 6).
graphicalMorph position: self center - (graphicalMorph extent // 2).
self addMorph: graphicalMorph.
graphicalMorph
baseGraphic;
lock.
!
Item was changed:
----- Method: InsetBorder>>bottomRightColor (in category 'accessing') -----
bottomRightColor
+ ^ color mixed: 0.65 with: Color white!
- ^width = 1
- ifTrue: [color twiceLighter]
- ifFalse: [color lighter]!
Item was removed:
- ----- Method: InsetBorder>>colorsAtCorners (in category 'accessing') -----
- colorsAtCorners
- | c c14 c23 |
- c := self color.
- c14 := c lighter. c23 := c darker.
- ^Array with: c23 with: c14 with: c14 with: c23.!
Item was changed:
----- Method: InsetBorder>>topLeftColor (in category 'accessing') -----
topLeftColor
+ ^ color mixed: 0.70 with: Color black!
- ^width = 1
- ifTrue: [color twiceDarker]
- ifFalse: [color darker]!
Item was changed:
----- Method: MenuMorph>>applyUserInterfaceTheme (in category 'update') -----
applyUserInterfaceTheme
| colorToUse |
super applyUserInterfaceTheme.
self setDefaultParameters.
"Update properties of separating lines."
colorToUse := self userInterfaceTheme lineColor ifNil: [Color gray: 0.9].
self submorphs
select: [:ea | ea knownName = #line]
thenDo: [:line |
line
color: colorToUse;
height: (self userInterfaceTheme lineWidth ifNil: [2]);
+ borderStyle: (self userInterfaceTheme lineStyle ifNil: [BorderStyle inset]) copy;
- borderStyle: (self userInterfaceTheme lineStyle ifNil: [BorderStyle inset]);
borderColor: colorToUse].!
Item was changed:
----- Method: MenuMorph>>setDefaultParameters (in category 'initialization') -----
setDefaultParameters
"change the receiver's appareance parameters"
self
color: (self userInterfaceTheme color ifNil: [Color r: 0.9 g: 0.9 b: 0.9]);
+ borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle simple]) copy;
- borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]);
borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]);
borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]).
Preferences menuAppearance3d ifTrue: [self addDropShadow].
self layoutInset: 3.
!
Item was changed:
----- Method: MenuMorph>>setTitleParametersFor: (in category 'initialization') -----
setTitleParametersFor: aMenuTitle
aMenuTitle
color: (self userInterfaceTheme titleColor ifNil: [Color transparent]);
+ borderStyle: (self userInterfaceTheme titleBorderStyle ifNil: [BorderStyle simple]) copy;
- borderStyle: (self userInterfaceTheme titleBorderStyle ifNil: [BorderStyle default]);
borderColor: (self userInterfaceTheme titleBorderColor ifNil: [Color r: 0.6 g: 0.7 b: 1]);
borderWidth: (self userInterfaceTheme titleBorderWidth ifNil: [0]);
cornerStyle: (self wantsRoundedCorners ifTrue: [#rounded] ifFalse: [#square]);
vResizing: #shrinkWrap;
wrapCentering: #center;
cellPositioning: #center;
cellInset: 5;
layoutInset: (5 at 0 corner: 5 at 0).!
Item was changed:
----- Method: Morph>>borderColor: (in category 'accessing') -----
borderColor: aColorOrSymbolOrNil
- "Unfortunately, the argument to borderColor could be more than just a color.
- It could also be a symbol, in which case it is to be interpreted as a style identifier.
- But I might not be able to draw that kind of border, so it may have to be ignored.
- Or it could be nil, in which case I should revert to the default border."
+ self flag: #compatibility. "mt: For old code. Should be removed in the future."
+ aColorOrSymbolOrNil
+ ifNil: [self borderStyle: nil]
+ ifNotNil: [:colorOrSymbol |
+ colorOrSymbol isSymbol ifTrue: [
+ ^ self borderStyle: ((self borderStyleForSymbol: colorOrSymbol)
+ width: self borderStyle width;
+ baseColor: self borderStyle baseColor;
+ trackColorFrom: self;
+ yourself)]].
- | style newStyle |
- style := self borderStyle.
- style baseColor = aColorOrSymbolOrNil
- ifTrue: [^ self].
+ "Set the color of the current border style."
+ self borderStyle
+ baseColor: aColorOrSymbolOrNil;
+ trackColorFrom: self.
- aColorOrSymbolOrNil isColor
- ifTrue: [style style = #none "default border?"
- ifTrue: [self borderStyle: (SimpleBorder width: 0 color: aColorOrSymbolOrNil)]
- ifFalse: [style baseColor: aColorOrSymbolOrNil.
- self changed].
- ^ self].
+ self changed.!
- self
- borderStyle: ( ({ nil. #none } includes: aColorOrSymbolOrNil)
- ifTrue: [BorderStyle default]
- ifFalse: [ "a symbol"
- self doesBevels ifFalse: [ ^self ].
- newStyle := (BorderStyle perform: aColorOrSymbolOrNil)
- color: style color;
- width: style width;
- yourself.
- (self canDrawBorder: newStyle)
- ifTrue: [newStyle]
- ifFalse: [style]])!
Item was changed:
----- Method: Morph>>borderStyle (in category 'accessing') -----
borderStyle
+ ^ self valueOfProperty: #borderStyle ifAbsentPut: [BorderStyle default]!
- ^(self valueOfProperty: #borderStyle ifAbsent:[BorderStyle default]) trackColorFrom: self!
Item was changed:
----- Method: Morph>>borderStyle: (in category 'accessing') -----
+ borderStyle: aBorderStyle
+
+ aBorderStyle = self borderStyle ifTrue: [^ self].
+
+ "If we cannot draw the new border, accept at least its color and width."
+ ((self canDrawBorder: aBorderStyle) or: [aBorderStyle isNil])
+ ifTrue: [self setProperty: #borderStyle toValue: aBorderStyle]
+ ifFalse: [
+ self borderStyle
+ width: aBorderStyle width;
+ baseColor: aBorderStyle baseColor].
+
+ self borderStyle trackColorFrom: self.
+
+ self
+ layoutChanged;
+ changed.!
- borderStyle: newStyle
- newStyle = self borderStyle ifFalse:[
- (self canDrawBorder: newStyle) ifFalse:[
- "Replace the suggested border with a simple one"
- ^self borderStyle: (BorderStyle width: newStyle width color: (newStyle trackColorFrom: self) color)].
- self setProperty: #borderStyle toValue: newStyle.
- self changed].!
Item was changed:
----- Method: Morph>>borderStyleForSymbol: (in category 'accessing') -----
borderStyleForSymbol: aStyleSymbol
"Answer a suitable BorderStyle for me of the type represented by a given symbol"
+ ^ (BorderStyle borderStyleForSymbol: aStyleSymbol asSymbol)
+ ifNotNil: [:style | | existing |
+ existing := self borderStyle.
+ style
+ width: existing width;
+ baseColor: existing baseColor;
+ trackColorFrom: self;
+ yourself]!
- | aStyle existing |
- aStyle := BorderStyle borderStyleForSymbol: aStyleSymbol asSymbol.
- aStyle ifNil: [self error: 'bad style'].
- existing := self borderStyle.
- aStyle width: existing width;
- baseColor: existing baseColor.
- ^ (self canDrawBorder: aStyle)
- ifTrue:
- [aStyle]
- ifFalse:
- [nil]!
Item was changed:
----- Method: Morph>>borderWidth: (in category 'accessing') -----
borderWidth: aNumber
+ "Sets the width of the border in the current border style. If there is no border yet, set up a simple one so that the user can actually see the border width."
- | style |
- style := self borderStyle.
- style width = aNumber ifTrue: [ ^self ].
+ self borderStyle width = aNumber ifTrue: [^ self].
+
+ self borderStyle style = #none
+ ifTrue: [^ self borderStyle: (BorderStyle simple width: aNumber; yourself)].
+
+ self borderStyle width: aNumber.
+ self layoutChanged; changed.!
- style style = #none
- ifTrue: [ self borderStyle: (SimpleBorder width: aNumber color: Color transparent) ]
- ifFalse: [ style width: aNumber. self changed ].
- !
Item was changed:
----- Method: Morph>>color: (in category 'accessing') -----
color: aColor
"Set the receiver's color. Directly set the color if appropriate, else go by way of fillStyle"
(aColor isColor or: [aColor isKindOf: InfiniteForm]) ifFalse:[^ self fillStyle: aColor].
color = aColor ifFalse:
[self removeProperty: #fillStyle.
color := aColor.
+ self borderStyle trackColorFrom: self.
self changed]!
Item was removed:
- ----- Method: Morph>>doesBevels (in category 'accessing') -----
- doesBevels
- "To return true means that this object can show bevelled borders, and
- therefore can accept, eg, #raised or #inset as valid borderColors.
- Must be overridden by subclasses that do not support bevelled borders."
-
- ^ false!
Item was changed:
----- Method: Morph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
self wantsRoundedCorners
+ ifTrue: [aCanvas frameAndFillRoundRect: self bounds radius: self cornerRadius fillStyle: self fillStyle borderStyle: self borderStyle]
- ifTrue: [aCanvas frameAndFillRoundRect: self bounds radius: self cornerRadius fillStyle: self fillStyle borderWidth: self borderStyle width borderColor: self borderStyle color]
ifFalse: [aCanvas frameAndFillRectangle: self bounds fillStyle: self fillStyle borderStyle: self borderStyle].
!
Item was changed:
----- Method: Morph>>fillStyle: (in category 'visual properties') -----
fillStyle: aFillStyle
"Set the current fillStyle of the receiver."
self setProperty: #fillStyle toValue: aFillStyle.
"Workaround for Morphs not yet converted"
color := aFillStyle asColor.
+ self borderStyle trackColorFrom: self.
self changed.!
Item was changed:
----- Method: Morph>>setBorderStyle: (in category 'accessing') -----
setBorderStyle: aSymbol
"Set the border style of my costume"
+ (self borderStyleForSymbol: aSymbol)
+ ifNotNil: [:style | self borderStyle: style].!
- | aStyle |
- aStyle := self borderStyleForSymbol: aSymbol.
- aStyle ifNil: [^ self].
- (self canDrawBorder: aStyle)
- ifTrue:
- [self borderStyle: aStyle]!
Item was changed:
----- Method: NewHandleMorph>>followHand:forEachPointDo:lastPointDo:withCursor: (in category 'all') -----
followHand: aHand forEachPointDo: block1 lastPointDo: block2 withCursor: aCursor
+
hand := aHand.
hand showTemporaryCursor: aCursor "hotSpotOffset: aCursor offset negated".
+
- borderWidth := 0.
color := Color transparent.
pointBlock := block1.
lastPointBlock := block2.
+
+ self borderWidth: 0.
self position: hand lastEvent cursorPoint - (self extent // 2)!
Item was changed:
----- Method: PluggableButtonMorph>>setDefaultParameters (in category 'initialization') -----
setDefaultParameters
"change the receiver's appareance parameters"
self
color: (self userInterfaceTheme color ifNil: [Color gray: 0.91]);
+ borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]) copy;
- borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]);
borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]);
borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]);
font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]);
textColor: (self userInterfaceTheme textColor ifNil: [Color black]).
borderColor := self borderColor.
self offColor: self color.!
Item was changed:
----- Method: PolygonMorph>>arrowBoundsAt:from: (in category 'private') -----
arrowBoundsAt: endPoint from: priorPoint
"Answer a triangle oriented along the line from priorPoint to endPoint."
| d v angle wingBase arrowSpec length width |
v := endPoint - priorPoint.
angle := v degrees.
+ d := self borderWidth max: 1.
- d := borderWidth max: 1.
arrowSpec := self valueOfProperty: #arrowSpec ifAbsent: [5 at 4].
length := arrowSpec x abs. width := arrowSpec y abs.
wingBase := endPoint + (Point r: d * length degrees: angle + 180.0).
arrowSpec x >= 0
ifTrue: [^ { endPoint.
wingBase + (Point r: d * width degrees: angle + 125.0).
wingBase + (Point r: d * width degrees: angle - 125.0) }]
ifFalse: ["Negative length means concave base."
^ { endPoint.
wingBase + (Point r: d * width degrees: angle + 125.0).
wingBase.
wingBase + (Point r: d * width degrees: angle - 125.0) }]!
Item was changed:
+ ----- Method: PolygonMorph>>borderColor: (in category 'accessing') -----
- ----- Method: PolygonMorph>>borderColor: (in category 'access') -----
borderColor: aColor
+ "Recompute fillForm and borderForm if translucency of border changes."
+
-
super borderColor: aColor.
- (borderColor isColor and: [borderColor isTranslucentColor])
- == (aColor isColor and: [aColor isTranslucentColor])
- ifFalse:
- ["Need to recompute fillForm and borderForm
- if translucency of border changes."
+ (self borderColor isColor and: [self borderColor isTranslucentColor])
+ == (aColor isColor and: [aColor isTranslucentColor])
+ ifFalse: [self releaseCachedState]!
- self releaseCachedState]!
Item was added:
+ ----- Method: PolygonMorph>>borderDashSpec (in category 'accessing') -----
+ borderDashSpec
+ ^ borderDashSpec!
Item was added:
+ ----- Method: PolygonMorph>>borderStyle: (in category 'accessing') -----
+ borderStyle: aBorderStyle
+
+ super borderStyle: aBorderStyle.
+ self computeBounds!
Item was changed:
----- Method: PolygonMorph>>borderWidth: (in category 'accessing') -----
borderWidth: anInteger
+ super borderWidth: anInteger.
- borderColor ifNil: [borderColor := Color black].
- borderWidth := anInteger max: 0.
self computeBounds!
Item was changed:
----- Method: PolygonMorph>>computeBounds (in category 'private') -----
computeBounds
| oldBounds delta excludeHandles |
+
+ self flag: #refactor. "mt: Make it lazy like all layout policies in Morph. See #fullBounds and #doLayoutIn:."
+
vertices ifNil: [^ self].
self changed.
oldBounds := bounds.
self releaseCachedState.
bounds := self curveBounds expanded copy.
self arrowForms do:
[:f | bounds swallow: (f offset extent: f extent)].
handles ifNotNil: [self updateHandles].
"since we are directly updating bounds, see if any ordinary submorphs exist and move them accordingly"
(oldBounds notNil and: [(delta := bounds origin - oldBounds origin) ~= (0 at 0)]) ifTrue: [
excludeHandles := IdentitySet new.
handles ifNotNil: [excludeHandles addAll: handles].
self submorphsDo: [ :each |
(excludeHandles includes: each) ifFalse: [
each position: each position + delta
].
].
].
self layoutChanged.
self changed.
!
Item was changed:
----- Method: PolygonMorph>>containsPoint: (in category 'geometry testing') -----
containsPoint: aPoint
(super containsPoint: aPoint) ifFalse: [^ false].
closed & color isTransparent not ifTrue:
+ [^ (self filledForm pixelValueAt: aPoint - self topLeft + 1) > 0].
- [^ (self filledForm pixelValueAt: aPoint - bounds topLeft + 1) > 0].
self lineSegmentsDo:
[:p1 :p2 |
+ (aPoint onLineFrom: p1 to: p2 within: (3 max: self borderWidth+1//2) asFloat)
- (aPoint onLineFrom: p1 to: p2 within: (3 max: borderWidth+1//2) asFloat)
ifTrue: [^ true]].
self arrowForms do:
[:f | (f pixelValueAt: aPoint - f offset) > 0 ifTrue: [^ true]].
^ false!
Item was changed:
----- Method: PolygonMorph>>curveBounds (in category 'private') -----
curveBounds
"Compute the bounds from actual curve traversal, with
leeway for borderWidth.
Also note the next-to-first and next-to-last points for arrow
directions."
"wiz - to avoid roundoff errors we return unrounded curvebounds."
"we expect our receiver to take responsibility for approriate rounding adjustment."
"hint: this is most likely 'self curveBounds expanded' "
| pointAfterFirst pointBeforeLast oX oY cX cY |
self isCurvy
ifFalse: [^ (Rectangle encompassing: vertices)
+ expandBy: self borderWidth * 0.5 ].
- expandBy: borderWidth * 0.5 ].
curveState := nil.
"Force recomputation"
"curveBounds := vertices first corner: vertices last."
pointAfterFirst := nil.
self
lineSegmentsDo: [:p1 :p2 |
pointAfterFirst isNil
ifTrue: [pointAfterFirst := p2 floor .
oX := cX := p1 x.
oY := cY := p1 y. ].
"curveBounds := curveBounds encompass: p2 ."
oX:= oX min: p2 x.
cX := cX max: p2 x.
oY := oY min: p2 y.
cY := cY max: p2 y.
pointBeforeLast := p1 floor ].
curveState at: 2 put: pointAfterFirst.
curveState at: 3 put: pointBeforeLast.
+ ^ ( oX @ oY corner: cX @ cY ) expandBy: self borderWidth * 0.5 !
- ^ ( oX @ oY corner: cX @ cY ) expandBy: borderWidth * 0.5 !
Item was changed:
----- Method: PolygonMorph>>drawArrowOn:at:from: (in category 'drawing') -----
drawArrowOn: aCanvas at: endPoint from: priorPoint
"Draw a triangle oriented along the line from priorPoint to
endPoint. Answer the wingBase."
| pts spec wingBase |
pts := self arrowBoundsAt: endPoint from: priorPoint.
wingBase := pts size = 4
ifTrue: [pts third]
ifFalse: [(pts copyFrom: 2 to: 3) average].
spec := self valueOfProperty: #arrowSpec ifAbsent: [5 @ 4].
spec x sign = spec y sign
+ ifTrue: [aCanvas drawPolygon: pts fillStyle: self borderColor]
- ifTrue: [aCanvas drawPolygon: pts fillStyle: borderColor]
ifFalse:
[aCanvas
drawPolygon: pts
fillStyle: Color transparent
+ borderWidth: (self borderWidth + 1) // 2
+ borderColor: self borderColor].
- borderWidth: (borderWidth + 1) // 2
- borderColor: borderColor].
^wingBase!
Item was changed:
----- Method: PolygonMorph>>drawArrowsOn: (in category 'drawing') -----
drawArrowsOn: aCanvas
"Answer (possibly modified) endpoints for border drawing"
"ArrowForms are computed only upon demand"
| array |
self hasArrows
ifFalse: [^ #() ].
"Nothing to do"
array := Array with: vertices first with: vertices last.
"Prevent crashes for #raised or #inset borders"
+ self borderColor isColor
- borderColor isColor
ifFalse: [ ^array ].
(arrows == #forward or: [arrows == #both])
ifTrue: [ array at: 2 put: (self
drawArrowOn: aCanvas
at: vertices last
from: self nextToLastPoint) ].
(arrows == #back or: [arrows == #both])
ifTrue: [ array at: 1 put: (self
drawArrowOn: aCanvas
at: vertices first
from: self nextToFirstPoint) ].
^array!
Item was changed:
----- Method: PolygonMorph>>drawDashedBorderOn:usingEnds: (in category 'drawing') -----
drawDashedBorderOn: aCanvas usingEnds: anArray
"Display my border on the canvas. NOTE: mostly copied from
drawBorderOn:"
| bevel topLeftColor bottomRightColor bigClipRect lineColor segmentOffset |
+ (self borderColor isNil
+ or: [self borderColor isColor
+ and: [self borderColor isTransparent]])
- (borderColor isNil
- or: [borderColor isColor
- and: [borderColor isTransparent]])
ifTrue: [^ self].
+ lineColor := self borderColor.
- lineColor := borderColor.
bevel := false.
"Border colors for bevelled effects depend on CW ordering of
vertices"
+ self borderStyle style == #raised
+ ifTrue: [topLeftColor := self color lighter.
+ bottomRightColor := self color darker.
- borderColor == #raised
- ifTrue: [topLeftColor := color lighter.
- bottomRightColor := color darker.
bevel := true].
+ self borderStyle style == #inset
- borderColor == #inset
ifTrue: [topLeftColor := owner colorForInsets darker.
bottomRightColor := owner colorForInsets lighter.
bevel := true].
bigClipRect := aCanvas clipRect expandBy: self borderWidth + 1 // 2.
segmentOffset := self borderDashOffset.
self
lineSegmentsDo: [:p1 :p2 | | p1i p2i |
p1i := p1 asIntegerPoint.
p2i := p2 asIntegerPoint.
self hasArrows
ifTrue: ["Shorten line ends so as not to interfere with tip
of arrow."
((arrows == #back
or: [arrows == #both])
and: [p1 = vertices first])
ifTrue: [p1i := anArray first asIntegerPoint].
((arrows == #forward
or: [arrows == #both])
and: [p2 = vertices last])
ifTrue: [p2i := anArray last asIntegerPoint]].
(closed
or: ["bigClipRect intersects: (p1i rect: p2i)
optimized:"
((p1i min: p2i)
max: bigClipRect origin)
<= ((p1i max: p2i)
min: bigClipRect corner)])
ifTrue: [bevel
ifTrue: [lineColor := (p1i quadrantOf: p2i)
> 2
ifTrue: [topLeftColor]
ifFalse: [bottomRightColor]].
segmentOffset := aCanvas
line: p1i
to: p2i
+ width: self borderWidth
- width: borderWidth
color: lineColor
+ dashLength: self borderDashSpec first
+ secondColor: self borderDashSpec third
+ secondDashLength: self borderDashSpec second
- dashLength: borderDashSpec first
- secondColor: borderDashSpec third
- secondDashLength: borderDashSpec second
startingOffset: segmentOffset]]!
Item was changed:
----- Method: PolygonMorph>>drawOnFormCanvas: (in category 'drawing') -----
drawOnFormCanvas: aCanvas
"Display the receiver, a spline curve, approximated by straight line segments."
| |
vertices size < 1 ifTrue: [self error: 'a polygon must have at least one point'].
closed & color isTransparent not
+ ifTrue: [aCanvas stencil: self filledForm at: self bounds topLeft - 1 color: self color].
+ (self borderColor isColor and: [self borderColor isTranslucentColor])
+ ifTrue: [aCanvas stencil: self borderForm at: self bounds topLeft
+ color: self borderColor]
- ifTrue: [aCanvas stencil: self filledForm at: bounds topLeft - 1 color: color].
- (borderColor isColor and: [borderColor isTranslucentColor])
- ifTrue: [aCanvas stencil: self borderForm at: bounds topLeft
- color: borderColor]
ifFalse: [self drawBorderOn: aCanvas].
self arrowForms do:
[:f | aCanvas stencil: f at: f offset
+ color: (self borderColor isColor ifTrue: [self borderColor] ifFalse: [self color])]!
- color: (borderColor isColor ifTrue: [borderColor] ifFalse: [color])]!
Item was changed:
----- Method: PolygonMorph>>filledForm (in category 'private') -----
filledForm
"Note: The filled form is actually 2 pixels bigger than bounds, and the point corresponding to this morphs' position is at 1 at 1 in the form. This is due to the details of the fillig routines, at least one of which requires an extra 1-pixel margin around the outside. Computation of the filled form is done only on demand."
| bb origin |
closed ifFalse: [^ filledForm := nil].
filledForm ifNotNil: [^ filledForm].
filledForm := Form extent: bounds extent+2.
"Draw the border..."
bb := (BitBlt toForm: filledForm) sourceForm: nil; fillColor: Color black;
combinationRule: Form over; width: 1; height: 1.
origin := bounds topLeft asIntegerPoint-1.
self lineSegmentsDo: [:p1 :p2 | bb drawFrom: p1 asIntegerPoint-origin
to: p2 asIntegerPoint-origin].
"Fill it in..."
filledForm convexShapeFill: Color black.
+ (self borderColor isColor and: [self borderColor isTranslucentColor]) ifTrue:
- (borderColor isColor and: [borderColor isTranslucentColor]) ifTrue:
["If border is stored as a form, then erase any overlap now."
filledForm copy: self borderForm boundingBox from: self borderForm
to: 1 at 1 rule: Form erase].
^ filledForm!
Item was changed:
----- Method: PolygonMorph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
justDroppedInto: newOwner event: evt
| delta |
(newOwner isKindOf: PasteUpMorph) ifTrue:
["Compensate for border width so that gridded drop
is consistent with gridded drag of handles."
+ delta := self borderWidth+1//2.
- delta := borderWidth+1//2.
self position: (newOwner gridPoint: self position + delta) - delta].
^ super justDroppedInto: newOwner event: evt!
Item was changed:
----- Method: PolygonMorph>>vertices:color:borderWidth:borderColor: (in category 'initialization') -----
vertices: verts color: aColor borderWidth: borderWidthInteger borderColor: anotherColor
super initialize.
""
vertices := verts.
color := aColor.
+
- borderWidth := borderWidthInteger.
- borderColor := anotherColor.
closed := vertices size > 2.
arrows := #none.
+
+ self borderStyle
+ color: anotherColor;
+ width: borderWidthInteger.
+
self computeBounds!
Item was changed:
----- Method: RaisedBorder>>bottomRightColor (in category 'accessing') -----
bottomRightColor
+ ^ color mixed: 0.70 with: Color black!
- ^width = 1
- ifTrue: [color twiceDarker]
- ifFalse: [color darker]!
Item was removed:
- ----- Method: RaisedBorder>>colorsAtCorners (in category 'accessing') -----
- colorsAtCorners
- | c c14 c23 |
- c := self color.
- c14 := c lighter. c23 := c darker.
- ^Array with: c14 with: c23 with: c23 with: c14!
Item was changed:
----- Method: RaisedBorder>>topLeftColor (in category 'accessing') -----
topLeftColor
+ ^ color mixed: 0.65 with: Color white!
- ^width = 1
- ifTrue: [color twiceLighter]
- ifFalse: [color lighter]!
Item was changed:
----- Method: ScrollBar class>>arrowOfDirection:size:color: (in category 'images') -----
arrowOfDirection: aSymbol size: finalSizeInteger color: aColor
"answer a form with an arrow based on the parameters"
+ ^ ArrowImagesCache at: {aSymbol. finalSizeInteger max: 1. aColor}!
- ^ ArrowImagesCache at: {aSymbol. finalSizeInteger. aColor}!
Item was changed:
----- Method: ScrollPane>>borderStyle: (in category 'accessing') -----
borderStyle: aBorderStyle
super borderStyle: aBorderStyle.
+ scroller ifNotNil: [self setScrollDeltas].!
- self setScrollDeltas!
Item was changed:
----- Method: ScrollPane>>drawOverlayOn: (in category 'drawing') -----
drawOverlayOn: aCanvas
"Draw my border OVER my submorphs because the scrollbars overlap."
self wantsRoundedCorners
+ ifTrue: [aCanvas frameRoundRect: self bounds radius: self cornerRadius borderStyle: self borderStyle]
+ ifFalse: [aCanvas frameRectangle: self bounds borderStyle: self borderStyle].
- ifTrue: [aCanvas frameRoundRect: self bounds radius: self cornerRadius width: self borderStyle width color: self borderStyle color]
- ifFalse: [aCanvas frameRectangle: self bounds width: self borderStyle width color: self borderStyle color].
super drawOverlayOn: aCanvas.!
Item was changed:
----- Method: ScrollPane>>hResizeScrollBar (in category 'geometry') -----
hResizeScrollBar
| topLeft h border offset |
self hScrollBarPolicy == #never ifTrue: [^self].
+ self bounds ifNil: [self fullBounds].
- bounds ifNil: [ self fullBounds ].
h := self scrollBarThickness.
+ border := self borderWidth.
- border := borderWidth.
offset := (scrollBarOnLeft and: [self vIsScrollbarShowing and: [retractableScrollBar not]])
ifTrue: [h]
ifFalse: [0].
topLeft := retractableScrollBar
ifTrue: [bounds bottomLeft + (offset @ border negated)]
ifFalse: [bounds bottomLeft + (offset @ h negated)].
hScrollBar bounds: (topLeft extent: self hScrollBarWidth@ h)!
Item was added:
+ ----- Method: ScrollPane>>insetColor (in category 'accessing') -----
+ insetColor
+
+ ^ self containingWindow
+ ifNil: [super insetColor]
+ ifNotNil: [:window | window colorForInsets]!
Item was added:
+ ----- Method: ScrollPane>>raisedColor (in category 'accessing') -----
+ raisedColor
+
+ ^ self containingWindow
+ ifNil: [super raisedColor]
+ ifNotNil: [:window | window raisedColor]!
Item was changed:
----- Method: ScrollPane>>setDefaultParameters (in category 'initialization') -----
setDefaultParameters
"change the receiver's appareance parameters"
self
color: (self userInterfaceTheme color ifNil: [Color white]);
+ borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle simple]) copy;
- borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]);
borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray: 0.6]);
borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]).!
Item was changed:
----- Method: SimpleBorder>>baseColor: (in category 'accessing') -----
baseColor: aColor
baseColor = aColor ifTrue:[^self].
+ baseColor := aColor ifNil: [Color transparent].
+ self color: baseColor "#color: will do #releaseCachedState"!
- baseColor := aColor.
- self color: aColor "#color: will do #releaseCachedState"!
Item was changed:
----- Method: SimpleButtonMorph>>fitContents (in category 'accessing') -----
fitContents
| aMorph aCenter |
aCenter := self center.
+ self hasSubmorphs ifFalse: [^self].
+ aMorph := self firstSubmorph.
+ self extent: aMorph extent + (self borderWidth + 6).
- submorphs isEmpty ifTrue: [^self].
- aMorph := submorphs first.
- self extent: aMorph extent + (borderWidth + 6).
self center: aCenter.
aMorph position: aCenter - (aMorph extent // 2)!
Item was changed:
----- Method: SimpleButtonMorph>>label: (in category 'accessing') -----
label: aString
| oldLabel m |
(oldLabel := self findA: StringMorph)
ifNotNil: [oldLabel delete].
m := StringMorph contents: aString font: TextStyle defaultFont.
+ self extent: m extent + (self borderWidth + 6).
- self extent: m extent + (borderWidth + 6).
m position: self center - (m extent // 2).
self addMorph: m.
m lock!
Item was changed:
----- Method: SimpleButtonMorph>>mouseUp: (in category 'event handling') -----
mouseUp: evt
super mouseUp: evt.
oldColor ifNotNil:
["if oldColor nil, it signals that mouse had not gone DOWN
inside me, e.g. because of a cmd-drag; in this case we want
to avoid triggering the action!!"
self color: oldColor.
oldColor := nil.
(self containsPoint: evt cursorPoint)
ifTrue: [ actWhen == #buttonUp
ifTrue: [self doButtonAction] ]
+ ifFalse: [ self mouseLeave: evt "This is a balk. Note that we have left." ]].
+ self borderStyle style = #inset ifTrue: [self borderRaised].
- ifFalse: [ self mouseLeave: evt "This is a balk. Note that we have left." ]]
!
Item was changed:
----- Method: SimpleButtonMorph>>updateVisualState: (in category 'visual properties') -----
updateVisualState: evt
+ (self containsPoint: evt cursorPoint)
+ ifTrue: [
+ oldColor ifNotNil: [self color: (oldColor mixed: 1/2 with: Color white)].
+ self borderStyle style = #raised ifTrue: [self borderInset]]
+ ifFalse: [
+ oldColor ifNotNil: [self color: oldColor].
+ self borderStyle style = #inset ifTrue: [self borderRaised]].
- oldColor ifNotNil: [
- self color:
- ((self containsPoint: evt cursorPoint)
- ifTrue: [oldColor mixed: 1/2 with: Color white]
- ifFalse: [oldColor])]
!
Item was changed:
----- Method: Slider>>mouseDownInSlider: (in category 'other events') -----
mouseDownInSlider: event
slider borderStyle style == #raised
+ ifTrue: [slider borderStyle: (BorderStyle inset width: slider borderWidth)].
- ifTrue: [slider borderColor: #inset].
self showSliderShadow.!
Item was changed:
----- Method: Slider>>mouseUpInSlider: (in category 'other events') -----
mouseUpInSlider: event
slider borderStyle style == #inset
+ ifTrue: [slider borderStyle: (BorderStyle raised width: slider borderWidth)].
- ifTrue: [slider borderColor: #raised].
self hideSliderShadow.!
Item was changed:
----- Method: SystemProgressBarMorph>>setDefaultParameters (in category 'initialization') -----
setDefaultParameters
"change the receiver's appareance parameters"
self
color: (self userInterfaceTheme color ifNil: [Color r: 0.977 g: 0.977 b: 0.977]);
+ borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle simple]) copy;
- borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]);
borderColor: (self userInterfaceTheme borderColor ifNil: [Color transparent]);
borderWidth: (self userInterfaceTheme borderWidth ifNil: [0]);
barColor: (self userInterfaceTheme barColor ifNil: [Color r: 0.72 g: 0.72 b: 0.9]).!
Item was changed:
----- Method: SystemProgressMorph>>setDefaultParameters (in category 'initialization') -----
setDefaultParameters
"change the receiver's appareance parameters"
self
color: (self userInterfaceTheme color ifNil: [Color r: 0.9 g: 0.9 b: 0.9]);
+ borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle simple]) copy;
- borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]);
borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]);
borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]).
Preferences menuAppearance3d ifTrue: [self addDropShadow].
self
font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]);
textColor: (self userInterfaceTheme textColor ifNil: [Color black]).
self
updateColor: self
color: self color
intensity: 1.!
Item was changed:
----- Method: SystemWindow>>setLabel: (in category 'label') -----
setLabel: aString
| frame |
labelString := aString.
label ifNil: [^ self].
label contents: (aString ifNil: ['']).
self labelWidgetAllowance. "Sets it if not already"
self isCollapsed
ifTrue: [self extent: (label width + labelWidgetAllowance) @ (self labelHeight + 2)]
+ ifFalse: [label fitContents; setWidth: (label width min: self width - labelWidgetAllowance).
+ label align: label bounds topCenter with: self topCenter + (0 at self borderWidth).
- ifFalse: [label fitContents; setWidth: (label width min: bounds width - labelWidgetAllowance).
- label align: label bounds topCenter with: bounds topCenter + (0 at borderWidth).
collapsedFrame ifNotNil:
[collapsedFrame := collapsedFrame withWidth: label width + labelWidgetAllowance]].
frame := LayoutFrame new.
frame leftFraction: 0.5;
topFraction: 0.5;
leftOffset: label width negated // 2;
topOffset: label height negated // 2.
label layoutFrame: frame.
!
Item was removed:
- ----- Method: TTSampleFontMorph>>doesBevels (in category 'accessing') -----
- doesBevels
- ^false!
Item was changed:
----- Method: TTSampleFontMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
| origin extent offset |
(font isNil)
+ ifTrue:[^aCanvas frameRectangle: self bounds color: Color black].
- ifTrue:[^aCanvas frameRectangle: bounds color: Color black].
origin := self position asIntegerPoint.
extent := self extent asIntegerPoint.
0 to: 16 do:[:i|
offset := (extent x * i // 16) @ (extent y * i // 16).
aCanvas line: origin x @ (origin y + offset y)
to: (origin x + extent x) @ (origin y + offset y)
+ width: self borderWidth color: self borderColor.
- width: borderWidth color: borderColor.
aCanvas line: (origin x + offset x) @ origin y
to: (origin x + offset x) @ (origin y + extent y)
+ width: self borderWidth color: self borderColor.
- width: borderWidth color: borderColor.
].
aCanvas asBalloonCanvas preserveStateDuring:[:balloonCanvas|
balloonCanvas transformBy: self transform.
balloonCanvas aaLevel: self smoothing.
self drawCharactersOn: balloonCanvas.
].!
Item was changed:
----- Method: TTSampleStringMorph>>computeTransform (in category 'private') -----
computeTransform
| cy |
cy := bounds origin y + bounds corner y * 0.5.
transform := MatrixTransform2x3
+ transformFromLocal: (ttBounds insetBy: self borderWidth negated)
- transformFromLocal: (ttBounds insetBy: borderWidth negated)
toGlobal: bounds.
transform := transform composedWithGlobal:(MatrixTransform2x3 withOffset: 0 @ cy negated).
transform := transform composedWithGlobal:(MatrixTransform2x3 withScale: 1.0 @ -1.0).
transform := transform composedWithGlobal:(MatrixTransform2x3 withOffset: 0 @ cy).
^transform!
Item was changed:
----- Method: TTSampleStringMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
| xStart |
(font isNil or:[string isNil or:[string isEmpty]])
+ ifTrue:[^aCanvas frameRectangle: self bounds color: Color black].
- ifTrue:[^aCanvas frameRectangle: bounds color: Color black].
xStart := 0.
aCanvas asBalloonCanvas preserveStateDuring:[:balloonCanvas|
balloonCanvas transformBy: self transform.
balloonCanvas aaLevel: self smoothing.
string do:[:char| | glyph |
glyph := font at: char.
balloonCanvas preserveStateDuring:[:subCanvas|
subCanvas transformBy: (MatrixTransform2x3 withOffset: xStart at 0).
subCanvas
drawGeneralBezierShape: glyph contours
+ color: self color
+ borderWidth: self borderWidth
+ borderColor: self borderColor].
- color: color
- borderWidth: borderWidth
- borderColor: borderColor].
xStart := xStart + glyph advanceWidth.
].
].!
Item was changed:
----- Method: TTSampleStringMorph>>initializeString (in category 'initialize') -----
initializeString
| xStart char glyph |
(font isNil or: [string isNil]) ifTrue: [^ self].
xStart := 0.
ttBounds := 0 at 0 corner: 0 at 0.
1 to: string size do:
[:i |
char := string at: i.
glyph := font at: char.
ttBounds := ttBounds quickMerge: (glyph bounds translateBy: xStart at 0).
xStart := xStart + glyph advanceWidth.
].
self extent: ttBounds extent // 40.
+ self borderWidth: ttBounds height // 40!
- borderWidth := ttBounds height // 40!
Item was changed:
----- Method: TextMorph>>areasRemainingToFill: (in category 'drawing') -----
areasRemainingToFill: aRectangle
"Overridden from BorderedMorph to test backgroundColor instead of (text) color."
(self backgroundColor isNil or: [self backgroundColor asColor isTranslucent])
ifTrue: [^ Array with: aRectangle].
self wantsRoundedCorners
+ ifTrue: [(self borderWidth > 0 and: [self borderColor isColor and: [self borderColor isTranslucent]])
- ifTrue: [(borderWidth > 0 and: [borderColor isColor and: [borderColor isTranslucent]])
ifTrue: [^ aRectangle areasOutside: (self innerBounds intersect: self boundsWithinCorners)]
ifFalse: [^ aRectangle areasOutside: self boundsWithinCorners]]
+ ifFalse: [(self borderWidth > 0 and: [self borderColor isColor and: [self borderColor isTranslucent]])
- ifFalse: [(borderWidth > 0 and: [borderColor isColor and: [borderColor isTranslucent]])
ifTrue: [^ aRectangle areasOutside: self innerBounds]
ifFalse: [^ aRectangle areasOutside: self bounds]]!
Item was changed:
----- Method: TextMorph>>convertToCurrentVersion:refStream: (in category 'objects from disk') -----
convertToCurrentVersion: varDict refStream: smartRefStrm
+ self borderWidth ifNil: [
+ self borderWidth: 0.
- borderWidth ifNil:
- [borderWidth := 0.
self removeProperty: #fillStyle].
^ super convertToCurrentVersion: varDict refStream: smartRefStrm.
!
Item was added:
+ ----- Method: TextMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ ^ 0!
Item was changed:
----- Method: TextMorph>>fit (in category 'private') -----
fit
"Adjust my bounds to fit the text. Should be a no-op if autoFit is not specified.
Required after the text changes,
or if wrapFlag is true and the user attempts to change the extent."
| newExtent para cBounds lastOfLines heightOfLast wid |
self isAutoFit
ifTrue:
[wid := (text notNil and: [text size > 2]) ifTrue: [5] ifFalse: [40].
newExtent := (self paragraph extent max: wid @ ( self defaultLineHeight)) + (0 @ 2).
+ newExtent := newExtent + (2 * self borderWidth).
- newExtent := newExtent + (2 * borderWidth).
margins
ifNotNil: [newExtent := ((0 @ 0 extent: newExtent) expandBy: margins) extent].
newExtent ~= bounds extent
ifTrue:
[(container isNil and: [successor isNil])
ifTrue:
[para := paragraph. "Save para (layoutChanged smashes it)"
super extent: newExtent.
paragraph := para]].
container notNil & successor isNil
ifTrue:
[cBounds := container bounds truncated.
"23 sept 2000 - try to allow vertical growth"
lastOfLines := self paragraph lines last.
heightOfLast := lastOfLines bottom - lastOfLines top.
(lastOfLines last < text size
and: [lastOfLines bottom + heightOfLast >= self bottom])
ifTrue:
[container releaseCachedState.
cBounds := cBounds origin corner: cBounds corner + (0 @ heightOfLast)].
self privateBounds: cBounds]].
"These statements should be pushed back into senders"
self paragraph positionWhenComposed: self position.
successor ifNotNil: [successor predecessorChanged].
self changed "Too conservative: only paragraph composition
should cause invalidation."!
Item was changed:
----- Method: TextMorph>>hasTranslucentColor (in category 'accessing') -----
hasTranslucentColor
"Overridden from BorderedMorph to test backgroundColor instead of (text) color."
+ ^ self backgroundColor isNil
+ or: [self backgroundColor isColor and: [self backgroundColor isTranslucentColor]]
+ or: [self borderColor isColor and: [self borderColor isTranslucentColor]]!
- ^ backgroundColor isNil
- or: [backgroundColor isColor and: [backgroundColor isTranslucentColor]]
- or: [borderColor isColor and: [borderColor isTranslucentColor]]!
Item was changed:
----- Method: TextMorph>>initialize (in category 'initialization') -----
initialize
+
super initialize.
+
- borderWidth := 0.
textStyle := TextStyle default copy.
wrapFlag := true.
!
Item was changed:
----- Method: TextMorph>>minHeight (in category 'layout') -----
minHeight
| result |
textStyle ifNil: [^ 16].
- borderWidth ifNil: [^ 16].
+ result := (textStyle lineGrid + 2) + (self borderWidth*2).
- result := (textStyle lineGrid + 2) + (borderWidth*2).
margins ifNil: [^ result].
^ margins isRectangle
ifTrue: [result + margins top + margins bottom]
ifFalse: [margins isPoint
ifTrue: [result + margins y + margins y]
ifFalse: [result + (2*margins)]]!
Item was changed:
----- Method: TextMorph>>minWidth (in category 'layout') -----
minWidth
| result |
textStyle ifNil: [^ 9].
- borderWidth ifNil: [^ 9].
+ result := 9 + (self borderWidth*2).
- result := 9 + (borderWidth*2).
margins ifNil: [^ result].
^ margins isRectangle
ifTrue: [result + margins left + margins right]
ifFalse: [margins isPoint
ifTrue: [result + margins x + margins x]
ifFalse: [result + (2*margins)]]!
Item was changed:
+ (PackageInfo named: 'Morphic') postscript: 'Project allMorphicProjects do: [:p |
+ p world allMorphsDo: [:m |
+ (m isKindOf: BorderedMorph) ifTrue: [
+ m borderColor: (m instVarNamed: #borderColor).
+ m borderWidth: (m instVarNamed: #borderWidth)]]].'!
- (PackageInfo named: 'Morphic') postscript: 'MenuIcons classPool at: #Icons put: ((MenuIcons classPool at: #Icons) as: Dictionary)'!
More information about the Squeak-dev
mailing list
|