'From Squeak3.7gamma of ''17 July 2004'' [latest update: #5978] on 29 July 2004 at 10:31:02 am'! "Change Set: NewProgressBar Date: 19 May 2004 Author: Alexander@Lazarevic.de A different progress bar will be displayed for MVC and Morphic. This also ensures that a progress bar gets removed. In Morphic progress bars get stacked, the most recent one is at the bottom. This changeset makes the DefaultProgressBar changeset obsolete. Thanks Karl, Dan and Yoshiki for advice on how to make things faster or look better"! RectangleMorph subclass: #SystemProgressBarMorph instanceVariableNames: 'barSize' classVariableNames: 'BarHeight BarWidth FillColor' 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.! RectangleMorph subclass: #SystemProgressMorph instanceVariableNames: 'activeSlots bars labels font lock' classVariableNames: 'BarHeight BarWidth UniqueInstance' poolDictionaries: '' category: 'Morphic-Widgets'! !SystemProgressMorph commentStamp: '' 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.! ]style[(461 8 51 33 233 11 1)f2,f2LSystemProgressMorph class example;,f2,f2LString displayProgressAt:from:to:during:;,f2,f2dPreferences openFactoredPanel;;,f2! !MVCMenuMorph methodsFor: 'initializing' stamp: 'laza 4/20/2004 10:41'! initialize super initialize. self setProperty: #morphicLayerNumber toValue: self morphicLayerNumber ! ! !MVCMenuMorph methodsFor: 'WiW support' stamp: 'laza 4/20/2004 10:38'! morphicLayerNumber ^self valueOfProperty: #morphicLayerNumber ifAbsent: [10]. ! ! !ProgressInitiationException methodsFor: 'as yet unclassified' stamp: 'laza 4/6/2004 10:01'! defaultAction (Smalltalk isMorphic and: [Preferences valueOfFlag: #morphicProgressStyle]) ifTrue: [self defaultMorphicAction] ifFalse: [self defaultMVCAction]. ! ! !ProgressInitiationException methodsFor: 'as yet unclassified' stamp: 'laza 4/1/2004 12:47'! defaultMVCAction | delta savedArea captionText textFrame barFrame outerFrame result range lastW w | barFrame _ aPoint - (75@10) corner: aPoint + (75@10). captionText _ DisplayText text: progressTitle asText allBold. captionText foregroundColor: Color black backgroundColor: Color white. textFrame _ captionText boundingBox insetBy: -4. textFrame _ textFrame align: textFrame bottomCenter with: barFrame topCenter + (0@2). outerFrame _ barFrame merge: textFrame. delta _ outerFrame amountToTranslateWithin: Display boundingBox. barFrame _ barFrame translateBy: delta. textFrame _ textFrame translateBy: delta. outerFrame _ outerFrame translateBy: delta. savedArea _ Form fromDisplay: outerFrame. Display fillBlack: barFrame; fillWhite: (barFrame insetBy: 2). Display fillBlack: textFrame; fillWhite: (textFrame insetBy: 2). captionText displayOn: Display at: textFrame topLeft + (4@4). range _ maxVal = minVal ifTrue: [1] ifFalse: [maxVal - minVal]. "Avoid div by 0" lastW _ 0. [result _ workBlock value: "Supply the bar-update block for evaluation in the work block" [:barVal | w _ ((barFrame width-4) asFloat * ((barVal-minVal) asFloat / range min: 1.0)) asInteger. w ~= lastW ifTrue: [ Display fillGray: (barFrame topLeft + (2@2) extent: w@16). lastW _ w]]] ensure: [savedArea displayOn: Display at: outerFrame topLeft]. self resume: result! ! !ProgressInitiationException methodsFor: 'as yet unclassified' stamp: 'laza 4/9/2004 10:52'! defaultMorphicAction | result progress | progress _ SystemProgressMorph label: progressTitle min: minVal max: maxVal. [result _ workBlock value: progress] ensure: [SystemProgressMorph close: progress]. self resume: result! ! !ProgressInitiationException class methodsFor: 'class initialization' stamp: 'laza 4/7/2004 14:44'! initialize Preferences addPreference: #morphicProgressStyle categories: #(#morphic #performance) default: true balloonHelp: 'This switches between morphic and plain style for progress display'! ! !SystemProgressBarMorph methodsFor: 'drawing' stamp: 'laza 4/7/2004 13:00'! drawOn: aCanvas | area | super drawOn: aCanvas. barSize > 0 ifTrue: [ area _ self innerBounds. area _ area origin extent: barSize-2@area extent y. aCanvas fillRectangle: area color: Color gray] ! ! !SystemProgressBarMorph methodsFor: 'initialization' stamp: 'laza 4/7/2004 05:20'! initialize super initialize. self borderWidth: 1; color: Color white. barSize _ 0.! ! !SystemProgressBarMorph methodsFor: 'accessing' stamp: 'laza 4/9/2004 10:37'! barSize: anInteger barSize _ anInteger. self changed.! ! !SystemProgressMorph methodsFor: 'initialization' stamp: 'laza 7/29/2004 10:26'! close: aBlock | slot | slot _ aBlock value: SmallInteger maxVal. "This should prevent a redraw" self freeSlot: slot ! ! !SystemProgressMorph methodsFor: 'initialization' stamp: 'laza 4/20/2004 10:40'! initialize super initialize. activeSlots _ 0. bars _ Array new: 10. labels _ Array new: 10. font _ Preferences windowTitleFont. lock _ Semaphore forMutualExclusion. self setDefaultParameters; setProperty: #morphicLayerNumber toValue: self morphicLayerNumber; layoutPolicy: TableLayout new; listDirection: #topToBottom; cellPositioning: #topCenter; cellInset: 5; listCentering: #center; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset:4@4.! ! !SystemProgressMorph methodsFor: 'initialization' stamp: 'laza 4/18/2004 21:31'! morphicLayerNumber "progress morphs are behind menus and balloons, but in front of most other stuff" ^self valueOfProperty: #morphicLayerNumber ifAbsent: [12]. ! ! !SystemProgressMorph methodsFor: 'initialization' stamp: 'laza 4/7/2004 13:08'! setDefaultParameters "change the receiver's appareance parameters" | 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: [Preferences menuColor]. menuBorderColor := Preferences menuAppearance3d ifTrue: [#raised] ifFalse: [colorFromMenu ifTrue: [worldColor muchDarker] ifFalse: [Preferences menuBorderColor]]. Preferences roundedMenuCorners ifTrue: [self useRoundedCorners]. self setColor: menuColor borderWidth: Preferences menuBorderWidth borderColor: menuBorderColor. self updateColor: self color: self color intensity: 1.! ! !SystemProgressMorph methodsFor: 'initialization' stamp: 'laza 4/7/2004 13:07'! updateColor: aMorph color: aColor intensity: anInteger "update the apareance of aMorph" | fill fromColor toColor | Preferences gradientMenu ifFalse: [^ self]. fromColor := aColor. toColor := aColor. anInteger timesRepeat: [ fromColor := fromColor lighter. toColor := toColor darker]. fill := GradientFillStyle ramp: {0.0 -> fromColor. 1 -> toColor}. fill origin: aMorph topLeft. fill direction: aMorph width @ 0. fill radial: true. aMorph fillStyle: fill! ! !SystemProgressMorph methodsFor: 'private' stamp: 'laza 5/28/2004 06:03'! freeSlot: number number > 0 ifTrue: [ lock critical: [ (bars at: number) delete. (labels at: number) delete. activeSlots _ activeSlots - 1. activeSlots = 0 ifTrue: [self delete] ifFalse: [self align: self fullBounds center with: Display boundingBox center]]]! ! !SystemProgressMorph methodsFor: 'private' stamp: 'laza 7/29/2004 10:30'! label: shortDescription min: minValue max: maxValue | slot range newBarSize barSize lastRefresh | ((range _ maxValue - minValue) <= 0 or: [(slot _ self nextSlotFor: shortDescription) = 0]) ifTrue: [^[:barVal| 0 ]]. self openInWorld. self align: self fullBounds center with: Display boundingBox center. barSize _ -1. "Enforces a inital draw of the morph" lastRefresh _ 0. ^[:barVal | (barVal between: minValue and: maxValue) ifTrue: [ newBarSize _ (barVal - minValue / range * BarWidth) truncated. newBarSize = barSize ifFalse: [ barSize _ newBarSize. (bars at: slot) barSize: barSize. Time primMillisecondClock - lastRefresh > 25 ifTrue: [ self currentWorld displayWorld. lastRefresh _ Time primMillisecondClock]]]. slot] ! ! !SystemProgressMorph methodsFor: 'private' stamp: 'laza 4/9/2004 10:23'! nextSlotFor: shortDescription | bar slots label | lock critical: [ slots _ bars size. activeSlots = slots ifTrue: [^0]. activeSlots _ activeSlots + 1. 1 to: slots do: [:index | bar _ (bars at: index). bar ifNil: [ bar _ bars at: index put: (SystemProgressBarMorph new extent: BarWidth@BarHeight). label _ labels at: index put: (StringMorph contents: shortDescription font: font). self addMorphBack: label; addMorphBack: bar. ^index]. bar owner ifNil: [ bar _ bars at: index. label _ labels at: index. self addMorphBack: (label contents: shortDescription); addMorphBack: (bar barSize: 0). ^index]]] ! ! !SystemProgressMorph methodsFor: 'dropping/grabbing' stamp: 'laza 4/20/2004 11:38'! slideToTrash: evt "If the user needs to dismiss a progress morph by hand, start with a fresh instance next time." self dismissViaHalo! ! !SystemProgressMorph methodsFor: 'submorphs-add/remove' stamp: 'laza 4/20/2004 12:01'! dismissViaHalo self class reset! ! !SystemProgressMorph class methodsFor: 'instance creation' stamp: 'laza 4/9/2004 10:51'! close: aBlock UniqueInstance ifNotNil: [UniqueInstance close: aBlock]! ! !SystemProgressMorph class methodsFor: 'instance creation' stamp: 'laza 4/18/2004 21:16'! label: shortDescription min: minValue max: maxValue UniqueInstance ifNil: [UniqueInstance _ super new]. ^UniqueInstance label: (shortDescription contractTo: 100) min: minValue asFloat max: maxValue asFloat! ! !SystemProgressMorph class methodsFor: 'instance creation' stamp: 'laza 4/6/2004 21:17'! new ^self shouldNotImplement! ! !SystemProgressMorph class methodsFor: 'instance creation' stamp: 'laza 4/9/2004 10:35'! reset "SystemProgressMorph reset" UniqueInstance ifNotNil: [UniqueInstance delete]. UniqueInstance _ nil.! ! !SystemProgressMorph class methodsFor: 'class initialization' stamp: 'laza 4/10/2004 20:29'! initialize "SystemProgressMorph initialize" BarHeight _ 16. BarWidth _ 200. self reset! ! !SystemProgressMorph class methodsFor: 'examples' stamp: 'laza 4/9/2004 10:49'! example "SystemProgressMorph example" 'Progress' displayProgressAt: Display center from: 0 to: 1000 during: [:bar | 0 to: 1000 do: [:i | bar value: i. (Delay forMilliseconds: 2) wait]] ! ! SystemProgressMorph initialize! ProgressInitiationException initialize!