Squeak-dev July 2016

squeak-dev@lists.squeakfoundation.org

38 participants
224 discussions

The Trunk: ToolBuilder-Morphic-mt.174.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.174.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.174 Author: mt Time: 31 July 2016, 11:17:03.77049 am UUID: f9224283-fd0c-3e47-8895-a070844b3e2a Ancestors: ToolBuilder-Morphic-mt.173 *** Widget Refactorings and UI Themes (Part 6 of 11) *** Some fixes and refactorings for buttons including added support for UI theming. =============== Diff against ToolBuilder-Morphic-mt.173 =============== Item was changed: PluggableButtonMorph subclass: #PluggableButtonMorphPlus + instanceVariableNames: 'enabled action getColorSelector getEnabledSelector updateMap disabledColor disabledTextColor' - instanceVariableNames: 'enabled action getColorSelector getEnabledSelector updateMap' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Morphic'! !PluggableButtonMorphPlus commentStamp: 'ar 2/11/2005 21:53' prior: 0! An extended version of PluggableButtonMorph supporting enablement, color and block/message actions.! Item was added: + ----- Method: PluggableButtonMorphPlus class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #disabledColor. 'Colors'. 'Color when button cannot be clicked.' }. + { #disabledTextColor. 'Colors'. 'Color for label when button cannot be clicked.' }. + }! Item was added: + ----- Method: PluggableButtonMorphPlus>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme.! Item was changed: ----- Method: PluggableButtonMorphPlus>>enabled: (in category 'accessing') ----- enabled: aBool enabled := aBool. + self updateFillStyle.! - enabled - ifFalse:[self color: Color gray] - ifTrue:[self getModelState - ifTrue: [self color: onColor] - ifFalse: [self color: offColor]]! Item was changed: ----- Method: PluggableButtonMorphPlus>>getEnabledSelector: (in category 'accessing') ----- getEnabledSelector: aSymbol getEnabledSelector := aSymbol. + self update: getEnabledSelector.! - self update: aSymbol.! Item was added: + ----- Method: PluggableButtonMorphPlus>>handlesMouseDown: (in category 'event handling') ----- + handlesMouseDown: evt + ^ enabled! Item was added: + ----- Method: PluggableButtonMorphPlus>>handlesMouseOver: (in category 'event handling') ----- + handlesMouseOver: evt + ^ enabled! Item was added: + ----- Method: PluggableButtonMorphPlus>>handlesMouseOverDragging: (in category 'event handling') ----- + handlesMouseOverDragging: evt + ^ enabled! Item was changed: ----- Method: PluggableButtonMorphPlus>>initialize (in category 'initialize-release') ----- initialize + - super initialize. enabled := true. + super initialize.! - onColor := Color veryLightGray. - offColor := Color white! Item was removed: - ----- Method: PluggableButtonMorphPlus>>mouseDown: (in category 'action') ----- - mouseDown: evt - enabled ifFalse:[^self]. - ^super mouseDown: evt! Item was removed: - ----- Method: PluggableButtonMorphPlus>>mouseMove: (in category 'action') ----- - mouseMove: evt - enabled ifFalse:[^self]. - ^super mouseMove: evt! Item was removed: - ----- Method: PluggableButtonMorphPlus>>mouseUp: (in category 'action') ----- - mouseUp: evt - enabled ifFalse:[^self]. - ^super mouseUp: evt! Item was removed: - ----- Method: PluggableButtonMorphPlus>>onColor:offColor: (in category 'accessing') ----- - onColor: colorWhenOn offColor: colorWhenOff - "Set the fill colors to be used when this button is on/off." - - onColor := colorWhenOn. - offColor := colorWhenOff. - self update: getStateSelector.! Item was added: + ----- Method: PluggableButtonMorphPlus>>setDefaultParameters (in category 'initialize-release') ----- + setDefaultParameters + + disabledColor := (self userInterfaceTheme disabledColor ifNil: [Color transparent]). + disabledTextColor := (self userInterfaceTheme disabledTextColor ifNil: [Color gray: 0.6]). + + super setDefaultParameters. + ! Item was added: + ----- Method: PluggableButtonMorphPlus>>textColorToUse (in category 'drawing') ----- + textColorToUse + + ^ self enabled + ifTrue: [super textColorToUse] + ifFalse: [disabledTextColor ifNil: [Color gray: 0.6]]! Item was changed: ----- Method: PluggableButtonMorphPlus>>update: (in category 'updating') ----- update: what + super update: what. + + getColorSelector ifNotNil: [:sel | + what == sel ifTrue: [self offColor: (model perform: sel)]]. - self getModelState - ifTrue: [self color: onColor] - ifFalse: [self color: offColor]. + getEnabledSelector ifNotNil: [:sel | + what == sel ifTrue: [self enabled: (model perform: sel)]]. - what ifNil:[^self]. - what == getLabelSelector ifTrue: [ - self label: (model perform: getLabelSelector)]. - what == getEnabledSelector ifTrue:[^self enabled: (model perform: getEnabledSelector)]. - - getColorSelector ifNotNil: [ | cc | - color = (cc := model perform: getColorSelector) ifFalse:[ - color := cc. - self onColor: color offColor: color. - self changed. - ]. - ]. - - getEnabledSelector ifNotNil:[ - self enabled: (model perform: getEnabledSelector). - ]. updateMap ifNotNil: [(updateMap at: what ifAbsent: []) + ifNotNilDo: [ :newTarget | self update: newTarget]]. - ifNotNilDo: [ :newTarget | ^self update: newTarget]]. ! Item was added: + ----- Method: PluggableButtonMorphPlus>>updateFillStylePressing:hovering: (in category 'initialize-release') ----- + updateFillStylePressing: isPressing hovering: isHovering + + enabled ifFalse: [ + self color: (disabledColor ifNil: [Color transparent]). + self borderStyle color: Color transparent. + ^ self]. + + super updateFillStylePressing: isPressing hovering: isHovering.!

1 0

The Trunk: Morphic-mt.1212.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1212.mcz ==================== Summary ==================== Name: Morphic-mt.1212 Author: mt Time: 31 July 2016, 11:16:13.00249 am UUID: 33cfd9c4-1799-954f-a7fd-b73579490169 Ancestors: Morphic-mt.1211 *** Widget Refactorings and UI Themes (Part 6 of 11) *** Some fixes and refactorings for buttons including added support for UI theming. =============== Diff against Morphic-mt.1211 =============== Item was changed: + Morph subclass: #PluggableButtonMorph + instanceVariableNames: 'model label font getStateSelector actionSelector getLabelSelector getMenuSelector shortcutCharacter askBeforeChanging triggerOnMouseDown offColor onColor feedbackColor showSelectionFeedback allButtons arguments argumentsProvider argumentsSelector style hoverColor borderColor textColor labelOffset' - AlignmentMorph subclass: #PluggableButtonMorph - instanceVariableNames: 'model label font getStateSelector actionSelector getLabelSelector getMenuSelector shortcutCharacter askBeforeChanging triggerOnMouseDown offColor onColor feedbackColor showSelectionFeedback allButtons arguments argumentsProvider argumentsSelector style' classVariableNames: 'GradientButton RoundedButtonCorners' poolDictionaries: '' category: 'Morphic-Pluggable Widgets'! !PluggableButtonMorph commentStamp: '<historical>' prior: 0! A PluggableButtonMorph is a combination of an indicator for a boolean value stored in its model and an action button. The action of a button is often, but not always, to toggle the boolean value that it shows. Its pluggable selectors are: getStateSelector fetch a boolean value from the model actionSelector invoke this button's action on the model getLabelSelector fetch this button's lable from the model getMenuSelector fetch a pop-up menu for this button from the model Any of the above selectors can be nil, meaning that the model does not supply behavior for the given action, and the default behavior should be used. For example, if getStateSelector is nil, then this button shows the state of a read-only boolean that is always false. The model informs its view(s) of changes by sending #changed: to itself with getStateSelector as a parameter. The view tells the model when the button is pressed by sending actionSelector. If the actionSelector takes one or more arguments, then the following are relevant: arguments A list of arguments to provide when the actionSelector is called. argumentsProvider The object that is sent the argumentSelector to obtain arguments, if dynamic argumentsSelector The message sent to the argumentProvider to obtain the arguments. Options: askBeforeChanging have model ask user before allowing a change that could lose edits triggerOnMouseDown do this button's action on mouse down (vs. up) transition shortcutCharacter a place to record an optional shortcut key ! Item was changed: ----- Method: PluggableButtonMorph class>>gradientButton: (in category 'preferences') ----- gradientButton: aBoolean + GradientButton = aBoolean ifTrue: [^ self]. + GradientButton := aBoolean. + + PluggableButtonMorph allSubInstancesDo: [:ea | ea updateFillStyle].! - GradientButton := aBoolean.! Item was added: + ----- Method: PluggableButtonMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the button''s border.' }. + { #borderWidth. 'Borders'. 'Width of the button''s border.' }. + { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. + { #color. 'Colors'. 'Background color of the button.' }. + + { #font. 'Fonts'. 'Font for button title.' }. + { #textColor. 'Colors'. 'Color for the button title label.' }. + }! Item was added: + ----- Method: PluggableButtonMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + self setDefaultParameters.! Item was removed: - ----- Method: PluggableButtonMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 1! Item was removed: - ----- Method: PluggableButtonMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color gray: 0.7! Item was removed: - ----- Method: PluggableButtonMorph>>drawBackgroundOn: (in category 'drawing') ----- - drawBackgroundOn: aCanvas - | cc gradient borderColor fill | - cc := self color. - cc isTransparent ifTrue:[cc := Color gray: 0.9]. - self enabled ifFalse:[cc := Color lightGray]. - cc brightness > 0.9 ifTrue:[cc := cc adjustBrightness: 0.9 - cc brightness]. - showSelectionFeedback ifTrue:[ - borderColor := cc muchDarker. - gradient := GradientFillStyle ramp: { - 0.0 -> cc muchDarker. - 0.1-> (cc adjustBrightness: -0.2). - 0.5 -> cc. - 0.9-> (cc adjustBrightness: -0.1). - 1 -> cc muchDarker}. - cc := cc muchDarker. - ] ifFalse:[ - borderColor := Color lightGray. - gradient := GradientFillStyle ramp: { - 0.0 -> Color white. - 0.1-> (cc adjustBrightness: 0.05). - 0.6 -> (cc darker)}. - ]. - gradient origin: bounds topLeft. - gradient direction: 0@self height. - - PluggableButtonMorph gradientButton - ifFalse: [fill := SolidFillStyle color: cc] - ifTrue: [fill := gradient]. - - ^ self wantsRoundedCorners - ifTrue: [aCanvas - frameAndFillRoundRect: self bounds - radius: self cornerRadius - fillStyle: fill - borderWidth: 1 - borderColor: borderColor] - ifFalse: [aCanvas - frameAndFillRectangle: self bounds - fillColor: fill asColor - borderWidth: 1 - borderColor: borderColor darker; - fillRectangle: self innerBounds - fillStyle: fill]! Item was changed: ----- Method: PluggableButtonMorph>>drawLabelOn: (in category 'drawing') ----- drawLabelOn: aCanvas + | fontToUse labelToUse colorToUse labelWidth layoutBounds drawBlock | - | fontToUse labelToUse labelWidth layoutBounds drawBlock | self label ifNil: [^ self]. layoutBounds := self layoutBounds. labelToUse := self label asString. fontToUse := self font. + colorToUse := self textColorToUse. "Support very narrow buttons. Shrink text to monogram then." (layoutBounds width < self labelShrinkThreshold and: [labelToUse size > 3]) ifTrue: [ labelToUse := labelToUse first asString. "Show first character only." fontToUse := fontToUse emphasized: (TextEmphasis bold) emphasisCode]. labelWidth := fontToUse widthOfString: labelToUse. drawBlock := [:c | c drawString: labelToUse at: (layoutBounds center x - (labelWidth // 2) max: (layoutBounds left)) @ (layoutBounds center y - (fontToUse height // 2)) font: fontToUse + color: colorToUse]. - color: Color black]. self clipSubmorphs ifTrue: [aCanvas clipBy: layoutBounds during: drawBlock] ifFalse: [drawBlock value: aCanvas]! Item was changed: ----- Method: PluggableButtonMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas + (self fillStyle isColor not and: [self fillStyle isGradientFill]) + ifTrue: [self fillStyle origin: self topLeft; direction: 0@ self height]. + + super drawOn: aCanvas. - self drawBackgroundOn: aCanvas. + aCanvas + translateBy: self labelOffset + during: [:c | + self label isMorph + ifTrue: [self drawMorphLabelOn: c] + ifFalse: [self drawLabelOn: c]].! - self label isMorph - ifTrue: [self drawMorphLabelOn: aCanvas] - ifFalse: [self drawLabelOn: aCanvas].! Item was added: + ----- Method: PluggableButtonMorph>>feedbackColor (in category 'accessing') ----- + feedbackColor + ^ feedbackColor! Item was changed: + ----- Method: PluggableButtonMorph>>initialize (in category 'initialization') ----- - ----- Method: PluggableButtonMorph>>initialize (in category 'initialize-release') ----- initialize super initialize. "Layout properties." self extent: 20 @ 15; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: (4@0 corner: 4@0); clipSubmorphs: true; wrapCentering: #center; cellPositioning: #topCenter. - "Visuals." - self borderStyle: BorderStyle thinGray. - "Initialize instance variables." model := nil. label := nil. getStateSelector := nil. actionSelector := nil. getLabelSelector := nil. getMenuSelector := nil. shortcutCharacter := nil. askBeforeChanging := false. triggerOnMouseDown := false. - onColor := self color darker. - offColor := self color. - feedbackColor := Color red. - showSelectionFeedback := false. allButtons := nil. argumentsProvider := nil. + argumentsSelector := nil. + + self setDefaultParameters. + ! - argumentsSelector := nil.! Item was changed: ----- Method: PluggableButtonMorph>>label: (in category 'accessing') ----- label: aStringOrTextOrMorph label = aStringOrTextOrMorph ifTrue: [^ self]. + label := aStringOrTextOrMorph isString + ifFalse: [aStringOrTextOrMorph asMorph] + ifTrue: [aStringOrTextOrMorph]. - label := aStringOrTextOrMorph isText - ifTrue: [aStringOrTextOrMorph asMorph] - ifFalse: [aStringOrTextOrMorph]. self updateMinimumExtent. self changed.! Item was added: + ----- Method: PluggableButtonMorph>>labelOffset (in category 'accessing') ----- + labelOffset + ^ labelOffset ifNil: [0@0]! Item was added: + ----- Method: PluggableButtonMorph>>labelOffset: (in category 'accessing') ----- + labelOffset: aPoint + labelOffset := aPoint.! Item was changed: ----- Method: PluggableButtonMorph>>mouseDown: (in category 'event handling') ----- mouseDown: evt "Details: If this button is triggered on mouse down or the event is the menu gesture, handle it immediately. Otherwise, make a list of buttons (including the receiver) for mouseMove feedback. This allows a simple radio-button effect among the button submorphs of a given morph." allButtons := nil. evt yellowButtonPressed ifTrue: [^ self invokeMenu: evt]. triggerOnMouseDown ifTrue: [self performAction] ifFalse: [ allButtons := owner submorphs select: [:m | m class = self class]. + self updateFillStyle: evt]. - self updateFeedbackForEvt: evt]. ! Item was changed: ----- Method: PluggableButtonMorph>>mouseEnter: (in category 'event handling') ----- mouseEnter: evt + self updateFillStyle: evt.! - "0.09375 is exact in floating point so no cumulative rounding error will occur" - self color: (self color adjustBrightness: -0.09375)! Item was changed: ----- Method: PluggableButtonMorph>>mouseLeave: (in category 'event handling') ----- mouseLeave: evt + self updateFillStyle: evt.! - "0.09375 is exact in floating point so no cumulative rounding error will occur" - self color: (self color adjustBrightness: 0.09375). - self update: nil! Item was changed: ----- Method: PluggableButtonMorph>>mouseMove: (in category 'event handling') ----- mouseMove: evt allButtons ifNil: [^ self]. + allButtons do: [:m | m updateFillStyle: evt].! - allButtons do: [:m | m updateFeedbackForEvt: evt]. - ! Item was changed: ----- Method: PluggableButtonMorph>>mouseUp: (in category 'event handling') ----- mouseUp: evt + self updateFillStyle: evt. + - showSelectionFeedback := false. - borderColor isColor ifFalse:[borderColor := #raised]. allButtons ifNil: [^ self]. allButtons do: [:m | (m containsPoint: evt cursorPoint) ifTrue: [m performAction]]. allButtons := nil. self changed. ! Item was changed: ----- Method: PluggableButtonMorph>>offColor: (in category 'accessing') ----- offColor: colorWhenOff "Set the fill colors to be used when this button is off." + | cc | + cc := colorWhenOff isTransparent ifTrue: [(Color gray: 0.9) alpha: 0.5] ifFalse: [colorWhenOff]. + self + onColor: ((self userInterfaceTheme selectionModifier ifNil: [ [:c | c adjustBrightness: -0.2] ]) value: cc) + offColor: cc - self onColor: onColor offColor: colorWhenOff ! Item was changed: + ----- Method: PluggableButtonMorph>>on:getState:action:label:menu: (in category 'initialization') ----- - ----- Method: PluggableButtonMorph>>on:getState:action:label:menu: (in category 'initialize-release') ----- on: anObject getState: getStateSel action: actionSel label: labelSel menu: menuSel self model: anObject. getStateSelector := getStateSel. actionSelector := actionSel. getLabelSelector := labelSel. getMenuSelector := menuSel. + self update: labelSel. + self update: getStateSel. + self updateFillStyle.! - ! Item was changed: ----- Method: PluggableButtonMorph>>onColor:offColor: (in category 'accessing') ----- onColor: colorWhenOn offColor: colorWhenOff "Set the fill colors to be used when this button is on/off." onColor := colorWhenOn. offColor := colorWhenOff. + + hoverColor := (self userInterfaceTheme hoverModifier ifNil: [ [:c | c adjustBrightness: -0.1] ]) value: offColor. + feedbackColor := (self userInterfaceTheme feedbackModifier ifNil: [ [:c | c adjustBrightness: -0.3] ]) value: offColor. + + self updateFillStyle.! - self update: nil. - ! Item was added: + ----- 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]); + 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 added: + ----- Method: PluggableButtonMorph>>textColor (in category 'accessing') ----- + textColor + ^ textColor ifNil: [Color black "old instances"]! Item was added: + ----- Method: PluggableButtonMorph>>textColor: (in category 'accessing') ----- + textColor: aColor + textColor := aColor. + self changed.! Item was added: + ----- Method: PluggableButtonMorph>>textColorToUse (in category 'drawing') ----- + textColorToUse + + ^ self textColor! Item was changed: ----- Method: PluggableButtonMorph>>update: (in category 'updating') ----- update: aParameter + getLabelSelector ifNotNil: [:sel | + aParameter == sel ifTrue: [self label: (model perform: sel)]]. + getStateSelector ifNotNil: [:sel | + aParameter == sel ifTrue: [self updateFillStyle]].! - getLabelSelector ifNotNil: [ - aParameter == getLabelSelector ifTrue: [ - self label: (model perform: getLabelSelector)]]. - self getModelState - ifTrue: [self color: onColor] - ifFalse: [self color: offColor]. - ! Item was removed: - ----- Method: PluggableButtonMorph>>updateFeedbackForEvt: (in category 'events') ----- - updateFeedbackForEvt: evt - - | newState | - newState := self containsPoint: evt cursorPoint. - newState = showSelectionFeedback ifFalse: [ - borderColor isColor - ifTrue:[showSelectionFeedback := newState] - ifFalse:[borderColor := newState ifTrue:[#inset] ifFalse:[#raised]]. - self changed]. - ! Item was added: + ----- Method: PluggableButtonMorph>>updateFillStyle (in category 'updating') ----- + updateFillStyle + + self + updateFillStylePressing: false + hovering: false.! Item was added: + ----- Method: PluggableButtonMorph>>updateFillStyle: (in category 'updating') ----- + updateFillStyle: evt + + self + updateFillStylePressing: (evt redButtonPressed and: [self containsPoint: evt position]) + hovering: (evt redButtonPressed not and: [self containsPoint: evt position]).! Item was added: + ----- Method: PluggableButtonMorph>>updateFillStylePressing:hovering: (in category 'updating') ----- + updateFillStylePressing: isPressing hovering: isHovering + + | gradient cc | + "Migrate old instances." + hoverColor ifNil: [hoverColor := onColor darker]. + + self labelOffset: (isPressing ifTrue: [1@1] ifFalse: [0@0]). + + self getModelState + ifTrue: [self color: onColor] + ifFalse: [self color: offColor]. + self borderColor: borderColor. + + self class gradientButton ifFalse: [ + isPressing ifTrue: [ + self color: feedbackColor. + self borderColor: feedbackColor muchDarker]. + isHovering ifTrue: [ + self color: hoverColor. + self borderColor: borderColor]. + ^ self]. + + isPressing ifTrue: [ + cc := feedbackColor. + self borderColor: feedbackColor muchDarker. + gradient := GradientFillStyle ramp: { + 0.0 -> cc muchDarker. + 0.1-> (cc adjustBrightness: -0.2). + 0.5 -> cc. + 0.9-> (cc adjustBrightness: -0.1). + 1 -> cc muchDarker}]. + isHovering ifTrue: [ + cc := hoverColor. + gradient := GradientFillStyle ramp: { + 0.0 -> Color white. + 0.1-> (cc adjustBrightness: 0.05). + 0.6 -> (cc darker)}]. + gradient ifNil: [ + cc := self color. + gradient := GradientFillStyle ramp: { + 0.0 -> Color white. + 0.1-> (cc adjustBrightness: 0.05). + 0.6 -> (cc darker)}]. + + gradient origin: bounds topLeft. + gradient direction: 0@self height. + + self fillStyle: gradient.! Item was changed: ----- Method: PluggableButtonMorph>>veryDeepInner: (in category 'copying') ----- veryDeepInner: deepCopier "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment." super veryDeepInner: deepCopier. "model := model. Weakly copied" label := label veryDeepCopyWith: deepCopier. "getStateSelector := getStateSelector. a Symbol" "actionSelector := actionSelector. a Symbol" "getLabelSelector := getLabelSelector. a Symbol" "getMenuSelector := getMenuSelector. a Symbol" shortcutCharacter := shortcutCharacter veryDeepCopyWith: deepCopier. askBeforeChanging := askBeforeChanging veryDeepCopyWith: deepCopier. triggerOnMouseDown := triggerOnMouseDown veryDeepCopyWith: deepCopier. offColor := offColor veryDeepCopyWith: deepCopier. onColor := onColor veryDeepCopyWith: deepCopier. feedbackColor := feedbackColor veryDeepCopyWith: deepCopier. + hoverColor := hoverColor veryDeepCopyWith: deepCopier. + borderColor := borderColor veryDeepCopyWith: deepCopier. + textColor := textColor veryDeepCopyWith: deepCopier. + labelOffset := labelOffset veryDeepCopyWith: deepCopier. - showSelectionFeedback := showSelectionFeedback veryDeepCopyWith: deepCopier. allButtons := nil. "a cache" arguments := arguments veryDeepCopyWith: deepCopier. argumentsProvider := argumentsProvider veryDeepCopyWith: deepCopier. "argumentsSelector := argumentsSelector. a Symbol" style := style. "a Symbol"!

1 0

