Newsgroups: comp.lang.smalltalk
Path: utzoo!utgpu!cunews!bnrgate!bqnes74!news
From: CWatts@BNR.CA (Carl Watts)
Subject: Making MVC Controllers in Smalltalk-80 v2.5 not consume 100% of the Processor
Message-ID: <1991Jun3.183729.20327@bqnes74.bnr.ca>
Sender: news@bqnes74.bnr.ca
Organization: Bell Northern Research
Date: Mon, 3 Jun 91 18:37:29 GMT

As I promised last week, here is my version of a modification to Smalltalk-80 v2.5 to change MVC Controllers so that they don't consume 100% of the CPU when they have control.

This is very important if you have applications (like my Finder for Smalltalk-80) that allow the users to do things by creating a Process running at userBackgroundPriority (like Finder ST can do to move/copy large directories in the background while you continue doing other work in the foreground).

Without this modification to MVC Controllers, a Process running at userBackgroundPriority will almost never get a chance to run.

There are several other implementations of ways to accomplish this goal.  Mine isn't necessarily any better, it just works.  It isn't the best solution either.  Its just a good, simple solution.

Anyway...  Here it is...  The theory is simple.  The InputState signals a semaphore (called EventSemaphore) whenever a input event comes in from the virtual machine.  And then appropriate parts of the Controller mechanism wait on this semaphore in their polling loops.  Simple.

'From Objectworks for Smalltalk-80(tm), Version 2.5 of 29 July 1989 on 5 November 1990 at 4:06:17 pm'!

'This fileIn is specifically ordered to fileIn appropriately...'!


(InputState classVarNames includes: #EventSemaphore)
	ifFalse: [InputState addClassVarName: 'EventSemaphore']!


!InputState methodsFor: 'initialize-release'!

install

"Initialize and connect the receiver to the hardware.  Terminate the old input process if any."
"Modified by Carl Watts to initialize the new EventSemaphore as well."

	InputProcess == nil ifFalse: [InputProcess terminate].
	self initState.
	EventSemaphore _ Semaphore new.
	InputSemaphore _ Semaphore new.
	IdleSemaphore _ Semaphore new.
	InputProcess _ [IdleSemaphore signal. self run] newProcess.
	InputProcess priority: Processor lowIOPriority.
	InputProcess resume.
	self primInputSemaphore: InputSemaphore! !

!InputState methodsFor: 'private'!

run

"This is the loop that actually processes input events."
"Modified by Carl Watts to nudge the EventSemaphore every time I get some kind of event from the OS."

	| word type param |
	[true]
		whileTrue: 
			[InputSemaphore wait.
			"Test for mouse X/Y events here to avoid an activation."
			word _ self primInputWord.
			type _ word bitShift: -12.
			param _ word bitAnd: 4095.
"Mouse X"	type = 1 ifTrue: [self mouseX: param]
"Mouse Y"	ifFalse: [type = 2 ifTrue: [self mouseY: param]
"Key down"	ifFalse: [type = 3 ifTrue: [self keyAt: param put: 1]
"Key up"	ifFalse: [type = 4 ifTrue: [self keyAt: param put: 0]
"MetaInput"ifFalse: [type = 7 ifTrue: [self metaInput: word]
"Delta time"ifFalse: [type = 0 ifTrue: []
"Reset time"ifFalse: [type = 5 ifTrue: [self primInputWord; primInputWord]
			ifFalse: [self error: 'Bad event type']]]]]]].
			self nudge]! !

!InputState methodsFor: 'events'!

nudge

"Something interesting has happened, signal the event semaphore."

	EventSemaphore signal!

pause

"Wait on the Event Semaphore for something interesting to happen."

	EventSemaphore wait! !


!InputSensor methodsFor: 'events'!

nudge

"Something interesting has happened.  Signal the event semaphore."

	CurrentInputState nudge!

pause

"Wait on the Event Semaphore for something interesting to happen."

	CurrentInputState pause! !


InputSensor install!


!Controller methodsFor: 'basic control sequence'!

controlLoop

"Sent by Controller|startUp as part of the standard control sequence. Controller|controlLoop sends the message Controller|isControlActive to test for loop termination. As long as true is returned, the loop continues. When false is returned, the loop ends. Each time through the loop, the message Controller|controlActivity is sent."
"Modified by Carl Watts to pause on the sensor in case nothing interesting is happening."

	[self isControlActive] whileTrue: [
		Processor yield.
		sensor pause.
		self controlActivity].
	sensor nudge! !


!ControlManager methodsFor: 'scheduling'!

searchForActiveController

"Find a scheduled controller that wants control and give control to it.  If none wants control, then see if the System Menu has been requested."
"Modified by Carl Watts so that a scheduled controller does not take control unless the mouse button is pressed.  This gets rid of the annoying window flipping to front just because you moved over it.  Also modified to pause on the sensor in case nothing interesting is happening."

	| newController |

	(activeControllerProcess == nil or: [activeControllerProcess == Processor activeProcess])
		ifFalse: [^self].
	activeController _ nil.
	Object errorSignal 
		handle: [:ex | "bad controller"
				ScheduledControllers removeInvalidControllers.
				ex restart]
		"If the active controller's view is nil, MessageNotUnderstoodSignal 
		is raised and caught as ErrorSignal by the handler."
		do: [[Processor yield.
			 screenController sensor pause.
	 		 newController _ (screenController sensor anyButtonPressed)
				ifTrue: [
					scheduledControllers
						detect: [:aController | aController isControlWanted & (aController ~~ screenController)]
						ifNone:	[screenController isControlWanted
							ifTrue: [screenController]
							ifFalse: [nil]]]
				ifFalse: [nil].
			 newController isNil] whileTrue].
	self activeController: newController.
	Processor terminateActive! !

!ScrollController methodsFor: 'scrolling'!

scroll

"Check to see whether the user wishes to jump, scroll up, or scroll down."
"Modified by Carl Watts to pause on the sensor in case nothing interesting is happening."

	| savedCursor regionPercent |
	self yellowMenuContainsCursor
				ifTrue: [^self yellowMenuActivity].
	savedCursor _ sensor currentCursor.
	[self scrollBarOnlyContainsCursor]
		whileTrue: 
			[Processor yield.  sensor pause.
			regionPercent _ 100 * (sensor cursorPoint x - scrollBar left) // scrollBar width.
			regionPercent <= 40
				ifTrue: [self scrollDown]
				ifFalse: [regionPercent >= 60
							ifTrue: [self scrollUp]
							ifFalse: [self scrollAbsolute]]].
	savedCursor show! !
