Squeak-dev May 2018

squeak-dev@lists.squeakfoundation.org

44 participants
189 discussions

The Trunk: 60Deprecated-mt.18.mcz
by commits＠source.squeak.org 06 May '18

06 May '18

Marcel Taeumel uploaded a new version of 60Deprecated to project The Trunk: http://source.squeak.org/trunk/60Deprecated-mt.18.mcz ==================== Summary ==================== Name: 60Deprecated-mt.18 Author: mt Time: 6 May 2018, 3:04:54.850836 pm UUID: c3fb6f9b-652f-c640-a2d9-61e690ffe944 Ancestors: 60Deprecated-pre.17 Supplement to refactoring in Morphic-mt.1427. =============== Diff against 60Deprecated-pre.17 =============== Item was added: + ----- Method: BorderStyle>>colorsAtCorners (in category '*60Deprecated-accessing') ----- + colorsAtCorners + + self deprecated: 'See #topLeftColor and #bottomRightColor.'. + ^Array new: 4 withAll: self color! Item was added: + ----- Method: BorderStyle>>dotOfSize:forDirection: (in category '*60Deprecated-accessing') ----- + dotOfSize: diameter forDirection: aDirection + + self deprecated: 'See Form for such convenience functions.'. + ^ Form dotOfSize: diameter color: self color! Item was added: + ----- Method: BorderStyle>>widthForRounding (in category '*60Deprecated-accessing') ----- + widthForRounding + + self deprecated: 'See BalloonCanvas for drawing rounded corners.'. + ^self width! Item was added: + ----- Method: BorderedMorph>>doesBevels (in category '*60Deprecated-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." + + self deprecated: 'Use border styles such as InsetBorder or RaisedBorder.'. + ^ false! Item was added: + ----- Method: ComplexBorder>>widthForRounding (in category '*60Deprecated-accessing') ----- + widthForRounding + + self deprecated: 'See BalloonCanvas for drawing rounded corners.'. + ^0! Item was added: + ----- Method: EllipseMorph>>doesBevels (in category '*60Deprecated-accessing') ----- + doesBevels + self deprecated: 'Use border styles such as InsetBorder or RaisedBorder.'. + ^ false! Item was added: + ----- Method: InsetBorder>>colorsAtCorners (in category '*60Deprecated-accessing') ----- + colorsAtCorners + + | c c14 c23 | + self deprecated: 'See #topLeftColor and #bottomRightColor.'. + + c := self color. + c14 := c lighter. c23 := c darker. + ^Array with: c23 with: c14 with: c14 with: c23.! Item was added: + ----- Method: Morph>>doesBevels (in category '*60Deprecated-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." + + self deprecated: 'Use border styles such as InsetBorder or RaisedBorder.'. + ^ false! Item was added: + ----- Method: RaisedBorder>>colorsAtCorners (in category '*60Deprecated-accessing') ----- + colorsAtCorners + + | c c14 c23 | + self deprecated: 'See #topLeftColor and #bottomRightColor.'. + c := self color. + c14 := c lighter. c23 := c darker. + ^Array with: c14 with: c23 with: c23 with: c14! Item was added: + ----- Method: TTSampleFontMorph>>doesBevels (in category '*60Deprecated-accessing') ----- + doesBevels + self deprecated: 'Use border styles such as InsetBorder or RaisedBorder.'. + ^ false!

1 0

The Trunk: Morphic-mt.1427.mcz
by commits＠source.squeak.org 06 May '18

06 May '18

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)'!

1 0

Regression in "Upgrade is Merge" preference?
by Marcel Taeumel 06 May '18

06 May '18

Hi, there. I just discovered a big mess in my working image. I have to recover a recent code slice because the update seems to have reverted several changes. It might be related to extension methods. I don't know. See the problem? Best, Marcel

2 3

WastCompilerToWasm.13.st
by Edgar De Cleene 05 May '18

05 May '18

https://youtu.be/Bx6frV_6qeE <https://youtu.be/Bx6frV_6qeE> Seems 13 is no bad luck :=)

1 0

Please transfer ownership or make me a co-maintainer of the orphaned SM "XPath" project
by monty 05 May '18

05 May '18

"monty" on map.squeak.org ___ montyos.wordpress.com

7 11

Two tests failing in trunk but not 5.1
by Tim Johnson 05 May '18

05 May '18

Hi, I ran some tests and found a couple that are failing. I also checked and found these tests don't fail in my 5.1 image. BrowserTest>>#testBuildMessageCategoryBrowserEditString DebuggerExtensionsTest>>#testCollectionsGeneralise I think the first one might actually be a case where a bug was fixed. The test fails because of a timeout, because there is a dialog on-screen which is not returning. Not sure, but the test may be intended to declare that the dialog should appear, and now it is (?). The second one, I don't understand. There is no comment. Image/VM info: Squeak6.0alpha latest update: #17922 Image format 6521 (32 bit) Virtual Machine --------------- C:\Users\tcj\Desktop\squeak.cog.spur_win32x86_201803080952\Squeak.exe Croquet Closure Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.2347] Win32 built on Mar 8 2018 11:08:39 GMT Compiler: 6.4.0 platform sources revision VM: 201803080952 Cheers, Tim

5 11

