Hi all,

attached is my first stab at a real time based event scheduler.
You might also need the fix for the Heap species method.

Michael



Change Set:		EventScheduling
Date:			21 March 2000
Author:			Michael Rueger

This change set implements a small framework for scheduling of events and the
time stepping for real time related event handling.
ATTENTION: This scheduler is built to work within the morphic step loop to
avoid issues related to async events. You need to call the step method! 

Somewhat odd (at least it would be in discrete simulation) is the fact, that
because our timeline is based on real time, events might already be in the
past (they can't be scheduled for the past though) when they are activated. 

-- 

 "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:		EventScheduling
Date:			21 March 2000
Author:			Michael Rueger

This change set implements a small framework for scheduling of events and the time stepping for real time related event handling.
ATTENTION: This scheduler is built to work within the morphic step loop to avoid issues related to async events. You need to call the step method! 

Somewhat odd (at least it would be in discrete simulation) is the fact, that because our timeline is based on real time, events might already be in the past (they can't be scheduled for the past though) when they are activated. 

"!

Object subclass: #EventScheduler
	instanceVariableNames: 'currentTime nextTime lastSystemTime eventQueue stopped temporalDistortion interval objectsToUpdate '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Framework-Scheduling'!
!EventScheduler commentStamp: '<historical>' prior: 0!
This class handles the scheduling of events and the time stepping for real time related event handling.
ATTENTION: This scheduler is built to work within the morphic step loop to avoid issues related to async events. You need to call the step method! 

Somewhat odd (at least it would be in discrete simulation) is the fact, that because our timeline is based on real time events might already be in the past (they can't be scheduled for the past though) when they are activated. 

	currentTime		<Float>	My understanding of "time now"
	temporalDistortion <Float> the factor with which my timeline moves relative to real time. Remember that the faster this computer moves through space-time the more the "real" time will also be distorted. ;-)
	lastSystemTime		<SmallInteger>	value of the millisecond clock the last time I was invoked. This clock will eventually roll over, that's why I keep my own linear time base.
	nextTime	<Float>	the next time (on my timeline) something needs to be done
	interval		<SmallInteger>	max system time in milliseconds between step invocations. It may be less if there are scheduled events due in between.
	eventQueue	<Heap>	list of events sorted by time
	stopped !


!EventScheduler methodsFor: 'accessing' stamp: 'mir 10/30/1999 20:53'!
registerUpdateObject: anObject
	self objectsToUpdate add: anObject! !

!EventScheduler methodsFor: 'accessing' stamp: 'mir 10/30/1999 20:54'!
unregisterUpdateObject: anObject
	self objectsToUpdate remove: anObject ifAbsent: []! !


!EventScheduler methodsFor: 'initialize' stamp: 'mir 12/22/1999 17:31'!
initialize
	currentTime _ 0.0.
	temporalDistortion _ 1.0.
	lastSystemTime _ Time millisecondClockValue.
	nextTime _ -1.0.
	interval _ 0.001.
	eventQueue _ Heap sortBlock: [:a :b | (a ~~ nil and: [b ~~ nil]) and: [a time < b time]].
	stopped _ false.
	objectsToUpdate _ IdentitySet new! !


!EventScheduler methodsFor: 'printing' stamp: 'mir 10/29/1999 16:30'!
printOn: stream
	stream nextPutAll: 'Timer ('.
	self currentTime printOn: stream.
	stream nextPut: $)! !


!EventScheduler methodsFor: 'stepping' stamp: 'mir 11/1/1999 19:23'!
step
	| deltaSecs deltaTime |
	"Process all events due."

	(self stopped or: [
			deltaTime _ Time millisecondsSince: self lastSystemTime.
			deltaSecs _ deltaTime / 1000.0.
			(self currentTime + deltaSecs) < self nextTime])
		ifFalse: [
			lastSystemTime _ self lastSystemTime + deltaTime.
			self timeStep: deltaSecs]! !


!EventScheduler methodsFor: 'private' stamp: 'mir 10/31/1999 15:12'!
currentTime
	^currentTime! !

!EventScheduler methodsFor: 'private' stamp: 'mir 11/9/1999 19:22'!
eventQueue
	^eventQueue! !

!EventScheduler methodsFor: 'private' stamp: 'mir 11/5/1999 14:41'!
interval
	^interval! !

!EventScheduler methodsFor: 'private' stamp: 'mir 11/1/1999 17:32'!
lastSystemTime
	^lastSystemTime! !

!EventScheduler methodsFor: 'private' stamp: 'mir 10/29/1999 16:34'!
nextEvent
	"Process the next event in the queue.
	Events scheduled with zero delay are not catched here, but processed later."


"	self currentTime > eventQueue first eventTime value
		ifTrue: [self error: 'Invalid time step in kernel.'].

	lastTime := currentTime.
	currentTime := eventQueue first eventTime value.

	[eventQueue isEmpty
		or: [eventQueue first eventTime value > currentTime]]
		whileFalse: [currentEvents add: eventQueue removeFirst].

	[currentEvents isEmpty]
		whileFalse: [
		| event |
		event := currentEvents removeFirst.
		event takePlace.

		]"! !

!EventScheduler methodsFor: 'private' stamp: 'mir 11/1/1999 17:33'!
nextTime
	^nextTime! !

!EventScheduler methodsFor: 'private' stamp: 'mir 10/30/1999 20:53'!
objectsToUpdate
	^objectsToUpdate! !

!EventScheduler methodsFor: 'private' stamp: 'mir 10/29/1999 16:35'!
proceed
	"Look for a new event.
	Update time.
	Activate event"

	[stopped] whileFalse: [
		(self eventQueue isEmpty)
			ifTrue: [stopped := true]
			ifFalse: [self timeStep]]! !

!EventScheduler methodsFor: 'private' stamp: 'mir 10/29/1999 16:27'!
restartScheduling! !

!EventScheduler methodsFor: 'private' stamp: 'mir 10/29/1999 17:13'!
stopped
	^stopped! !

!EventScheduler methodsFor: 'private' stamp: 'mir 11/10/1999 14:03'!
timeStep: deltaSecs
	| lastTime currentEvents |
	"Process the next event in the queue."

	lastTime _ currentTime.
	currentTime _ currentTime + deltaSecs.
	nextTime _ currentTime + self interval.
"	self updateFrom: lastTime upTo: currentTime."

	currentEvents _ OrderedCollection new.
	[eventQueue isEmpty
		or: [eventQueue first time > currentTime]]
		whileFalse: [currentEvents add: eventQueue removeFirst].

	[currentEvents isEmpty]
		whileFalse: [
		currentEvents removeFirst invoke.
		]! !


!EventScheduler methodsFor: 'run control' stamp: 'mir 10/29/1999 16:27'!
run
	stopped _ false.
	self restartScheduling! !

!EventScheduler methodsFor: 'run control' stamp: 'mir 10/29/1999 16:28'!
stop
	stopped _ true! !


!EventScheduler methodsFor: 'scheduling' stamp: 'mir 1/21/2000 10:14'!
cancelAllEvents
	(self eventQueue collect: [:each | each]) do: [:event |
		self cancelEvent: event]! !

!EventScheduler methodsFor: 'scheduling' stamp: 'mir 12/1/1999 11:37'!
cancelAllEventsSuchThat: aBlock
	| eventsToCancel |
	eventsToCancel _ self eventQueue select: [:event | aBlock value: event].
	eventsToCancel do: [:event |
		self cancelEvent: event]! !

!EventScheduler methodsFor: 'scheduling' stamp: 'mir 11/9/1999 19:25'!
cancelEvent: anEvent
	self eventQueue remove: anEvent! !

!EventScheduler methodsFor: 'scheduling' stamp: 'mir 12/1/1999 11:40'!
cancelEventsFor: receiverObject
	self cancelAllEventsSuchThat: [:event | event receiver = receiverObject]
! !

!EventScheduler methodsFor: 'scheduling' stamp: 'mir 12/17/1999 18:37'!
for: aReceiver perform: aSelector after: deltaTime
	^self for: aReceiver perform: aSelector withArguments: nil after: deltaTime! !

!EventScheduler methodsFor: 'scheduling' stamp: 'mir 12/17/1999 18:37'!
for: aReceiver perform: aSelector withArguments: arguments after: deltaTime
	^self for: aReceiver perform: aSelector withArguments: arguments at: self currentTime + deltaTime! !

!EventScheduler methodsFor: 'scheduling' stamp: 'mir 12/17/1999 18:38'!
for: aReceiver perform: aSelector withArguments: arguments at: aTime
	| event |
	event _ ScheduledEvent at: aTime for: aReceiver perform: aSelector withArguments: arguments.
	self schedule: event.
	^event! !

!EventScheduler methodsFor: 'scheduling' stamp: 'mir 11/10/1999 13:55'!
reschedule: anEvent after: deltaTime
	self reschedule: anEvent at: self currentTime + deltaTime! !

!EventScheduler methodsFor: 'scheduling' stamp: 'mir 11/30/1999 16:55'!
reschedule: anEvent at: newTime
	anEvent ifNil: [
		^nil].
	self eventQueue remove: anEvent ifAbsent: [^nil].
	anEvent time: newTime.
	self eventQueue add: anEvent! !

!EventScheduler methodsFor: 'scheduling' stamp: 'mir 11/9/1999 19:22'!
schedule: anEvent
	self eventQueue add: anEvent! !

!EventScheduler methodsFor: 'scheduling' stamp: 'mir 12/20/1999 18:20'!
send: aSelector to: aReceiver after: deltaTime
	^self for: aReceiver perform: aSelector after: deltaTime! !

!EventScheduler methodsFor: 'scheduling' stamp: 'mir 1/14/2000 08:06'!
send: aSelector with: anArgument to: aReceiver after: deltaTime
	^self for: aReceiver perform: aSelector withArguments: (Array with: anArgument) after: deltaTime! !

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

EventScheduler class
	instanceVariableNames: ''!

!EventScheduler class methodsFor: 'instance creation' stamp: 'mir 10/29/1999 16:14'!
new
	^super new initialize! !


Object subclass: #MessageSend
	instanceVariableNames: 'receiver selector args '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Framework-Scheduling'!

!MessageSend methodsFor: 'comparing' stamp: 'mir 11/9/1999 19:18'!
= anotherObject
	^(anotherObject isKindOf: self)
		and: [receiver = anotherObject receiver
		and: [selector = anotherObject selector]]! !

!MessageSend methodsFor: 'comparing' stamp: 'mir 11/9/1999 19:18'!
hash
	^receiver hash + selector hash! !


!MessageSend methodsFor: 'accessing' stamp: 'mir 11/9/1999 19:16'!
receiver
	^receiver! !

!MessageSend methodsFor: 'accessing' stamp: 'mir 11/9/1999 19:16'!
selector
	^selector! !


!MessageSend methodsFor: 'initialize' stamp: 'mir 11/9/1999 19:08'!
receiver: anObject selector: aSelector with: arguments
	receiver _ anObject.
	selector _ aSelector.
	args _ arguments! !


!MessageSend methodsFor: 'private' stamp: 'mir 11/9/1999 18:43'!
privateValueWithArguments: arguments
	^arguments isNil
		ifTrue: [receiver perform: selector]
		ifFalse: [receiver perform: selector withArguments: arguments]! !


!MessageSend methodsFor: 'evaluation' stamp: 'mir 11/9/1999 18:43'!
value
	^self privateValueWithArguments: args! !

!MessageSend methodsFor: 'evaluation' stamp: 'mir 11/9/1999 18:44'!
valueWith: arg
	^args isNil
		ifTrue: [self privateValueWithArguments: (Array with: arg)]
		ifFalse: [self privateValueWithArguments: (args copyWith: arg)]! !

!MessageSend methodsFor: 'evaluation' stamp: 'mir 11/9/1999 18:41'!
valueWithArguments: arguments
	^arguments isNil
		ifTrue: [receiver perform: selector]
		ifFalse: [receiver perform: selector withArguments: arguments]! !

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

MessageSend class
	instanceVariableNames: ''!

!MessageSend class methodsFor: 'instance creation' stamp: 'mir 11/9/1999 19:08'!
receiver: anObject selector: aSelector
	^self new receiver: anObject selector: aSelector with: nil! !

!MessageSend class methodsFor: 'instance creation' stamp: 'mir 11/9/1999 19:08'!
receiver: anObject selector: aSelector with: arguments
	^self new receiver: anObject selector: aSelector with: arguments! !


Object subclass: #ScheduledEvent
	instanceVariableNames: 'time action '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Framework-Scheduling'!

!ScheduledEvent methodsFor: 'accessing' stamp: 'mir 12/1/1999 11:39'!
receiver
	^self action receiver! !

!ScheduledEvent methodsFor: 'accessing' stamp: 'mir 11/9/1999 19:21'!
time
	^time! !

!ScheduledEvent methodsFor: 'accessing' stamp: 'mir 11/9/1999 19:26'!
time: newTime
	time _ newTime! !


!ScheduledEvent methodsFor: 'invocation' stamp: 'mir 11/9/1999 19:10'!
invoke
	action value! !


!ScheduledEvent methodsFor: 'initialize' stamp: 'mir 12/17/1999 18:39'!
at: aTime for: aReceiver perform: aSelector withArguments: arguments
	time _ aTime.
	action _ MessageSend receiver: aReceiver selector: aSelector with: arguments! !


!ScheduledEvent methodsFor: 'private' stamp: 'mir 11/9/1999 19:16'!
action
	^action! !

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

ScheduledEvent class
	instanceVariableNames: ''!

!ScheduledEvent class methodsFor: 'instance creation' stamp: 'mir 12/17/1999 18:38'!
at: aTime for: aHandler perform: aSelector withArguments: arguments
	^ScheduledMessageSend new at: aTime for: aHandler perform: aSelector withArguments: arguments! !

!ScheduledEvent class methodsFor: 'instance creation' stamp: 'mir 12/17/1999 18:39'!
at: aTime invoke: aBlock withArguments: arguments
	^self new at: aTime invoke: aBlock withArguments: arguments! !


ScheduledEvent subclass: #ScheduledMessageSend
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Framework-Scheduling'!

!ScheduledMessageSend methodsFor: 'private' stamp: 'mir 11/9/1999 19:16'!
messageSend
	^self action! !


!ScheduledMessageSend methodsFor: 'accessing' stamp: 'mir 11/9/1999 19:16'!
receiver
	^self messageSend receiver! !