'From Squeak3.1alpha of 4 February 2001 [latest update: #3575] on 12 February 2001 at 7:05:04 pm'! "Change Set: ScriptTicks Date: 12 February 2001 Author: Andreas Raab Adds a little clock to each script so that it's ticking rate (e.g., the number of ticks per second) can be adjusted."! Object subclass: #ScriptInstantiation instanceVariableNames: 'player selector status frequency anonymous lastTick tickingRate ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Scripting'! EllipseMorph subclass: #TickIndicatorMorph instanceVariableNames: 'stepTime corners index range isTicking lastTick ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Widgets'! !Morph methodsFor: 'stepping and presenter' stamp: 'ar 2/12/2001 17:04'! step "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message. The generic version dispatches control to the player, if any. The nasty circumlocation about owner's transformation is necessitated by the flexing problem that the player remains in the properties dictionary both of the flex and the real morph. In the current architecture, only the top renderer's pointer to the player should actually be honored for the purpose of firing." ! ! !Morph methodsFor: 'stepping and presenter' stamp: 'ar 2/12/2001 18:05'! stepAt: millisecondClockValue "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message. The millisecondClockValue parameter gives the value of the millisecond clock at the moment of dispatch. Default is to dispatch to the parameterless step method for the morph, but this protocol makes it possible for some morphs to do differing things depending on the clock value" self player ifNotNilDo:[:p| p stepAt: millisecondClockValue]. self step ! ! !PasteUpMorph methodsFor: 'world state' stamp: 'ar 2/12/2001 18:57'! install owner _ nil. "since we may have been inside another world previously" submorphs do: [:ss | ss owner == nil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." self viewBox: Display boundingBox. Sensor eventQueue: SharedQueue new. worldState handsDo: [:h | h initForEvents]. self installFlaps. self borderWidth: 0. "default" (Preferences showSecurityStatus and:[SecurityManager default isInRestrictedMode]) ifTrue:[self borderWidth: 2; borderColor: Color red]. self presenter allExtantPlayers do:[:player| player prepareToBeRunning]. SystemWindow noteTopWindowIn: self. self displayWorldSafely. ! ! !Player methodsFor: 'scripts-execution' stamp: 'ar 2/12/2001 18:57'! prepareToBeRunning self instantiatedUserScriptsDo: [:aScriptInstantiation | aScriptInstantiation prepareToBeRunning].! ! !Player methodsFor: 'scripts-execution' stamp: 'ar 2/12/2001 18:04'! runAllTickingScripts: nowTick self instantiatedUserScriptsDo: [:aScriptInstantiation | aScriptInstantiation runIfTicking: nowTick]! ! !Player methodsFor: 'scripts-execution' stamp: 'ar 2/12/2001 18:50'! step "obsolete" ^self stepAt: Time millisecondClockValue.! ! !Player methodsFor: 'scripts-execution' stamp: 'ar 2/12/2001 18:04'! stepAt: nowTick self runAllTickingScripts: nowTick! ! !ScriptInstantiation methodsFor: 'running' stamp: 'ar 2/12/2001 18:28'! runIfTicking: nowTick | ticks rate | status == #ticking ifFalse:[^self]. rate _ self tickingRate. (lastTick == nil or:[nowTick < lastTick]) ifTrue:[lastTick _ nowTick. ticks _ 1] ifFalse:[ticks _ (nowTick - lastTick * rate / 1000) asInteger]. ticks <= 0 ifTrue:[^self]. 1 to: ticks * self frequency do:[:i | player perform: selector]. lastTick _ nowTick. ticks > 10 ifTrue:[ "check if we're lagging behind" (ticks <= (Time millisecondClockValue - lastTick * rate / 1000) asInteger) ifTrue:[ "e.g., time to run script is higher than number of ticks" self status: #paused. self updateAllStatusMorphs. ]. ].! ! !ScriptInstantiation methodsFor: 'running' stamp: 'ar 2/12/2001 17:00'! startRunningIfPaused "If the receiver is paused, start it ticking" status == #paused ifTrue: [self status: #ticking. self updateAllStatusMorphs]! ! !ScriptInstantiation methodsFor: 'running' stamp: 'ar 2/12/2001 17:00'! stopTicking "If I'm ticking stop, else do nothing" status == #ticking ifTrue: [self status: #paused. self updateAllStatusMorphs]! ! !ScriptInstantiation methodsFor: 'misc' stamp: 'ar 2/12/2001 18:58'! prepareToBeRunning lastTick _ nil.! ! !ScriptInstantiation methodsFor: 'frequency' stamp: 'ar 2/12/2001 18:26'! tickingRate "Return the number of ticks per second this script should get" ^tickingRate ifNil:[8]! ! !ScriptInstantiation methodsFor: 'frequency' stamp: 'ar 2/12/2001 18:26'! tickingRate: aNumber "See the comment in #tickingRate" tickingRate _ aNumber. self updateAllStatusMorphs.! ! !ScriptInstantiation methodsFor: 'status control' stamp: 'ar 2/12/2001 18:46'! presentTickingMenu "Put up a menu of status alternatives and carry out the request" | aMenu ticks item any | ticks _ self tickingRate. ticks = ticks asInteger ifTrue:[ticks _ ticks asInteger]. aMenu _ MenuMorph new defaultTarget: self. any _ false. #(1 2 5 8 10 25 50 100) do:[:i | item _ aMenu addUpdating: nil target: self selector: #tickingRate: argumentList: {i}. item contents: ((ticks = i) ifTrue:[ any _ true. '', i printString] ifFalse:['', i printString])]. item _ aMenu addUpdating: nil target: self selector: #typeInTickingRate argumentList: #(). item contents: (any ifTrue:[''] ifFalse:['']), 'other...'. aMenu addTitle: 'Ticks (now: ', ticks printString, '/sec)'. aMenu popUpEvent: self currentEvent in: self currentWorld! ! !ScriptInstantiation methodsFor: 'status control' stamp: 'ar 2/12/2001 18:06'! status: newStatus | stati actualMorph | actualMorph _ player costume renderedMorph. stati _ ScriptingSystem standardEventStati. (stati includes: status) ifTrue:[ actualMorph on: status send: nil to: nil. "remove old link in event handler" status == #mouseStillDown ifTrue:[actualMorph on: #mouseDown send: nil to: nil]]. (stati includes: newStatus) ifTrue:[ actualMorph on: newStatus send: selector to: player. "establish new link in evt handler" newStatus == #mouseStillDown ifTrue:[actualMorph on: #mouseDown send: selector to: player]]. status _ newStatus. (status == #ticking or:[status == #paused]) ifTrue: [lastTick _ nil]. ! ! !ScriptInstantiation methodsFor: 'status control' stamp: 'ar 2/12/2001 16:58'! typeInTickingRate | reply aNumber | reply _ FillInTheBlank request: 'Number of ticks per second: ' initialAnswer: self tickingRate printString. reply ifNotNil: [aNumber _ reply asNumber. aNumber > 0 ifTrue: [self tickingRate: aNumber]]! ! !ScriptStatusControl methodsFor: 'initialization' stamp: 'ar 2/12/2001 18:39'! assurePauseTickControlsShow "Add two little buttons that allow the user quickly to toggle between paused and ticking state" | colorSelector status | self beTransparent. (tickPauseWrapper isKindOf: TickIndicatorMorph) ifFalse:[ "this was an old guy" tickPauseWrapper ifNotNil:[tickPauseWrapper delete]. tickPauseWrapper _ TickIndicatorMorph new. tickPauseWrapper on: #mouseDown send: #mouseDownTick:onItem: to: self. tickPauseWrapper on: #mouseUp send: #mouseUpTick:onItem: to: self. tickPauseWrapper setBalloonText:'Press to toggle ticking state. Hold down to set tick rate.'. self addMorphFront: tickPauseWrapper. ]. status _ scriptInstantiation status. colorSelector _ ScriptingSystem statusColorSymbolFor: status. tickPauseWrapper color: (Color perform: colorSelector) muchLighter. tickPauseWrapper stepTime: (1000 // scriptInstantiation tickingRate max: 0). tickPauseWrapper isTicking: status == #ticking. tickPauseButtonsShowing _ true.! ! !ScriptStatusControl methodsFor: 'initialization' stamp: 'ar 2/12/2001 18:19'! initializeFor: aScriptInstantiation "Answer a control that will serve to reflect and allow the user to change the status of the receiver" | statusReadout | self hResizing: #shrinkWrap. self cellInset: 2@0. scriptInstantiation _ aScriptInstantiation. tickPauseButtonsShowing _ false. self addMorphBack: (statusReadout _ UpdatingSimpleButtonMorph new). statusReadout setNameTo: 'trigger'. statusReadout target: aScriptInstantiation; wordingSelector: #status; actionSelector: #presentScriptStatusPopUp. statusReadout setBalloonText: 'when this script should run'. statusReadout actWhen: #buttonDown. self assurePauseTickControlsShow. aScriptInstantiation updateStatusMorph: self! ! !ScriptStatusControl methodsFor: 'initialization' stamp: 'ar 2/12/2001 18:24'! maybeRemovePauseTickControls "If we're in the business of removing pauseTick controls when we're neither paused nor ticking, then do it now. The present take is not to remove these controls, which explains why the body of this method is currently commented out." tickPauseButtonsShowing _ false. "note: the following is to change color of the tick control appropriately" self assurePauseTickControlsShow.! ! !ScriptStatusControl methodsFor: 'mouse gestures' stamp: 'ar 2/11/2001 20:37'! mouseDownTick: evt onItem: aMorph aMorph color: Color veryLightGray. self addAlarm: #offerTickingMenu: with: aMorph after: 200.! ! !ScriptStatusControl methodsFor: 'mouse gestures' stamp: 'ar 2/11/2001 21:02'! mouseUpTick: evt onItem: aMorph self removeAlarm: #offerTickingMenu:. aMorph color: (Color r: 0.767 g: 0.767 b: 1.0). (scriptInstantiation status == #ticking) ifTrue:[ scriptInstantiation status: #paused. aMorph color: (Color r: 1.0 g: 0.774 b: 0.774). aMorph isTicking: false. ] ifFalse:[ scriptInstantiation status: #ticking. aMorph color: (Color r: 0.767 g: 0.767 b: 1.0). aMorph isTicking: true. ]. scriptInstantiation updateAllStatusMorphs.! ! !ScriptStatusControl methodsFor: 'mouse gestures' stamp: 'ar 2/12/2001 18:40'! offerTickingMenu: aMorph self assurePauseTickControlsShow. "to set the color" ^scriptInstantiation presentTickingMenu! ! !TickIndicatorMorph methodsFor: 'initialization' stamp: 'ar 2/12/2001 18:10'! initialize super initialize. self borderWidth: 1. self borderColor: (Color r: 0.333 g: 0.667 b: 0.5). self color: (Color r: 0.767 g: 0.767 b: 1.0). self extent: 20@20. index _ 0.! ! !TickIndicatorMorph methodsFor: 'accessing' stamp: 'ar 2/11/2001 19:48'! color: aColor super color: aColor. self borderColor: aColor darker.! ! !TickIndicatorMorph methodsFor: 'accessing' stamp: 'ar 2/11/2001 20:31'! isTicking ^isTicking ifNil:[false].! ! !TickIndicatorMorph methodsFor: 'accessing' stamp: 'ar 2/11/2001 20:32'! isTicking: aBool isTicking _ aBool.! ! !TickIndicatorMorph methodsFor: 'accessing' stamp: 'ar 2/12/2001 17:40'! stepTime: aNumber stepTime _ aNumber max: 1.! ! !TickIndicatorMorph methodsFor: 'stepping' stamp: 'ar 2/12/2001 17:52'! stepAt: nowTick | delta | self isTicking ifTrue:[ (lastTick == nil or:[nowTick < lastTick]) ifTrue:[lastTick _ nowTick]. delta _ (nowTick - lastTick) // stepTime. delta > 0 ifTrue:[ index _ index + delta. lastTick _ nowTick. self changed. ]. ].! ! !TickIndicatorMorph methodsFor: 'stepping' stamp: 'ar 2/12/2001 17:53'! stepTime ^(stepTime ifNil:[125]) max: 50! ! !TickIndicatorMorph methodsFor: 'stepping' stamp: 'ar 2/11/2001 19:14'! wantsSteps ^true! ! !TickIndicatorMorph methodsFor: 'drawing' stamp: 'ar 2/12/2001 17:50'! drawOn: aCanvas | r center cc deg | super drawOn: aCanvas. corners ifNil:[ r _ (bounds topCenter - bounds center) r - 2. corners _ Array new: 32. 1 to: corners size do:[:i| deg _ 360.0 / corners size * (i-1). corners at: i put: (Point r: r degrees: deg-90) asIntegerPoint]]. index _ index \\ corners size. cc _ color darker. center _ bounds center. 1 to: corners size by: 4 do:[:i| aCanvas fillRectangle: (center + (corners at: i)-2 extent: 4@4) color: cc. ]. cc _ cc darker. aCanvas line: center to: center + (corners at: index + 1) width: 2 color: cc.! ! !TickIndicatorMorph methodsFor: 'geometry' stamp: 'ar 2/11/2001 20:12'! extent: aPoint super extent: ((aPoint x max: aPoint y) asInteger bitClear: 3) asPoint. corners _ nil.! ! !TickIndicatorMorph methodsFor: 'geometry' stamp: 'ar 2/11/2001 19:22'! privateMoveBy: delta corners _ nil. super privateMoveBy: delta! ! ScriptInstantiation removeSelector: #runIfTicking! Object subclass: #ScriptInstantiation instanceVariableNames: 'player selector status frequency anonymous tickingRate lastTick ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Scripting'! Player removeSelector: #runAllTickingScripts!