The Trunk: ToolBuilder-Morphic-mt.173.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.173.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.173 Author: mt Time: 31 July 2016, 11:11:41.15449 am UUID: 859eb0f9-c596-2f48-9ae3-a3f8056450c5 Ancestors: ToolBuilder-Morphic-mt.172 *** Widget Refactorings and UI Themes (Part 5 of 11) *** Some fixes and refactorings for dialogs including added support for UI theming. =============== Diff against ToolBuilder-Morphic-mt.172 =============== Item was changed: Model subclass: #ListChooser + instanceVariableNames: 'selectedIndex items searchText addAllowed result title listMorph dialogMorph' - instanceVariableNames: 'window fullList selectedItems searchText searchMorph title listMorph index realIndex buttonBar builder addAllowed result' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Morphic'! !ListChooser commentStamp: 'MAD 3/14/2010 16:20' prior: 0! I am a simple dialog to allow the user to pick from a list of strings or symbols. I support keyboard and mouse navigation, and interactive filtering of the displayed items. You can specify whether you want the index, or the value of the selected item. If you're interested in the value, you can also allow users to Add a new value not in the list. cmd-s or <enter> or double-click answers the currently selected item's value/index; cmd-l or <escape> or closing the window answers nil/zero. Now using ToolBuilder, so needs Morphic-MAD.381. Released under the MIT Licence.! Item was added: + ----- Method: ListChooser class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #okColor. 'Colors'. 'Color for the OK button.' }. + { #cancelColor. 'Colors'. 'Color for the Cancel button.' }. + { #addColor. 'Colors'. 'Color for a normal button.' }. + { #disabledColor. 'Colors'. 'Color for a disabled button.' }. + }! Item was changed: + ----- Method: ListChooser>>accept (in category 'actions') ----- - ----- Method: ListChooser>>accept (in category 'event handling') ----- accept "if the user submits with no valid entry, make them start over" - self canAccept ifFalse: [ - searchMorph selectAll. - ^ self ]. + | choice | + self canAccept ifFalse: [ + self canAdd ifTrue: [^ self add]. + ^ self changed: #textSelection]. + + choice := self selectedItem. + + self canAdd ifTrue: [ + "Ask the user whether to add the new item or choose the list selection." + (UserDialogBoxMorph confirm: 'You can either choose an existing item or add a new one.\What do you want?' translated withCRs title: 'Choose or Add' translated trueChoice: choice asString falseChoice: self searchText asString at: ActiveHand position) + ifTrue: [self result: choice] ifFalse: [self result: self searchText asString] + ] ifFalse: [self result: choice]. + + + self changed: #close.! - "find the selected item in the original list, and return it" - result := selectedItems at: index. - - builder ifNotNil: [ :bldr | - builder := nil. - bldr close: window ]! Item was changed: + ----- Method: ListChooser>>acceptColor (in category 'colors') ----- - ----- Method: ListChooser>>acceptColor (in category 'drawing') ----- acceptColor + + self canAdd ifTrue: [^ self addColor]. + ^ self canAccept + ifTrue: [ self userInterfaceTheme okColor ifNil: [(Color r: 0.49 g: 0.749 b: 0.49)] ] + ifFalse: [ self userInterfaceTheme disabledColor ifNil: [Color lightGray] ]! - ifTrue: [ ColorTheme current okColor ] - ifFalse: [ Color lightGray "ColorTheme current disabledColor <- you don't have this!!" ]! Item was added: + ----- Method: ListChooser>>acceptLabel (in category 'colors') ----- + acceptLabel + + ^ self canAdd + ifFalse: ['Choose' translated] + ifTrue: [self canAccept + ifTrue: ['Choose or Add' translated] + ifFalse: ['Add' translated]]! Item was changed: + ----- Method: ListChooser>>acceptText: (in category 'actions') ----- - ----- Method: ListChooser>>acceptText: (in category 'event handling') ----- acceptText: someText "the text morph wants to tell us about its contents but I don't care, I'm only interested in the list" self accept! Item was changed: + ----- Method: ListChooser>>add (in category 'actions') ----- - ----- Method: ListChooser>>add (in category 'event handling') ----- add "if the user submits with no valid entry, make them start over" + self canAdd ifFalse: [^ self changed: #textSelection]. + self result: self searchText asString. + self changed: #close.! - self canAdd ifFalse: [ - searchMorph selectAll. - ^ self ]. - - "find the string to return" - result := searchMorph getText. - - builder ifNotNil: [ :bldr | - builder := nil. - bldr close: window ]! Item was added: + ----- Method: ListChooser>>addAllowed (in category 'accessing') ----- + addAllowed + + ^ addAllowed! Item was added: + ----- Method: ListChooser>>addAllowed: (in category 'accessing') ----- + addAllowed: anObject + + addAllowed := anObject! Item was added: + ----- Method: ListChooser>>addColor (in category 'colors') ----- + addColor + + ^ self canAdd + ifTrue: [ self userInterfaceTheme addColor ifNil: [Color blue muchLighter] ] + ifFalse: [ self userInterfaceTheme disabledColor ifNil: [Color lightGray] ]! Item was added: + ----- Method: ListChooser>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self + changed: #okColor; + changed: #cancelColor; + changed: #addColor.! Item was removed: - ----- Method: ListChooser>>buildButtonBarWith: (in category 'building') ----- - buildButtonBarWith: builder - | panel button | - panel := builder pluggablePanelSpec new - model: self; - layout: #proportional; - children: OrderedCollection new. - button := builder pluggableButtonSpec new. - button - model: self; - label: 'Accept (s)'; - action: #accept; - enabled: #canAccept; - state: #canAccept; - color: #acceptColor; - frame: (0.0 @ 0.0 corner: 0.34@1). - panel children add: button. - - button := builder pluggableButtonSpec new. - button - model: self; - label: 'Add (a)'; - action: #add; - enabled: #canAdd; - frame: (0.36 @ 0.0 corner: 0.63@1). - panel children add: button. - - button := builder pluggableButtonSpec new. - button - model: self; - label: 'Cancel (l)'; - action: #cancel; - color: #cancelColor; - frame: (0.65 @ 0.0 corner: 1@1). - panel children add: button. - - ^ panel! Item was removed: - ----- Method: ListChooser>>buildListMorphWith: (in category 'building') ----- - buildListMorphWith: builder - | listSpec | - listSpec := builder pluggableListSpec new. - listSpec - model: self; - list: #list; - getIndex: #selectedIndex; - setIndex: #selectedIndex:; - doubleClick: #accept; - "handleBasicKeys: false;" - keystrokePreview: #keyStrokeFromList:; - "doubleClickSelector: #accept;" - autoDeselect: false. - ^ listSpec! Item was removed: - ----- Method: ListChooser>>buildSearchMorphWith: (in category 'building') ----- - buildSearchMorphWith: builder - | fieldSpec | - fieldSpec := builder pluggableInputFieldSpec new. - fieldSpec - model: self; - getText: #searchText; - setText: #acceptText:; - menu: nil. - "hideScrollBarsIndefinitely;" - "acceptOnCR: true;" - "setBalloonText: 'Type a string to filter down the listed items'." - "onKeyStrokeSend: #keyStroke: to: self." - ^ fieldSpec! Item was removed: - ----- Method: ListChooser>>buildWindowWith: (in category 'building') ----- - buildWindowWith: builder - | windowSpec | - windowSpec := builder pluggableWindowSpec new. - windowSpec model: self. - windowSpec label: #title. - windowSpec children: OrderedCollection new. - ^windowSpec! Item was removed: - ----- Method: ListChooser>>buildWindowWith:specs: (in category 'building') ----- - buildWindowWith: builder specs: specs - | windowSpec | - windowSpec := self buildWindowWith: builder. - specs do: [ :assoc | - | rect action widgetSpec | - rect := assoc key. - action := assoc value. - widgetSpec := action value. - widgetSpec ifNotNil:[ - widgetSpec frame: rect. - windowSpec children add: widgetSpec ] ]. - ^ windowSpec! Item was changed: ----- Method: ListChooser>>buildWith: (in category 'building') ----- + buildWith: builder + + | dialogSpec searchBarHeight listSpec fieldSpec | - buildWith: aBuilder - | windowSpec searchBarHeight buttonBarHeight | - builder := aBuilder. searchBarHeight := Preferences standardDefaultTextFont height * 2. - buttonBarHeight := Preferences standardButtonFont height * 4. + dialogSpec := builder pluggableDialogSpec new + model: self; + title: #title; + closeAction: #closed; + extent: self initialExtent; + children: OrderedCollection new; + buttons: OrderedCollection new; + yourself. - windowSpec := self buildWindowWith: builder specs: { - (LayoutFrame fractions: (0@0 corner: 1@0) offsets: (0@0 corner: 0@searchBarHeight)) -> [self buildSearchMorphWith: builder]. - (LayoutFrame fractions: (0@0 corner: 1@1) offsets: (0@searchBarHeight corner: 0@buttonBarHeight negated)) -> [self buildListMorphWith: builder]. - (LayoutFrame fractions: (0@1 corner: 1@1) offsets: (0@buttonBarHeight negated corner: 0@0)) -> [self buildButtonBarWith: builder]. - }. - windowSpec closeAction: #closed. - windowSpec extent: self initialExtent. - window := builder build: windowSpec. + listSpec := builder pluggableListSpec new. + listSpec + model: self; + list: #items; + getIndex: #selectedIndex; + setIndex: #selectedIndex:; + doubleClick: #accept; + "keystrokePreview: #keyStrokeFromList:;" + autoDeselect: false; + name: #list; + frame: (LayoutFrame fractions: (0@0 corner: 1@1) offsets: (0@searchBarHeight corner: 0@0)). + dialogSpec children add: listSpec. + fieldSpec := builder pluggableInputFieldSpec new. + fieldSpec + model: self; + getText: #searchText; + editText: #searchText:; + setText: #acceptText:; + selection: #textSelection; + menu: nil; + indicateUnacceptedChanges: false; + askBeforeDiscardingEdits: false; + help: 'Type a string to filter down the listed items'; + frame: (LayoutFrame fractions: (0@0 corner: 1@0) offsets: (0@0 corner: 0@searchBarHeight)). + dialogSpec children add: fieldSpec. + + "Buttons" + dialogSpec buttons add: ( + builder pluggableButtonSpec new + model: self; + label: #acceptLabel; + action: #accept; + enabled: #canAcceptOrAdd; + color: #acceptColor). + + dialogSpec buttons add: ( + builder pluggableButtonSpec new + model: self; + label: 'Cancel'; + action: #cancel; + color: #cancelColor). + + dialogMorph := builder build: dialogSpec. + dialogMorph addKeyboardCaptureFilter: self. + listMorph := builder widgetAt: #list. + listMorph allowEmptyFilterResult: true. + + ^ dialogMorph! - searchMorph := window submorphs detect: - [ :each | each isKindOf: PluggableTextMorph ]. - searchMorph - hideScrollBarsIndefinitely; - acceptOnCR: true; - setBalloonText: 'Type a string to filter down the listed items'; - onKeyStrokeSend: #keyStroke: to: self; - hasUnacceptedEdits: true "force acceptOnCR to work even with no text entered". - listMorph := window submorphs detect: - [ :each | each isKindOf: PluggableListMorph ]. - ^ window! Item was added: + ----- Method: ListChooser>>canAcceptOrAdd (in category 'testing') ----- + canAcceptOrAdd + ^ self canAccept or: [self canAdd]! Item was changed: ----- Method: ListChooser>>canAdd (in category 'testing') ----- canAdd + ^ self addAllowed + and: [self searchText asString withBlanksTrimmed notEmpty] + and: [self selectedItem asString ~= self searchText asString]! - ^ addAllowed and: [ self canAccept not ]! Item was changed: + ----- Method: ListChooser>>cancel (in category 'actions') ----- - ----- Method: ListChooser>>cancel (in category 'event handling') ----- cancel + + self result: nil. + self changed: #close.! - "Cancel the dialog and move on" - index := 0. - builder ifNotNil: [ builder close: window ]! Item was changed: + ----- Method: ListChooser>>cancelColor (in category 'colors') ----- - ----- Method: ListChooser>>cancelColor (in category 'drawing') ----- cancelColor + + ^ self userInterfaceTheme cancelColor ifNil: [Color r: 1 g: 0.6 b: 0.588]! - ^ ColorTheme current cancelColor! Item was changed: ----- Method: ListChooser>>chooseIndexFrom:title: (in category 'initialize-release') ----- chooseIndexFrom: labelList title: aString | choice | choice := self chooseItemFrom: labelList title: aString addAllowed: false. + ^ self items indexOf: choice ifAbsent: 0! - ^ fullList indexOf: choice ifAbsent: 0! Item was changed: ----- Method: ListChooser>>chooseIndexFrom:title:addAllowed: (in category 'initialize-release') ----- chooseIndexFrom: labelList title: aString addAllowed: aBoolean | choice | choice := self chooseItemFrom: labelList title: aString addAllowed: false. + self addAllowed: aBoolean. + ^ self items indexOf: choice ifAbsent: 0! - addAllowed := aBoolean. - ^ fullList indexOf: choice ifAbsent: 0! Item was changed: ----- Method: ListChooser>>chooseItemFrom:title:addAllowed: (in category 'initialize-release') ----- chooseItemFrom: labelList title: aString addAllowed: aBoolean + + self items: labelList asOrderedCollection. - fullList := labelList asOrderedCollection. "coerce everything into an OC" - builder := ToolBuilder default. - self list: fullList. self title: aString. + self addAllowed: aBoolean. + + ToolBuilder open: self. + ^ self result! - addAllowed := aBoolean. - window := ToolBuilder default open: self. - window center: Sensor cursorPoint. - window setConstrainedPosition: (Sensor cursorPoint - (window fullBounds extent // 2)) hangOut: false. - - self changed: #inputRequested with: #searchText. - window lookFocused. "Sigh..." - - builder runModal: window. - ^ result! Item was changed: + ----- Method: ListChooser>>closed (in category 'actions') ----- - ----- Method: ListChooser>>closed (in category 'event handling') ----- closed + + self selectedIndex: 0.! - "Cancel the dialog and move on" - builder ifNotNil: [ index := 0 ]! Item was added: + ----- Method: ListChooser>>filterEvent:for: (in category 'event handling') ----- + filterEvent: aKeyboardEvent for: aMorph + + | char | + aKeyboardEvent isKeystroke ifFalse: [^ aKeyboardEvent]. + aKeyboardEvent anyModifierKeyPressed ifTrue: [^ aKeyboardEvent]. + + char := aKeyboardEvent keyCharacter. + + char = Character backspace + ifTrue: [self searchText: (self searchText asString ifNotEmpty: [:s | s allButLast]). ^ aKeyboardEvent ignore]. + char = Character delete + ifTrue: [self searchText: (self searchText asString ifNotEmpty: [:s | s allButFirst]). ^ aKeyboardEvent ignore]. + (char = Character cr or: [char = Character enter]) + ifTrue: [self accept. aKeyboardEvent ignore]. + char = Character escape + ifTrue: [self cancel. aKeyboardEvent ignore]. + (char asInteger between: 32 and: 126) + ifTrue: [self searchText: self searchText asString, char asString. aKeyboardEvent ignore]. + + ^ aKeyboardEvent! Item was removed: - ----- Method: ListChooser>>handlesKeyboard: (in category 'event handling') ----- - handlesKeyboard: evt - ^ true! Item was changed: ----- Method: ListChooser>>initialExtent (in category 'building') ----- initialExtent + + | listFont | - | listFont titleFont buttonFont listWidth titleWidth buttonWidth | listFont := Preferences standardListFont. + ^ (20 * (listFont widthOf: $m))@(15 * listFont height)! - titleFont := Preferences windowTitleFont. - buttonFont := Preferences standardButtonFont. - listWidth := 20 * (listFont widthOf: $m). - titleWidth := titleFont widthOfString: self title, '__________'. "add some space for titlebar icons" - buttonWidth := buttonFont widthOfString: '_Accept_(s)___Add (a)___Cancel_(l)_'. - ^ (listWidth max: (titleWidth max: buttonWidth))@(30 * (listFont height))! Item was added: + ----- Method: ListChooser>>items (in category 'accessing') ----- + items + + ^ items! Item was added: + ----- Method: ListChooser>>items: (in category 'accessing') ----- + items: anObject + + items := anObject! Item was removed: - ----- Method: ListChooser>>keyStroke: (in category 'event handling') ----- - keyStroke: event - | newText key | - "handle updates to the search box interactively" - key := event keyString. - (key = '<up>') ifTrue: [ - self move: -1. - ^ self ]. - (key = '<down>') ifTrue: [ - self move: 1. - ^ self ]. - - (key = '<Cmd-s>') ifTrue: [ self accept. ^ self ]. - (key = '<cr>') ifTrue: [ self accept. ^ self ]. - - (key = '<escape>') ifTrue: [ self cancel. ^ self ]. - (key = '<Cmd-l>') ifTrue: [ self cancel. ^ self ]. - - (key = '<Cmd-a>') ifTrue: [ self add. ^ self ]. - - "pull out what's been typed, and update the list as required" - newText := searchMorph textMorph asText asString. - (newText = searchText) ifFalse: [ - searchText := newText. - self updateFilter ]. - ! Item was removed: - ----- Method: ListChooser>>keyStrokeFromList: (in category 'event handling') ----- - keyStrokeFromList: event - "we don't want the list to be picking up events, excepting scroll events" - - "Don't sent ctrl-up/ctrl-down events to the searchMorph: they're scrolling events." - (#(30 31) contains: [:each | each = event keyValue]) not - ifTrue: - ["window world primaryHand keyboardFocus: searchMorph." - searchMorph keyStroke: event. - "let the list know we've dealt with it" - ^true]. - ^false. - ! Item was removed: - ----- Method: ListChooser>>list (in category 'accessing') ----- - list - ^ selectedItems! Item was removed: - ----- Method: ListChooser>>list: (in category 'accessing') ----- - list: items - fullList := items. - selectedItems := items. - self changed: #itemList.! Item was removed: - ----- Method: ListChooser>>list:title: (in category 'accessing') ----- - list: aList title: aString - self list: aList. - self title: aString! Item was removed: - ----- Method: ListChooser>>move: (in category 'event handling') ----- - move: offset - | newindex | - "The up arrow key moves the cursor, and it seems impossible to restore. - So, for consistency, on either arrow, select everything, so a new letter-press starts over. yuk." - searchMorph selectAll. - - newindex := self selectedIndex + offset. - newindex > selectedItems size ifTrue: [ ^ nil ]. - newindex < 1 ifTrue: [ ^ nil ]. - self selectedIndex: newindex. - ! Item was removed: - ----- Method: ListChooser>>moveWindowNear: (in category 'drawing') ----- - moveWindowNear: aPoint - | trialRect delta | - trialRect := Rectangle center: aPoint extent: window fullBounds extent. - delta := trialRect amountToTranslateWithin: World bounds. - window position: trialRect origin + delta.! Item was removed: - ----- Method: ListChooser>>realIndex (in category 'accessing') ----- - realIndex - ^ realIndex ifNil: [ 0 ]! Item was added: + ----- Method: ListChooser>>result (in category 'accessing') ----- + result + + ^ result! Item was added: + ----- Method: ListChooser>>result: (in category 'accessing') ----- + result: anObject + + result := anObject! Item was changed: ----- Method: ListChooser>>searchText: (in category 'accessing') ----- searchText: aString + searchText := aString. + listMorph filterList: aString asString. + + self changed: #searchText. + self changed: #canAcceptOrAdd. + self changed: #acceptLabel. + self changed: #buttons.! - searchText := aString! Item was changed: ----- Method: ListChooser>>selectedIndex (in category 'accessing') ----- selectedIndex + ^ selectedIndex ifNil: [ 1 ]! - ^ index ifNil: [ index := 1 ]! Item was changed: ----- Method: ListChooser>>selectedIndex: (in category 'accessing') ----- selectedIndex: anInt + selectedIndex := anInt. + self changed: #selectedIndex.! - index := (anInt min: selectedItems size). - self changed: #selectedIndex. - self changed: #canAccept.! Item was added: + ----- Method: ListChooser>>selectedItem (in category 'accessing') ----- + selectedItem + + ^ self items at: self selectedIndex ifAbsent: []! Item was added: + ----- Method: ListChooser>>textSelection (in category 'accessing') ----- + textSelection + ^ self searchText size +1 to: self searchText size ! Item was removed: - ----- Method: ListChooser>>updateFilter (in category 'event handling') ----- - updateFilter - - selectedItems := - searchText isEmptyOrNil - ifTrue: [ fullList ] - ifFalse: [ | pattern patternMatches prefixMatches | - pattern := (searchText includes: $*) - ifTrue: [ searchText ] - ifFalse: [ '*', searchText, '*' ]. - patternMatches := fullList select: [:s | pattern match: s ]. - prefixMatches := OrderedCollection new: patternMatches size. - patternMatches removeAllSuchThat: [ :each | - (each findString: searchText startingAt: 1 caseSensitive: false) = 1 - and: [ - prefixMatches add: each. - true ] ]. - prefixMatches addAllLast: patternMatches; yourself]. - self changed: #list. - self selectedIndex: 1. - self changed: #selectedIndex.! Item was added: + ----- Method: ListMultipleChooser class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #okColor. 'Colors'. 'Color for the OK button.' }. + { #cancelColor. 'Colors'. 'Color for the Cancel button.' }. + }! Item was added: + ----- Method: ListMultipleChooser>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self + changed: #okColor; + changed: #cancelColor.! Item was changed: ----- Method: ListMultipleChooser>>buildWith: (in category 'toolbuilder') ----- buildWith: builder + | dialogSpec choicesSpec | + dialogSpec := builder pluggableDialogSpec new - | windowSpec choicesSpec acceptSpec cancelSpec buttonHeight | - windowSpec := builder pluggableWindowSpec new model: self; + extent: self initialExtent; + title: #title; + children: OrderedCollection new; + buttons: OrderedCollection new. + - extent: 250@400; - label: #title; - children: OrderedCollection new. - - buttonHeight := Preferences standardButtonFont height * 4. - choicesSpec := builder pluggableMultiSelectionListSpec new model: self; list: #labels; setIndex: #selectedIndex:; getIndex: #selectedIndex; setSelectionList: #selectionAt:put:; getSelectionList: #selectionAt:; + frame: (0@0 corner: 1@1). + dialogSpec children add: choicesSpec. - frame: (LayoutFrame fractions: (0@0 corner: 1@1) offsets: (0@0 corner: 0@ buttonHeight negated)). - windowSpec children add: choicesSpec. + "Buttons" + dialogSpec buttons add: ( + builder pluggableButtonSpec new + model: self; + label: 'accept'; + color: (self userInterfaceTheme okColor ifNil: [Color r: 0.49 g: 0.749 b: 0.49]); + action: #accept). + + dialogSpec buttons add: ( + builder pluggableButtonSpec new + model: self; + label: 'cancel'; + color: (self userInterfaceTheme cancelColor ifNil: [Color r: 1 g: 0.6 b: 0.588]); + action: #cancel). + + ^ builder build: dialogSpec! - acceptSpec := builder pluggableButtonSpec new - model: self; - label: 'accept'; - color: ColorTheme current okColor; - action: #accept; - frame: (LayoutFrame fractions: (0@1 corner: 0.5@1) offsets: (0@ buttonHeight negated corner: 0@0)). - windowSpec children add: acceptSpec. - - cancelSpec := builder pluggableButtonSpec new - model: self; - label: 'cancel'; - color: ColorTheme current cancelColor; - action: #cancel; - frame: (LayoutFrame fractions: (0.5@1 corner: 1@1) offsets: (0@ buttonHeight negated corner: 0@0)). - windowSpec children add: cancelSpec. - - ^ builder build: windowSpec! Item was changed: ----- Method: ListMultipleChooser>>choose (in category 'actions') ----- choose - | builder window | - builder := ToolBuilder default. - window := builder open: self.. - window center: Sensor cursorPoint. "Avoid morphic dependency here..." + " self changed: #inputRequested with: #selectedIndex. + " + ToolBuilder open: self. - self changed: #inputRequested with: #selectedIndex. - window lookFocused. "Sigh..." - - builder runModal: window. - ^ self selectedValues! Item was added: + ----- Method: ListMultipleChooser>>initialExtent (in category 'toolbuilder') ----- + initialExtent + + | listFont | + listFont := Preferences standardListFont. + ^ (20 * (listFont widthOf: $m))@(15 * listFont height)! Item was added: + ----- Method: MorphicToolBuilder>>buildPluggableDialog: (in category 'widgets optional') ----- + buildPluggableDialog: aSpec + + | widget | + + widget := self dialogClass new. + self register: widget id: aSpec name. + + widget model: aSpec model. + + "Set child dependent layout properties. The pane morph holds the special contents." + widget paneMorph wantsPaneSplitters: (aSpec wantsResizeHandles ifNil: [true]). + self setLayoutHintsFor: widget paneMorph spec: aSpec. + widget paneMorph layoutInset: (aSpec padding ifNil: [ProportionalSplitterMorph gripThickness]). + widget paneMorph cellInset: (aSpec spacing ifNil: [ProportionalSplitterMorph gripThickness]). + widget paneMorph wantsPaneSplitters ifTrue: [widget paneMorph addCornerGrips"addEdgeGrips"]. + + "Now create the children." + panes := OrderedCollection new. + aSpec children isSymbol + ifTrue: [ + widget getChildrenSelector: aSpec children. + widget update: aSpec children] + ifFalse: [ + self buildAll: aSpec children in: widget paneMorph]. + + "Now create the buttons." + aSpec buttons isSymbol + ifTrue: [ + widget getButtonsSelector: aSpec buttons. + widget update: aSpec buttons] + ifFalse: [ + self buildAll: aSpec buttons in: widget buttonRowMorph. + widget updateButtonProperties]. + + aSpec title ifNotNil: [:label | + label isSymbol + ifTrue:[widget getTitleSelector: label; update: label] + ifFalse:[widget title: label]]. + aSpec message ifNotNil: [:label | + label isSymbol + ifTrue:[widget getMessageSelector: label; update: label] + ifFalse:[widget message: label]]. + + widget closeDialogSelector: aSpec closeAction. + self buildHelpFor: widget spec: aSpec. + + "Everything is shrink-wrapped around the pane morph." + widget paneMorph extent: (aSpec extent ifNil:[widget initialExtent]). + + ^ widget! Item was added: + ----- Method: MorphicToolBuilder>>dialogClass (in category 'widget classes') ----- + dialogClass + ^ PluggableDialogWindow! Item was changed: ----- Method: MorphicToolBuilder>>open: (in category 'opening') ----- open: anObject "Build and open the object. Answer the widget opened." | morph | anObject isMorph ifTrue:[morph := anObject] ifFalse:[morph := self build: anObject]. (morph isKindOf: MenuMorph) ifTrue:[morph popUpInWorld: World]. + (morph isKindOf: DialogWindow) + ifTrue: [^ morph moveToHand; getUserResponse]. (morph isKindOf: SystemWindow) ifFalse:[morph openInWorld] ifTrue:[ morph := morph openInWorldExtent: morph extent. (self class openToolsAttachedToMouseCursor and: [self currentEvent isMouse and: [self currentEvent isMouseUp]]) ifTrue: [ morph setProperty: #initialDrop toValue: true. morph hasDropShadow: false. self currentHand attachMorph: morph]]. ^morph! Item was changed: ----- Method: MorphicToolBuilder>>windowClassFor: (in category 'widget classes') ----- windowClassFor: aSpec - aSpec isDialog ifTrue: [^ PluggableDialogWindow]. ^aSpec multiWindowStyle caseOf: { [nil] -> [PluggableSystemWindow]. [#labelButton] -> [PluggableSystemWindowWithLabelButton] } otherwise: [PluggableSystemWindowWithLabelButton]! Item was changed: ----- Method: MorphicUIManager>>chooseFrom:lines:title: (in category 'ui requests') ----- chooseFrom: aList lines: linesArray title: aString "Choose an item from the given list. Answer the index of the selected item." + + aList size <= 7 ifTrue: [ + | dialog | + dialog := DialogWindow new + title: 'Please Choose'; + message: aString; + yourself. + aList doWithIndex: [:ea :index | + dialog createButton: ea value: index]. + dialog selectedButtonIndex: 1. + ^ dialog getUserResponseAtHand ifNil: [0]]. + + ^ ListChooser chooseFrom: aList title: aString! - ^ aList size > 30 - ifTrue: - [ "Don't put more than 30 items in a menu. Use ListChooser insted" - ListChooser - chooseFrom: aList - title: aString ] - ifFalse: - [ MenuMorph - chooseFrom: aList - lines: linesArray - title: aString ]! Item was changed: ----- Method: MorphicUIManager>>chooseFrom:values:lines:title: (in category 'ui requests') ----- chooseFrom: labelList values: valueList lines: linesArray title: aString "Choose an item from the given list. Answer the selected item." + | index | + index := self chooseFrom: labelList lines: linesArray title: aString. + ^ index = 0 + ifTrue: [ nil ] + ifFalse: [ valueList at: index ]! - ^ labelList size > 30 - ifTrue: - [ "No point in displaying more than 30 items in a menu. Use ListChooser insted" - index := ListChooser - chooseFrom: labelList - title: aString. - index = 0 ifFalse: [ valueList at: index ] ] - ifFalse: - [ MenuMorph - chooseFrom: labelList - values: valueList - lines: linesArray - title: aString ]! Item was added: + ----- Method: MorphicUIManager>>chooseFromOrAddTo:lines:title: (in category 'ui requests') ----- + chooseFromOrAddTo: aList lines: linesArray title: aString + + ^ ListChooser + chooseItemFrom: aList + title: aString + addAllowed: true! Item was changed: + DialogWindow subclass: #PluggableDialogWindow + instanceVariableNames: 'model getTitleSelector getMessageSelector getChildrenSelector getButtonsSelector closeDialogSelector' - PluggableSystemWindow subclass: #PluggableDialogWindow - instanceVariableNames: 'statusValue' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Morphic'! Item was added: + ----- Method: PluggableDialogWindow>>closeDialogSelector (in category 'accessing') ----- + closeDialogSelector + + ^ closeDialogSelector! Item was added: + ----- Method: PluggableDialogWindow>>closeDialogSelector: (in category 'accessing') ----- + closeDialogSelector: anObject + + closeDialogSelector := anObject! Item was added: + ----- Method: PluggableDialogWindow>>delete (in category 'submorphs-add/remove') ----- + delete + + self model okToClose ifFalse: [^ self]. + + self closeDialogSelector ifNotNil: [:sel | self model perform: sel]. + + self model + windowIsClosing; + release. + self model: nil. + + super delete.! Item was added: + ----- Method: PluggableDialogWindow>>getButtonsSelector (in category 'accessing') ----- + getButtonsSelector + + ^ getButtonsSelector! Item was added: + ----- Method: PluggableDialogWindow>>getButtonsSelector: (in category 'accessing') ----- + getButtonsSelector: anObject + + getButtonsSelector := anObject! Item was added: + ----- Method: PluggableDialogWindow>>getChildrenSelector (in category 'accessing') ----- + getChildrenSelector + + ^ getChildrenSelector! Item was added: + ----- Method: PluggableDialogWindow>>getChildrenSelector: (in category 'accessing') ----- + getChildrenSelector: anObject + + getChildrenSelector := anObject! Item was added: + ----- Method: PluggableDialogWindow>>getMessageSelector (in category 'accessing') ----- + getMessageSelector + + ^ getMessageSelector! Item was added: + ----- Method: PluggableDialogWindow>>getMessageSelector: (in category 'accessing') ----- + getMessageSelector: anObject + + getMessageSelector := anObject! Item was added: + ----- Method: PluggableDialogWindow>>getTitleSelector (in category 'accessing') ----- + getTitleSelector + + ^ getTitleSelector! Item was added: + ----- Method: PluggableDialogWindow>>getTitleSelector: (in category 'accessing') ----- + getTitleSelector: anObject + + getTitleSelector := anObject! Item was added: + ----- Method: PluggableDialogWindow>>model (in category 'accessing') ----- + model + ^ model! Item was added: + ----- Method: PluggableDialogWindow>>model: (in category 'accessing') ----- + model: anObject + + model ifNotNil: [model removeDependent: self]. + anObject ifNotNil: [anObject addDependent: self]. + model := anObject.! Item was removed: - ----- Method: PluggableDialogWindow>>statusValue (in category 'as yet unclassified') ----- - statusValue - ^statusValue! Item was removed: - ----- Method: PluggableDialogWindow>>statusValue: (in category 'as yet unclassified') ----- - statusValue: val - statusValue := val! Item was added: + ----- Method: PluggableDialogWindow>>update: (in category 'updating') ----- + update: what + + what ifNil:[^self]. + + what == self getTitleSelector ifTrue:[self title: (model perform: self getTitleSelector)]. + what == self getMessageSelector ifTrue:[self message: (model perform: self getMessageSelector)]. + + what == self getChildrenSelector ifTrue:[ + self paneMorph removeAllMorphs. + (self model perform: self getChildrenSelector) + do: [:m| m hResizing: #spaceFill; vResizing: #spaceFill]; + in: [:children | self paneMorph addAllMorphs: children]]. + + what == self getButtonsSelector ifTrue:[ + self buttonRow + removeAllMorphs; + addAllMorphs: (self model perform: self getButtonsSelector). + self updateButtonProperties]. + + what == #close ifTrue: [^ self delete]. + + super update: what.! Item was added: + ----- Method: PluggableDialogWindow>>updateButtonProperties (in category 'updating') ----- + updateButtonProperties + + self buttons do: [:ea | + ea setProperty: #normalColor toValue: ea offColor. + ea setProperty: #normalLabel toValue: ea label. + ea hResizing: #rigid; vResizing: #rigid]. + + self updateButtonExtent.!

