[squeak-dev] The Trunk: Morphic-mt.1697.mczcommits at source.squeak.org commits at source.squeak.orgThu Oct 8 15:12:32 UTC 2020
Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1697.mcz ==================== Summary ==================== Name: Morphic-mt.1697 Author: mt Time: 8 October 2020, 5:12:27.351452 pm UUID: 09479921-7aa2-5e4b-b9d9-6b07134b2372 Ancestors: Morphic-mt.1696 Refactoring global Active(World|Hand|Event) variables to be actual DynamicVariable's. Step 1 of 2 -- Core refactoring to check whether system stays functional. All remaining references to the Active(World|Hand|Event) globals will be removed in a second step. See: http://forum.world.st/Changeset-Eliminating-global-state-from-Morphic-td5121690.html =============== Diff against Morphic-mt.1696 =============== Item was changed: + (PackageInfo named: 'Morphic') preamble: '"Turn off Morphic drawing because we are refactoring ActiveWorld, ActiveHand, and ActiveEvent." + Project current world setProperty: #shouldDisplayWorld toValue: false.'! - (PackageInfo named: 'Morphic') preamble: 'PluggableListMorph allSubInstancesDo: [:m | - m listMorph cellInset: 3 at 0].'! Item was added: + DynamicVariable subclass: #ActiveEventVariable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Worlds'! Item was added: + ----- Method: ActiveEventVariable class>>default (in category 'accessing') ----- + default + + ^ self currentHand ifNotNil: [:hand | hand lastEvent]! Item was added: + ----- Method: ActiveEventVariable class>>value:during: (in category 'accessing') ----- + value: anObject during: aBlock + "For backword compatibility with 5.3 and earlier, still maintain the original global variable." + + | priorEvent | + priorEvent := self value. + ActiveEvent := anObject. + ^ [super value: anObject during: aBlock] ensure: [ + ActiveEvent == anObject ifTrue: [ActiveEvent := priorEvent]]! Item was added: + DynamicVariable subclass: #ActiveHandVariable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Worlds'! Item was added: + ----- Method: ActiveHandVariable class>>default (in category 'accessing') ----- + default + + ^ self currentWorld primaryHand! Item was added: + ----- Method: ActiveHandVariable class>>value:during: (in category 'accessing') ----- + value: anObject during: aBlock + "For backword compatibility with 5.3 and earlier, still maintain the original global variable." + + | priorHand | + priorHand := self value. + ActiveHand := anObject. + ^ [super value: anObject during: aBlock] ensure: [ + ActiveHand == anObject ifTrue: [ActiveHand := priorHand]]! Item was added: + DynamicVariable subclass: #ActiveWorldVariable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Worlds'! Item was added: + ----- Method: ActiveWorldVariable class>>default (in category 'accessing') ----- + default + + ^ Project current world! Item was added: + ----- Method: ActiveWorldVariable class>>value:during: (in category 'accessing') ----- + value: anObject during: aBlock + "For backword compatibility with 5.3 and earlier, still maintain the original global variable." + + | priorWorld | + priorWorld := self value. + ActiveWorld := anObject. + ^ [super value: anObject during: aBlock] ensure: [ + ActiveWorld == anObject ifTrue: [ActiveWorld := priorWorld]]! Item was changed: ----- Method: HandMorph>>becomeActiveDuring: (in category 'initialization') ----- becomeActiveDuring: aBlock + "Make the receiver the active hand during the evaluation of aBlock." - "Make the receiver the ActiveHand during the evaluation of aBlock." + ^ ActiveHandVariable value: self during: aBlock! - | priorHand | - priorHand := ActiveHand. - ActiveHand := self. - ^ aBlock ensure: [ - "check to support project switching." - ActiveHand == self ifTrue: [ActiveHand := priorHand]].! Item was changed: ----- Method: HandMorph>>processEvents (in category 'event handling') ----- processEvents "Process user input events from the local input devices." | evt evtBuf type hadAny | + self currentEvent ~= lastMouseEvent ifTrue: [ + "Meaning that we were invoked from within an event response. + Make sure z-order is up to date." + self mouseOverHandler processMouseOver: lastMouseEvent]. + - ActiveEvent ifNotNil: - ["Meaning that we were invoked from within an event response. - Make sure z-order is up to date" - - self mouseOverHandler processMouseOver: lastMouseEvent]. hadAny := false. [(evtBuf := Sensor nextEvent) isNil] whileFalse: [evt := nil. "for unknown event types" type := evtBuf first. type = EventTypeMouse ifTrue: [evt := self generateMouseEvent: evtBuf]. type = EventTypeMouseWheel ifTrue: [evt := self generateMouseWheelEvent: evtBuf]. type = EventTypeKeyboard ifTrue: [evt := self generateKeyboardEvent: evtBuf]. type = EventTypeDragDropFiles ifTrue: [evt := self generateDropFilesEvent: evtBuf]. type = EventTypeWindow ifTrue:[evt := self generateWindowEvent: evtBuf]. "All other events are ignored" (type ~= EventTypeDragDropFiles and: [evt isNil]) ifTrue: [^self]. + evt ifNotNil: ["Finally, handle it." - evt isNil - ifFalse: - ["Finally, handle it" - self handleEvent: evt. hadAny := true. + - "For better user feedback, return immediately after a mouse event has been processed." + evt isMouse ifTrue: [^ self]]]. + - evt isMouse ifTrue: [^self]]]. "note: if we come here we didn't have any mouse events" + mouseClickState ifNotNil: [ + "No mouse events during this cycle. Make sure click states time out accordingly" + mouseClickState handleEvent: lastMouseEvent asMouseMove from: self]. + hadAny ifFalse: [ + "No pending events. Make sure z-order is up to date" + self mouseOverHandler processMouseOver: lastMouseEvent].! - mouseClickState notNil - ifTrue: - ["No mouse events during this cycle. Make sure click states time out accordingly" - - mouseClickState handleEvent: lastMouseEvent asMouseMove from: self]. - hadAny - ifFalse: - ["No pending events. Make sure z-order is up to date" - - self mouseOverHandler processMouseOver: lastMouseEvent]! Item was changed: ----- Method: Morph>>activeHand (in category 'structure') ----- activeHand + + self flag: #deprecated. "mt: Use #currentHand instead." + ^ self currentHand! - - ^ ActiveHand ifNil: [ - self isInWorld - ifTrue: [self world activeHand] - ifFalse: [nil]]! Item was changed: ----- Method: Morph>>primaryHand (in category 'structure') ----- primaryHand + ^ self currentWorld primaryHand! - | outer | - outer := self outermostWorldMorph ifNil: [^ nil]. - ^ outer activeHand ifNil: [outer firstHand]! Item was changed: ----- Method: MorphicEvent>>becomeActiveDuring: (in category 'initialize') ----- becomeActiveDuring: aBlock + "Make the receiver the active event during the evaluation of aBlock." - "Make the receiver the ActiveEvent during the evaluation of aBlock." + ^ ActiveEventVariable value: self during: aBlock! - | priorEvent | - priorEvent := ActiveEvent. - ActiveEvent := self. - ^ aBlock ensure: [ - "check to support project switching." - ActiveEvent == self ifTrue: [ActiveEvent := priorEvent]].! Item was changed: ----- Method: MorphicProject>>interruptCleanUpFor: (in category 'scheduling & debugging') ----- interruptCleanUpFor: interruptedProcess "Clean up things in case of a process interrupt." super interruptCleanUpFor: interruptedProcess. self uiProcess == interruptedProcess ifTrue: [ + self currentHand ifNotNil: [:hand | hand interrupted]. - ActiveHand ifNotNil: [ActiveHand interrupted]. - ActiveWorld := world. "reinstall active globals" - ActiveHand := world primaryHand. - ActiveHand interrupted. "make sure this one's interrupted too" - ActiveEvent := nil. - world removeProperty: #shouldDisplayWorld. + Preferences eToyFriendly ifTrue: [world stopRunningAll]].! - - Preferences eToyFriendly - ifTrue: [world stopRunningAll]].! Item was changed: + ----- Method: Object>>currentEvent (in category '*Morphic-Kernel-accessing') ----- - ----- Method: Object>>currentEvent (in category '*Morphic-Kernel') ----- currentEvent + "Answer the current MorphicEvent. Provided that a morphic project is loaded, this method never returns nil." + + ^ ActiveEventVariable value! - "Answer the current Morphic event. This method never returns nil." - ^ActiveEvent ifNil:[self currentHand lastEvent]! Item was changed: + ----- Method: Object>>currentHand (in category '*Morphic-Kernel-accessing') ----- - ----- Method: Object>>currentHand (in category '*Morphic-Kernel') ----- currentHand + "Answer the current HandMorph. Provided that a morphic project is loaded, this method will never return nil." - "Return a usable HandMorph -- the one associated with the object's current environment. This method will always return a hand, even if it has to conjure one up as a last resort. If a particular hand is actually handling events at the moment (such as a remote hand or a ghost hand), it will be returned." + ^ Project current isMorphic + ifTrue: [ActiveHandVariable value] + ifFalse: [Sensor "MVC/ST80 fallback"]! - ^ActiveHand ifNil: [ self currentWorld primaryHand ]! Item was changed: + ----- Method: Object>>currentWorld (in category '*Morphic-Kernel-accessing') ----- - ----- Method: Object>>currentWorld (in category '*Morphic-Kernel') ----- currentWorld + "Answer the current world. This method will never return nil." + + ^ ActiveWorldVariable value! - "Answer a morphic world that is the current UI focus." - ^ActiveWorld ifNil:[Project current world]! Item was removed: - ----- Method: PasteUpMorph>>activeHand (in category 'structure') ----- - activeHand - - ^ worldState - ifNotNil: [:ws | ws activeHand ifNil: [ws hands first]] - ifNil: [super activeHand]! Item was removed: - ----- Method: PasteUpMorph>>activeHand: (in category 'world state') ----- - activeHand: aHandMorph - "temporarily retained for old main event loops" - - worldState activeHand: aHandMorph. - - ! Item was changed: ----- Method: PasteUpMorph>>becomeActiveDuring: (in category 'initialization') ----- becomeActiveDuring: aBlock + "Make the receiver the active world during the evaluation of aBlock." - "Make the receiver the ActiveWorld during the evaluation of aBlock." + ^ ActiveWorldVariable value: self during: aBlock! - | priorWorld | - priorWorld := ActiveWorld. - ActiveWorld := self. - ^ aBlock ensure: [ - "check to support project switching." - ActiveWorld == self ifTrue: [ActiveWorld := priorWorld]].! Item was changed: ----- Method: PasteUpMorph>>install (in category 'world state') ----- install + owner := nil. "since we may have been inside another world previously" + - ActiveWorld := self. - ActiveHand := self hands first. "default" - ActiveEvent := nil. submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." self viewBox: Display boundingBox. EventSensor default flushEvents. 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.! Item was added: + ----- Method: PasteUpMorph>>primaryHand (in category 'structure') ----- + primaryHand + + ^ self hands at: 1 ifAbsent: [nil]! Item was changed: ----- Method: PasteUpMorph>>processEvent:using: (in category 'events-processing') ----- processEvent: anEvent using: defaultDispatcher + "Reimplemented to install the receiver as the new active world if it is one" + + self isWorldMorph ifFalse: [ + ^ super processEvent: anEvent using: defaultDispatcher]. + + ^ self becomeActiveDuring: [ + super processEvent: anEvent using: defaultDispatcher]! - "Reimplemented to install the receiver as the new ActiveWorld if it is one" - | priorWorld result | - self isWorldMorph ifFalse:[^super processEvent: anEvent using: defaultDispatcher]. - priorWorld := ActiveWorld. - ActiveWorld := self. - [result := super processEvent: anEvent using: defaultDispatcher] - ensure: [ActiveWorld := priorWorld]. - ^result - ! Item was removed: - ----- Method: WorldState>>activeHand (in category 'hands') ----- - activeHand - - ^ ActiveHand! Item was changed: ----- Method: WorldState>>doOneCycleNowFor: (in category 'update cycle') ----- doOneCycleNowFor: aWorld "Immediately do one cycle of the interaction loop. This should not be called directly, but only via doOneCycleFor:" | capturingGesture | DisplayScreen checkForNewScreenSize. capturingGesture := false. "self flag: #bob. " "need to consider remote hands in lower worlds" + - "process user input events" LastCycleTime := Time millisecondClockValue. + self handsDo: [:hand | + hand becomeActiveDuring: [ + hand processEvents. + capturingGesture := capturingGesture or: [hand isCapturingGesturePoints]]]. + - self handsDo: [:h | - ActiveHand := h. - h processEvents. - capturingGesture := capturingGesture or: [ h isCapturingGesturePoints ]. - ActiveHand := nil - ]. - - "the default is the primary hand" - ActiveHand := self hands first. - "The gesture recognizer needs enough points to be accurate. Therefore morph stepping is disabled while capturing points for the recognizer" + capturingGesture ifFalse: [ + aWorld runStepMethods. "there are currently some variations here" + self displayWorldSafely: aWorld].! - capturingGesture ifFalse: - [aWorld runStepMethods. "there are currently some variations here" - self displayWorldSafely: aWorld]. - ! Item was changed: ----- Method: WorldState>>doOneSubCycleFor: (in category 'update cycle') ----- doOneSubCycleFor: aWorld - "Like doOneCycle, but preserves activeHand." + self flag: #deprecate. "ct: Historically, global state was preserved here. Since the introduction of ActiveHandVariable, this is no longer necessary, so this is equivalent to #doOneCycleFor:. However, let's keep this possibly valuable hook for now." + + ^ self doOneCycleFor: aWorld! - | currentHand | - currentHand := ActiveHand. - self doOneCycleFor: aWorld. - ActiveHand := currentHand! Item was added: + ----- Method: WorldState>>primaryHand (in category 'hands') ----- + primaryHand + + self flag: #deprecated. "ct: Send #primaryHand to #currentWorld instead." + ^ self currentWorld primaryHand! Item was changed: ----- Method: WorldState>>removeHand: (in category 'hands') ----- removeHand: aHandMorph "Remove the given hand from the list of hands for this world." + (hands includes: aHandMorph) ifFalse: [^ self]. + self currentHand == aHandMorph ifTrue: [ + self flag: #invalidate. "ct: Should we try to clear ActiveHandVariable here or doesn't this matter? In past, ActiveHand was set to nil at this point."]. + hands := hands copyWithout: aHandMorph.! - (hands includes: aHandMorph) ifFalse: [^self]. - hands := hands copyWithout: aHandMorph. - ActiveHand == aHandMorph ifTrue: [ActiveHand := nil]. - ! Item was changed: ----- Method: WorldState>>runLocalStepMethodsIn: (in category 'stepping') ----- runLocalStepMethodsIn: aWorld "Run morph 'step' methods (LOCAL TO THIS WORLD) whose time has come. Purge any morphs that are no longer in this world. ar 3/13/1999: Remove buggy morphs from the step list so that they don't raise repeated errors." + | now morphToStep stepTime | - | now morphToStep stepTime priorWorld | now := Time millisecondClockValue. + + aWorld becomeActiveDuring: [ + self triggerAlarmsBefore: now. + + stepList ifEmpty: [^ self]. + + (now < lastStepTime or: [now - lastStepTime > 5000]) ifTrue: [ + self adjustWakeupTimes: now]. "clock slipped" + + [stepList notEmpty and: [stepList first scheduledTime < now]] whileTrue: [ + lastStepMessage := stepList removeFirst. - priorWorld := ActiveWorld. - ActiveWorld := aWorld. - self triggerAlarmsBefore: now. - stepList isEmpty - ifTrue: - [ActiveWorld := priorWorld. - ^self]. - (now < lastStepTime or: [now - lastStepTime > 5000]) - ifTrue: [self adjustWakeupTimes: now]. "clock slipped" - [stepList isEmpty not and: [stepList first scheduledTime < now]] - whileTrue: - [lastStepMessage := stepList removeFirst. morphToStep := lastStepMessage receiver. + (morphToStep shouldGetStepsFrom: aWorld) ifTrue: [ + lastStepMessage value: now. + lastStepMessage ifNotNil: [ + stepTime := lastStepMessage stepTime ifNil: [morphToStep stepTime]. + lastStepMessage scheduledTime: now + (stepTime max: 1). + stepList add: lastStepMessage]]. - (morphToStep shouldGetStepsFrom: aWorld) - ifTrue: - [lastStepMessage value: now. - lastStepMessage ifNotNil: - [stepTime := lastStepMessage stepTime ifNil: [morphToStep stepTime]. - lastStepMessage scheduledTime: now + (stepTime max: 1). - stepList add: lastStepMessage]]. lastStepMessage := nil]. + + lastStepTime := now].! - lastStepTime := now. - ActiveWorld := priorWorld! Item was changed: + (PackageInfo named: 'Morphic') postscript: '"Turn on Morphic drawing again." + Project current world removeProperty: #shouldDisplayWorld.'! - (PackageInfo named: 'Morphic') postscript: 'Smalltalk removeFromStartUpList: PasteUpMorph. - Smalltalk removeFromShutDownList: PasteUpMorph.'!
More information about the Squeak-dev mailing list |