pieter@prls.UUCP (Pieter van der Meulen) (04/05/89)
Since my last note on wether to post a ST80 goodie or not I have had many reponses mailed to me directly. All of them asked me to post it or otherwise mail it to them. I think this is plenty of justification, so here it is: Have fun, Pieter. '---------------------cut here---------------------'! 'This file implements a time-out mechanism for FillInTheBlanks and BinaryChoices. After fileIn, try (i.e. printIt): "FillInTheBlank exampleTimeOut" "BinaryChoice exampleTimeOut" If you respond in time, they will operate like you would expect: they will return respectively a String and a Boolean value. If time-out occurs they will return respectively nil and a "message" in stead of a String and a Boolean value. However, some methods like (BinaryChoice class) <message:timeOut:onTimeOut:> allow you to specify aBlock to be executed "onTimeOut". This code should work on both ParcPlace and Tektronix versions of Smalltalk, but no guarantees..... To beautify the code you could replace the lines containing "PP-V2.3" or "TB2.2.2a" to the code relevant to the version you are actually using. Some of the methods are quit similar to already available BinaryChoice and FillInTheBlanks methods, which resulted in long comments and long methods (and I definetely do not want to take credit for those). If you modify these sources and feel it would be benificial to others who use this, or if you fix a bug, please send me the change: Pieter S. van der Meulen (UUCP: pieter@prls) Signetics div. of NAPC, MS 02 811 E. Arques Avenue. P.O.Box 3409 Sunnyvale, California 94088-3409,USA'! BinaryChoiceController subclass: #TimedChoiceController instanceVariableNames: 'timer timeOut ' classVariableNames: '' poolDictionaries: '' category: 'Interface-Prompt/Confirm'! TimedChoiceController comment: 'I am implemented in order to allow TimeOut mechanisms in FillInTheBlanks and BinaryChoices. I behave like the BinaryCoiceController, except that control is not only given up if the model responds true to the message actionTaken, but also if no response has been observed for a certain amount of time. The TimeOut mechanism for FillInTheBlanks and BinaryChoices was written by Pieter S. van der Meulen." Instance variables: timer Implements a milli-seconds timer and is set to the current Time. timeOut Specifies the amount of milli-seconds before TimeOut should take place.'! !TimedChoiceController methodsFor: 'accessing'! setTimer "Set the timer to the current Time. May be used to reset the timeOut." timer _ Time millisecondClockValue! timeLeft "Return the number of milliSeconds left till timeOut. Return exactly zero if the timers are not initialized, in which case I will act like BinaryChoiceController." (timeOut isNil or: [timer isNil]) ifTrue: [^0]. ^timeOut - Time millisecondClockValue + timer! timeOut: milliSec "Do not allow any timeOut shorter than 1 second or longer that 1 minute. You may want to overwrite this, but be careful: Users may think they are dealing with seconds in stead of milli-seconds." timeOut _ (milliSec max: 1000) min: 60000! ! !TimedChoiceController methodsFor: 'control defaults'! isControlActive self timeLeft < 0 ifTrue: [^false]. model actionTaken ifTrue: [^false]. (view containsPoint: sensor cursorPoint) ifFalse: [view flash]. ^true! ! !BinaryChoiceView class methodsFor: 'private'! buildSwitchesFor: aBinaryChoice width: anInteger timeOut: milliSeconds "This method should work on both PP and Tek versions of Smalltalk, but in order to enable that we have to do some obscure coding. The TimeOut mechanism was written by Pieter S. van der Meulen." |switchView yesSwitchView noSwitchView| switchView _ View new model: aBinaryChoice. switchView controller: TimedChoiceController new. switchView controller timeOut: milliSeconds. yesSwitchView _ SwitchView new model: aBinaryChoice. yesSwitchView borderWidthLeft: 0 right: 2 top: 0 bottom: 0. yesSwitchView selector: #active. yesSwitchView controller selector: #selectTrue. yesSwitchView controller cursor: ((Cursor respondsTo: #thumbsUp) ifTrue: [Cursor thumbsUp] "PP-V2.3" ifFalse: [classPool at: #ThumbsUp]). "TB2.2.2a" yesSwitchView label: 'yes' asParagraph. yesSwitchView window: (0@0 extent: anInteger//2 @ yesSwitchView window height). noSwitchView _ SwitchView new model: aBinaryChoice. noSwitchView selector: #active. noSwitchView controller selector: #selectFalse. noSwitchView controller cursor: ((Cursor respondsTo: #thumbsUp) ifTrue: [Cursor thumbsDown] "PP-V2.3" ifFalse: [classPool at: #ThumbsDown]). "TB2.2.2a" noSwitchView label: 'no' asParagraph. noSwitchView window: (0@0 extent: anInteger//2 @ noSwitchView window height). switchView addSubView: yesSwitchView. switchView addSubView: noSwitchView toRightOf: yesSwitchView. switchView borderWidthLeft: 0 right: 0 top: 2 bottom: 0. ^switchView! ! !BinaryChoiceView class methodsFor: 'instance creation'! openOn: aBinaryChoice message: messageString displayAt: originPoint centered: centered timeOut: milliSeconds "Answer an instance of me that displays aBinaryChoice asking the question messageString. If the argument centered, a Boolean, is false, display the instance with top left corner at originPoint; otherwise, display it with its center at originPoint. If necessary, translate so the view is completely on the screen. Do not schedule, rather take control immediately and insist that the user respond. If the user waits longer than anInteger seconds, return nil. The TimeOut mechanism was written by Pieter S. van der Meulen." | topView messageView switchView savedArea | messageView _ ((DisplayTextView respondsTo: #editParagraph:) ifTrue: [DisplayTextView new editParagraph: messageString asParagraph] "PP-V2.3" ifFalse: [DisplayTextView new model: messageString asDisplayText]). "TB2.2.2a" messageView insideColor: Form white. messageView controller: NoController new. messageView centered. switchView _ self buildSwitchesFor: aBinaryChoice width: messageView window width timeOut: milliSeconds. topView _ self new model: aBinaryChoice. topView addSubView: messageView. topView addSubView: switchView below: messageView. topView align: (centered ifTrue: [switchView viewport center] ifFalse: [topView viewport topLeft]) with: originPoint. topView borderWidth: 2. topView translateBy: (topView displayBox amountToTranslateWithin: Display boundingBox). topView insideColor: Form white. savedArea _ Form fromDisplay: topView displayBox. topView display. switchView controller setTimer. topView controller: TimedChoiceController new. topView controller timeOut: milliSeconds. topView controller setTimer; startUp. topView release. savedArea displayOn: Display at: topView viewport topLeft! ! !BinaryChoice class methodsFor: 'instance creation'! message: messageString displayAt: aPoint centered: centered ifTrue: trueAlternative ifFalse: falseAlternative timeOut: milliSeconds "Answer an instance of me whose question is messageString. If the user answer is yes, then evaluate trueAlternative. If the user answer is no, evaluate falseAlternative. If centered, a Boolean, is false, display the view of the instance at aPoint; otherwise display it with its center at aPoint. If the user waits longer than anInteger seconds, return nil. The TimeOut mechanism was written by Pieter S. van der Meulen." | newChoice | newChoice _ self new initialize. newChoice trueAction: trueAlternative. newChoice falseAction: falseAlternative. BinaryChoiceView openOn: newChoice message: messageString displayAt: aPoint centered: centered timeOut: milliSeconds! message: messageString timeOut: milliSeconds onTimeOut: aBlock "Answer an instance of me whose question is messageString. If the user answer is yes, then return true. If the user answer is no, return false. Display the view of the instance at the cursor location. If the user waits longer than anInteger seconds, evaluate aBlock and return the result. The TimeOut mechanism was written by Pieter S. van der Meulen." | answer | self message: messageString displayAt: Sensor cursorPoint centered: true ifTrue: [answer _ true] ifFalse: [answer _ false] timeOut: milliSeconds. answer isNil ifTrue: [^aBlock value]. ^answer! message: messageString timeOut: milliSeconds "Answer an instance of me whose question is messageString. If the user answer is yes, then return true. If the user answer is no, return false. Display the view of the instance at the cursor location. If the user waits longer than anInteger seconds, return nil. The TimeOut mechanism was written by Pieter S. van der Meulen." | answer | self message: messageString displayAt: Sensor cursorPoint centered: true ifTrue: [answer _ true] ifFalse: [answer _ false] timeOut: milliSeconds. ^answer! ! !BinaryChoice class methodsFor: 'examples'! exampleTimeOut ^BinaryChoice message: 'Do you have quick reflexes' timeOut: 1000 onTimeOut: ['I gues not :-)'] "BinaryChoice exampleTimeOut."! ! CRFillInTheBlankController subclass: #TCRFillInTheBlankController instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Interface-Prompt/Confirm'! TCRFillInTheBlankController comment: 'The T stands for TimeOut: I am implemented in order to allow time-out mechanisms in FillInTheBlanks. I overwrite the <isControlActive> method of my superClass. Assuming my view has a superView, I check wether that superViews controller <isControlActive> and if it is not, I consider myself also as not active anymore. This is true, even if my model has not taken any action yet. The TimeOut mechanism for FillInTheBlanks and BinaryChoices was written by Pieter S. van der Meulen.'! !TCRFillInTheBlankController methodsFor: 'control defaults'! isControlActive view superView controller isControlActive ifFalse: [^false]. ^super isControlActive! ! !FillInTheBlankView class methodsFor: 'instance creation'! "Answer an instance of me on the model aFillInTheBlank asking the question messageString. If the argument centered, a Boolean, is false, display the instance with top left corner at originPoint; otherwise, display it with its center at originPoint. If necessary, translate so the view is completely on the screen. If the user waits longer than anInteger seconds, return nil. The TimeOut mechanism was written by Pieter S. van der Meulen." on: aFillInTheBlank message: messageString displayAt: originPoint centered: centered useCRController: useCRController timeOut: milliSeconds | topView messageView answerView | messageView _ self buildMessageView: messageString. answerView _ self buildAnswerView: aFillInTheBlank frameWidth: messageView window width. useCRController ifTrue: [answerView controller: TCRFillInTheBlankController new]. topView _ View new model: aFillInTheBlank. topView controller: TimedChoiceController new. topView controller timeOut: milliSeconds. topView addSubView: messageView. topView addSubView: answerView below: messageView. topView align: (centered ifTrue: [topView viewport center] ifFalse: [topView viewport topLeft]) with: originPoint. topView window: (0 @ 0 extent: messageView window width @ (messageView window height + answerView window height)). topView translateBy: (topView displayBox amountToTranslateWithin: Display boundingBox). ^topView! ! !FillInTheBlank class methodsFor: 'instance creation'! request: messageString displayAt: aPoint centered: centered action: aBlock initialAnswer: aString useCRController: useCRController timeOut: milliSeconds "Answer an instance of me whose question is messageString. Once the user provides an answer, then evaluate aBlock. If centered, a Boolean, is false, display the view of the instance at aPoint; otherwise display it with its center at aPoint. If the user waits longer than anInteger seconds, return nil. The TimeOut mechanism was written by Pieter S. van der Meulen." | newBlank fillInView savedArea | newBlank _ self new initialize. newBlank action: aBlock. newBlank contents: aString. fillInView _ FillInTheBlankView on: newBlank message: messageString displayAt: aPoint centered: centered useCRController: useCRController timeOut: milliSeconds. savedArea _ Form fromDisplay: fillInView displayBox. fillInView display. fillInView controller setTimer; centerCursorInView. fillInView controller startUp. fillInView release. savedArea displayOn: Display at: fillInView viewport topLeft! request: messageString initialAnswer: aString timeOut: milliSeconds "Create an instance of me whose question is messageString. Display it centered around the cursor. Supply aString as an initial answer. Simply return whatever the user accepts." | response | self request: messageString displayAt: Sensor cursorPoint centered: true action: [:resp | response _ resp] initialAnswer: aString useCRController: true timeOut: milliSeconds. ^response! request: messageString timeOut: milliSeconds "Create an instance of me whose question is messageString. Display it centered around the cursor. Simply return whatever the user accepts." ^self request: messageString initialAnswer: '' timeOut: milliSeconds! ! !FillInTheBlank class methodsFor: 'examples'! exampleTimeOut "FillInTheBlank exampleTimeOut." ^FillInTheBlank request: 'This message will self destruct after 5 seconds' initialAnswer: 'or if you hit return here......' timeOut: 5000! ! '---------------------cut here---------------------'! -- --------------------------------------------- P.S. van der Meulen, MS 02 prls!pieter PRLS, Signetics div. of NAPC ----------- 811 E.Arques Avenue, Sunnyvale, CA 94088-3409