1 0

The Trunk: ToolBuilder-Kernel-mt.100.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of ToolBuilder-Kernel to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Kernel-mt.100.mcz ==================== Summary ==================== Name: ToolBuilder-Kernel-mt.100 Author: mt Time: 31 July 2016, 11:11:03.29749 am UUID: 8ae8d06d-141f-d846-9c73-f7fa561bb78a Ancestors: ToolBuilder-Kernel-mt.99 *** Widget Refactorings and UI Themes (Part 5 of 11) *** Some fixes and refactorings for dialogs including added support for UI theming. =============== Diff against ToolBuilder-Kernel-mt.99 =============== Item was added: + PluggableCompositeSpec subclass: #PluggableDialogSpec + instanceVariableNames: 'title message extent buttons closeAction' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolBuilder-Kernel'! Item was added: + ----- Method: PluggableDialogSpec>>buildWith: (in category 'building') ----- + buildWith: builder + ^builder buildPluggableDialog: self.! Item was added: + ----- Method: PluggableDialogSpec>>buttons (in category 'accessing') ----- + buttons + + ^ buttons! Item was added: + ----- Method: PluggableDialogSpec>>buttons: (in category 'accessing') ----- + buttons: anObject + + buttons := anObject! Item was added: + ----- Method: PluggableDialogSpec>>closeAction (in category 'accessing') ----- + closeAction + + ^ closeAction! Item was added: + ----- Method: PluggableDialogSpec>>closeAction: (in category 'accessing') ----- + closeAction: anObject + + closeAction := anObject! Item was added: + ----- Method: PluggableDialogSpec>>extent (in category 'accessing') ----- + extent + + ^ extent! Item was added: + ----- Method: PluggableDialogSpec>>extent: (in category 'accessing') ----- + extent: anObject + + extent := anObject! Item was added: + ----- Method: PluggableDialogSpec>>horizontalResizing (in category 'as yet unclassified') ----- + horizontalResizing + ^ #rigid! Item was added: + ----- Method: PluggableDialogSpec>>label (in category 'window compatibility') ----- + label + ^ self title! Item was added: + ----- Method: PluggableDialogSpec>>label: (in category 'window compatibility') ----- + label: stringOrSymbol + self title: stringOrSymbol.! Item was added: + ----- Method: PluggableDialogSpec>>message (in category 'accessing') ----- + message + + ^ message! Item was added: + ----- Method: PluggableDialogSpec>>message: (in category 'accessing') ----- + message: anObject + + message := anObject! Item was added: + ----- Method: PluggableDialogSpec>>title (in category 'accessing') ----- + title + + ^ title! Item was added: + ----- Method: PluggableDialogSpec>>title: (in category 'accessing') ----- + title: anObject + + title := anObject! Item was added: + ----- Method: PluggableDialogSpec>>verticalResizing (in category 'as yet unclassified') ----- + verticalResizing + ^ #rigid! Item was changed: PluggableCompositeSpec subclass: #PluggableWindowSpec + instanceVariableNames: 'label extent closeAction multiWindowStyle' - instanceVariableNames: 'label extent closeAction isDialog multiWindowStyle' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableWindowSpec commentStamp: '<historical>' prior: 0! A common window. Expects to see change/update notifications when the label should change. Instance variables: label <String|Symbol> The selector under which to retrieve the label or the label directly extent <Point> The (initial) extent of the window. closeAction <Symbol> The action to perform when the window is closed.! Item was removed: - ----- Method: PluggableWindowSpec>>isDialog (in category 'accessing') ----- - isDialog - - ^isDialog ifNil: [false] - ! Item was removed: - ----- Method: PluggableWindowSpec>>isDialog: (in category 'accessing') ----- - isDialog: val - - isDialog := val - - ! Item was added: + ----- Method: ToolBuilder>>buildPluggableDialog: (in category 'widgets optional') ----- + buildPluggableDialog: spec + + | windowSpec | + windowSpec := self pluggableWindowSpec new. + windowSpec children: (spec children ifNil: [OrderedCollection new]). + + "TODO: Convert the dialog's message into some element in the children." + + spec buttons ifNotNil: [:buttons | windowSpec children addAll: buttons]. + windowSpec + model: spec model; + extent: spec extent; + label: spec title. + ^ self buildPluggableWindow: windowSpec! Item was added: + ----- Method: ToolBuilder>>pluggableDialogSpec (in category 'defaults') ----- + pluggableDialogSpec + ^PluggableDialogSpec!

1 0

The Trunk: Compiler-mt.324.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler-mt.324.mcz ==================== Summary ==================== Name: Compiler-mt.324 Author: mt Time: 31 July 2016, 11:10:04.90449 am UUID: f8b4e0ae-171c-8541-ae32-656183633ad6 Ancestors: Compiler-eem.323 *** Widget Refactorings and UI Themes (Part 5 of 11) *** Some fixes and refactorings for dialogs including added support for UI theming. =============== Diff against Compiler-eem.323 =============== Item was changed: ----- Method: UndefinedVariable>>openMenuIn: (in category 'as yet unclassified') ----- openMenuIn: aBlock - | labels caption index | - labels := #('yes' 'no'). - caption := name, ' appears to be - undefined at this point. - Proceed anyway?'. + ^ self resume: (UIManager default + confirm: name asText allBold, ' appears to be undefined at this point.\Proceed anyway?' withCRs + title: 'Undefined Variable').! - index := aBlock value: labels value: #() value: caption. - ^ self resume: index = 1! Item was changed: ----- Method: UnknownSelector>>openMenuIn: (in category 'as yet unclassified') ----- openMenuIn: aBlock | alternatives labels lines caption choice | alternatives := Symbol possibleSelectorsFor: name. labels := Array streamContents: + [:s | s nextPut: name; nextPutAll: alternatives]. - [:s | s nextPut: name; nextPutAll: alternatives; nextPut: 'cancel']. lines := {1. alternatives size + 1}. caption := 'Unknown selector, please\confirm, correct, or cancel' withCRs. choice := aBlock value: labels value: lines value: caption. + + choice = 0 ifTrue: [^ self resume: nil]. + choice = 1 ifTrue: [^ self resume: name asSymbol]. - choice = 0 ifTrue: [self resume: nil]. - choice = 1 ifTrue: [self resume: name asSymbol]. - choice = labels size ifTrue: [self resume: nil]. self resume: (alternatives at: choice - 1)! Item was changed: ----- Method: UnusedVariable>>openMenuIn: (in category 'as yet unclassified') ----- openMenuIn: aBlock + + self resume: (UIManager default + confirm: name asText allBold, ' appears to be unused in this method.\Remove it from the code?' withCRs + title: 'Unused Variable').! - | index | - index := aBlock value: #('yes' 'no') - value: #() - value: name, ' appears to be\unused in this method.\OK to remove it?' withCRs. - self resume: index = 1!

1 0

