From: atoenne@mpi-sb.mpg.de (Andreas Toenne)
Newsgroups: comp.lang.smalltalk
Subject: Animated Cursors (15kb)
Date: 18 Aug 92 11:05:30 GMT
Organization: Max-Planck-Institut f"ur Informatik

This is a package of animated cursors. It contains a spinning wheel ala Mac
and a filein-cursor that shows the current progress.

Note that class Cursor is changed:
new class variable 'IsExclusive'
redefined methods 'show' and 'beCursor'
new method 'showExclusiveWhile:' that does not allow cursor changes during the 
execution of its block. These cursor class changes are not needed to use the new
cursors!

See the class comments for examples and guidelines how to install these new cursors.

	Enjoy,
	Andreas
-- 

	Andreas Toenne			Voice: 	x49 681 5846272
	Max-Planck-Institut		Office:	x49 681 302 5363
	fuer Informatik			e-mail:	atoenne@mpi-sb.mpg.de

	Im Stadtwald
	6600 Saarbruecken, Germany

~~~~~~~~~~~ snip ~~~~~~~~~~~~~~~~~
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 08/18/1992 10:51 UTC by atoenne@hamster
# Source directory /HG/usr1/atoenne/st80
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#  13785 -rw-rw-r-- Cursor.st
#
# ============= Cursor.st ==============
if test -f 'Cursor.st' -a X"$1" != X"-c"; then
	echo 'x - skipping Cursor.st (File already exists)'
