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!
squeak-dev@lists.squeakfoundation.org