The Trunk: Morphic-mt.1211.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1211.mcz ==================== Summary ==================== Name: Morphic-mt.1211 Author: mt Time: 31 July 2016, 11:09:16.28949 am UUID: ea98f52e-1be2-e946-947b-465339d1c150 Ancestors: Morphic-mt.1210 *** Widget Refactorings and UI Themes (Part 5 of 11) *** Some fixes and refactorings for dialogs including added support for UI theming. =============== Diff against Morphic-mt.1210 =============== Item was added: + Morph subclass: #DialogWindow + instanceVariableNames: 'titleMorph messageMorph paneMorph buttonRow result selectedButton cancelButton timeout preferredPosition keyMap exclusive' + classVariableNames: 'GradientDialog RoundedDialogCorners UseWiggleAnimation' + poolDictionaries: '' + category: 'Morphic-Windows'! + + !DialogWindow commentStamp: '<historical>' prior: 0! + A DialogBoxMorph is Morph used in simple yes/no/confirm dialogs. Strongly modal.! Item was added: + ----- Method: DialogWindow class>>gradientDialog (in category 'preferences') ----- + gradientDialog + + <preference: 'gradientDialog' + category: 'dialogs' + description: 'If true, dialogs will have a gradient look.' + type: #Boolean> + ^ GradientDialog ifNil: [true] + ! Item was added: + ----- Method: DialogWindow class>>gradientDialog: (in category 'preferences') ----- + gradientDialog: aBoolean + + aBoolean = GradientDialog ifTrue: [^ self]. + GradientDialog := aBoolean. + self refreshAllDialogs.! Item was added: + ----- Method: DialogWindow class>>refreshAllDialogs (in category 'preferences') ----- + refreshAllDialogs + + self allSubInstances do: [:instance | instance setDefaultParameters; setTitleParameters].! Item was added: + ----- Method: DialogWindow class>>roundedDialogCorners (in category 'preferences') ----- + roundedDialogCorners + <preference: 'Rounded Dialog Corners' + categoryList: #(windows dialogs) + description: 'Governs whether dialog windows should have rounded corners' + type: #Boolean> + ^ RoundedDialogCorners ifNil: [ true ]! Item was added: + ----- Method: DialogWindow class>>roundedDialogCorners: (in category 'preferences') ----- + roundedDialogCorners: aBoolean + + RoundedDialogCorners = aBoolean ifTrue: [^ self]. + RoundedDialogCorners := aBoolean. + self refreshAllDialogs.! Item was added: + ----- Method: DialogWindow class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the dialogs''s border.' }. + { #borderWidth. 'Borders'. 'Width of the dialogs''s border.' }. + { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. + { #color. 'Colors'. 'Background color of the dialog.' }. + { #font. 'Fonts'. 'Font for dialog messages.' }. + { #textColor. 'Colors'. 'Color for dialog messages.' }. + + { #titleBorderColor. 'Colors'. 'Color of the dialogs title border.' }. + { #titleBorderWidth. 'Geometry'. 'Width of the dialog title border.' }. + { #titleBorderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset for the title.' }. + { #titleColor. 'Colors'. 'Background color of the dialogs'' title.' }. + { #titleFont. 'Fonts'. 'Font for dialog title.' }. + { #titleTextColor. 'Colors'. 'Color for the dialog title label.' }. + + { #okColor. 'Colors'. 'Color for the OK button.' }. + { #cancelColor. 'Colors'. 'Color for the Cancel button.' }. + { #buttonColor. 'Colors'. 'Color for a normal button.' }. + { #selectionModifier. 'Colors'. 'How to convert the color of a selected button?' }. + }! Item was added: + ----- Method: DialogWindow class>>useWiggleAnimation (in category 'preferences') ----- + useWiggleAnimation + + <preference: 'Use Wiggle Animation in Modal Dialogs' + categoryList: #(Morphic windows dialogs) + description: 'In order to indicate that a modal dialog is waiting for a user''s input, wiggle instead of flash.' + type: #Boolean> + ^ UseWiggleAnimation ifNil: [true]! Item was added: + ----- Method: DialogWindow class>>useWiggleAnimation: (in category 'preferences') ----- + useWiggleAnimation: aBoolean + + UseWiggleAnimation := aBoolean.! Item was added: + ----- Method: DialogWindow>>addPaneMorph: (in category 'constructing') ----- + addPaneMorph: aMorph + + self paneMorph addMorphBack: aMorph.! Item was added: + ----- Method: DialogWindow>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self + setDefaultParameters; + setTitleParameters; + setMessageParameters. + + "Update all buttons." + selectedButton in: [:sb | + self buttons do: [:ea | + ea setProperty: #normalColor toValue: self defaultButtonColor. + self deselectButton: ea]. + sb ifNotNil: [self selectButton: sb]].! Item was added: + ----- Method: DialogWindow>>buttonRowMorph (in category 'accessing - ui') ----- + buttonRowMorph + ^ buttonRow! Item was added: + ----- Method: DialogWindow>>buttons (in category 'accessing - ui') ----- + buttons + + ^buttonRow submorphs! Item was added: + ----- Method: DialogWindow>>cancelButton (in category 'accessing - ui') ----- + cancelButton + ^ cancelButton! Item was added: + ----- Method: DialogWindow>>cancelDialog (in category 'running') ----- + cancelDialog + + self cancelButton + ifNil: [self closeDialog: nil] + ifNotNil: [:btn | btn performAction]. ! Item was added: + ----- Method: DialogWindow>>closeDialog (in category 'running') ----- + closeDialog + + self selectedButton + ifNil: [self closeDialog: nil] + ifNotNil: [:btn | btn performAction]. ! Item was added: + ----- Method: DialogWindow>>closeDialog: (in category 'running') ----- + closeDialog: returnValue + result := returnValue. + self delete.! Item was added: + ----- Method: DialogWindow>>createAcceptButton (in category 'constructing') ----- + createAcceptButton + + ^ self + createButton: 'Accept' translated + value: true + color: (self userInterfaceTheme okColor ifNil: [Color r: 0.49 g: 0.749 b: 0.49])! Item was added: + ----- Method: DialogWindow>>createBody (in category 'initialization') ----- + createBody + + | body | + body := Morph new + changeTableLayout; + hResizing: #shrinkWrap; + vResizing: #shrinkWrap; + listDirection: #topToBottom; + cellPositioning: #leftCenter; + layoutInset: (10@5 corner: 10@10); + cellInset: 5; + color: Color transparent; + yourself. + body addAllMorphs: {self createMessage: ''. self createPane. self createButtonRow}. + self addMorphBack: body.! Item was added: + ----- Method: DialogWindow>>createButton: (in category 'constructing') ----- + createButton: buttonLabel + + ^ self + createButton: buttonLabel + value: self buttonRow submorphs size + 1 + color: self defaultButtonColor! Item was added: + ----- Method: DialogWindow>>createButton:value: (in category 'constructing') ----- + createButton: buttonLabel value: buttonValue + + ^ self + createButton: buttonLabel + value: buttonValue + color: self defaultButtonColor! Item was added: + ----- Method: DialogWindow>>createButton:value:color: (in category 'constructing') ----- + createButton: buttonLabel value: buttonValue color: buttonColor + + | button | + button := PluggableButtonMorphPlus new + label: buttonLabel ; + action: [ self closeDialog: buttonValue ] ; + setProperty: #normalColor toValue: buttonColor ; + setProperty: #normalLabel toValue: buttonLabel ; + hResizing: #rigid; + vResizing: #rigid; + yourself. + + self deselectButton: button. + buttonRow addMorphBack: button. + self updateButtonExtent. + + ^ button! Item was added: + ----- Method: DialogWindow>>createButtonRow (in category 'initialization') ----- + createButtonRow + + ^ buttonRow := Morph new + color: Color transparent; + changeTableLayout; + vResizing: #shrinkWrap; + hResizing: #spaceFill; + listDirection: #leftToRight; + listCentering: #center; + cellInset: 5; + yourself! Item was added: + ----- Method: DialogWindow>>createCancelButton (in category 'constructing') ----- + createCancelButton + + ^ cancelButton := self + createButton: 'Cancel' translated + value: false + color: (self userInterfaceTheme cancelColor ifNil: [Color r: 1 g: 0.6 b: 0.588])! Item was added: + ----- Method: DialogWindow>>createCancelButton:value: (in category 'constructing') ----- + createCancelButton: label value: result + + ^ cancelButton := self + createButton: label + value: result! Item was added: + ----- Method: DialogWindow>>createMessage: (in category 'initialization') ----- + createMessage: aString + + messageMorph := aString asText asMorph lock. + self setMessageParameters. + ^ messageMorph! Item was added: + ----- Method: DialogWindow>>createPane (in category 'initialization') ----- + createPane + + ^ paneMorph := BorderedMorph new + changeProportionalLayout; + hResizing: #rigid; + vResizing: #rigid; + layoutInset: 0; + color: Color transparent; + borderWidth: 0; + yourself.! Item was added: + ----- Method: DialogWindow>>createTitle: (in category 'initialization') ----- + createTitle: aString + "Mimick behavior of MenuMorph title creation." + + | box closeButton menuButton | + box := Morph new + name: #title; + changeTableLayout; + listDirection: #leftToRight; + listCentering: #justified; + yourself. + + titleMorph := aString asText asMorph lock. + + closeButton := SystemWindowButton new + color: Color transparent; + target: self; + extent: 12@12; + actionSelector: #cancelDialog; + balloonText: 'Cancel this dialog' translated; + borderWidth: 0; + labelGraphic: SystemWindow closeBoxImage; + extent: SystemWindow closeBoxImage extent; + yourself. + + menuButton := SystemWindowButton new + color: Color transparent; + target: self; + actionSelector: #offerDialogMenu; + balloonText: 'Dialog menu' translated; + borderWidth: 0; + labelGraphic: SystemWindow menuBoxImage; + extent: SystemWindow menuBoxImage extent; + yourself. + + box addAllMorphs: {closeButton. titleMorph. menuButton}. + + self addMorphBack: box. + self setTitleParameters. + ! Item was added: + ----- Method: DialogWindow>>defaultButtonColor (in category 'accessing') ----- + defaultButtonColor + + ^ self userInterfaceTheme buttonColor ifNil: [(Color r: 0.658 g: 0.678 b: 0.78) twiceLighter]! Item was added: + ----- Method: DialogWindow>>deselectButton: (in category 'selection') ----- + deselectButton: aButton + + aButton ifNil: [^ self]. + aButton offColor: (aButton valueOfProperty: #normalColor). + aButton == selectedButton ifTrue: [selectedButton := nil].! Item was added: + ----- Method: DialogWindow>>drawOverlayOn: (in category 'drawing') ----- + drawOverlayOn: aCanvas + + | title inset | + super drawOverlayOn: aCanvas. + + title := self submorphs first. + + self wantsRoundedCorners ifTrue: [ + inset := (self class roundedDialogCorners and: [self class gradientDialog]) + "This check compensates a bug in balloon." + ifTrue: [0@0 corner: 0@ -1] ifFalse: [self borderWidth @ 0]. + + "Overdraw lower part of title bar to hide bottom corners." + aCanvas + fillRectangle:( (title bottomLeft - (0 @ self submorphs first cornerRadius) corner: title bottomRight) insetBy: inset) + color: self color]. + + "Draw a line between the title and the contents." + self borderWidth > 0 ifTrue: [ + "Redraw the border all around. Needed because rounded borders do not align very well." + self wantsRoundedCorners + 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]].! Item was added: + ----- Method: DialogWindow>>ensureSelectedButton (in category 'selection') ----- + ensureSelectedButton + + self selectedButton ifNil: [self selectButton: self buttons first].! Item was added: + ----- Method: DialogWindow>>exclusive (in category 'accessing') ----- + exclusive + + ^ exclusive! Item was added: + ----- Method: DialogWindow>>exclusive: (in category 'accessing') ----- + exclusive: aBoolean + + exclusive := aBoolean. + + exclusive + ifTrue: [self activeHand newMouseFocus: self] + ifFalse: [self activeHand releaseMouseFocus: self].! Item was added: + ----- Method: DialogWindow>>exploreInvocation (in category 'running') ----- + exploreInvocation + + | result context | + self exclusive: false. "We want to explore." + + result := OrderedCollection new. + context := thisContext. + + [context method selector = #getUserResponse] + whileFalse: [context := context sender]. + + [context sender] whileNotNil: [ + result add: context method. + context := context sender]. + result add: context method. + + result explore.! Item was added: + ----- Method: DialogWindow>>flash (in category 'running') ----- + flash + "Flash me" + Beeper beepPrimitive. + + self class useWiggleAnimation ifTrue: [ + #(-2 4 -6 8 -4) do: [:i | + self left: self left + i. + self refreshWorld. + ] separatedBy: [(Delay forMilliseconds: 50) wait] + ] ifFalse: [ + 1 to: 2 do:[:i| + self color: Color black. + self world doOneCycleNow. + (Delay forMilliseconds: 50) wait. + self color: Color white. + self world doOneCycleNow. + (Delay forMilliseconds: 50) wait] ]! Item was added: + ----- Method: DialogWindow>>getUserResponse (in category 'running') ----- + getUserResponse + + | hand world | + (ProvideAnswerNotification signal: self title asString) ifNotNil: [:answer| ^ answer]. + + self message ifEmpty: [messageMorph delete]. "Do not waste space." + self paneMorph submorphs ifEmpty: [self paneMorph delete]. "Do not waste space." + + hand := self currentHand. + world := self currentWorld. + + self fullBounds. + self center: preferredPosition. + self bounds: (self bounds translatedToBeWithin: world bounds). + self openInWorld: world. + + hand keyboardFocus in: [:priorKeyboardFocus | + hand mouseFocus in: [:priorMouseFocus | + self exclusive ifTrue: [hand newMouseFocus: self]. + hand newKeyboardFocus: self. + + [self isInWorld] whileTrue:[world doOneSubCycle]. + + hand newKeyboardFocus: priorKeyboardFocus. + self exclusive ifTrue: [ + hand newMouseFocus: priorMouseFocus]]]. + + ^ result! Item was added: + ----- Method: DialogWindow>>getUserResponseAfter: (in category 'running') ----- + getUserResponseAfter: seconds + + timeout := seconds + 1. + + self ensureSelectedButton. + self step. + self updateButtonExtent. + + ^ self getUserResponse! Item was added: + ----- Method: DialogWindow>>getUserResponseAtHand (in category 'running') ----- + getUserResponseAtHand + + ^ self getUserResponseAtHand: ActiveHand! Item was added: + ----- Method: DialogWindow>>getUserResponseAtHand: (in category 'running') ----- + getUserResponseAtHand: aHand + + self message ifEmpty: [messageMorph delete]. "Do not waste space." + self paneMorph submorphs ifEmpty: [self paneMorph delete]. "Do not waste space." + + self moveSelectedButtonToHand: aHand. + ^ self getUserResponse! Item was added: + ----- Method: DialogWindow>>handleMouseUp: (in category 'events') ----- + handleMouseUp: event + + super handleMouseUp: event. + self exclusive ifTrue: [event hand newMouseFocus: self].! Item was added: + ----- Method: DialogWindow>>handlesKeyboard: (in category 'events') ----- + handlesKeyboard: evt + + ^true! Item was added: + ----- Method: DialogWindow>>handlesMouseDown: (in category 'events') ----- + handlesMouseDown: evt + + ^ true! Item was added: + ----- Method: DialogWindow>>initialExtent (in category 'initialization') ----- + initialExtent + + ^ 200@150! Item was added: + ----- Method: DialogWindow>>initialize (in category 'initialization') ----- + initialize + + super initialize. + + self + changeTableLayout; + listDirection: #topToBottom; + hResizing: #shrinkWrap; + vResizing: #shrinkWrap; + setProperty: #indicateKeyboardFocus toValue: #never. + + self createTitle: 'Dialog'. + self createBody. + + self setDefaultParameters. + + keyMap := Dictionary new. + exclusive := true. + preferredPosition := ActiveWorld center.! Item was added: + ----- Method: DialogWindow>>justDroppedInto:event: (in category 'dropping/grabbing') ----- + justDroppedInto: aMorph event: event + + "Restore drop shadow if necessary." + self hasDropShadow: Preferences menuAppearance3d. + + self exclusive ifTrue: [ + "aggressively preserve focus" + event hand newMouseFocus: self].! Item was added: + ----- Method: DialogWindow>>keyStroke: (in category 'events') ----- + keyStroke: evt + | char | + self stopAutoTrigger. + char := evt keyCharacter. + + char = Character escape ifTrue: [ ^ self cancelDialog ]. + (char = Character cr or: [char = Character enter]) ifTrue: [ ^ self closeDialog ]. + + ((char = Character arrowLeft or: [char = Character arrowUp]) + or: [ evt shiftPressed and: [ char = Character tab ] ]) + ifTrue: [ ^ self selectPreviousButton ]. + ((char = Character arrowRight or: [char = Character arrowDown]) + or: [ char = Character tab ]) + ifTrue: [ ^ self selectNextButton ]. + + keyMap + at: char asLowercase + ifPresent: [ : foundButton | foundButton performAction ] + ifAbsent: [ "do nothing" ].! Item was added: + ----- Method: DialogWindow>>message (in category 'accessing') ----- + message + ^messageMorph contents! Item was added: + ----- Method: DialogWindow>>message: (in category 'accessing') ----- + message: aStringOrText + + messageMorph contents: aStringOrText. + self setMessageParameters.! Item was added: + ----- Method: DialogWindow>>messageMorph (in category 'accessing - ui') ----- + messageMorph + ^ messageMorph! Item was added: + ----- Method: DialogWindow>>mouseDown: (in category 'events') ----- + mouseDown: event + + self stopAutoTrigger. + + "Always bring me to the front since I am modal" + self comeToFront. + + (self containsPoint: event position) + ifFalse:[^ self flash]. + + event hand + waitForClicksOrDrag: self + event: event + selectors: { nil. nil. nil. #startDrag: } + threshold: HandMorph dragThreshold.! Item was added: + ----- Method: DialogWindow>>mouseUp: (in category 'events') ----- + mouseUp: event + self stopAutoTrigger. + ! Item was added: + ----- Method: DialogWindow>>moveSelectedButtonToHand: (in category 'position') ----- + moveSelectedButtonToHand: aHand + "Just let the user confirm the selected button without having to reposition the mouse." + + self ensureSelectedButton. + self moveTo: self fullBounds center + (aHand position - self selectedButton center).! Item was added: + ----- Method: DialogWindow>>moveTo: (in category 'position') ----- + moveTo: position + + preferredPosition := position.! Item was added: + ----- Method: DialogWindow>>moveToHand (in category 'position') ----- + moveToHand + + self moveToHand: self activeHand.! Item was added: + ----- Method: DialogWindow>>moveToHand: (in category 'position') ----- + moveToHand: aHand + + self moveTo: aHand position.! Item was added: + ----- Method: DialogWindow>>offerDialogMenu (in category 'running') ----- + offerDialogMenu + + | menu | + menu := MenuMorph new defaultTarget: self. + menu + add: (exclusive == true ifTrue: ['<yes>'] ifFalse: ['<no>']), 'be modally exclusive' translated + action: #toggleExclusive; + addLine; + add: 'explore dialog invocation' translated + action: #exploreInvocation. + + menu popUpEvent: self currentEvent in: self world. + + [menu isInWorld] whileTrue: [self world doOneSubCycle]. + self exclusive ifTrue: [self activeHand newMouseFocus: self].! Item was added: + ----- Method: DialogWindow>>paneMorph (in category 'accessing - ui') ----- + paneMorph + ^ paneMorph! Item was added: + ----- Method: DialogWindow>>processFocusEvent:using: (in category 'events') ----- + processFocusEvent: evt using: dispatcher + + ^ dispatcher dispatchFocusEventFully: evt with: self! Item was added: + ----- Method: DialogWindow>>registerKeyboardShortcutFor: (in category 'constructing') ----- + registerKeyboardShortcutFor: button + "Take the first alpha-numeric character that is not already used as a shortcut, and use it as a shortcut." + + (button valueOfProperty: #normalLabel) asString in: [:normalLabel | normalLabel do: [:char | + char isAlphaNumeric ifTrue: [ keyMap + at: char asLowercase + ifPresent: [] + ifAbsent: [ + button label: ('{1} ({2})' format: {normalLabel. char}). + ^ keyMap at: char asLowercase put: button ] ] ] ]! Item was added: + ----- Method: DialogWindow>>registerKeyboardShortcuts (in category 'constructing') ----- + registerKeyboardShortcuts + + self buttons do: [:ea | self registerKeyboardShortcutFor: ea].! Item was added: + ----- Method: DialogWindow>>selectButton: (in category 'selection') ----- + selectButton: aButton + + | buttonColor | + buttonColor := ((self userInterfaceTheme selectionModifier ifNil: [ [:c | c muchLighter] ]) value: (aButton valueOfProperty: #normalColor)). + self deselectButton: selectedButton. + aButton offColor: buttonColor. + selectedButton := aButton.! Item was added: + ----- Method: DialogWindow>>selectNextButton (in category 'selection') ----- + selectNextButton + + self selectedButton ifNil: [^ self]. + self selectedButtonIndex: self selectedButtonIndex \\ self buttons size + 1.! Item was added: + ----- Method: DialogWindow>>selectPreviousButton (in category 'selection') ----- + selectPreviousButton + + self selectedButton ifNil: [^ self]. + self selectedButtonIndex: self selectedButtonIndex - 2 \\ self buttons size + 1.! Item was added: + ----- Method: DialogWindow>>selectedButton (in category 'accessing') ----- + selectedButton + ^ selectedButton! Item was added: + ----- Method: DialogWindow>>selectedButton: (in category 'accessing') ----- + selectedButton: aButton + + aButton + ifNil: [self deselectButton: self selectedButton] + ifNotNil: [self selectButton: aButton].! Item was added: + ----- Method: DialogWindow>>selectedButtonIndex (in category 'accessing') ----- + selectedButtonIndex + + ^ self selectedButton + ifNil: [0] + ifNotNil: [:btn | self buttons indexOf: btn]! Item was added: + ----- Method: DialogWindow>>selectedButtonIndex: (in category 'accessing') ----- + selectedButtonIndex: anInteger + + anInteger = 0 ifTrue: [^ self selectedButton: nil]. + self selectedButton: (self buttons at: anInteger).! Item was added: + ----- 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 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 added: + ----- Method: DialogWindow>>setMessageParameters (in category 'initialization') ----- + setMessageParameters + + messageMorph ifNotNil: [ + | fontToUse colorToUse | + fontToUse := self userInterfaceTheme font ifNil: [TextStyle defaultFont]. + colorToUse := self userInterfaceTheme textColor ifNil: [Color black]. + + messageMorph contents + addAttribute: (TextFontReference toFont: fontToUse); + addAttribute: (TextColor color: colorToUse). + messageMorph releaseParagraph; changed].! Item was added: + ----- 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 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]. + + titleMorph contents + addAttribute: (TextFontReference toFont: fontToUse); + addAttribute: (TextColor color: colorToUse). + titleMorph releaseParagraph; changed].! Item was added: + ----- Method: DialogWindow>>startDrag: (in category 'dropping/grabbing') ----- + startDrag: event + + self hasDropShadow: false. + event hand grabMorph: self.! Item was added: + ----- Method: DialogWindow>>step (in category 'stepping and presenter') ----- + step + timeout ifNil: [^self]. + timeout = 0 + ifTrue: [ + self stopStepping. + selectedButton performAction] + ifFalse: [ + selectedButton label: ('{1} ({2})' format: { + selectedButton valueOfProperty: #normalLabel. + timeout}). + timeout := timeout - 1]! Item was added: + ----- Method: DialogWindow>>stepTime (in category 'stepping and presenter') ----- + stepTime + ^1000! Item was added: + ----- Method: DialogWindow>>stopAutoTrigger (in category 'stepping and presenter') ----- + stopAutoTrigger + timeout ifNil: [^self]. + timeout := nil. + self stopStepping. + selectedButton label: (selectedButton valueOfProperty: #normalLabel). ! Item was added: + ----- Method: DialogWindow>>title (in category 'accessing') ----- + title + ^titleMorph contents! Item was added: + ----- Method: DialogWindow>>title: (in category 'accessing') ----- + title: aString + + titleMorph contents: aString asText. + self setTitleParameters.! Item was added: + ----- Method: DialogWindow>>titleGradientFor:from: (in category 'initialization') ----- + titleGradientFor: morph from: aColor + + | cc gradient | + cc := aColor. + gradient := GradientFillStyle ramp: { + 0.0 -> Color white. + 0.15 ->(cc mixed: 0.5 with: Color white). + 0.7 -> cc. + }. + gradient origin: morph topLeft. + gradient direction: 0 @ (TextStyle defaultFont height + 10). + ^ gradient! Item was added: + ----- Method: DialogWindow>>toggleExclusive (in category 'running') ----- + toggleExclusive + + self exclusive: self exclusive not.! Item was added: + ----- Method: DialogWindow>>update: (in category 'updating') ----- + update: aspect + + aspect == #buttons + ifTrue: [self updateButtonExtent]. + + ^ super update: aspect! Item was added: + ----- Method: DialogWindow>>updateButtonExtent (in category 'updating') ----- + updateButtonExtent + + self updateButtonExtent: 20@10.! Item was added: + ----- Method: DialogWindow>>updateButtonExtent: (in category 'updating') ----- + updateButtonExtent: margin + + "Update all button extents." + (buttonRow submorphs collect: [:ea | ea minimumExtent]) max + margin in: [:preferredExtent | + buttonRow submorphsDo: [:ea | ea extent: preferredExtent]]. + + "See if horizontal button layout would be more appropriate." + self flag: #magicNumber. "mt: Remove number with computation, maybe choose button font and 20 characters" + (buttonRow submorphs collect: [:ea | ea fullBounds width]) sum > 400 + ifTrue: [buttonRow + hResizing: #shrinkWrap; + listDirection: #topToBottom; + layoutInset: (buttonRow owner fullBounds width - (buttonRow owner layoutInset left*2) - buttonRow submorphs first fullBounds width // 2@0)] + ifFalse: [buttonRow + hResizing: #spaceFill; + listDirection: #leftToRight; + layoutInset: 0].! Item was added: + ----- Method: DialogWindow>>wantsRoundedCorners (in category 'rounding') ----- + wantsRoundedCorners + + ^ self class roundedDialogCorners or: [super wantsRoundedCorners]! Item was added: + ----- Method: DialogWindow>>wantsToBeDroppedInto: (in category 'dropping/grabbing') ----- + wantsToBeDroppedInto: aMorph + "Return true if it's okay to drop the receiver into aMorph" + ^aMorph isWorldMorph "only into worlds"! Item was changed: + DialogWindow subclass: #FillInTheBlankMorph - RectangleMorph subclass: #FillInTheBlankMorph instanceVariableNames: 'response done textPane responseUponCancel' + classVariableNames: '' - classVariableNames: 'RoundedDialogCorners' poolDictionaries: '' category: 'Morphic-Windows'! Item was changed: ----- Method: FillInTheBlankMorph class>>request:initialAnswer:centerAt:inWorld:onCancelReturn:acceptOnCR:answerExtent: (in category 'instance creation') ----- request: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld onCancelReturn: returnOnCancel acceptOnCR: acceptBoolean answerExtent: answerExtent "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. If the user cancels, answer returnOnCancel." "FillInTheBlankMorph request: 'Type something, then type CR.' initialAnswer: 'yo ho ho!!' centerAt: Display center" | aFillInTheBlankMorph | aFillInTheBlankMorph := self new setQuery: queryString initialAnswer: defaultAnswer answerExtent: answerExtent acceptOnCR: acceptBoolean. + + aFillInTheBlankMorph createAcceptButton + action: [aFillInTheBlankMorph textPane accept]. + aFillInTheBlankMorph createCancelButton + action: [aFillInTheBlankMorph closeDialog: returnOnCancel]. + + aFillInTheBlankMorph moveTo: aPoint. - aFillInTheBlankMorph responseUponCancel: returnOnCancel. - aWorld addMorph: aFillInTheBlankMorph centeredNear: aPoint. ^ aFillInTheBlankMorph getUserResponse ! Item was changed: ----- Method: FillInTheBlankMorph class>>requestPassword:initialAnswer:centerAt:inWorld:onCancelReturn:acceptOnCR: (in category 'instance creation') ----- requestPassword: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld onCancelReturn: returnOnCancel acceptOnCR: acceptBoolean "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. If the user cancels, answer returnOnCancel." "FillInTheBlankMorph request: 'Type something, then type CR.' initialAnswer: 'yo ho ho!!' centerAt: Display center" | aFillInTheBlankMorph | aFillInTheBlankMorph := self new setPasswordQuery: queryString initialAnswer: defaultAnswer answerHeight: 50 acceptOnCR: acceptBoolean. + + aFillInTheBlankMorph createAcceptButton + action: [aFillInTheBlankMorph textPane accept]. + aFillInTheBlankMorph createCancelButton + action: [aFillInTheBlankMorph closeDialog: returnOnCancel]. + + aFillInTheBlankMorph moveTo: aPoint. + ^ aFillInTheBlankMorph getUserResponse! - aFillInTheBlankMorph responseUponCancel: returnOnCancel. - aWorld addMorph: aFillInTheBlankMorph centeredNear: aPoint. - ^ aFillInTheBlankMorph getUserResponse - ! Item was removed: - ----- Method: FillInTheBlankMorph class>>roundedDialogCorners (in category 'preferences') ----- - roundedDialogCorners - <preference: 'Rounded Dialog Corners' - category: 'windows' - description: 'Governs whether dialog windows should have rounded corners' - type: #Boolean> - ^ RoundedDialogCorners ifNil: [ true ]! Item was removed: - ----- Method: FillInTheBlankMorph class>>roundedDialogCorners: (in category 'preferences') ----- - roundedDialogCorners: aBoolean - - RoundedDialogCorners := aBoolean. - self allInstances do: [:instance | - aBoolean - ifTrue: [instance useRoundedCorners] - ifFalse: [instance useSquareCorners]].! Item was removed: - ----- Method: FillInTheBlankMorph>>accept (in category 'menu') ----- - accept - "Sent by the accept button." - - textPane accept. - ! Item was removed: - ----- Method: FillInTheBlankMorph>>cancel (in category 'menu') ----- - cancel - "Sent by the cancel button." - - response := responseUponCancel. - done := true. - ! Item was removed: - ----- Method: FillInTheBlankMorph>>convertToCurrentVersion:refStream: (in category 'object fileIn') ----- - convertToCurrentVersion: varDict refStream: smartRefStrm - - varDict at: 'responseUponCancel' ifAbsent: [responseUponCancel := '']. - ^super convertToCurrentVersion: varDict refStream: smartRefStrm. - - ! Item was removed: - ----- Method: FillInTheBlankMorph>>createAcceptButton (in category 'initialization') ----- - createAcceptButton - "create the [accept] button" - | result frame | - result := SimpleButtonMorph new target: self; - color: ColorTheme current okColor. - result - borderColor: (Preferences menuAppearance3d - ifTrue: [#raised] - ifFalse: [result color twiceDarker]). - result label: 'Accept(s)' translated; - actionSelector: #accept. - result setNameTo: 'accept'. - frame := LayoutFrame new. - frame rightFraction: 0.5; - rightOffset: -10; - bottomFraction: 1.0; - bottomOffset: -2. - result layoutFrame: frame. - self addMorph: result. - self - updateColor: result - color: result color - intensity: 2. - ^ result! Item was removed: - ----- Method: FillInTheBlankMorph>>createCancelButton (in category 'initialization') ----- - createCancelButton - "create the [cancel] button" - | result frame | - result := SimpleButtonMorph new target: self; - color: ColorTheme current cancelColor. - result - borderColor: (Preferences menuAppearance3d - ifTrue: [#raised] - ifFalse: [result color twiceDarker]). - result label: 'Cancel(l)' translated; - actionSelector: #cancel. - result setNameTo: 'cancel'. - frame := LayoutFrame new. - frame leftFraction: 0.5; - leftOffset: 10; - bottomFraction: 1.0; - bottomOffset: -2. - result layoutFrame: frame. - self addMorph: result. - self - updateColor: result - color: result color - intensity: 2. - ^ result! Item was removed: - ----- Method: FillInTheBlankMorph>>createQueryTextMorph: (in category 'initialization') ----- - createQueryTextMorph: queryString - "create the queryTextMorph" - | result frame | - result := TextMorph new contents: queryString. - result setNameTo: 'query' translated. - result lock. - frame := LayoutFrame new. - frame topFraction: 0.0; - topOffset: 2. - frame leftFraction: 0.5; - leftOffset: (result width // 2) negated. - result layoutFrame: frame. - self addMorph: result. - ^ result! Item was added: + ----- Method: FillInTheBlankMorph>>createTextPaneAcceptOnCR: (in category 'initialization') ----- + createTextPaneAcceptOnCR: acceptBoolean + + textPane := PluggableTextMorph + on: self + text: #response + accept: #response: + readSelection: #selectionInterval + menu: #codePaneMenu:shifted:. + textPane + showScrollBarsOnlyWhenNeeded; + wantsFrameAdornments: false; + hasUnacceptedEdits: true; + acceptOnCR: acceptBoolean; + setNameTo: 'textPane'; + layoutFrame: (LayoutFrame fractions: (0@0 corner: 1@1)); + hResizing: #spaceFill; + vResizing: #spaceFill. + + ^ textPane! Item was removed: - ----- Method: FillInTheBlankMorph>>createTextPaneExtent:acceptBoolean:topOffset:buttonAreaHeight: (in category 'initialization') ----- - createTextPaneExtent: answerExtent acceptBoolean: acceptBoolean topOffset: topOffset buttonAreaHeight: buttonAreaHeight - "create the textPane" - | result frame | - result := PluggableTextMorph - on: self - text: #response - accept: #response: - readSelection: #selectionInterval - menu: #codePaneMenu:shifted:. - result - extent: answerExtent; - showScrollBarsOnlyWhenNeeded; - hResizing: #spaceFill; - vResizing: #spaceFill; - borderWidth: 1; - hasUnacceptedEdits: true; - acceptOnCR: acceptBoolean; - setNameTo: 'textPane'. - frame := LayoutFrame new - leftFraction: 0.0; - rightFraction: 1.0; - topFraction: 0.0; - topOffset: topOffset; - bottomFraction: 1.0; - bottomOffset: buttonAreaHeight negated; - yourself. - result layoutFrame: frame. - self addMorph: result. - ^ result! Item was removed: - ----- Method: FillInTheBlankMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color white! Item was removed: - ----- Method: FillInTheBlankMorph>>delete (in category 'initialization') ----- - delete - - self breakDependents. - super delete.! Item was removed: - ----- Method: FillInTheBlankMorph>>extent: (in category 'geometry') ----- - extent: aPoint - "change the receiver's extent" - - super extent: aPoint . - self setDefaultParameters. - self updateColor! Item was added: + ----- Method: FillInTheBlankMorph>>filterEvent:for: (in category 'events') ----- + filterEvent: event for: morph + + (event isKeystroke and: [event keyCharacter = Character escape]) + ifTrue: [event ignore. self cancelDialog]. + + ^ event! Item was removed: - ----- Method: FillInTheBlankMorph>>getUserResponse (in category 'invoking') ----- - getUserResponse - "Wait for the user to accept or cancel, and answer the result string. Answers the empty string if the user cancels." - "Details: This is invoked synchronously from the caller. In order to keep processing inputs and updating the screen while waiting for the user to respond, this method has its own version of the World's event loop." - - | w | - w := self world. - w ifNil: [^ response]. - - (ProvideAnswerNotification signal: - (self submorphOfClass: TextMorph) userString) ifNotNil: - [:answer | - self delete. - w doOneCycle. - ^ response := (answer == #default) ifTrue: [response] ifFalse: [answer]]. - - done := false. - w activeHand newKeyboardFocus: textPane. - [done] whileFalse: [w doOneCycle]. - self delete. - w doOneCycle. - ^ response - ! Item was removed: - ----- Method: FillInTheBlankMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - ^true! Item was changed: ----- Method: FillInTheBlankMorph>>initialize (in category 'initialization') ----- initialize super initialize. + self addKeyboardCaptureFilter: self.! - self setDefaultParameters. - self extent: 400 @ 150. - responseUponCancel := ''. - self class roundedDialogCorners ifTrue: [self useRoundedCorners]. - ! Item was removed: - ----- Method: FillInTheBlankMorph>>morphicLayerNumber (in category 'invoking') ----- - morphicLayerNumber - - ^10.6! Item was removed: - ----- Method: FillInTheBlankMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - (self containsPoint: evt position) ifFalse:[^ Beeper beep]. "sent in response to outside modal click" - evt hand grabMorph: self. "allow repositioning"! Item was changed: ----- Method: FillInTheBlankMorph>>response (in category 'accessing') ----- response + ^ result - ^ response ! Item was changed: ----- Method: FillInTheBlankMorph>>response: (in category 'accessing') ----- response: aText "Sent when text pane accepts." + result := aText asString. + self delete. - response := aText asString. - done := true. - ^ true ! Item was removed: - ----- Method: FillInTheBlankMorph>>responseUponCancel: (in category 'initialization') ----- - responseUponCancel: anObject - responseUponCancel := anObject - ! Item was changed: ----- Method: FillInTheBlankMorph>>selectionInterval (in category 'accessing') ----- selectionInterval + ^ 1 to: result size - ^ 1 to: response size ! Item was changed: ----- Method: FillInTheBlankMorph>>setDefaultParameters (in category 'initialization') ----- setDefaultParameters - "change the receiver's appareance parameters" + super setDefaultParameters. + textPane ifNotNil: [:tp | tp borderColor: self borderColor].! - | colorFromMenu worldColor menuColor | - - colorFromMenu := Preferences menuColorFromWorld - and: [Display depth > 4 - and: [(worldColor := self currentWorld color) isColor]]. - - menuColor := colorFromMenu - ifTrue: [worldColor luminance > 0.7 - ifTrue: [worldColor mixed: 0.85 with: Color black] - ifFalse: [worldColor mixed: 0.4 with: Color white]] - ifFalse: [MenuMorph menuColor]. - - self color: menuColor. - self borderWidth: MenuMorph menuBorderWidth. - - Preferences menuAppearance3d ifTrue: [ - self borderStyle: BorderStyle thinGray. - self hasDropShadow: true. - - self useSoftDropShadow - ifFalse: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.666); - shadowOffset: 1 @ 1] - ifTrue: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.01); - shadowOffset: (10@8 corner: 10@12) ] - ] - ifFalse: [ - | menuBorderColor | - menuBorderColor := colorFromMenu - ifTrue: [worldColor muchDarker] - ifFalse: [MenuMorph menuBorderColor]. - self borderColor: menuBorderColor. - ]. - - - self layoutInset: 3. - ! Item was changed: ----- Method: FillInTheBlankMorph>>setPasswordQuery:initialAnswer:answerHeight:acceptOnCR: (in category 'initialization') ----- setPasswordQuery: queryString initialAnswer: initialAnswer answerHeight: answerHeight acceptOnCR: acceptBoolean + - | pane | self setQuery: queryString initialAnswer: initialAnswer answerHeight: answerHeight acceptOnCR: acceptBoolean. + textPane font: (StrikeFont passwordFontSize: 12).! - pane := self submorphNamed: 'textPane'. - pane font: (StrikeFont passwordFontSize: 12).! Item was changed: ----- Method: FillInTheBlankMorph>>setQuery:initialAnswer:answerExtent:acceptOnCR: (in category 'initialization') ----- setQuery: queryString initialAnswer: initialAnswer answerExtent: answerExtent acceptOnCR: acceptBoolean + + | text | + + result := initialAnswer. - | query topOffset accept cancel buttonAreaHeight | - response := initialAnswer. done := false. + + self paneMorph removeAllMorphs. + + self title: 'Input Requested'. + self message: queryString. - self removeAllMorphs. - self layoutPolicy: ProportionalLayout new. - query := self createQueryTextMorph: queryString. - topOffset := query height + 4. - accept := self createAcceptButton. - cancel := self createCancelButton. - buttonAreaHeight := (accept height max: cancel height) - + 7. - textPane := self - createTextPaneExtent: answerExtent - acceptBoolean: acceptBoolean - topOffset: topOffset - buttonAreaHeight: buttonAreaHeight. + text := self createTextPaneAcceptOnCR: acceptBoolean. + self paneMorph addMorphBack: text. + + self paneMorph extent: ((initialAnswer asText asMorph extent + (20@10) max: answerExtent) min: 500@500). + self setDefaultParameters.! - self extent: (((answerExtent max: query extent) - max: (initialAnswer asText asMorph extent)) min: 500@500) + (20@30) + (0 @ (topOffset + buttonAreaHeight))! Item was added: + ----- Method: FillInTheBlankMorph>>textPane (in category 'accessing') ----- + textPane + ^ textPane! Item was removed: - ----- Method: FillInTheBlankMorph>>undoGrabCommand (in category 'grabbing/dropping') ----- - undoGrabCommand - ^nil! Item was removed: - ----- Method: FillInTheBlankMorph>>updateColor (in category 'initialization') ----- - updateColor - "update the recevier's fillStyle" - | textPaneBorderColor | - self - updateColor: self - color: self color - intensity: 1. - textPane isNil - ifTrue: [^ self]. - textPaneBorderColor := self borderColor == #raised - ifTrue: [#inset] - ifFalse: [self borderColor]. - textPane borderColor: textPaneBorderColor! Item was removed: - ----- Method: FillInTheBlankMorph>>updateColor:color:intensity: (in category 'initialization') ----- - updateColor: aMorph color: aColor intensity: anInteger - "update the apareance of aMorph" - | fill | - MenuMorph gradientMenu - ifFalse: [^ self]. - - fill := GradientFillStyle ramp: {0.0 -> Color white. 1 -> aColor}. - fill radial: false; - origin: aMorph topLeft; - direction: 0 @ aMorph height. - aMorph fillStyle: fill! Item was changed: Morph subclass: #NewBalloonMorph instanceVariableNames: 'balloonOwner textMorph maximumWidth orientation hasTail' + classVariableNames: 'UseNewBalloonMorph' - classVariableNames: 'DefaultBalloonTextColor UseNewBalloonMorph' poolDictionaries: '' category: 'Morphic-Widgets'! !NewBalloonMorph commentStamp: 'mt 3/31/2015 10:15' prior: 0! A balloon is a bubble with an optional tail. It contains rich text, which describes something about its balloon-owner.! Item was removed: - ----- Method: NewBalloonMorph class>>defaultBalloonTextColor (in category 'preferences') ----- - defaultBalloonTextColor - - <preference: 'Default balloon text color' - categoryList: #(Morphic colors) - description: 'Specifies the default text color if no color information is provided via text attributes such as for plain strings. Otherwise the color information from the text attributes is used.' - type: #Color> - ^ DefaultBalloonTextColor ifNil: [Color black]! Item was removed: - ----- Method: NewBalloonMorph class>>defaultBalloonTextColor: (in category 'preferences') ----- - defaultBalloonTextColor: color - - DefaultBalloonTextColor := color.! Item was changed: ----- Method: NewBalloonMorph class>>string:for:corner: (in category 'instance creation') ----- string: message for: morph corner: symbol ^ self new - color: morph balloonColor; balloonOwner: morph; setText: message; orientation: symbol; yourself! Item was added: + ----- Method: NewBalloonMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the balloon''s border.' }. + { #borderWidth. 'Borders'. 'Width of the balloon''s border.' }. + { #color. 'Colors', 'Color for the balloon background.' }. + { #font. 'Fonts'. 'Font for balloon text if not overridden by text attributes.' }. + { #textColor. 'Colors'. 'Color for the balloon text if not overridden by text attributes.' }. + }! Item was added: + ----- Method: NewBalloonMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + self setDefaultParameters.! Item was removed: - ----- Method: NewBalloonMorph>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - - ^ self defaultColor muchDarker"Color black"! Item was removed: - ----- Method: NewBalloonMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - - ^ MenuMorph menuBorderWidth! Item was removed: - ----- Method: NewBalloonMorph>>defaultColor (in category 'initialization') ----- - defaultColor - - ^ BalloonMorph balloonColor! Item was changed: ----- Method: NewBalloonMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas + self fillStyle isColor + ifFalse: [self fillStyle isGradientFill + ifTrue: [self fillStyle direction: 0 @ self height]]. "Bubble." self wantsRoundedCorners ifTrue: [aCanvas frameAndFillRoundRect: self bubbleBounds radius: self cornerRadius fillStyle: self fillStyle borderWidth: self borderStyle width borderColor: self borderStyle color] ifFalse: [aCanvas fillRectangle: self bubbleBounds fillStyle: self fillStyle borderStyle: self borderStyle]. "Tail." self hasTail ifTrue: [ self verticesForTail in: [:points | | pixelOffset | pixelOffset := points first y < points second y ifFalse: [points first x < points second x ifTrue: [self borderStyle width negated @ self borderStyle width] "bottomLeft" ifFalse: [self borderStyle width @ self borderStyle width]] "bottomRight" ifTrue: [points first x < points second x ifTrue: [self borderStyle width negated @ self borderStyle width negated] "topLeft" ifFalse: [self borderStyle width @ self borderStyle width negated]]. "topRight" aCanvas drawPolygon: points fillStyle: self fillStyle. aCanvas line: points first to: points second + pixelOffset width: self borderStyle width color: self borderStyle color. aCanvas line: points first to: points third + pixelOffset width: self borderStyle width color: self borderStyle color]]! Item was changed: ----- Method: NewBalloonMorph>>initialize (in category 'initialization') ----- initialize super initialize. + self setDefaultParameters. + - self - borderWidth: self defaultBorderWidth; - borderColor: self defaultBorderColor; - color: self defaultColor; - hasDropShadow: (Preferences menuAppearance3d and: [self defaultColor isTranslucent not]); - shadowOffset: 1@1; - shadowColor: (self color muchDarker muchDarker alpha: 0.333); - orientation: #bottomLeft. - - MenuMorph roundedMenuCorners - ifTrue: [self cornerStyle: #rounded]. - textMorph := TextMorph new wrapFlag: false; lock; yourself. self addMorph: textMorph.! Item was added: + ----- Method: NewBalloonMorph>>setDefaultParameters (in category 'initialization') ----- + setDefaultParameters + + self + borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]); + borderColor: (self userInterfaceTheme borderColor ifNil: [Color r: 0.46 g: 0.46 b: 0.353]); + color: (self userInterfaceTheme color ifNil: [Color r: 0.92 g: 0.92 b: 0.706]); + hasDropShadow: (Preferences menuAppearance3d and: [self color isTranslucent not]); + shadowOffset: 1@1; + shadowColor: (self color muchDarker muchDarker alpha: 0.333); + orientation: #bottomLeft. + + MenuMorph roundedMenuCorners + ifTrue: [self cornerStyle: #rounded]. + + "Gradients?" + MenuMorph gradientMenu ifTrue: [ + | cc fill | + cc := self color. + fill := GradientFillStyle ramp: { + 0.0 -> Color white. + 0.15 -> (cc mixed: 0.5 with: Color white). + 0.5 -> cc. + 0.8 -> cc twiceDarker}. + fill + origin: self topLeft; + direction: 0@self height. + self fillStyle: fill].! Item was changed: ----- Method: NewBalloonMorph>>setText: (in category 'initialization') ----- setText: stringOrText | text | text := stringOrText asText. text unembellished ifTrue: [ + text addAttribute: (TextColor color: (self userInterfaceTheme textColor ifNil: [Color black]))]. - text addAttribute: (TextColor color: self class defaultBalloonTextColor)]. + text addAttribute: (TextFontReference toFont: (self userInterfaceTheme font ifNil: [TextStyle defaultFont])). - text addAttribute: (TextFontReference toFont: (self balloonOwner ifNil: [BalloonMorph]) balloonFont). self textMorph wrapFlag: false. self textMorph newContents: text. self textMorph fullBounds. (self maximumWidth > 0 and: [self textMorph width > self maximumWidth]) ifTrue: [ self textMorph wrapFlag: true; width: self maximumWidth]. self updateLayout.! Item was changed: + Morph subclass: #SystemProgressBarMorph + instanceVariableNames: 'barSize barColor' - RectangleMorph subclass: #SystemProgressBarMorph - instanceVariableNames: 'barSize' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Widgets'! !SystemProgressBarMorph commentStamp: 'laza 4/9/2004 11:47' prior: 0! Instances of this morph get used by SystemProgressMoprh to quickly display a progress bar.! Item was added: + ----- Method: SystemProgressBarMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the progress bar''s border.' }. + { #borderWidth. 'Borders'. 'Width of the progress bar''s border.' }. + { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. + { #color. 'Colors'. 'Background color of the progress bar.' }. + { #barColor. 'Colors'. 'Color of the progress bar''s bar.' }. + }! Item was added: + ----- Method: SystemProgressBarMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self setDefaultParameters.! Item was changed: ----- Method: SystemProgressBarMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas | area | super drawOn: aCanvas. barSize > 0 ifTrue: [ area := self innerBounds. + area := area origin extent: (barSize min: area extent x)@area extent y. + aCanvas fillRectangle: area color: barColor - area := area origin extent: barSize-2@area extent y. - aCanvas fillRectangle: area color: LazyListMorph listSelectionColor ]. ! Item was changed: ----- Method: SystemProgressBarMorph>>initialize (in category 'initialization') ----- initialize super initialize. + self setDefaultParameters. - self - borderWidth: 0; - color: MenuMorph menuColor muchLighter. - barSize := 0. ! Item was added: + ----- 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 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: + Morph subclass: #SystemProgressMorph + instanceVariableNames: 'activeSlots bars labels font lock requestedPosition textColor' - RectangleMorph subclass: #SystemProgressMorph - instanceVariableNames: 'activeSlots bars labels font lock requestedPosition' classVariableNames: 'BarHeight BarWidth Inset UniqueInstance' poolDictionaries: '' category: 'Morphic-Widgets'! !SystemProgressMorph commentStamp: '<historical>' prior: 0! An single instance of this morph class is used to display progress while the system is busy, eg. while it receives code updates or does a fileIn. To give the user progress information you don't deal directly with SystemProgressMorph. You keep on using the well established way of progress notification, that has been a long time in the system, is widely used and does not depend on the existence of SystemProgressMorph. For more information on this look at the example in this class or look at the comment of the method displayProgressAt:from:to:during: in class String. SystemProgressMorph is not meant to be used as a component inside other morphs. You can switch back to the old style of progress display by disabling the morphicProgressStyle setting in the morphic section of the preferences.! Item was added: + ----- Method: SystemProgressMorph class>>applyUserInterfaceTheme (in category 'preferences') ----- + applyUserInterfaceTheme + + self reset.! Item was added: + ----- Method: SystemProgressMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the progress'' border.' }. + { #borderWidth. 'Borders'. 'Width of the progress'' border.' }. + { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. + { #color. 'Colors'. 'Background color of the progress.' }. + + { #font. 'Fonts'. 'Font for bar labels.' }. + { #textColor. 'Colors'. 'Color for bar labels.' }. + }! Item was added: + ----- Method: SystemProgressMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self setDefaultParameters.! Item was changed: ----- Method: SystemProgressMorph>>font: (in category 'accessing') ----- font: anObject + font := anObject. + self labels select: [:ea | ea notNil] thenDo: [:ea | ea font: font].! - font := anObject! Item was changed: ----- Method: SystemProgressMorph>>initialize (in category 'initialization') ----- initialize super initialize. activeSlots := 0. bars := Array new: 10. labels := Array new: 10. - font := Preferences standardMenuFont. lock := Semaphore forMutualExclusion. self setDefaultParameters; setProperty: #morphicLayerNumber toValue: self morphicLayerNumber; layoutPolicy: TableLayout new; listDirection: #topToBottom; cellPositioning: #leftCenter; cellInset: 5; listCentering: #center; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: Inset; minWidth: 150! Item was changed: ----- Method: SystemProgressMorph>>nextSlotFor: (in category 'private') ----- nextSlotFor: shortDescription lock critical: [ | label bar slots | slots := self labels size. self activeSlots = slots ifTrue: [^0]. self activeSlots: self activeSlots + 1. 1 to: slots do: [:index | label := (self labels at: index). label ifNil: [ bar := self bars at: index put: (SystemProgressBarMorph new extent: BarWidth@BarHeight). + label := self labels at: index put: ((StringMorph contents: shortDescription font: self font) color: self textColor). - label := self labels at: index put: (StringMorph contents: shortDescription font: self font). self addMorphBack: label; addMorphBack: bar. ^index]. label owner ifNil: [ bar := self bars at: index. label := self labels at: index. self addMorphBack: (label contents: shortDescription); addMorphBack: (bar barSize: 0). ^index]]] ! 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 default]); + borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]); + borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]). - | colorFromMenu worldColor menuColor | + Preferences menuAppearance3d ifTrue: [self addDropShadow]. - colorFromMenu := Preferences menuColorFromWorld - and: [Display depth > 4 - and: [(worldColor := self currentWorld color) isColor]]. + self + font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]); + textColor: (self userInterfaceTheme textColor ifNil: [Color black]). - menuColor := colorFromMenu - ifTrue: [worldColor luminance > 0.7 - ifTrue: [worldColor mixed: 0.85 with: Color black] - ifFalse: [worldColor mixed: 0.4 with: Color white]] - ifFalse: [MenuMorph menuColor]. - self color: menuColor. - - MenuMorph roundedMenuCorners - ifTrue: [self useRoundedCorners]. - self borderWidth: MenuMorph menuBorderWidth. - - Preferences menuAppearance3d ifTrue: [ - self borderStyle: BorderStyle thinGray. - self hasDropShadow: true. - - self useSoftDropShadow - ifFalse: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.666); - shadowOffset: 1 @ 1] - ifTrue: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.01); - shadowOffset: (10@8 corner: 10@12) ] - ] - ifFalse: [ - | menuBorderColor | - menuBorderColor := colorFromMenu - ifTrue: [worldColor muchDarker] - ifFalse: [MenuMorph menuBorderColor]. - self borderColor: menuBorderColor. - ]. - self updateColor: self color: self color intensity: 1.! Item was added: + ----- Method: SystemProgressMorph>>textColor (in category 'accessing') ----- + textColor + + ^ textColor ifNil: [Color black]! Item was added: + ----- Method: SystemProgressMorph>>textColor: (in category 'accessing') ----- + textColor: aColor + + textColor := aColor. + self labels select: [:ea | ea notNil] thenDo: [:ea | ea color: textColor].! Item was changed: ----- Method: SystemProgressMorph>>updateColor:color:intensity: (in category 'initialization') ----- updateColor: aMorph color: aColor intensity: anInteger "update the apareance of aMorph" + | fill cc | - | fill | MenuMorph gradientMenu ifFalse: [^ self]. + + cc := aColor adjustSaturation: -0.08 brightness: 0.4. + fill := GradientFillStyle ramp: { + 0.0 -> cc. + 0.25 -> (aColor mixed: 0.5 with: cc). + 1.0 -> aColor}. + - fill := GradientFillStyle ramp: {0.0 -> Color white. 1 ->aColor}. fill radial: false; origin: aMorph topLeft; direction: 0 @ aMorph height. aMorph fillStyle: fill! Item was added: + ----- Method: SystemProgressMorph>>wantsRoundedCorners (in category 'rounding') ----- + wantsRoundedCorners + + ^ MenuMorph roundedMenuCorners or: [super wantsRoundedCorners]! Item was changed: + DialogWindow subclass: #UserDialogBoxMorph + instanceVariableNames: '' - AlignmentMorph subclass: #UserDialogBoxMorph - instanceVariableNames: 'titleMorph labelMorph buttonRow value selectedButton cancelButton timeout savedLabel keyMap' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! !UserDialogBoxMorph commentStamp: 'ar 12/11/2009 22:33' prior: 0! A DialogBoxMorph is Morph used in simple yes/no/confirm dialogs. Strongly modal.! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm: (in category 'utilities') ----- confirm: aString "UserDialogBoxMorph confirm: 'Do you like chocolate?'" + ^self confirm: aString title: 'Please Confirm'! - ^self confirm: aString title: 'Please confirm:'! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm:orCancel:at: (in category 'utilities') ----- confirm: aString orCancel: cancelBlock at: aPointOrNil ^self confirm: aString orCancel: cancelBlock + title: 'Please Confirm' - title: 'Please confirm:' at: aPointOrNil! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm:orCancel:title:at: (in category 'utilities') ----- confirm: aString orCancel: cancelBlock title: titleString at: aPointOrNil + (self new - ^(self new title: titleString; + message: aString; + createButton: 'Yes' translated value: true; + createButton: 'No' translated value: false; + createButton: 'Cancel' translated value: nil; + selectedButtonIndex: 1; "YES" + yourself) in: [:dialog | + ^ (aPointOrNil + ifNil: [dialog getUserResponseAtHand] + ifNotNil: [ + dialog moveTo: aPointOrNil. + dialog getUserResponse]) + ifNil: [ cancelBlock value ]]! - label: aString; - addSelectedButton: 'Yes' translated value: true; - addButton: 'No' translated value: false; - addCancelButton: 'Cancel' translated value: nil; - runModalIn: ActiveWorld forHand: ActiveHand at: aPointOrNil) - ifNil: [ cancelBlock value ]! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm:title:at: (in category 'utilities') ----- confirm: aString title: titleString at: aPointOrNil "UserDialogBoxMorph confirm: 'Make your choice carefully' withCRs title: 'Do you like chocolate?'" ^self new title: titleString; + message: aString; + createButton: 'Yes' translated value: true; + createCancelButton: 'No' translated value: false; + selectedButtonIndex: 1; "YES" + getUserResponseAtHand! - label: aString; - addSelectedButton: 'Yes' translated value: true; - addCancelButton: 'No' translated value: false; - runModalIn: ActiveWorld forHand: ActiveHand at: aPointOrNil! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm:title:trueChoice:falseChoice:at: (in category 'utilities') ----- confirm: aString title: titleString trueChoice: trueChoice falseChoice: falseChoice at: aPointOrNil "UserDialogBoxMorph confirm: 'Make your choice carefully' withCRs title: 'Do you like chocolate?' trueChoice: 'Oh yessir!!' falseChoice: 'Not so much...'" ^self new title: titleString; + message: aString; + createButton: trueChoice translated value: true; + createCancelButton: falseChoice translated value: false; + selectedButtonIndex: 1; + moveTo: (aPointOrNil ifNil: [ActiveWorld center]); + getUserResponse! - label: aString; - addSelectedButton: trueChoice translated value: true; - addCancelButton: falseChoice translated value: false; - runModalIn: ActiveWorld forHand: ActiveHand at: aPointOrNil! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm:title:trueChoice:falseChoice:default:triggerAfter:at: (in category 'utilities') ----- confirm: aString title: titleString trueChoice: trueChoice falseChoice: falseChoice default: default triggerAfter: seconds at: aPointOrNil "UserDialogBoxMorph confirm: 'I like hot java' title: 'What do you say?' trueChoice: 'You bet!!' falseChoice: 'Nope' default: false triggerAfter: 12 at: 121@212" ^self new title: titleString; + message: aString; + createButton: trueChoice translated value: true; + createCancelButton: falseChoice translated value: false; + selectedButtonIndex: (default ifTrue: [1] ifFalse: [2]); + moveTo: (aPointOrNil ifNil: [ActiveWorld center]); + getUserResponseAfter: seconds! - label: aString; - addButton: trueChoice translated value: true selected: default performActionOnEscape: false; - addButton: falseChoice translated value: false selected: default not performActionOnEscape: true; - triggerAfter: seconds; - runModalIn: ActiveWorld forHand: ActiveHand at: aPointOrNil! Item was changed: ----- Method: UserDialogBoxMorph class>>inform: (in category 'utilities') ----- inform: aString "UserDialogBoxMorph inform: 'Squeak is great!!'" + ^self inform: aString title: 'Note' translated! - ^self inform: aString title: 'Note:'! Item was changed: ----- Method: UserDialogBoxMorph class>>inform:title:at: (in category 'utilities') ----- inform: aString title: titleString at: aPointOrNil "UserDialogBoxMorph inform: 'Squeak is great!!' title: 'Will you look at this:'" ^self new title: titleString; + message: aString; + createButton: 'OK' translated value: nil; + getUserResponseAtHand! - label: aString; - addSelectedCancelButton: 'OK' translated value: nil; - runModalIn: ActiveWorld forHand: ActiveHand at: aPointOrNil! Item was removed: - ----- Method: UserDialogBoxMorph>>addButton:value: (in category 'constructing') ----- - addButton: buttonLabel value: buttonValue - - self - addButton: buttonLabel - value: buttonValue - selected: false - performActionOnEscape: false! Item was removed: - ----- Method: UserDialogBoxMorph>>addButton:value:selected:performActionOnEscape: (in category 'constructing') ----- - addButton: buttonLabel value: buttonValue selected: isSelected performActionOnEscape: performActionOnEscape - "Adds a button with the given label and value. - The value is returned if the user presses the button." - | button | - button := PluggableButtonMorphPlus new - label: buttonLabel ; - action: [ self closeDialog: buttonValue ] ; - onColor: self buttonColor twiceLighter - offColor: self buttonColor twiceLighter. - button hResizing: #spaceFill; vResizing: #spaceFill. - isSelected ifTrue: [ self selectButton: button ]. - performActionOnEscape ifTrue: [ self performActionOnEscapeOf: button ]. - self registerKeyFor: button. - buttonRow addMorphBack: button! Item was removed: - ----- Method: UserDialogBoxMorph>>addCancelButton:value: (in category 'constructing') ----- - addCancelButton: buttonLabel value: buttonValue - - self - addButton: buttonLabel - value: buttonValue - selected: false - performActionOnEscape: true! Item was removed: - ----- Method: UserDialogBoxMorph>>addSelectedButton:value: (in category 'constructing') ----- - addSelectedButton: buttonLabel value: buttonValue - - self - addButton: buttonLabel - value: buttonValue - selected: true - performActionOnEscape: false! Item was removed: - ----- Method: UserDialogBoxMorph>>addSelectedCancelButton:value: (in category 'constructing') ----- - addSelectedCancelButton: buttonLabel value: buttonValue - - self - addButton: buttonLabel - value: buttonValue - selected: true - performActionOnEscape: true! Item was removed: - ----- Method: UserDialogBoxMorph>>buttonColor (in category 'initialization') ----- - buttonColor - ^Color r: 0.658 g: 0.678 b: 0.78! Item was removed: - ----- Method: UserDialogBoxMorph>>buttons (in category 'events') ----- - buttons - - ^buttonRow submorphs select: [ :each | - each isKindOf: PluggableButtonMorphPlus ].! Item was removed: - ----- Method: UserDialogBoxMorph>>checkAgainstKeymap: (in category 'events') ----- - checkAgainstKeymap: aCharacter - keyMap - at: aCharacter asLowercase - ifPresent: [ : foundButton | foundButton performAction ] - ifAbsent: [ "do nothing" ]! Item was removed: - ----- Method: UserDialogBoxMorph>>closeDialog: (in category 'running') ----- - closeDialog: returnValue - value := returnValue. - self delete.! Item was removed: - ----- Method: UserDialogBoxMorph>>deselectSelectedButton (in category 'events') ----- - deselectSelectedButton - - selectedButton ifNil: [ ^self ]. - selectedButton - onColor: self buttonColor twiceLighter - offColor: self buttonColor twiceLighter. - selectedButton := nil! Item was removed: - ----- Method: UserDialogBoxMorph>>drawSubmorphsOn: (in category 'drawing') ----- - drawSubmorphsOn: aCanvas - - super drawSubmorphsOn: aCanvas. - - self wantsRoundedCorners ifTrue: [ - "Overdraw lower part of title bar to hide bottom corners." - aCanvas - fillRectangle: (self submorphs first "titleRow" bottomLeft - (-1 @ self submorphs first cornerRadius) - corner: self submorphs first "titleRow" bottomRight - (1@0)) - color: self color].! Item was removed: - ----- Method: UserDialogBoxMorph>>flash (in category 'events') ----- - flash - "Flash me" - 1 to: 2 do:[:i| - self color: Color black. - self world doOneCycleNow. - (Delay forMilliseconds: 50) wait. - self color: Color white. - self world doOneCycleNow. - (Delay forMilliseconds: 50) wait. - ].! Item was removed: - ----- Method: UserDialogBoxMorph>>handlesKeyboard: (in category 'events') ----- - handlesKeyboard: evt - - ^true! Item was removed: - ----- Method: UserDialogBoxMorph>>initialize (in category 'initialization') ----- - initialize - - | titleRow cc | - super initialize. - self color: Color white. - self listDirection: #topToBottom; wrapCentering: #center; - hResizing: #shrinkWrap; vResizing: #shrinkWrap. - self layoutInset: -1 @ -1; cellInset: 5@5. - self borderStyle: BorderStyle thinGray. - self setProperty: #indicateKeyboardFocus: toValue: #never. - - FillInTheBlankMorph roundedDialogCorners - ifTrue: [self useRoundedCorners]. - - self hasDropShadow: Preferences menuAppearance3d. - self useSoftDropShadow - ifFalse: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.666); - shadowOffset: 1 @ 1] - ifTrue: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.01); - shadowOffset: (10@8 corner: 10@12)]. - - cc := Color gray: 0.8. - titleRow := AlignmentMorph newRow. - titleRow hResizing: #spaceFill; vResizing: #shrinkWrap. - - self cornerStyle == #rounded - ifTrue: [titleRow useRoundedCorners]. - - titleRow borderStyle: BorderStyle thinGray. - titleRow layoutInset: (5@5 corner: (2@ (5 + (titleRow cornerStyle == #rounded ifTrue: [titleRow cornerRadius] ifFalse: [0])))). - titleRow color: cc. - titleRow fillStyle: self titleGradient. - - titleMorph := StringMorph new. - titleMorph emphasis: 1. - titleRow addMorph: titleMorph. - labelMorph := TextMorph new. - labelMorph margins: (Preferences standardButtonFont widthOf: $x) * 2 @ 0. - labelMorph lock. - buttonRow := AlignmentMorph newRow - vResizing: #rigid; - height: (Preferences standardButtonFont height + 20); - hResizing: #spaceFill; - layoutInset: - (((Preferences standardButtonFont widthOf: $x) * 2 @ 0) - corner: ((Preferences standardButtonFont widthOf: $x) * 2 @ 10)); - cellInset: (Preferences standardButtonFont widthOf: $x) * 2. - buttonRow color: Color transparent. - self - addMorphBack: titleRow ; - addMorphBack: labelMorph ; - addMorphBack: buttonRow. - keyMap := Dictionary new! Item was removed: - ----- Method: UserDialogBoxMorph>>justDroppedInto:event: (in category 'events') ----- - justDroppedInto: aMorph event: event - - "Restore drop shadow if necessary." - self hasDropShadow: Preferences menuAppearance3d. - - "aggressively preserve focus" - event hand newMouseFocus: self.! Item was removed: - ----- Method: UserDialogBoxMorph>>keyStroke: (in category 'events') ----- - keyStroke: evt - | evtCharacter | - self stopAutoTrigger. - evtCharacter := evt keyCharacter. - evtCharacter = Character escape ifTrue: [ - ^cancelButton ifNotNil: [ cancelButton performAction ] ]. - evtCharacter = Character cr ifTrue: [ - ^selectedButton ifNotNil: [ selectedButton performAction ] ]. - (evtCharacter = Character arrowLeft or: [ - evt shiftPressed and: [ evtCharacter = Character tab ] ]) ifTrue: [ - ^self selectPreviousButton ]. - (evtCharacter = Character arrowRight or: [ - evtCharacter = Character tab ]) ifTrue: [ - ^self selectNextButton ]. - self checkAgainstKeymap: evtCharacter! Item was changed: + ----- Method: UserDialogBoxMorph>>label (in category 'accessing') ----- - ----- Method: UserDialogBoxMorph>>label (in category 'constructing') ----- label + ^ self message! - "The dialog's label (String)" - ^labelMorph contents - ! Item was changed: + ----- Method: UserDialogBoxMorph>>label: (in category 'accessing') ----- - ----- Method: UserDialogBoxMorph>>label: (in category 'constructing') ----- label: aString + self message: aString.! - "The dialog's label (String)" - labelMorph contents: aString. - ! Item was removed: - ----- Method: UserDialogBoxMorph>>mouseDown: (in category 'events') ----- - mouseDown: event - self stopAutoTrigger. - "Always bring me to the front since I am modal" - self comeToFront. - (self containsPoint: event position) ifFalse:[ - Beeper beepPrimitive. - ^self flash]. - - self hasDropShadow: false. - event hand grabMorph: self.! Item was removed: - ----- Method: UserDialogBoxMorph>>mouseUp: (in category 'events') ----- - mouseUp: event - self stopAutoTrigger. - "aggressively preserve focus" - event hand newMouseFocus: self.! Item was removed: - ----- Method: UserDialogBoxMorph>>performActionOnEscapeOf: (in category 'constructing') ----- - performActionOnEscapeOf: aButton - - cancelButton := aButton! Item was removed: - ----- Method: UserDialogBoxMorph>>processFocusEvent:using: (in category 'events') ----- - processFocusEvent: evt using: dispatcher - - ^ dispatcher dispatchFocusEventFully: evt with: self! Item was removed: - ----- Method: UserDialogBoxMorph>>registerKeyFor: (in category 'constructing') ----- - registerKeyFor: button - button label do: - [ : eachChar | eachChar isAlphaNumeric ifTrue: - [ keyMap - at: eachChar asLowercase - ifPresent: [ : found | "It's already taken, don't use it." ] - ifAbsent: - [ ^ keyMap - at: eachChar asLowercase - put: button ] ] ]! Item was removed: - ----- Method: UserDialogBoxMorph>>runModalIn:forHand:at: (in category 'running') ----- - runModalIn: aWorld forHand: aHand at: aPointOrNil - "Ensure that we have a reasonable minimum size" - | oldFocus pos offset | - (ProvideAnswerNotification signal: self label asString) ifNotNil:[:answer| ^answer]. - self openInWorld: aWorld. - pos := aPointOrNil ifNil: [ - "If called after a longer UI operation, be sure to use the current mouse cursor. Hand position is not up-to-date. Do one world cycle does not help if there are currently no mouse events. So, we *have to be* this extreme." - Sensor cursorPoint]. - offset := aPointOrNil - ifNil: [selectedButton fullBounds origin - (selectedButton fullBounds extent // 2 * (-1@1))] - ifNotNil: [self fullBounds extent // 2]. - self setConstrainedPosition: pos - offset hangOut: false. - oldFocus := aHand keyboardFocus. - aHand newMouseFocus: self. - aHand newKeyboardFocus: self. - savedLabel := selectedButton label. - [self isInWorld] whileTrue:[aWorld doOneSubCycle]. - oldFocus ifNotNil:[aHand newKeyboardFocus: oldFocus]. - ^value! Item was removed: - ----- Method: UserDialogBoxMorph>>selectButton: (in category 'events') ----- - selectButton: aButton - - self deselectSelectedButton. - aButton - onColor: Color orange muchLighter - offColor: Color orange muchLighter. - selectedButton := aButton! Item was removed: - ----- Method: UserDialogBoxMorph>>selectNextButton (in category 'events') ----- - selectNextButton - - | buttons | - buttons := self buttons. - self selectButton: (buttons atWrap: (buttons indexOf: selectedButton) + 1)! Item was removed: - ----- Method: UserDialogBoxMorph>>selectPreviousButton (in category 'events') ----- - selectPreviousButton - - | buttons | - buttons := self buttons. - self selectButton: (buttons atWrap: (buttons indexOf: selectedButton) - 1)! Item was removed: - ----- Method: UserDialogBoxMorph>>step (in category 'stepping and presenter') ----- - step - timeout ifNil: [^self]. - timeout = 0 - ifTrue: [ - self stopStepping. - selectedButton performAction] - ifFalse: [ - selectedButton label: savedLabel, '(', timeout printString, ')'. - timeout := timeout - 1]! Item was removed: - ----- Method: UserDialogBoxMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - ^1000! Item was removed: - ----- Method: UserDialogBoxMorph>>stopAutoTrigger (in category 'stepping and presenter') ----- - stopAutoTrigger - timeout ifNil: [^self]. - timeout := nil. - self stopStepping. - selectedButton label: savedLabel ! Item was removed: - ----- Method: UserDialogBoxMorph>>title (in category 'constructing') ----- - title - ^titleMorph contents! Item was removed: - ----- Method: UserDialogBoxMorph>>title: (in category 'constructing') ----- - title: aString - titleMorph contents: aString! Item was removed: - ----- Method: UserDialogBoxMorph>>titleGradient (in category 'initialization') ----- - titleGradient - - | cc gradient | - SystemWindow gradientWindow - ifFalse: [^ SolidFillStyle color: self buttonColor]. - - cc := self buttonColor. - gradient := GradientFillStyle ramp: { - 0.0 -> Color white. - 0.33 ->(cc mixed: 0.5 with: Color white). - 1.0 -> cc. - }. - gradient origin: 0@0. - gradient direction: 0 @ (TextStyle defaultFont height + 10). - ^gradient! Item was removed: - ----- Method: UserDialogBoxMorph>>triggerAfter: (in category 'constructing') ----- - triggerAfter: seconds - timeout := seconds! Item was removed: - ----- Method: UserDialogBoxMorph>>wantsToBeDroppedInto: (in category 'events') ----- - wantsToBeDroppedInto: aMorph - "Return true if it's okay to drop the receiver into aMorph" - ^aMorph isWorldMorph "only into worlds"! Item was changed: + (PackageInfo named: 'Morphic') postscript: 'SystemProgressMorph reset.'! - (PackageInfo named: 'Morphic') postscript: 'MenuIcons initializeIcons. - TheWorldMainDockingBar updateInstances.'!

1 0

The Trunk: 51Deprecated-mt.37.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of 51Deprecated to project The Trunk: http://source.squeak.org/trunk/51Deprecated-mt.37.mcz ==================== Summary ==================== Name: 51Deprecated-mt.37 Author: mt Time: 31 July 2016, 11:02:27.47649 am UUID: 7a39db3d-68a6-8545-a4b4-ec7c35d1edf9 Ancestors: 51Deprecated-mt.36 *** Widget Refactorings and UI Themes (Part 4 of 11) *** Some fixes and refactorings in menus and docking bars. Prepare both for UI themeing. =============== Diff against 51Deprecated-mt.36 =============== Item was added: + ----- Method: MenuMorph class>>menuBorderColor (in category '*51Deprecated') ----- + menuBorderColor + + self deprecated: 'mt: Use UI themes.'. + ^ (UserInterfaceTheme current get: #borderColor for: self) ifNil: [(Color r: 0.2 g: 0.3 b: 0.9)]! Item was added: + ----- Method: MenuMorph class>>menuBorderWidth (in category '*51Deprecated') ----- + menuBorderWidth + + self deprecated: 'mt: Use UI themes.'. + ^ (UserInterfaceTheme current get: #borderWidth for: self) ifNil: [2]! Item was added: + ----- Method: MenuMorph class>>menuColor (in category '*51Deprecated') ----- + menuColor + + self deprecated: 'mt: Use UI themes.'. + ^ (UserInterfaceTheme current get: #color for: self) ifNil: [(Color r: 0.9 g: 0.9 b: 0.9)]! Item was added: + ----- Method: MenuMorph class>>menuLineColor (in category '*51Deprecated') ----- + menuLineColor + + self deprecated: 'mt: Use UI themes.'. + ^ (UserInterfaceTheme current get: #lineColor for: self) ifNil: [(Color r: 0.6 g: 0.7 b: 1)]! Item was added: + ----- Method: MenuMorph class>>menuSelectionColor (in category '*51Deprecated') ----- + menuSelectionColor + + self deprecated: 'mt: Use UI themes.'. + ^ (UserInterfaceTheme current get: #selectionColor for: MenuItemMorph) ifNil: [(Color r: 0.4 g: 0.5 b: 0.7)]! Item was added: + ----- Method: MenuMorph class>>menuTitleBorderColor (in category '*51Deprecated') ----- + menuTitleBorderColor + + self deprecated: 'mt: Use UI themes.'. + ^ (UserInterfaceTheme current get: #titleBorderColor for: self) ifNil: [(Color r: 0.6 g: 0.7 b: 1)]! Item was added: + ----- Method: MenuMorph class>>menuTitleBorderWidth (in category '*51Deprecated') ----- + menuTitleBorderWidth + + self deprecated: 'mt: Use UI themes.'. + ^ (UserInterfaceTheme current get: #titleBorderWidth for: self) ifNil: [0]! Item was added: + ----- Method: MenuMorph class>>menuTitleColor (in category '*51Deprecated') ----- + menuTitleColor + + self deprecated: 'mt: Use UI themes.'. + ^ (UserInterfaceTheme current get: #titleColor for: self) ifNil: [ Color transparent]!

1 0

The Trunk: Morphic-mt.1210.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1210.mcz ==================== Summary ==================== Name: Morphic-mt.1210 Author: mt Time: 31 July 2016, 11:01:49.38749 am UUID: 885974ef-35e1-cd4f-8c9e-858dcd73e15b Ancestors: Morphic-mt.1209 *** Widget Refactorings and UI Themes (Part 4 of 11) *** Some fixes and refactorings in menus and docking bars. Prepare both for UI themeing. =============== Diff against Morphic-mt.1209 =============== Item was changed: ----- Method: DockingBarItemMorph>>adjacentTo (in category 'selecting') ----- adjacentTo + | roundedCornersOffset verticalOffset | - | roundedCornersOffset | roundedCornersOffset := MenuMorph roundedMenuCorners ifTrue: [Morph preferredCornerRadius negated] ifFalse: [0]. + verticalOffset := 2. owner isFloating + ifTrue: [^ {self bounds bottomLeft + (roundedCornersOffset @ verticalOffset)}]. - ifTrue: [^ {self bounds bottomLeft + (roundedCornersOffset @ 4)}]. owner isAdheringToTop + ifTrue: [^ {self bounds bottomLeft + (roundedCornersOffset @ verticalOffset)}]. - ifTrue: [^ {self bounds bottomLeft + (roundedCornersOffset @ 4)}]. owner isAdheringToLeft + ifTrue: [^ {self bounds topRight + (roundedCornersOffset @ verticalOffset)}]. - ifTrue: [^ {self bounds topRight + (roundedCornersOffset @ 4)}]. owner isAdheringToBottom + ifTrue: [^ {self bounds topLeft + (roundedCornersOffset @ verticalOffset)}]. - ifTrue: [^ {self bounds topLeft + (roundedCornersOffset @ 4)}]. owner isAdheringToRight + ifTrue: [^ {self bounds topLeft + (roundedCornersOffset @ verticalOffset negated)}]. - ifTrue: [^ {self bounds topLeft + (roundedCornersOffset @ -4)}]. ^ {self bounds bottomLeft + (roundedCornersOffset @ 5)}! Item was added: + ----- Method: DockingBarItemMorph>>drawIconOn: (in category 'drawing') ----- + drawIconOn: aCanvas + + | pos | + self hasIcon ifTrue: [ + | iconForm | + iconForm := self iconForm. + + pos := (contents + ifEmpty: [self left + (self width - iconForm width // 2)] + ifNotEmpty: [self left]) + @ (self top + (self height - iconForm height // 2)). + + aCanvas + translucentImage: iconForm + at: pos].! Item was added: + ----- Method: DockingBarItemMorph>>drawLabelOn: (in category 'drawing') ----- + drawLabelOn: aCanvas + + | stringBounds | + self contents ifEmpty: [^ self]. + + stringBounds := bounds. + + self hasIcon ifTrue: [ + stringBounds := stringBounds left: stringBounds left + self iconForm width + 2 ]. + + "Vertical centering." + stringBounds := stringBounds top: stringBounds top + stringBounds bottom - self fontToUse height // 2. + "Horizontal centering." + stringBounds := stringBounds left: stringBounds left + (stringBounds width - (self fontToUse widthOfString: contents) // 2) abs. + + aCanvas + drawString: contents + in: stringBounds + font: self fontToUse + color: self colorToUse.! Item was removed: - ----- Method: DockingBarItemMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - | stringColor stringBounds | - (isSelected and: [ isEnabled ]) - ifTrue: [ - aCanvas fillRectangle: self bounds fillStyle: self selectionFillStyle. - stringColor := color negated ] - ifFalse: [ stringColor := color ]. - stringBounds := bounds. - stringBounds := stringBounds left: stringBounds left + self stringMargin. - self hasIcon ifTrue: [ - | iconForm | - iconForm := self iconForm. - aCanvas - translucentImage: iconForm - at: stringBounds left @ (self top + (self height - iconForm height // 2)). - stringBounds := stringBounds left: stringBounds left + iconForm width + 2 ]. - stringBounds := stringBounds top: stringBounds top + stringBounds bottom - self fontToUse height // 2. - aCanvas - drawString: contents - in: stringBounds - font: self fontToUse - color: stringColor! Item was added: + ----- Method: DockingBarItemMorph>>drawSubMenuMarkerOn: (in category 'drawing') ----- + drawSubMenuMarkerOn: aCanvas + "Ignore."! Item was removed: - ----- Method: DockingBarItemMorph>>minWidth (in category 'layout') ----- - minWidth - - | iconWidth | - iconWidth := self hasIcon - ifTrue: [ self icon width + 2 ] - ifFalse: [ 0 ]. - ^ (self fontToUse widthOfString: contents) + iconWidth + (2 * self stringMargin)! Item was removed: - ----- Method: DockingBarItemMorph>>stringMargin (in category 'layout') ----- - stringMargin - - ^Preferences tinyDisplay - ifTrue: [ 1 ] - ifFalse: [ 6 ]! Item was removed: - ----- Method: DockingBarItemMorph>>subMenuMarker (in category 'private') ----- - subMenuMarker - - self shouldNotImplement! Item was changed: + Morph subclass: #DockingBarMorph - AlignmentMorph subclass: #DockingBarMorph instanceVariableNames: 'originalColor gradientRamp fillsOwner avoidVisibleBordersAtEdge autoGradient selectedItem activeSubMenu oldKeyboardFocus oldMouseFocus' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Menus-DockingBar'! Item was added: + ----- Method: DockingBarMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the menu''s border.' }. + { #borderWidth. 'Geometry'. 'Width of the menu''s border.' }. + { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. + { #color. 'Colors'. 'Background color of the menu.' }. + + { #lineColor. 'Colors'. 'Color of the separators between menu items.' }. + { #lineStyle. 'Colors'. 'Use border-style to change appearance.' }. + { #lineWidth. 'Geometry'. 'How big the separators should be.' }. + }! Item was changed: ----- Method: DockingBarMorph>>addLine (in category 'construction') ----- addLine "Append a divider line to this menu. Suppress duplicate lines." + | colorToUse | submorphs isEmpty ifTrue: [^ self]. + self lastSubmorph knownName = #line ifTrue: [^ self]. + + colorToUse := self userInterfaceTheme lineColor ifNil: [Color gray: 0.9]. + self addMorphBack: (Morph new + color: colorToUse; + extent: (self userInterfaceTheme lineWidth ifNil: [2]) asPoint; + borderStyle: (self userInterfaceTheme lineStyle ifNil: [BorderStyle inset]); + borderColor: colorToUse; + borderWidth: 1; + name: #line; "see above" + yourself).! - (self lastSubmorph isKindOf: MenuLineMorph) - ifFalse: [self addMorphBack: MenuLineMorph new]. - ! Item was added: + ----- 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]); + borderColor: colorToUse].! Item was changed: ----- Method: DockingBarMorph>>color: (in category 'accessing') ----- color: aColor "Set the receiver's color." + super color: aColor. originalColor := aColor asColor. + gradientRamp := nil. "" self updateColor! Item was changed: ----- Method: DockingBarMorph>>gradientRamp (in category 'private - layout') ----- gradientRamp + | cc | + cc := originalColor adjustSaturation: -0.08 brightness: 0.4. + ^ gradientRamp ifNil:[gradientRamp := { + 0.0 -> cc. + 0.25 -> (originalColor mixed: 0.5 with: cc). + 0.9 -> originalColor. + 1.0 -> originalColor darker.}]! - ^ gradientRamp ifNil:[{0.0 -> originalColor muchLighter. 1.0 -> originalColor twiceDarker}]! Item was changed: ----- Method: DockingBarMorph>>initialize (in category 'initialize-release') ----- initialize "initialize the receiver" super initialize. + self changeTableLayout. + selectedItem := nil. activeSubMenu := nil. fillsOwner := true. avoidVisibleBordersAtEdge := true. autoGradient := MenuMorph gradientMenu. self setDefaultParameters ; beFloating ; beSticky ; layoutInset: 0 ; dropEnabled: true! Item was changed: ----- Method: DockingBarMorph>>setDefaultParameters (in category 'initialize-release') ----- setDefaultParameters "private - set the default parameter using Preferences as the inspiration source" + - | colorFromMenu worldColor menuColor menuBorderColor | - colorFromMenu := Preferences menuColorFromWorld - and: [Display depth > 4 - and: [(worldColor := self currentWorld color) isColor]]. - "" - menuColor := colorFromMenu - ifTrue: [worldColor luminance > 0.7 - ifTrue: [worldColor mixed: 0.85 with: Color black] - ifFalse: [worldColor mixed: 0.4 with: Color white]] - ifFalse: [MenuMorph menuColor]. - "" - menuBorderColor := Preferences menuAppearance3d - ifTrue: [#raised] - ifFalse: [colorFromMenu - ifTrue: [worldColor muchDarker] - ifFalse: [MenuMorph menuBorderColor]]. - "" self + color: (self userInterfaceTheme color ifNil: [Color r: 0.9 g: 0.9 b: 0.9]); + 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).! - setColor: menuColor - borderWidth: MenuMorph menuBorderWidth - borderColor: menuBorderColor! Item was changed: ----- Method: DockingBarMorph>>updateColor (in category 'private - layout') ----- updateColor "private - update the receiver's color" | fill | + MenuMorph gradientMenu ifFalse: [ - self autoGradient ifFalse: [ self color ~= originalColor ifTrue: [self color: originalColor]. ^ self]. "" fill := GradientFillStyle ramp: self gradientRamp. "" fill origin: self topLeft. self isVertical ifTrue: [fill direction: self width @ 0] ifFalse: [fill direction: 0 @ self height]. "" self fillStyle: fill! Item was changed: ----- Method: DockingBarMorph>>updateLayoutProperties (in category 'private - layout') ----- updateLayoutProperties "private - update the layout properties based on adhering, fillsOwner and avoidVisibleBordersAtEdge preferencs" "" (self isHorizontal or: [self isFloating]) ifTrue: [self listDirection: #leftToRight] ifFalse: [self listDirection: #topToBottom]. "" self hResizing: #shrinkWrap. self vResizing: #shrinkWrap. self fillsOwner ifTrue: ["" self isHorizontal ifTrue: [self hResizing: #spaceFill]. self isVertical ifTrue: [self vResizing: #spaceFill]]. + "" + self isHorizontal ifTrue: [ + self submorphsDo: [:m | m hResizing: #shrinkWrap; vResizing: #spaceFill]]. + self isVertical ifTrue: [ + self submorphsDo: [:m | m vResizing: #shrinkWrap; hResizing: #spaceFill]]. + ! - ! Item was changed: ----- Method: MenuIcons class>>squeakLogoIcon (in category 'accessing - icons') ----- squeakLogoIcon ^ Icons at: #squeakLogoIcon ifAbsentPut: [(Form extent: 24@16 depth: 32 + fromArray: #( 0 0 67108865 2063597569 1778384897 889192449 0 0 0 0 0 0 0 0 0 0 0 0 1610612737 1811939329 1610612737 0 0 0 0 0 905969665 889192449 0 1442840577 788529153 0 0 0 0 0 0 0 0 0 0 1711276033 469762049 0 1728053249 0 0 0 0 0 1006632961 704643073 0 0 1895825409 234881025 0 0 0 0 0 0 0 0 1207959553 838860801 0 0 1728053249 0 0 0 0 0 738197505 989855745 0 0 167772161 1862270977 0 0 0 0 0 0 0 83886081 1879048193 0 0 0 1744830465 0 0 0 0 0 469762049 1258291201 0 0 0 1543503873 520093697 0 0 0 0 0 0 1543503873 335544321 0 0 0 1761607681 0 0 0 0 0 16777217 1644167169 0 0 0 33554433 67108865 0 0 0 0 0 0 33554433 0 0 0 0 1795162113 0 0 0 0 0 0 1711276033 0 0 0 0 0 117440513 0 0 0 0 0 0 0 0 0 100663297 1677721601 0 0 0 0 0 0 1744830465 0 0 0 0 3019898881 4009754625 1056964609 0 0 1090519041 3204448257 1325400065 0 0 0 889192449 889192449 0 0 0 0 0 0 1392508929 352321537 0 0 637534209 4278190081 4278190081 2650800129 0 0 3372220417 4278190081 3758096385 0 0 0 1560281089 117440513 0 0 0 0 0 0 0 0 0 0 134217729 4060086273 4278190081 1929379841 0 0 3187671041 4278190081 3590324225 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 704643073 1577058305 83886081 0 0 771751937 2667577345 956301313 0 0 0 0 0 0 0 0 0 0 369098753 973078529 1577058305 1728053249 1711276033 1325400065 805306369 218103809 0 855638017 922746881 16777217 0 268435457 788529153 1308622849 1593835521 1056964609 436207617 16777217 0 0 1442840577 1761607681 1409286145 788529153 301989889 872415233 1124073473 1627389953 1929379841 973078529 2030043137 4278190081 4278190081 2164260865 1040187393 1946157057 1577058305 939524097 452984833 687865857 1325400065 1778384897 1795162113 1392508929 0 0 855638017 1795162113 1677721601 855638017 620756993 436207617 486539265 285212673 2030043137 4278190081 4278190081 2164260865 486539265 1023410177 922746881 1157627905 1392508929 1845493761 1744830465 486539265 0 0 201326593 2013265921 1006632961 0 553648129 1694498817 1778384897 1694498817 1728053249 738197505 0 855638017 922746881 16777217 738197505 1728053249 1744830465 1778384897 1476395009 251658241 117440513 1476395009 1879048193 150994945 0 16777217 0 486539265 1426063361 16777217 0 0 0 0 0 0 0 0 0 0 0 0 234881025 1728053249 486539265 0 167772161 50331649) - fromArray: #( 16777215 16777215 67108864 2063597568 1778384896 889192448 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1610612736 1811939328 1610612736 16777215 16777215 16777215 16777215 16777215 905969664 889192448 16777215 1442840576 788529152 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1711276032 469762048 16777215 1728053248 16777215 16777215 16777215 16777215 16777215 1006632960 704643072 16777215 16777215 1895825408 234881024 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1207959552 838860800 16777215 16777215 1728053248 16777215 16777215 16777215 16777215 16777215 738197504 989855744 16777215 16777215 167772160 1862270976 16777215 16777215 16777215 16777215 16777215 16777215 16777215 83886080 1879048192 16777215 16777215 16777215 1744830464 16777215 16777215 16777215 16777215 16777215 469762048 1258291200 16777215 16777215 16777215 1543503872 520093696 16777215 16777215 16777215 16777215 16777215 16777215 1543503872 335544320 16777215 16777215 16777215 1761607680 16777215 16777215 16777215 16777215 16777215 16777216 1644167168 16777215 16777215 16777215 33554432 67108864 16777215 16777215 16777215 16777215 16777215 16777215 33554432 16777215 16777215 16777215 16777215 1795162112 16777215 16777215 16777215 16777215 16777215 16777215 1711276032 16777215 16777215 16777215 16777215 16777215 117440512 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 100663296 1677721600 16777215 16777215 16777215 16777215 16777215 16777215 1744830464 16777215 16777215 16777215 16777215 3019898880 4009754624 1056964608 16777215 16777215 1090519040 3204448256 1325400064 16777215 16777215 16777215 889192448 889192448 16777215 16777215 16777215 16777215 16777215 16777215 1392508928 352321536 16777215 16777215 637534208 4278190080 4278190080 2650800128 16777215 16777215 3372220416 4278190080 3758096384 16777215 16777215 16777215 1560281088 117440512 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 134217728 4060086272 4278190080 1929379840 16777215 16777215 3187671040 4278190080 3590324224 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 704643072 1577058304 83886080 16777215 16777215 771751936 2667577344 956301312 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 369098752 973078528 1577058304 1728053248 1711276032 1325400064 805306368 218103808 16777215 858262026 925501705 16777216 16777215 268435456 788529152 1308622848 1593835520 1056964608 436207616 16777216 16777215 16777215 1442840576 1761607680 1409286144 788529152 301989888 872415232 1124073472 1627389952 1929379840 973078528 2032667403 4280814347 4280814347 2166885388 1040187392 1946157056 1577058304 939524096 452984832 687865856 1325400064 1778384896 1795162112 1392508928 16777215 16777215 855638016 1795162112 1677721600 855638016 620756992 436207616 486539264 285212672 2032667403 4280814347 4280814347 2166885388 486539264 1023410176 922746880 1157627904 1392508928 1845493760 1744830464 486539264 16777215 16777215 201326592 2013265920 1006632960 16777215 553648128 1694498816 1778384896 1694498816 1728053248 738197504 16777215 858262026 925501705 16777216 738197504 1728053248 1744830464 1778384896 1476395008 251658240 117440512 1476395008 1879048192 150994944 16777215 16777216 16777215 486539264 1426063360 16777216 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 234881024 1728053248 486539264 16777215 167772160 50331648) offset: 0@0)]! Item was added: + ----- Method: MenuIcons class>>squeakLogoIconColorized: (in category 'accessing - icons') ----- + squeakLogoIconColorized: aColor + + ^ self squeakLogoIcon + collectColors: [:c | aColor alpha: c alpha]! Item was removed: - ----- Method: MenuIcons class>>squeakLogoInvertedIcon (in category 'accessing - icons') ----- - squeakLogoInvertedIcon - ^ Icons - at: #squeakLogoInvertedIcon ifAbsentPut: [(Form - extent: 24@16 - depth: 32 - fromArray: #( 16777215 16777215 83886079 2080374783 1795162111 905969663 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1627389951 1828716543 1627389951 16777215 16777215 16777215 16777215 16777215 922746879 905969663 16777215 1459617791 805306367 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1728053247 486539263 16777215 1744830463 16777215 16777215 16777215 16777215 16777215 1023410175 721420287 16777215 16777215 1912602623 251658239 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1224736767 855638015 16777215 16777215 1744830463 16777215 16777215 16777215 16777215 16777215 754974719 1006632959 16777215 16777215 184549375 1879048191 16777215 16777215 16777215 16777215 16777215 16777215 16777215 100663295 1895825407 16777215 16777215 16777215 1761607679 16777215 16777215 16777215 16777215 16777215 486539263 1275068415 16777215 16777215 16777215 1560281087 536870911 16777215 16777215 16777215 16777215 16777215 16777215 1560281087 352321535 16777215 16777215 16777215 1778384895 16777215 16777215 16777215 16777215 16777215 33554431 1660944383 16777215 16777215 16777215 50331647 83886079 16777215 16777215 16777215 16777215 16777215 16777215 50331647 16777215 16777215 16777215 16777215 1811939327 16777215 16777215 16777215 16777215 16777215 16777215 1728053247 16777215 16777215 16777215 16777215 16777215 134217727 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 117440511 1694498815 16777215 16777215 16777215 16777215 16777215 16777215 1761607679 16777215 16777215 16777215 16777215 3036676095 4026531839 1073741823 16777215 16777215 1107296255 3221225471 1342177279 16777215 16777215 16777215 905969663 905969663 16777215 16777215 16777215 16777215 16777215 16777215 1409286143 369098751 16777215 16777215 654311423 4294967295 4294967295 2667577343 16777215 16777215 3388997631 4294967295 3774873599 16777215 16777215 16777215 1577058303 134217727 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 150994943 4076863487 4294967295 1946157055 16777215 16777215 3204448255 4294967295 3607101439 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 721420287 1593835519 100663295 16777215 16777215 788529151 2684354559 973078527 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 385875967 989855743 1593835519 1744830463 1728053247 1342177279 822083583 234881023 16777215 869791221 936769270 33554431 16777215 285212671 805306367 1325400063 1610612735 1073741823 452984831 33554431 16777215 16777215 1459617791 1778384895 1426063359 805306367 318767103 889192447 1140850687 1644167167 1946157055 989855743 2044196084 4292343028 4292343028 2178413555 1056964607 1962934271 1593835519 956301311 469762047 704643071 1342177279 1795162111 1811939327 1409286143 16777215 16777215 872415231 1811939327 1694498815 872415231 637534207 452984831 503316479 301989887 2044196084 4292343028 4292343028 2178413555 503316479 1040187391 939524095 1174405119 1409286143 1862270975 1761607679 503316479 16777215 16777215 218103807 2030043135 1023410175 16777215 570425343 1711276031 1795162111 1711276031 1744830463 754974719 16777215 869791221 936769270 33554431 754974719 1744830463 1761607679 1795162111 1493172223 268435455 134217727 1493172223 1895825407 167772159 16777215 33554431 16777215 503316479 1442840575 33554431 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 251658239 1744830463 503316479 16777215 184549375 67108863) - offset: 0@0)]! Item was added: + ----- Method: MenuItemMorph class>>applyUserInterfaceTheme (in category 'preferences') ----- + applyUserInterfaceTheme + + SubMenuMarker := (UserInterfaceTheme current get: #subMenuMarker for: self) + ifNil: [self defaultSubMenuMarker].! Item was added: + ----- Method: MenuItemMorph class>>defaultSubMenuMarker (in category 'defaults') ----- + defaultSubMenuMarker + + | f | + f := Form + extent: 5@9 + fromArray: #(2147483648 3221225472 3758096384 4026531840 4160749568 4026531840 3758096384 3221225472 2147483648) + offset: 0@0. + ^ ColorForm mappingWhiteToTransparentFrom: f! Item was changed: ----- Method: MenuItemMorph class>>initialize (in category 'class initialization') ----- initialize "MenuItemMorph initialize" + SubMenuMarker := self defaultSubMenuMarker. - | f | - f := Form - extent: 5@9 - fromArray: #(2147483648 3221225472 3758096384 4026531840 4160749568 4026531840 3758096384 3221225472 2147483648) - offset: 0@0. - SubMenuMarker := ColorForm mappingWhiteToTransparentFrom: f. ! Item was added: + ----- Method: MenuItemMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #font. 'Fonts'. 'Font for menu items.' }. + { #textColor. 'Colors'. 'Color for the menu item''s labels.' }. + { #selectionColor. 'Colors'. 'Color used for items when hovering or selecting them.' }. + { #selectionTextColor. 'Colors'. 'Color used for label when hovering or selecting them.' }. + { #subMenuMarker. 'Forms'. 'The form to be used to indicate a submenu.' }. + }! Item was added: + ----- Method: MenuItemMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self + color: (self userInterfaceTheme textColor ifNil: [Color black]); + font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]). + ! Item was added: + ----- Method: MenuItemMorph>>colorToUse (in category 'accessing') ----- + colorToUse + + ^ isSelected & isEnabled + ifTrue: [ self userInterfaceTheme selectionTextColor ifNil: [Color white] ] + ifFalse: [ color ]! Item was added: + ----- Method: MenuItemMorph>>drawBackgroundOn: (in category 'drawing') ----- + drawBackgroundOn: aCanvas + + isSelected & isEnabled + ifTrue: [aCanvas fillRectangle: self bounds fillStyle: self selectionFillStyle].! Item was added: + ----- Method: MenuItemMorph>>drawIconOn: (in category 'drawing') ----- + drawIconOn: aCanvas + + self hasIcon ifTrue: [ + | iconForm | + iconForm := self iconForm. + aCanvas + translucentImage: iconForm + at: self bounds left @ (self top + (self height - iconForm height // 2)).].! Item was added: + ----- Method: MenuItemMorph>>drawLabelOn: (in category 'drawing') ----- + drawLabelOn: aCanvas + + | stringBounds | + stringBounds := bounds. + + self hasIcon ifTrue: [ + stringBounds := stringBounds left: stringBounds left + self iconForm width + 2 ]. + self hasMarker ifTrue: [ + stringBounds := stringBounds left: stringBounds left + self submorphBounds width + 8 ]. + + stringBounds := stringBounds top: stringBounds top + stringBounds bottom - self fontToUse height // 2. + + aCanvas + drawString: contents + in: stringBounds + font: self fontToUse + color: self colorToUse.! Item was changed: ----- Method: MenuItemMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas + + self + drawBackgroundOn: aCanvas; + drawIconOn: aCanvas; + drawLabelOn: aCanvas; + drawSubMenuMarkerOn: aCanvas.! - | stringColor stringBounds | - isSelected & isEnabled - ifTrue: [ - aCanvas fillRectangle: self bounds fillStyle: self selectionFillStyle. - stringColor := color negated ] - ifFalse: [ stringColor := color ]. - stringBounds := bounds. - self hasIcon ifTrue: [ - | iconForm | - iconForm := self iconForm. - aCanvas - translucentImage: iconForm - at: stringBounds left @ (self top + (self height - iconForm height // 2)). - stringBounds := stringBounds left: stringBounds left + iconForm width + 2 ]. - self hasMarker ifTrue: [ - stringBounds := stringBounds left: stringBounds left + self submorphBounds width + 8 ]. - stringBounds := stringBounds top: stringBounds top + stringBounds bottom - self fontToUse height // 2. - aCanvas - drawString: contents - in: stringBounds - font: self fontToUse - color: stringColor. - self hasSubMenu - ifTrue: [| subMenuMarker subMenuMarkerPosition | - subMenuMarker := self subMenuMarker. - subMenuMarkerPosition := self right - subMenuMarker width @ (self top + self bottom - subMenuMarker height // 2). - aCanvas paintImage: subMenuMarker at: subMenuMarkerPosition ]! Item was added: + ----- Method: MenuItemMorph>>drawSubMenuMarkerOn: (in category 'drawing') ----- + drawSubMenuMarkerOn: aCanvas + + self hasSubMenu ifTrue: [ + | subMenuMarker subMenuMarkerPosition | + subMenuMarker := self subMenuMarker. + subMenuMarkerPosition := self right - subMenuMarker width @ (self top + self bottom - subMenuMarker height // 2). + aCanvas paintImage: subMenuMarker at: subMenuMarkerPosition ]! Item was changed: ----- Method: MenuItemMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" contents := ''. hasFocus := false. isEnabled := true. subMenu := nil. isSelected := false. target := nil. selector := nil. arguments := nil. + font := self userInterfaceTheme font ifNil: [TextStyle defaultFont]. + self + color: (self userInterfaceTheme textColor ifNil: [Color black]); + hResizing: #spaceFill; + vResizing: #shrinkWrap! - font := Preferences standardMenuFont. - self hResizing: #spaceFill; - vResizing: #shrinkWrap! Item was changed: ----- Method: MenuItemMorph>>minWidth (in category 'layout') ----- minWidth | subMenuWidth iconWidth markerWidth | subMenuWidth := self hasSubMenu ifTrue: [ 10 ] ifFalse: [ 0 ]. iconWidth := self hasIcon ifTrue: [ self icon width + 2 ] ifFalse: [ 0 ]. markerWidth := self hasMarker ifTrue: [ self submorphBounds width + 8 ] ifFalse: [ 0 ]. ^(self fontToUse widthOfString: contents) + + subMenuWidth + iconWidth + markerWidth + self stringMargin! - + subMenuWidth + iconWidth + markerWidth! Item was changed: ----- Method: MenuItemMorph>>selectionFillStyle (in category 'private') ----- selectionFillStyle + " Answer the fill style to use with the receiver is the selected element " - " Answer the fill style to use with the receiver is the selected - element " + | fill baseColor | + baseColor := self userInterfaceTheme selectionColor ifNil: [Color r: 0.4 g: 0.5 b: 0.7]. - | fill baseColor preferenced | - Display depth <= 2 ifTrue: [ - ^Color gray ]. - preferenced := MenuMorph menuSelectionColor. - preferenced notNil ifTrue: [ ^preferenced ]. - baseColor := owner color negated. MenuMorph gradientMenu ifFalse: [ ^baseColor ]. + fill := GradientFillStyle ramp: { 0.0 -> baseColor twiceLighter. 1 -> baseColor twiceDarker }. fill origin: self topLeft. + fill direction: 0 @ self height. ^ fill! Item was added: + ----- Method: MenuItemMorph>>stringMargin (in category 'layout') ----- + stringMargin + + ^Preferences tinyDisplay + ifTrue: [ 1 ] + ifFalse: [ 6 ]! Item was changed: + Morph subclass: #MenuMorph - AlignmentMorph subclass: #MenuMorph instanceVariableNames: 'defaultTarget selectedItem stayUp popUpOwner activeSubMenu' classVariableNames: 'CloseBoxImage CloseBoxImageFlat CloseBoxImageGradient GradientMenu MenuBorderColor MenuBorderWidth MenuColor MenuLineColor MenuSelectionColor MenuTitleBorderColor MenuTitleBorderWidth MenuTitleColor PushPinImage RoundedMenuCorners' poolDictionaries: '' category: 'Morphic-Menus'! !MenuMorph commentStamp: '<historical>' prior: 0! Instance variables: defaultTarget <Object> The default target for creating menu items selectedItem <MenuItemMorph> The currently selected item in the receiver stayUp <Boolean> True if the receiver should stay up after clicks popUpOwner <MenuItemMorph> The menu item that automatically invoked the receiver, if any. activeSubMenu <MenuMorph> The currently active submenu.! Item was removed: - ----- Method: MenuMorph class>>menuBorderColor (in category 'preferences') ----- - menuBorderColor - - <preference: 'menuBorderColor' - category: #menus - description: 'Menus border color' - type: #Color> - Display depth <= 2 ifTrue: [^ Color black]. - ^MenuBorderColor ifNil: [(Color r: 0.2 g: 0.3 b: 0.9)]! Item was removed: - ----- Method: MenuMorph class>>menuBorderColor: (in category 'preferences') ----- - menuBorderColor: aColor - MenuBorderColor := aColor! Item was removed: - ----- Method: MenuMorph class>>menuBorderWidth (in category 'preferences') ----- - menuBorderWidth - <preference: 'menuBorderWidth' - category: #menus - description: 'Menus border width' - type: #Number> - ^MenuBorderWidth ifNil: [2]! Item was removed: - ----- Method: MenuMorph class>>menuBorderWidth: (in category 'preferences') ----- - menuBorderWidth: anInteger - MenuBorderWidth := anInteger! Item was removed: - ----- Method: MenuMorph class>>menuColor (in category 'preferences') ----- - menuColor - <preference: 'menuColor' - category: #menus - description: 'Menus color' - type: #Color> - Display depth <= 2 ifTrue: [^ Color black]. - ^MenuColor ifNil: [(Color r: 0.9 g: 0.9 b: 0.9)]! Item was removed: - ----- Method: MenuMorph class>>menuColor: (in category 'preferences') ----- - menuColor: aColor - MenuColor := aColor! Item was removed: - ----- Method: MenuMorph class>>menuLineColor (in category 'preferences') ----- - menuLineColor - <preference: 'menuLineColor' - category: #menus - description: 'Menus color of separating lines' - type: #Color> - ^MenuLineColor ifNil: [(Color r: 0.6 g: 0.7 b: 1)]! Item was removed: - ----- Method: MenuMorph class>>menuLineColor: (in category 'preferences') ----- - menuLineColor: aColor - MenuLineColor := aColor! Item was removed: - ----- Method: MenuMorph class>>menuSelectionColor (in category 'preferences') ----- - menuSelectionColor - <preference: 'menuSelectionColor' - category: #menus - description: 'Color of selected item in menu' - type: #Color> - Display depth <= 2 ifTrue: [^ Color black]. - ^MenuSelectionColor ifNil: [(Color r: 0.4 g: 0.5 b: 0.7)]! Item was removed: - ----- Method: MenuMorph class>>menuSelectionColor: (in category 'preferences') ----- - menuSelectionColor: aColor - MenuSelectionColor := aColor! Item was removed: - ----- Method: MenuMorph class>>menuTitleBorderColor (in category 'preferences') ----- - menuTitleBorderColor - <preference: 'menuTitleBorderColor' - category: #menus - description: 'Border color of frame around menu title' - type: #Color> - Display depth <= 2 ifTrue: [^ Color black]. - ^MenuTitleBorderColor ifNil: [(Color r: 0.6 g: 0.7 b: 1)]! Item was removed: - ----- Method: MenuMorph class>>menuTitleBorderColor: (in category 'preferences') ----- - menuTitleBorderColor: aColor - MenuTitleBorderColor := aColor! Item was removed: - ----- Method: MenuMorph class>>menuTitleBorderWidth (in category 'preferences') ----- - menuTitleBorderWidth - <preference: 'menuTitleBorderWidth' - category: #menus - description: 'Width of frame around menus title' - type: #Number> - ^MenuTitleBorderWidth ifNil: [0]! Item was removed: - ----- Method: MenuMorph class>>menuTitleBorderWidth: (in category 'preferences') ----- - menuTitleBorderWidth: anInteger - MenuTitleBorderWidth := anInteger! Item was removed: - ----- Method: MenuMorph class>>menuTitleColor (in category 'preferences') ----- - menuTitleColor - <preference: 'menuTitleColor' - category: #menus - description: 'Color of background of menus title' - type: #Color> - Display depth = 1 ifTrue: [^ Color white]. - Display depth = 2 ifTrue: [^ Color gray]. - ^MenuTitleColor ifNil: [ Color transparent]! Item was removed: - ----- Method: MenuMorph class>>menuTitleColor: (in category 'preferences') ----- - menuTitleColor: aColor - MenuTitleColor := aColor! Item was added: + ----- Method: MenuMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the menu''s border.' }. + { #borderWidth. 'Borders'. 'Width of the menu''s border.' }. + { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. + { #color. 'Colors'. 'Background color of the menu.' }. + + { #titleBorderColor. 'Colors'. 'Color of the menu title border.' }. + { #titleBorderWidth. 'Geometry'. 'Width of the menu title border.' }. + { #titleBorderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset for the title.' }. + { #titleColor. 'Colors'. 'Background color of the menu'' title.' }. + { #titleFont. 'Fonts'. 'Font for menu title.' }. + { #titleTextColor. 'Colors'. 'Color for the menu title label.' }. + + { #lineColor. 'Colors'. 'Color of the separators between menu items.' }. + { #lineStyle. 'Colors'. 'Use border-style to change appearance.' }. + { #lineWidth. 'Geometry'. 'How big the separators should be.' }. + }! Item was changed: ----- Method: MenuMorph>>addLine (in category 'construction') ----- addLine "Append a divider line to this menu. Suppress duplicate lines." + + | colorToUse | + self hasItems ifFalse: [^ self]. + self lastSubmorph knownName = #line ifTrue: [^ self]. + + colorToUse := self userInterfaceTheme lineColor ifNil: [Color gray: 0.9]. + self addMorphBack: (Morph new + color: colorToUse; + hResizing: #spaceFill; + height: (self userInterfaceTheme lineWidth ifNil: [2]); + borderStyle: (self userInterfaceTheme lineStyle ifNil: [BorderStyle inset]); + borderColor: colorToUse; + borderWidth: 1; + name: #line; "see above" + yourself).! - self hasItems - ifFalse: [^ self]. - (self lastSubmorph isKindOf: MenuLineMorph) - ifFalse: [self addMorphBack: MenuLineMorph new] ! Item was changed: ----- Method: MenuMorph>>addStayUpIcons (in category 'construction') ----- addStayUpIcons + | title closeBox pinBox | - | title closeBox pinBox titleBarArea titleString | title := submorphs detect: [:ea | ea hasProperty: #titleString] + ifNone: [ + "Called too soon. Will add stay-up icons when title is added." + self setProperty: #needsTitlebarWidgets toValue: true. - ifNone: [self setProperty: #needsTitlebarWidgets toValue: true. ^ self]. closeBox := SystemWindowButton new target: self; actionSelector: #delete; labelGraphic: self class closeBoxImage; color: Color transparent; extent: self class closeBoxImage extent; borderWidth: 0. pinBox := SystemWindowButton new target: self; actionSelector: #stayUp:; arguments: {true}; labelGraphic: self class pushPinImage; color: Color transparent; extent: self class pushPinImage extent; borderWidth: 0. + Preferences noviceMode ifTrue: [ + closeBox setBalloonText: 'close this menu'. + pinBox setBalloonText: 'keep this menu up']. + + title + addMorphFront: closeBox; + addMorphBack: pinBox. + - Preferences noviceMode - ifTrue: [closeBox setBalloonText: 'close this menu'. - pinBox setBalloonText: 'keep this menu up']. - titleBarArea := AlignmentMorph newRow vResizing: #shrinkWrap; - layoutInset: 3; - color: MenuMorph menuTitleColor; - addMorphBack: closeBox; - addMorphBack: title; - addMorphBack: pinBox. - - title color: Color transparent. - - titleString := title - findDeepSubmorphThat: [:each | each respondsTo: #font: ] - ifAbsent: [StringMorph contents: String empty]. - titleString font: Preferences windowTitleFont. - self wantsRoundedCorners - ifTrue: [titleBarArea useRoundedCorners]. - - self addMorphFront: titleBarArea. - titleBarArea setProperty: #titleString toValue: (title valueOfProperty: #titleString). - title removeProperty: #titleString. self setProperty: #hasTitlebarWidgets toValue: true. self removeProperty: #needsTitlebarWidgets. self removeStayUpItems! Item was changed: ----- Method: MenuMorph>>addTitle:icon:updatingSelector:updateTarget: (in category 'construction') ----- addTitle: aString icon: aForm updatingSelector: aSelector updateTarget: aTarget + "Add a title line at the top of this menu Make aString its initial contents. If aSelector is not nil, then periodically obtain fresh values for its contents by sending aSelector to aTarget." + + | container fontToUse colorToUse labelArea | + + container := AlignmentMorph newRow. + self setTitleParametersFor: container. + + aForm ifNotNil: [:form | container addMorphBack: form asMorph]. - "Add a title line at the top of this menu Make aString its initial - contents. - If aSelector is not nil, then periodically obtain fresh values for - its - contents by sending aSelector to aTarget.." - | title titleContainer | - title := AlignmentMorph newColumn. - self setTitleParametersFor: title. - "" - aForm isNil - ifTrue: [titleContainer := title] - ifFalse: [| pair | - pair := AlignmentMorph newRow. + fontToUse := self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont]. + colorToUse := self userInterfaceTheme titleTextColor ifNil: [Color black]. + + "Build the label." - pair color: Color transparent. - pair hResizing: #shrinkWrap. - pair layoutInset: 0. - pair addMorphBack: (Morph new extent: 5@5; color: Color transparent). "padding" - pair addMorphBack: aForm asMorph. - pair addMorphBack: (Morph new extent: 5@5; color: Color transparent). "padding" - titleContainer := AlignmentMorph newColumn. - titleContainer color: Color transparent. - titleContainer vResizing: #shrinkWrap. - titleContainer wrapCentering: #center. - titleContainer cellPositioning: #topCenter. - titleContainer layoutInset: 0. - pair addMorphBack: titleContainer. - "" - title addMorphBack: pair]. - "" aSelector + ifNil: [ + labelArea := AlignmentMorph newColumn + color: Color transparent; + vResizing: #shrinkWrap; + wrapCentering: #center; + cellPositioning: #topCenter. + aString asString linesDo: [:line | labelArea + addMorphBack: ((StringMorph contents: line + font: fontToUse) + color: colorToUse; - ifNil: ["" - aString asString - linesDo: [:line | titleContainer - addMorphBack: ((StringMorph - contents: line - font: Preferences standardMenuFont) - color: (Color black); yourself)]] + ifNotNil: [ + labelArea := UpdatingStringMorph on: aTarget selector: aSelector. + labelArea font: fontToUse. + labelArea color: colorToUse. + labelArea useStringFormat. + labelArea lock]. + + container addMorphBack: labelArea. - ifNotNil: [| usm | - usm := UpdatingStringMorph on: aTarget selector: aSelector. - usm font: Preferences standardMenuFont. - usm useStringFormat. - usm lock. - titleContainer addMorphBack: usm]. "" + container setProperty: #titleString toValue: aString. + self addMorphFront: container. - title setProperty: #titleString toValue: aString. - self addMorphFront: title. "" - title useSquareCorners. (self hasProperty: #needsTitlebarWidgets) ifTrue: [self addStayUpIcons]! Item was added: + ----- 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]); + borderColor: colorToUse].! Item was changed: ----- Method: MenuMorph>>initialize (in category 'initialization') ----- initialize super initialize. bounds := 0 @ 0 corner: 40 @ 10. self setDefaultParameters. + self changeTableLayout. self listDirection: #topToBottom. self hResizing: #shrinkWrap. self vResizing: #shrinkWrap. defaultTarget := nil. selectedItem := nil. stayUp := false. popUpOwner := nil.! 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 default]); + borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]); + borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]). - | colorFromMenu worldColor menuColor | - - colorFromMenu := Preferences menuColorFromWorld - and: [Display depth > 4 - and: [(worldColor := self currentWorld color) isColor]]. + Preferences menuAppearance3d ifTrue: [self addDropShadow]. + - menuColor := colorFromMenu - ifTrue: [worldColor luminance > 0.7 - ifTrue: [worldColor mixed: 0.85 with: Color black] - ifFalse: [worldColor mixed: 0.4 with: Color white]] - ifFalse: [self class menuColor]. - - self color: menuColor. - self borderWidth: self class menuBorderWidth. - - Preferences menuAppearance3d ifTrue: [ - self borderStyle: BorderStyle thinGray. - self hasDropShadow: true. - - self useSoftDropShadow - ifFalse: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.666); - shadowOffset: 1 @ 1] - ifTrue: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.01); - shadowOffset: (10@8 corner: 10@12) ] - ] - ifFalse: [ - | menuBorderColor | - menuBorderColor := colorFromMenu - ifTrue: [worldColor muchDarker] - ifFalse: [self class menuBorderColor]. - self borderColor: menuBorderColor. - ]. - - self layoutInset: 3. ! Item was added: + ----- Method: MenuMorph>>setTitleParameters (in category 'initialization') ----- + setTitleParameters + + self setTitleParametersFor: (self allMorphs + detect: [:each | each hasProperty: #titleString] + ifNone: [^ self]).! Item was changed: ----- Method: MenuMorph>>setTitleParametersFor: (in category 'initialization') ----- setTitleParametersFor: aMenuTitle - | menuTitleColor menuTitleBorderColor | - self wantsRoundedCorners - ifTrue: [aMenuTitle useRoundedCorners]. - menuTitleColor := Preferences menuColorFromWorld - ifTrue: [self color darker] - ifFalse: [MenuMorph menuTitleColor]. - - menuTitleBorderColor := Preferences menuAppearance3d - ifTrue: [#inset] - ifFalse: [Preferences menuColorFromWorld - ifTrue: [self color darker muchDarker] - ifFalse: [MenuMorph menuTitleBorderColor]]. - aMenuTitle + color: (self userInterfaceTheme titleColor ifNil: [Color transparent]); + 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]); - setColor: menuTitleColor - borderWidth: MenuMorph menuTitleBorderWidth - borderColor: menuTitleBorderColor; vResizing: #shrinkWrap; wrapCentering: #center; + cellPositioning: #center; + cellInset: 5; + layoutInset: (5@0 corner: 5@0).! - cellPositioning: #topCenter; - layoutInset: 0. - ! Item was changed: ----- Method: MenuMorph>>updateColor (in category 'control') ----- updateColor + | fill title cc | - | fill title | self class gradientMenu ifFalse: [^ self]. (self fillStyle == self color) not ifTrue: [^ self]. "Don't apply the gradient more than once" "" + title := self allMorphs + detect: [:each | each hasProperty: #titleString] + ifNone: []. + + cc := self color adjustSaturation: -0.08 brightness: 0.4. + fill := GradientFillStyle ramp: { + 0.0 -> (title ifNil: [cc] ifNotNil: [cc muchLighter]). + 0.25 -> (self color mixed: 0.5 with: cc). + 1.0 -> self color}. - fill := GradientFillStyle ramp: {0.0 -> Color white. 1 -> self color}. "" fill radial: false; origin: self topLeft; direction: 0 @ self height. "" - self fillStyle: fill. " update the title color" + + title ifNotNil: [fill direction: 0@ title height]. + self fillStyle: fill. + title ifNil: [^ self]. - title := self allMorphs - detect: [:each | each hasProperty: #titleString] - ifNone: [^ self]. "" + fill := GradientFillStyle ramp: { + 0.0 -> title color twiceLighter. + 1 -> title color twiceDarker}. - fill := GradientFillStyle ramp: {0.0 -> title color twiceLighter. 1 -> title color twiceDarker}. "" fill origin: title topLeft; direction: title width @ 0. "" title fillStyle: fill! Item was added: + ----- Method: TheWorldMainDockingBar class>>applyUserInterfaceTheme (in category 'preferences') ----- + applyUserInterfaceTheme + + self updateInstances.! Item was added: + ----- Method: TheWorldMainDockingBar class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ { + { #textColor. 'Colors'. 'The color for the clock and other labels.' }. + { #font. 'Fonts'. 'The font for the clock and other labels.' }. + { #logoColor. 'Colors'. 'The color of the Squeak logo.' }. + { #selectionLogoColor. 'Colors'. 'The color of the Squeak logo when it is selected.' }. + }! Item was added: + ----- Method: TheWorldMainDockingBar>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + "Do it on the class-side."! Item was changed: ----- Method: TheWorldMainDockingBar>>clockOn: (in category 'right side') ----- clockOn: aDockingBar aDockingBar addMorphBack: (ClockMorph new + font: self fontToUse; + color: self colorToUse; show24hr: self class twentyFourHourClock; showSeconds: self class showSecondsInClock; yourself); addDefaultSpace! Item was added: + ----- Method: TheWorldMainDockingBar>>colorToUse (in category 'private') ----- + colorToUse + + ^ self userInterfaceTheme textColor ifNil: [Color black]! Item was changed: ----- Method: TheWorldMainDockingBar>>createDockingBar (in category 'construction') ----- createDockingBar "Create a docking bar from the receiver's representation" | dockingBar | dockingBar := DockingBarMorph new adhereToTop; color: MenuMorph menuColor; - gradientRamp: self gradientRamp; autoGradient: MenuMorph gradientMenu; borderWidth: 0. self fillDockingBar: dockingBar. self labelIfNeeded: dockingBar. ^ dockingBar! Item was added: + ----- Method: TheWorldMainDockingBar>>fontToUse (in category 'private') ----- + fontToUse + + ^ self userInterfaceTheme font ifNil: [TextStyle defaultFont]! Item was changed: ----- Method: TheWorldMainDockingBar>>squeakMenuOn: (in category 'construction') ----- squeakMenuOn: aDockingBar "Private - fill the given docking bar" aDockingBar addItem: [ :item | item contents: ''; + icon: (MenuIcons squeakLogoIconColorized: + (self userInterfaceTheme logoColor ifNil: [Color black])); + selectedIcon: (MenuIcons squeakLogoIconColorized: + (self userInterfaceTheme selectionLogoColor ifNil: [Color white])); - icon: MenuIcons squeakLogoIcon; - selectedIcon: MenuIcons squeakLogoInvertedIcon; addSubMenu: [ :menu | self aboutMenuItemOn: menu; updateMenuItemOn: menu. menu addLine. self saveMenuItemOn: menu; saveAsMenuItemOn: menu; saveAsNewVersionMenuItemOn: menu. menu addLine. self saveAndQuitMenuItemOn: menu; quitMenuItemOn: menu ] ]! Item was added: + (PackageInfo named: 'Morphic') postscript: 'MenuIcons initializeIcons. + TheWorldMainDockingBar updateInstances.'!

1 0

The Trunk: 51Deprecated-mt.36.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of 51Deprecated to project The Trunk: http://source.squeak.org/trunk/51Deprecated-mt.36.mcz ==================== Summary ==================== Name: 51Deprecated-mt.36 Author: mt Time: 31 July 2016, 10:56:06.86249 am UUID: 5dae79d1-829b-6046-82de-e00a2acb0379 Ancestors: 51Deprecated-mt.35 *** Widget Refactorings and UI Themes (Part 3 of 11) *** Prepare Shout syntax highlighting for UI themes. (Temporarily no syntax highlighting. Sorry. Be patient.) =============== Diff against 51Deprecated-mt.35 =============== Item was added: + ----- Method: SHTextStylerST80 class>>attributesByPixelHeight: (in category '*51Deprecated') ----- + attributesByPixelHeight: aNumber + + self deprecated: 'Use UI themes.'. + ^self textAttributesByPixelHeight + at: aNumber + ifAbsent: [Dictionary new]! Item was added: + ----- Method: SHTextStylerST80 class>>attributesFor:pixelHeight: (in category '*51Deprecated') ----- + attributesFor: aSymbol pixelHeight: aNumber + + self deprecated: 'Use UI themes.'. + ^(self textAttributesByPixelHeight + at: aNumber + ifAbsent:[Dictionary new]) + at: aSymbol ifAbsent:[nil]!

1 0

The Trunk: ToolBuilder-Morphic-mt.172.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.172.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.172 Author: mt Time: 31 July 2016, 10:55:34.11149 am UUID: 525ee50b-1280-0244-981d-a03a26aae3eb Ancestors: ToolBuilder-Morphic-mt.171 *** Widget Refactorings and UI Themes (Part 3 of 11) *** Prepare Shout syntax highlighting for UI themes. (Temporarily no syntax highlighting. Sorry. Be patient.) =============== Diff against ToolBuilder-Morphic-mt.171 =============== Item was added: + ----- Method: PluggableTextMorphPlus class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #stylerClass. 'Editing'. 'The styler class you want to use for syntax highlighting' }. + { #balloonTextColor. 'Colors'. 'Color to use when drawing the balloon text on an empty text field.' }. + { #balloonTextFont. 'Fonts'. 'Font to use when drawing the balloon text on an empty text field.' }. + }! Item was added: + ----- Method: PluggableTextMorphPlus>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self styler ifNotNil: [:s | + s reset. + self updateStyle].! Item was changed: ----- Method: PluggableTextMorphPlus>>useDefaultStyler (in category 'initialize') ----- useDefaultStyler "This should be changed to a proper registry but as long as there is only shout this will do" + + (self userInterfaceTheme stylerClass ifNil: [Smalltalk at: #SHTextStylerST80]) + ifNotNil: [:stylerClass | self styler: (stylerClass new view: self)].! - Smalltalk at: #SHTextStylerST80 ifPresent:[:stylerClass| - self styler: (stylerClass new view: self). - ].!

1 0

← Newer
1
2
3
4
5
6
7
...
23
Older →

Jump to page: