The Trunk: Morphic-mt.1427.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

The Trunk: Morphic-mt.1427.mcz

commits-2
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@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@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@0 corner: 5@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@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@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@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@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@self borderWidth).
- ifFalse: [label fitContents; setWidth: (label width min: bounds width - labelWidgetAllowance).
- label align: label bounds topCenter with: bounds topCenter + (0@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@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@0 corner: 0@0.
  1 to: string size do:
  [:i |
  char := string at: i.
  glyph := font at: char.
  ttBounds := ttBounds quickMerge: (glyph bounds translateBy: xStart@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)'!