The Trunk: Morphic-mt.1697.mcz

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@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.'!