Change Set:		ProgressMorph
Date:			1 March 2000
Author:			Michael Rueger

A progress indicator.
You can provide a top and a sub label indicating the progress.
The progress value can either be set using absolute values between 0.0 - 1.0,
or by specifying the incremental progress with incrDone.

-- 

 "To improve is to change, to be perfect is to change often." 
                                            Winston Churchill
+------------------------------------------------------------+
| Michael Rueger                                             |
| Phone: ++1 (818) 623 3283        Fax:   ++1 (818) 623 3559 |
+---------- Michael.Rueger.-ND at corp.go.com ------------------+
-------------- next part --------------
"Change Set:		ProgressMorph
Date:			1 March 2000
Author:			Michael Rueger

A progress indicator.
You can provide a top and a sub label indicating the progress.
The progress value can either be set using absolute values between 0.0 - 1.0, or by specifying the incremental progress with incrDone.
"!

RectangleMorph subclass: #ProgressMorph
	instanceVariableNames: 'labelMorph subLabelMorph progress '
	classVariableNames: 'Current '
	poolDictionaries: ''
	category: 'Morphic-Widgets'!

!ProgressMorph methodsFor: 'accessing' stamp: 'mir 2/14/2000 17:55'!
done
	^self progress value contents! !

!ProgressMorph methodsFor: 'accessing' stamp: 'mir 1/19/2000 13:10'!
done: amountDone
	self progress value contents: (amountDone abs min: 1.0)! !

!ProgressMorph methodsFor: 'accessing' stamp: 'mir 1/19/2000 13:47'!
incrDone: incrDone
	self progress value contents: self progress value contents + incrDone! !

!ProgressMorph methodsFor: 'accessing' stamp: 'mir 1/19/2000 13:28'!
label
	^self labelMorph contents! !

!ProgressMorph methodsFor: 'accessing' stamp: 'mir 1/19/2000 13:26'!
label: aString
	self labelMorph contents: aString! !

!ProgressMorph methodsFor: 'accessing' stamp: 'mir 1/19/2000 13:25'!
progress
	^progress ifNil: [self initProgressMorph]! !

!ProgressMorph methodsFor: 'accessing' stamp: 'mir 1/19/2000 13:27'!
subLabel
	^self subLabelMorph contents! !

!ProgressMorph methodsFor: 'accessing' stamp: 'mir 1/19/2000 13:27'!
subLabel: aString
	self subLabelMorph contents: aString! !


!ProgressMorph methodsFor: 'private' stamp: 'mir 1/19/2000 13:25'!
labelMorph
	^labelMorph ifNil: [self initLabelMorph]! !

!ProgressMorph methodsFor: 'private' stamp: 'mir 1/19/2000 13:05'!
largeFont
	"Answer a small font to use for things like the label on the special weapons switch."

	| fontSize font |
	fontSize _ 19.
	font _ (TextConstants includesKey: #ComicBold)
		ifTrue: [
			(TextConstants at: #ComicBold) fontOfSize: fontSize]
		ifFalse: [
			TextStyle default fontOfSize: fontSize].

	^ font
! !

!ProgressMorph methodsFor: 'private' stamp: 'mir 1/19/2000 13:25'!
subLabelMorph
	^subLabelMorph ifNil: [self initSubLabelMorph]! !


!ProgressMorph methodsFor: 'initialization' stamp: 'mir 1/19/2000 13:30'!
initLabelMorph
	^labelMorph _ StringMorph contents: '' font: self largeFont.
! !

!ProgressMorph methodsFor: 'initialization' stamp: 'mir 1/19/2000 13:16'!
initProgressMorph
	progress _ FlashProgressMorph new.
	progress borderWidth: 1.
	progress color: Color transparent.
	progress progressColor: Color gray.
	progress extent: (200 @ 15).
! !

!ProgressMorph methodsFor: 'initialization' stamp: 'mir 1/19/2000 13:30'!
initSubLabelMorph
	^subLabelMorph _ StringMorph contents: '' font: self largeFont.
! !

!ProgressMorph methodsFor: 'initialization' stamp: 'mir 1/19/2000 13:28'!
initialize
	super initialize.
	self setupMorphs! !

!ProgressMorph methodsFor: 'initialization' stamp: 'mir 1/19/2000 13:33'!
setupMorphs
	| container  |
	self initProgressMorph.
	container _ AlignmentMorph newColumn.
	container
		centering: #center;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		color: Color transparent.

	container addMorphBack: self labelMorph.
	container addMorphBack: self subLabelMorph.
	container addMorphBack: self progress.

	self addMorph: container.
	self borderWidth: 2.
	self borderColor: Color black.

	self extent: container extent.
	self color: Color veryLightGray.
	self align: self fullBounds center with: Display boundingBox center
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ProgressMorph class
	instanceVariableNames: ''!

!ProgressMorph class methodsFor: 'instance creation' stamp: 'mir 1/19/2000 13:07'!
label: aString
	^self new label: aString! !


!ProgressMorph class methodsFor: 'accessing' stamp: 'mir 2/29/2000 12:30'!
current
	^Current
		ifNil: [self current: 'Progress']
		ifNotNil: [Current]! !

!ProgressMorph class methodsFor: 'accessing' stamp: 'mir 2/14/2000 17:43'!
current: aLabel
	Current
		ifNil: [
			Current _ ProgressMorph label: aLabel.
			Current beSticky.
			Current openInWorld]
		ifNotNil: [Current label: aLabel].
	^Current! !

!ProgressMorph class methodsFor: 'accessing' stamp: 'mir 2/13/2000 22:30'!
deleteCurrent
	Current ifNotNil: [
		Current delete.
		Current _ nil]! !


!ProgressMorph class methodsFor: 'example' stamp: 'mir 2/29/2000 12:31'!
example
	"ProgressMorph example"

	ProgressMorph current: 'Test progress'.
	[10 timesRepeat: [
		(Delay forMilliseconds: 200) wait.
		ProgressMorph current incrDone: 0.1].
	ProgressMorph deleteCurrent] fork! !