else
echo 'x - extracting Cursor.st (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'Cursor.st' &&
"!!PACKAGE!!"!
X
"!!Package define: 'Cursor'"!
"!!Package current fileName: 'Cursor.st'"!
"!!Package current commentFromCommentString:
') 1992 Andreas Tvnne
X
This package defines several nice cursors like a spinning wheel and a clock cursor.'"!
X
X
"!!Package current addNewClassNamed: #AnimatedCursor "!
Cursor subclass: #AnimatedCursor
X	instanceVariableNames: 'animator '
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'OS-Cursors'!
AnimatedCursor comment:
') 1992 Andreas Tvnne
X
AnimatedCursor act like regular cursors that are animated.
X
Subclasses should implement a method primSetupProcess that starts a process for the   animation.
This process should be of the following shape:
X
X	animator isNil
X		ifTrue: 
X			[animator := true.		"kludge to simulate a semaphore"
X			animator := 
X					[[Cursor currentCursor == self]
X						whileTrue: 
X							[self isActive ifTrue: [self class unregister: self].
X							self privateInstall.
X							self primBeCursor.
X							DO YOUR THING HERE].
X					animator := nil.
X					self class unregister: self] newProcess.
X			animator priority: 6.
X			animator resume]
X
The animation takes place by installing new cursor images in situ and unregistering the old handles.
X
See my subclass SpinningCursor for an example.
Note that we should use semaphores to prevent multiple animation processes when beCursor messages are received rapidly. But semaphores are to expensive for animation here.
X
Instance Variables:
X	animator <Process |  nil> the current animation process
Subclasses must implement the following messages:
X	private
X		primSetupProcess
'!
X
X
!AnimatedCursor methodsFor: 'displaying'!
X
beCursor
X	"Tell the VM to use the receiver as the current cursor image."
X
X	self isActive
X		ifFalse: [self privateInstall].
X	self privateSetupProcess.
X	self primBeCursor
"*AppOrgVersion 18-8-92 8:39:53 am 'Andreas Toenne'*"! !
X
!AnimatedCursor methodsFor: 'private'!
X
primSetupProcess
X	"See my class comment"
X
X	self subclassResponsibility
"*AppOrgVersion 18-8-92 10:07:17 am 'Andreas Toenne'*"! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
AnimatedCursor class
X	instanceVariableNames: ''!
X
X
!AnimatedCursor class methodsFor: 'instance creation'!
X
new
X	
X	^ super new initialize
"*AppOrgVersion 18-8-92 9:38:47 am 'Andreas Toenne'*"! !
X
"!!Package current addNewClassNamed: #SpinningCursor "!
AnimatedCursor subclass: #SpinningCursor
X	instanceVariableNames: 'thisStep '
X	classVariableNames: 'AnimationMask AnimationStages AnimationSteps '
X	poolDictionaries: ''
X	category: 'OS-Cursors'!
SpinningCursor comment:
') 1992 Andreas Tvnne
X
A SpinningCursor acts like a normal cursor but shows a rotating image as long as it is active.
This cursor is best installed by redefining the class method Cursor class>execute to return a new
SpinningCursor.
X
SpinningCursor new displayOn: ScheduledWindow currentWindow graphicsContext
[SpinningCursor new show] fork
SpinningCursor allInstances
X
Instance Variables:
X	thisStep	<Integer>	the current animation step in AnimationSteps.
X
Class Variables:
X	AnimationStages	<Integer>  the number of animation steps
X	AnimationSteps	<Array>   the Images of the stages of animation
X	AnimationMask <Image> the maskPixmap for the cursor.'!
X
X
!SpinningCursor methodsFor: 'initialize-release'!
X
initialize
X	"Set the current animation step, mask and image."
X
X	super initialize.
X	thisStep := 1.
X	image := AnimationSteps at: 1.
X	mask := AnimationMask.
X	hotSpot := 8@8
"*AppOrgVersion 18-8-92 8:39:19 am 'Andreas Toenne'*"! !
X
!SpinningCursor methodsFor: 'accessing'!
X
nextAnimation
X	"Get the next animation"
X
X	thisStep == AnimationStages ifTrue: [thisStep := 0].
X	thisStep := thisStep + 1.
X	image := AnimationSteps at: thisStep
"*AppOrgVersion 17-8-92 3:24:09 pm 'Andreas Toenne'*"! !
X
!SpinningCursor methodsFor: 'private'!
X
privateSetupProcess
X	"Install the cursor and setup the process"
X
X	animator isNil
X		ifTrue: 
X			[animator := true.
X			animator := 
X					[[Cursor currentCursor == self]
X						whileTrue: 
X							[self nextAnimation.
X							self isActive ifTrue: [self class unregister: self].
X							self privateInstall.
X							self primBeCursor.
X							(Delay forMilliseconds: 1000 // AnimationStages) wait].
X					animator := nil.
X					self class unregister: self] newProcess.
X			animator priority: 6.
X			animator resume]
"*AppOrgVersion 18-8-92 8:40:23 am 'Andreas Toenne'*"! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
SpinningCursor class
X	instanceVariableNames: ''!
X
X
!SpinningCursor class methodsFor: 'class initialization'!
X
initialize
X	"SpinningCursor initialize"
X
X	AnimationStages := 16.
X	self initializeAnimations
"*AppOrgVersion 17-8-92 2:43:10 pm 'Andreas Toenne'*"!
X
initializeAnimations
X	"SpinningCursor initializeAnimations"
X	"|gc| 
X	gc := ScheduledWindow currentWindow graphicsContext. 
X	3 timesRepeat: [AnimationSteps do: [:each| each displayOn: gc. 
X	(Delay forMilliseconds: 3000 // AnimationStages) wait]]"
X
X	| i g |
X	AnimationSteps := Array new: AnimationStages.
X	1 to: AnimationStages do: 
X		[:j | 
X		| pix gc |
X		pix := Pixmap extent: 16 @ 16.
X		gc := GraphicsContext on: pix.
X		gc
X			displayWedgeBoundedBy: (0 @ 0 extent: 16 @ 16)
X			startAngle: 360 // AnimationStages * j
X			sweepAngle: 90.
X		gc
X			displayWedgeBoundedBy: (0 @ 0 extent: 16 @ 16)
X			startAngle: 360 // AnimationStages * j + 180 \\ 360
X			sweepAngle: 90.
X		gc
X			displayArcBoundedBy: (0 @ 0 extent: 16 @ 16)
X			startAngle: 0
X			sweepAngle: 360.
X		AnimationSteps at: j put: (pix asImage convertToPalette: MappedPalette monochromeDefault)].
X	i := Mask extent: 16 @ 16. "Important!! Pixmaps cannot be rendered to CoveragePalette"
X	g := GraphicsContext on: i.
X	g
X		displayWedgeBoundedBy: (0 @ 0 extent: 16 @ 16)
X		startAngle: 0
X		sweepAngle: 360.
X	AnimationMask := (i asImage convertToPalette: CoveragePalette monoMaskPalette)
"*AppOrgVersion 18-8-92 9:20:21 am 'Andreas Toenne'*"! !
X
!SpinningCursor class methodsFor: 'instance creation'!
X
new
X	
X	^ super new initialize
"*AppOrgVersion 17-8-92 2:25:38 pm 'Andreas Toenne'*"! !
X
"!!Package current addNewClassNamed: #FileinCursor "!
AnimatedCursor subclass: #FileinCursor
X	instanceVariableNames: 'thisPercent length stream '
X	classVariableNames: 'AnimationMask AnimationStages AnimationSteps '
X	poolDictionaries: ''
X	category: 'OS-Cursors'!
FileinCursor comment:
') 1992 Andreas Tvnne
X
A FileinCursor monitors the progress in reading a specified stream. This may be used to show the fraction of file-in.
X
FileinCursor is best installed by redefining PeekableStream>filein.
Replace the beginning ''Cursor read showWhile:'' by (FileinCursor on: self) showExclusiveWhile:''.
X
Instance Variables:
X	thisPercent	<Float>  how much have we read already?
X	length	<Integer>  the overall filein length
X	stream	<Stream>  the stream that we monitor
X
Class Variables:
X	AnimationMask	<Image>  the cursor mask image
X	AnimationStages	<Integer>  how many different animation steps?
X	AnimationSteps	<Array of: Image>  the animation steps
'!
X
X
!FileinCursor methodsFor: 'initialize-release'!
X
initialize
X	"Initially we have seen nothing"
X
X	super initialize.
X	thisPercent := 0.
X	mask := AnimationMask.
X	image := AnimationSteps at: 1.
X	hotSpot := 8@8
"*AppOrgVersion 18-8-92 9:38:10 am 'Andreas Toenne'*"! !
X
!FileinCursor methodsFor: 'accessing'!
X
nextImage
X	"Compute the next cursor image"
X
X	| here |
X	here := stream position asFloat / length.
X	here = thisPercent
X		ifFalse: 
X			[thisPercent := here.
X			image := AnimationSteps at: ((thisPercent * AnimationStages) truncated max: 1).
X			^true]
X		ifTrue: [^false]
"*AppOrgVersion 18-8-92 9:51:48 am 'Andreas Toenne'*"!
X
on: aStream
X	"Keep the readstream that contains the filein code"
X
X	stream := aStream.
X	length := stream size
"*AppOrgVersion 18-8-92 9:37:40 am 'Andreas Toenne'*"! !
X
!FileinCursor methodsFor: 'private'!
X
privateSetupProcess 
X	"Install the cursor and setup the process"
X
X	animator isNil
X		ifTrue: 
X			[animator := true.
X			animator := 
X					[[Cursor currentCursor == self]
X						whileTrue: 
X							[self nextImage
X								ifTrue: 
X									[self isActive ifTrue: [self class unregister: self].
X									self privateInstall.
X									self primBeCursor].
X							(Delay forMilliseconds: 1000 // AnimationStages) wait].
X					animator := nil.
X					self class unregister: self] newProcess.
X			animator priority: 6.
X			animator resume]
"*AppOrgVersion 18-8-92 9:40:12 am 'Andreas Toenne'*"! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
FileinCursor class
X	instanceVariableNames: ''!
X
X
!FileinCursor class methodsFor: 'class initialization'!
X
initialize
X	"SpinningCursor initialize"
X
X	AnimationStages := 64.
X	self initializeAnimations
"*AppOrgVersion 18-8-92 8:47:48 am 'Andreas Toenne'*"!
X
initializeAnimations
X	"FileinCursor initializeAnimations"
X	"|gc| 
X	gc := ScheduledWindow currentWindow graphicsContext. 
X	3 timesRepeat: [AnimationSteps do: [:each| each displayOn: gc. 
X	(Delay forMilliseconds: 1000 // AnimationStages) wait]]"
X
X	| i g |
X	AnimationSteps := Array new: AnimationStages.
X	1 to: AnimationStages do: 
X		[:j | 
X		| pix gc |
X		pix := Pixmap extent: 16 @ 16.
X		gc := GraphicsContext on: pix.
X		gc
X			displayWedgeBoundedBy: (0 @ 0 extent: 16 @ 16)
X			startAngle: -90
X			sweepAngle: (360 / AnimationStages * (j-1) ) truncated.
X		gc
X			displayArcBoundedBy: (0 @ 0 extent: 16 @ 16)
X			startAngle: 0
X			sweepAngle: 360.
X		AnimationSteps at: j put: (pix asImage convertToPalette: MappedPalette monochromeDefault)].
X	i := Mask extent: 16 @ 16. "Important!! Pixmaps cannot be rendered to CoveragePalette"
X	g := GraphicsContext on: i.
X	g
X		displayWedgeBoundedBy: (0 @ 0 extent: 16 @ 16)
X		startAngle: 0
X		sweepAngle: 360.
X	AnimationMask := (i asImage convertToPalette: CoveragePalette monoMaskPalette)
"*AppOrgVersion 18-8-92 9:55:57 am 'Andreas Toenne'*"! !
X
!FileinCursor class methodsFor: 'instance creation'!
X
on: aStream
X	"Create a new filein-cursor on the stream"
X
X	^ self new on: aStream
"*AppOrgVersion 18-8-92 9:32:08 am 'Andreas Toenne'*"! !
X
"!!Package current addNewSelector: #showExclusiveWhile: classNamed: #Cursor meta: false "!
X
X
!Cursor methodsFor: 'displaying'!
X
showExclusiveWhile: aBlock 
X	"While evaluating the argument, aBlock, make the receiver be the 
X	cursor shape."
X	"Do not allow cursor changed during the execution of the block."
X
X	| oldcursor |
X	oldcursor := self class currentCursor.
X	self class exclusive: self.
X	self show.
X	^aBlock
X		valueNowOrOnUnwindDo: 
X			[self class exclusive: nil.
X			oldcursor show]
"*AppOrgVersion 18-8-92 10:13:30 am 'Andreas Toenne'*"! !
X
OSHandle subclass: #Cursor
X	instanceVariableNames: 'image mask hotSpot name '
X	classVariableNames: 'BlankCursor BottomLeftCursor BullCursor CaretCursor CompactMemoryCursor CornerCursor CrossHairCursor CurrentCursor DownCursor GarbageCursor HandCursor IsExclusive KnownCursorHandles MarkerCursor NormalCursor OriginCursor QuickGarbageCursor ReadCursor ScrollCursor SquareCursor ThumbsDownCursor ThumbsUpCursor TopRightCursor UpCursor WaitCursor WriteCursor XeqCursor '
X	poolDictionaries: ''
X	category: 'OS-Window System'!
X
Cursor comment:
'Class cursor provides for an interface to cursors that follow the mouse.  Each has an image which is the bits to show and a mask that defines the affected area.  Each also has a hot spot that defines the sensitive area of the mouse.
X
Instance Variables:
X	image		<Image>	The image to display
X	mask		<Image>	The affected area
X	hotSpot		<Point>	The sensitive spot
X	name		<CharacterArray | nil>	The cursor''s name
X
Class Variables:
X	KnownCursorHandles	<HandleRegistry>	The open cursors
X	CurrentCursor			<Cursor>		The current cursor
X	"Plus many useful cursors ..."
X	BlankCursor				<Cursor>
X	BottomLeftCursor			<Cursor>
X	BullCursor				<Cursor>
X	CaretCursor				<Cursor>
X	CompactMemoryCursor	<Cursor>
X	CornerCursor			<Cursor>
X	CrossHairCursor			<Cursor>
X	DownCursor				<Cursor>
X	GarbageCursor			<Cursor>
X	HandCursor				<Cursor>
X	MarkerCursor			<Cursor>
X	NormalCursor			<Cursor>
X	OriginCursor				<Cursor>
X	QuickGarbageCursor		<Cursor>
X	ReadCursor				<Cursor>
X	ScrollCursor				<Cursor>
X	SquareCursor			<Cursor>
X	ThumbsDownCursor		<Cursor>
X	ThumbsUpCursor			<Cursor>
X	TopRightCursor			<Cursor>
X	UpCursor				<Cursor>
X	WaitCursor				<Cursor>
X	WriteCursor				<Cursor>
X	XeqCursor				<Cursor>
X
X	IsExclusive			<Cursor | nil> the cursor that may not be replaced'!
X
"!!Package current addNewSelector: #exclusive: classNamed: #Cursor meta: true "!
X
X
!Cursor class methodsFor: 'current cursor'!
X
exclusive: aCursor 
X	"Set the cursor to be exclusive"
X
X	IsExclusive isNil ifTrue: [IsExclusive := aCursor].
X	aCursor isNil ifTrue: [IsExclusive := nil]
"*AppOrgVersion 18-8-92 9:49:27 am 'Andreas Toenne'*"! !
X
"!!Package current addNewSelector: #locked classNamed: #Cursor meta: true "!
X
X
!Cursor class methodsFor: 'current cursor'!
X
locked
X	"True when no other cursor may be installed right now"
X
X	^ IsExclusive notNil
"*AppOrgVersion 18-8-92 9:43:35 am 'Andreas Toenne'*"! !
X
"!!Package current addNewSelector: #exclusive classNamed: #Cursor meta: true "!
X
X
!Cursor class methodsFor: 'current cursor'!
X
exclusive
X	"The cursor that is exclusive"
X
X	^ IsExclusive
"*AppOrgVersion 18-8-92 9:45:14 am 'Andreas Toenne'*"! !
X
!Cursor methodsFor: 'displaying'!
X
beCursor
X	"Tell the VM to use the receiver as the current cursor image."
X
X	(self class locked not or: [self class exclusive = self])
X		ifTrue: 
X			[self isActive ifFalse: [self privateInstall].
X			self primBeCursor]
"*AppOrgVersion 18-8-92 9:47:27 am 'Andreas Toenne'*"! !
X
!Cursor methodsFor: 'displaying'!
X
show
X	"Make the current cursor shape be the receiver."
X
X	(self class locked not or: [self class exclusive = self])
X		ifTrue: [self class currentCursor: self]
"*AppOrgVersion 18-8-92 9:53:03 am 'Andreas Toenne'*"! !
SpinningCursor initialize!
FileinCursor initialize!
"!!Package current markClean"!
"!!Package default install"!
SHAR_EOF
chmod 0664 Cursor.st ||
echo 'restore of Cursor.st failed'
Wc_c="`wc -c < 'Cursor.st'`"
test 13785 -eq "$Wc_c" ||
	echo 'Cursor.st: original size 13785, current size' "$Wc_c"
fi
exit 0