The Trunk: Tools-dtl.811.mcz
by commits＠source.squeak.org 05 May '18

05 May '18

David T. Lewis uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-dtl.811.mcz ==================== Summary ==================== Name: Tools-dtl.811 Author: dtl Time: 5 May 2018, 10:41:00.811008 am UUID: e5d09833-9847-4845-bd49-b0a7eef2cb81 Ancestors: Tools-dtl.810 Remove SequencableCollection>>canonicalArgumentName (introduced in Tools-eem.788) because it produces unexpected results in DebuggerExtensionsTest>>testCollectionsGeneralise. See discussion in [squeak-dev] Two tests failing in trunk but not 5.1 =============== Diff against Tools-dtl.810 =============== Item was removed: - ----- Method: SequenceableCollection>>canonicalArgumentName (in category '*Tools-Debugger') ----- - canonicalArgumentName - ^ 'Sequence'!

2 1

The Trunk: ToolsTests-dtl.82.mcz
by commits＠source.squeak.org 05 May '18

05 May '18

David T. Lewis uploaded a new version of ToolsTests to project The Trunk: http://source.squeak.org/trunk/ToolsTests-dtl.82.mcz ==================== Summary ==================== Name: ToolsTests-dtl.82 Author: dtl Time: 5 May 2018, 10:39:38.472254 am UUID: ec63abd1-1478-4ed0-b739-2f5119311e0d Ancestors: ToolsTests-mt.81 Update DebuggerExtensionsTest>>testCollectionsGeneralise per Tools-eem.788 to expect 'Array' rather than 'Collection' for Array and its subclasses. OrderedCollection and LinkedList should continue to answer 'Collection'. =============== Diff against ToolsTests-mt.81 =============== Item was changed: ----- Method: DebuggerExtensionsTest>>testCollectionsGeneralise (in category 'testing - canonical argument names') ----- testCollectionsGeneralise + "ArrayedCollection and subclasses answer 'Array' " + self assert: Array name equals: Array new canonicalArgumentName. + "Otherwise answer the more general 'Collection' " - self assert: Collection name equals: Array new canonicalArgumentName. self assert: Collection name equals: OrderedCollection new canonicalArgumentName. self assert: Collection name equals: LinkedList new canonicalArgumentName!

1 0

The Trunk: Monticello-nice.681.mcz
by commits＠source.squeak.org 04 May '18

04 May '18

Nicolas Cellier uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-nice.681.mcz ==================== Summary ==================== Name: Monticello-nice.681 Author: nice Time: 4 May 2018, 10:00:40.132663 pm UUID: 9efb006e-e55d-40d3-8a5a-57517ef6daf1 Ancestors: Monticello-mt.680 named: yet classified =============== Diff against Monticello-mt.680 =============== Item was changed: + ----- Method: MCPackage class>>named: (in category 'instance creation') ----- - ----- Method: MCPackage class>>named: (in category 'as yet unclassified') ----- named: aString ^ self new name: aString!

1 0

The Trunk: Graphics-mt.397.mcz
by commits＠source.squeak.org 04 May '18

04 May '18

Marcel Taeumel uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-mt.397.mcz ==================== Summary ==================== Name: Graphics-mt.397 Author: mt Time: 4 May 2018, 3:57:07.881404 pm UUID: 3dce1413-6ad1-a249-8115-0bbb3bd2a241 Ancestors: Graphics-nice.396 Avoid the creation of strange-looking fonts. If that font already exhibits the requested emphasis, do not try to do further magic. =============== Diff against Graphics-nice.396 =============== Item was changed: ----- Method: StrikeFont>>emphasized: (in category 'emphasis') ----- emphasized: code "Answer a copy of the receiver with emphasis set to include code." | derivative addedEmphasis base safeCode | code = 0 ifTrue: [^ self]. + code = self emphasis ifTrue: [^ self]. (derivativeFonts == nil or: [derivativeFonts size = 0]) ifTrue: [^ self]. derivative := derivativeFonts at: (safeCode := code min: derivativeFonts size). derivative == nil ifFalse: [^ derivative]. "Already have this style" "Dont have it -- derive from another with one with less emphasis" addedEmphasis := 1 bitShift: safeCode highBit - 1. base := self emphasized: safeCode - addedEmphasis. "Order is Bold, Ital, Under, Narrow" addedEmphasis = 1 ifTrue: "Compute synthetic bold version of the font" [derivative := (base copy ensureCleanBold name: base name , 'B') makeBoldGlyphs]. addedEmphasis = 2 ifTrue: "Compute synthetic italic version of the font" [ derivative := (base copy name: base name , 'I') makeItalicGlyphs]. addedEmphasis = 4 ifTrue: "Compute underlined version of the font" [derivative := (base copy name: base name , 'U') makeUnderlinedGlyphs]. addedEmphasis = 8 ifTrue: "Compute narrow version of the font" [derivative := (base copy name: base name , 'N') makeCondensedGlyphs]. addedEmphasis = 16 ifTrue: "Compute struck-out version of the font" [derivative := (base copy name: base name , 'X') makeStruckOutGlyphs]. derivative emphasis: safeCode. derivativeFonts at: safeCode put: derivative. ^ derivative!

1 0

Jump to page: