The Inbox: Morphic-nice.1134.mcz

Nicolas Cellier uploaded a new version of Morphic to project The Inbox:
http://source.squeak.org/inbox/Morphic-nice.1134.mcz

==================== Summary ====================

Name: Morphic-nice.1134
Author: nice
Time: 4 May 2016, 6:12:01.818683 pm
UUID: 4b4eeafc-76a9-ae40-9016-6cf1372bd7d6
Ancestors: Morphic-mt.1133

Pick the GrowlMorph from Pharo (unthemed).
It is a nice way to display bits of information without requesting user acknowledge actions (like pressing an OK button)

=============== Diff against Morphic-mt.1133 ===============

Item was added:
+ TextMorph subclass: #GrowlMorph
+ instanceVariableNames: 'dismissHandle vanishTime alpha actionBlock vanishDelay attr labelAttr contentsAttr labelColor contentsColor'
+ classVariableNames: 'DefaultBackgroundColor Position'
+ poolDictionaries: ''
+ category: 'Morphic-Windows'!
+
+ !GrowlMorph commentStamp: 'StephanEggermont 9/5/2014 12:12' prior: 0!
+ A GrowlMorph is a little Morph to announce event happening. Freely inspired from the MIT Snarl developed by  Tony Garnock-Jones.
+
+ GrowlMorph new openInWorld.
+
+ 10 timesRepeat: [
+ (GrowlMorph openWithLabel: 'The time' contents: DateAndTime now)
+ " vanishDelay: 1000;
+ resetVanishTimer".
+ World doOneCycle ].
+
+ (GrowlMorph openWithLabel: 'The time' contents: DateAndTime now)
+ actionBlock: [Transcript open].!

Item was added:
+ ----- Method: GrowlMorph class>>contents: (in category 'instance creation') -----
+ contents: contentString
+
+ ^ self new
+ label: '' contents: contentString;
+ yourself!

Item was added:
+ ----- Method: GrowlMorph class>>growlPositionChoices (in category 'settings') -----
+ growlPositionChoices
+
+ ^#(topRight 'top right'
+ bottomLeft 'bottom left'
+ bottomRight 'bottom right'
+ topLeft 'topLeft') pairsCollect: [:a :b | b -> a]!

Item was added:
+ ----- Method: GrowlMorph class>>growlSettingsOn: (in category 'settings') -----
+ growlSettingsOn: aBuilder
+ <systemsettings>
+ (aBuilder group: #growl)
+ label: 'Popup notifiaction' translated;  
+ parent: #appearance;
+ description: 'All settings concerned with the notifications popup look''n feel' translated;
+ with: [
+ (aBuilder pickOne: #position)
+ label: 'Popup position' translated;
+ target: self;
+ default: #topRight;
+ order: 1;
+ domainValues: self growlPositionChoices.]!

Item was added:
+ ----- Method: GrowlMorph class>>label:contents: (in category 'instance creation') -----
+ label: aString contents: contentString
+
+ ^ self new
+ label: aString contents: contentString;
+ yourself!

Item was added:
+ ----- Method: GrowlMorph class>>openWithContents: (in category 'instance creation') -----
+ openWithContents: contentString
+
+ ^ (self contents: contentString) openInWorld!

Item was added:
+ ----- Method: GrowlMorph class>>openWithLabel:contents: (in category 'instance creation') -----
+ openWithLabel: aString contents: contentString
+
+ ^ (self label: aString contents: contentString) openInWorld!

Item was added:
+ ----- Method: GrowlMorph class>>openWithLabel:contents:backgroundColor:labelColor: (in category 'instance creation') -----
+ openWithLabel: aString contents: contentString backgroundColor: aColor labelColor: aLabelColor
+
+ ^ (self label: aString contents: contentString)
+ backgroundColor: aColor;
+ labelColor: aLabelColor;
+ contentsColor: aLabelColor;
+ openInWorld!

Item was added:
+ ----- Method: GrowlMorph class>>openWithLabel:contents:color: (in category 'instance creation') -----
+ openWithLabel: aString contents: contentString color: aColor
+
+ ^ (self label: aString contents: contentString)
+ backgroundColor: aColor;
+ openInWorld!

Item was added:
+ ----- Method: GrowlMorph class>>position (in category 'position') -----
+ position
+
+ ^ Position ifNil: [ Position := #topRight ]!

Item was added:
+ ----- Method: GrowlMorph class>>position: (in category 'position') -----
+ position: aSymbol
+
+ (self possiblePositions includes: aSymbol) ifFalse: [ ^ self ].
+
+ Position := aSymbol!

Item was added:
+ ----- Method: GrowlMorph class>>possiblePositions (in category 'position') -----
+ possiblePositions
+
+ ^ #( bottomRight bottomLeft topRight topLeft )!

Item was added:
+ ----- Method: GrowlMorph>>actionBlock: (in category 'building') -----
+ actionBlock: aBlock
+
+ actionBlock := aBlock!

Item was added:
+ ----- Method: GrowlMorph>>activeGrowlMorphs (in category 'internal') -----
+ activeGrowlMorphs
+
+ ^World submorphs select: [ :morph | morph isKindOf: GrowlMorph ].!

Item was added:
+ ----- Method: GrowlMorph>>alpha (in category 'accessing') -----
+ alpha
+ ^ alpha
+ !

Item was added:
+ ----- Method: GrowlMorph>>alpha: (in category 'accessing') -----
+ alpha: newAlpha
+
+ "self alpha = newAlpha ifTrue: [^ self]."
+ alpha := newAlpha.
+ labelAttr color: (self labelColor alpha: alpha).
+ contentsAttr color: (self contentsColor alpha: alpha).
+ self backgroundColor: (self nextColorStep: self backgroundColor).
+ self allMorphsDo: [:m |
+ m borderColor: (self nextColorStep: m borderColor).
+ m color: (self nextColorStep: m color)].
+ self borderColor isTransparent ifTrue: [self delete].!

Item was added:
+ ----- Method: GrowlMorph>>backgroundColor (in category 'accessing') -----
+ backgroundColor
+
+ ^ backgroundColor ifNil: [ backgroundColor := self defaultBackgroundColor ]!

Item was added:
+ ----- Method: GrowlMorph>>contents: (in category 'building') -----
+ contents: contentsString
+
+ self streamDo: [ :w |
+ w withAttributes: self contentsAttributes do: [w nextPutAll: contentsString asString]].!

Item was added:
+ ----- Method: GrowlMorph>>contentsAttributes (in category 'initialization') -----
+ contentsAttributes
+ ^ { contentsAttr. TextAlignment centered. TextFontChange font2. }!

Item was added:
+ ----- Method: GrowlMorph>>contentsColor (in category 'accessing') -----
+ contentsColor
+ ^ contentsColor ifNil: [ contentsColor := self highlightColor ]
+ !

Item was added:
+ ----- Method: GrowlMorph>>contentsColor: (in category 'accessing') -----
+ contentsColor: aColor
+ "when you set this contentsColor, it takes precedence over theme one. In certain case (such as for green as in SUnit) it is needed, normally you do not need it."
+ contentsColor := aColor.
+ contentsAttr color: aColor.
+ !

Item was added:
+ ----- Method: GrowlMorph>>createDismissHandle (in category 'initialization') -----
+ createDismissHandle
+ | handle form image |
+ form := SystemWindow closeBoxImage.
+ image := ImageMorph new.
+ image image: form.
+ image color: Color yellow.
+ handle := image.
+ handle on: #mouseUp send: #delete to: self.
+ ^ handle!

Item was added:
+ ----- Method: GrowlMorph>>defaultTextStyle (in category 'default') -----
+ defaultTextStyle
+ ^ TextStyle actualTextStyles at: #Accuny!

Item was added:
+ ----- Method: GrowlMorph>>defaultVanishDelay (in category 'default') -----
+ defaultVanishDelay
+
+ ^ 1  seconds!

Item was added:
+ ----- Method: GrowlMorph>>enabled (in category 'stepping') -----
+ enabled
+
+ ^ false!

Item was added:
+ ----- Method: GrowlMorph>>handlesMouseDown: (in category 'interaction') -----
+ handlesMouseDown: evt
+ ^ actionBlock notNil or: [super handlesMouseDown: evt]!

Item was added:
+ ----- Method: GrowlMorph>>initialize (in category 'initialization') -----
+ initialize
+ super initialize.
+   self  borderStyle: BorderStyle thinGray.
+
+ self setProperty: #autoFitContents toValue: false.
+  
+ self initializeLabelAttributes.
+ self initializeContentsAttributes.
+ self vanishDelay: self defaultVanishDelay.
+ self label: 'A cool title' contents: 'Here an important message'.
+ dismissHandle := self createDismissHandle.
+ self addMorph: dismissHandle!

Item was added:
+ ----- Method: GrowlMorph>>initializeContentsAttributes (in category 'initialization') -----
+ initializeContentsAttributes
+ contentsAttr := TextColor color: self contentsColor.
+ !

Item was added:
+ ----- Method: GrowlMorph>>initializeLabelAttributes (in category 'initialization') -----
+ initializeLabelAttributes
+ labelAttr := TextColor color: self labelColor.
+ !

Item was added:
+ ----- Method: GrowlMorph>>is:saneWithRespectTo: (in category 'internal') -----
+ is: rect saneWithRespectTo: morphs
+
+ ^(morphs anySatisfy: [ :morph | morph owner isNil not and: [morph bounds intersects: rect]]) not
+ !

Item was added:
+ ----- Method: GrowlMorph>>label:contents: (in category 'building') -----
+ label: labelString contents: contentsString
+
+ self streamDo: [ :w |
+ w withAttributes: self labelAttributes do: [w nextPutAll: labelString asString; cr].
+ w withAttributes: self contentsAttributes do: [w nextPutAll: contentsString asString].
+ ].!

Item was added:
+ ----- Method: GrowlMorph>>labelAttributes (in category 'initialization') -----
+ labelAttributes
+ ^ { labelAttr. TextAlignment centered. TextFontChange font4. TextEmphasis bold. }!

Item was added:
+ ----- Method: GrowlMorph>>labelColor (in category 'accessing') -----
+ labelColor
+ ^ labelColor ifNil: [ labelColor := self highlightColor ]!

Item was added:
+ ----- Method: GrowlMorph>>labelColor: (in category 'accessing') -----
+ labelColor: aColor
+ "when you set this labelColor, it takes precedence over theme one. In certain case (such as for green as in SUnit) it is needed, normally you do not need it."
+ labelColor := aColor.
+ labelAttr color: self labelColor.!

Item was added:
+ ----- Method: GrowlMorph>>minimumExtent (in category 'default') -----
+ minimumExtent
+ ^ 256@38!

Item was added:
+ ----- Method: GrowlMorph>>mouseDown: (in category 'interaction') -----
+ mouseDown: evt
+ super mouseDown: evt.
+ evt yellowButtonPressed ifTrue: [^ self].
+ actionBlock ifNotNil: [actionBlock valueWithPossibleArgs: { self }].!

Item was added:
+ ----- Method: GrowlMorph>>nextColorStep: (in category 'initialization') -----
+ nextColorStep: aColor
+ ^ aColor alpha: self alpha!

Item was added:
+ ----- Method: GrowlMorph>>openInWorld (in category 'internal') -----
+ openInWorld
+
+ self position: self unoccupiedPosition.
+ super openInWorld!

Item was added:
+ ----- Method: GrowlMorph>>resetAlpha (in category 'internal') -----
+ resetAlpha
+ ^ self alpha: 0.9!

Item was added:
+ ----- Method: GrowlMorph>>resetVanishTimer (in category 'internal') -----
+ resetVanishTimer
+
+ vanishTime := DateAndTime now + self vanishDelay.
+ self resetAlpha.!

Item was added:
+ ----- Method: GrowlMorph>>step (in category 'stepping') -----
+ step
+
+ (self containsPoint: ActiveHand position) ifTrue: [
+ self resetAlpha.
+ ^ self].
+ vanishTime ifNotNil: [DateAndTime now < vanishTime ifTrue: [^self]].
+ self alpha: self alpha - 0.05.!

Item was added:
+ ----- Method: GrowlMorph>>stepTime (in category 'stepping') -----
+ stepTime
+ ^ 100!

Item was added:
+ ----- Method: GrowlMorph>>streamDo: (in category 'internal') -----
+ streamDo: aBlock
+
+ self contentsWrapped: (Text streamContents: aBlock).
+ self extent: self minimumExtent.
+ self height: (paragraph extent y + (self borderWidth * 2) + (margins ifNil: [0] ifNotNil: [margins top + margins bottom]) + 2).
+
+ self vanishDelay: ((((self contents size /50)seconds)+1 seconds) max: self defaultVanishDelay).!

Item was added:
+ ----- Method: GrowlMorph>>unoccupiedPosition (in category 'position') -----
+ unoccupiedPosition
+
+ self class position = #bottomLeft
+ ifTrue: [ ^ self unoccupiedPositionBottomLeft ].
+ self class position = #topRight
+ ifTrue: [ ^ self unoccupiedPositionTopRight ].
+ self class position = #bottomRight
+ ifTrue: [ ^ self unoccupiedPositionBottomRight ].
+ self class position = #topLeft
+ ifTrue: [ ^ self unoccupiedPositionTopLeft ].
+ ^ 0@0
+ !

Item was added:
+ ----- Method: GrowlMorph>>unoccupiedPositionBottomLeft (in category 'position') -----
+ unoccupiedPositionBottomLeft
+
+ | startPos area rect morphs |
+
+ startPos := 10 negated @ (self height + 10).
+ area := World clearArea.
+ rect := (area bottomLeft - startPos) extent: self extent.
+
+ morphs := self activeGrowlMorphs.
+ [self is: rect saneWithRespectTo: morphs] whileFalse: [
+ rect := rect translateBy: 0@(-10).
+ rect top < 0 ifTrue: [^ area bottomLeft - startPos]
+ ].
+ ^ rect origin!

Item was added:
+ ----- Method: GrowlMorph>>unoccupiedPositionBottomRight (in category 'position') -----
+ unoccupiedPositionBottomRight
+
+ | startPos area rect morphs |
+
+ startPos := (self width + 10 ) @ (self height + 10).
+ area := World clearArea.
+ rect := (area bottomRight - startPos) extent: self extent.
+
+ morphs := self activeGrowlMorphs.
+ [self is: rect saneWithRespectTo: morphs] whileFalse: [
+ rect := rect translateBy: 0@(-10).
+ rect top < 0 ifTrue: [^ area bottomRight - startPos ]
+ ].
+ ^ rect origin!

Item was added:
+ ----- Method: GrowlMorph>>unoccupiedPositionTopLeft (in category 'position') -----
+ unoccupiedPositionTopLeft
+
+ | startPos area rect morphs |
+
+ startPos := 10@10.
+ area := World clearArea.
+ rect := area topLeft + (startPos) extent: self extent.
+
+ morphs := self activeGrowlMorphs.
+ [self is: rect saneWithRespectTo: morphs] whileFalse: [
+ rect := rect translateBy: 0@10.
+ rect bottom > area height ifTrue: [^ area topLeft + startPos ]
+ ].
+ ^ rect origin!

Item was added:
+ ----- Method: GrowlMorph>>unoccupiedPositionTopRight (in category 'position') -----
+ unoccupiedPositionTopRight
+
+ | startPos area rect morphs |
+
+ startPos := (self width + 10 @ 10 negated).
+ area := World clearArea.
+ rect := (area topRight - startPos) extent: self extent.
+
+ morphs := self activeGrowlMorphs.
+ [self is: rect saneWithRespectTo: morphs] whileFalse: [
+ rect := rect translateBy: 0@10.
+ rect bottom > area height ifTrue: [^ (area topRight - startPos) ]
+ ].
+
+ ^ rect origin!

Item was added:
+ ----- Method: GrowlMorph>>vanishDelay (in category 'accessing') -----
+ vanishDelay
+
+ ^ vanishDelay!

Item was added:
+ ----- Method: GrowlMorph>>vanishDelay: (in category 'accessing') -----
+ vanishDelay: aDuration
+
+ vanishDelay := aDuration.
+ self resetVanishTimer!

Item was added:
+ ----- Method: GrowlMorph>>wantsSteps (in category 'stepping') -----
+ wantsSteps
+ ^ true!

Hi Nicolas,

what about putting that into MorphicExtras instead of Morphic? Do you have plans to update UIManager and Object >> #inform:? Then we could leave it in Morphic, add a preference and choose between the traditional modal dialog and the growl-style one. :-) I would like that.

Best,
Marcel

I think something like this should not be determined by a preference,
but by individual use-case.

Like, updating a Squeak5.0 image to latest trunk, it will take a
while, so when I come back and I see a desktop I won't remember what I
was doing or whether it finished...

By contrast, some other things which would otherwise be pesky alerts
are not there at all because, as modal, too pesky.

So, a global preference would force user to choose a system that was
too pesky or potentially not informative when we wanted it to be...

On Fri, May 6, 2016 at 4:28 AM, marcel.taeumel <[hidden email]> wrote:

Hi Chris,

you mean that the current Object >> #inform: is more like a modal information by intention and we need another Object >> #notify: (for example) to give a hint to the user in a non-modal way? Yeah, sounds good.

Best,
Marcel

Hi Nicolas,

yes, MorphicExtras should not be required to keep Morphic and all development tools functional.

Best,
Marcel