The Trunk: EToys-dtl.313.mcz

David T. Lewis uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-dtl.313.mcz

==================== Summary ====================

Name: EToys-dtl.313
Author: dtl
Time: 25 November 2017, 9:54:37.052975 am
UUID: af30c57e-305f-4ee3-bf9a-c8e8e46c8b3f
Ancestors: EToys-bp.312

Remove most direct references to global World for Etoys.
Still to be done: Remove the World references in SyntaxMorph and WiWPasteUpMorph.

=============== Diff against EToys-bp.312 ===============

Item was changed:
  ----- Method: DisplayScreen class>>restoreDisplay (in category '*Etoys-Squeakland-screen modes') -----
  restoreDisplay
  "Clear the screen to gray and then redisplay all the scheduled views."
 
+ Smalltalk isMorphic ifTrue: [^ Project current world restoreMorphicDisplay].
- Smalltalk isMorphic ifTrue: [^ World restoreMorphicDisplay].
 
  Display extent = DisplayScreen actualScreenSize
  ifFalse:
  [DisplayScreen startUp.
  ScheduledControllers unCacheWindows].
  ScheduledControllers restore!

Item was changed:
  ----- Method: EToysLauncher>>onEnterWorld (in category 'event handling') -----
  onEnterWorld
  (owner notNil
+ and: [Project current world == owner])
- and: [World == owner])
  ifTrue: [owner addMorphInLayer: self.
  self updatePane]
+ ifFalse: [Project current world removeActionsWithReceiver: self]!
- ifFalse: [World removeActionsWithReceiver: self]!

Item was changed:
  ----- Method: EtoysDebugger>>highlight: (in category 'highlighting') -----
  highlight: aMorph
  "| rect |
  rect := BorderedMorph newBounds: aMorph bounds color: Color transparent.
  rect openInWorld.
+ Project current world addAlarm: #delete
- World addAlarm: #delete
  withArguments: #()
  for: rect
  at: (Time millisecondClockValue + 200)."
  highlighter ifNotNil: [highlighter delete].
  highlighter := HighlightMorph on: aMorph.
  highlighter openInWorld!

Item was changed:
  ----- Method: EtoysDebugger>>trailMorph (in category 'accessing') -----
  trailMorph
+ ^ self scriptedPlayer costume ifNil: [Project current world] ifNotNil: [:m | m trailMorph]!
- ^ self scriptedPlayer costume ifNil: [World] ifNotNil: [:m | m trailMorph]!

Item was changed:
  ----- Method: FileList2 class>>findAProjectSimple (in category '*Etoys-Squeakland-blue ui') -----
  findAProjectSimple
  "self findAProjectSimple"
  ^ self
+ morphicViewProjectLoader2InWorld: Project current world
- morphicViewProjectLoader2InWorld: World
  reallyLoad: true
  dirFilterType: #limitedSuperSwikiDirectoryList!

Item was changed:
  ----- Method: HTTPProxyEditor class>>activateWindow: (in category 'instance creation') -----
  activateWindow: aWindow
  "private - activate the window"
+ | world |
+ world := Project current world.
  aWindow
+ right: (aWindow right min: world bounds right);
+ bottom: (aWindow bottom min: world bounds bottom);
+ left: (aWindow left max: world bounds left);
+ top: (aWindow top max: world bounds top).
+ aWindow comeToFront; flash!
- right: (aWindow right min: World bounds right).
- aWindow
- bottom: (aWindow bottom min: World bounds bottom).
- aWindow
- left: (aWindow left max: World bounds left).
- aWindow
- top: (aWindow top max: World bounds top).
- ""
- aWindow comeToFront.
- aWindow flash!

Item was changed:
  ----- Method: HTTPProxyEditor class>>open (in category 'instance creation') -----
  open
  "open the receiver"
+ Project current world submorphs
+ do: [:each | (each isKindOf: self)
+ ifTrue: [self activateWindow: each.
- World submorphs
- do: [:each | ""
- ((each isKindOf: self)
- )
- ifTrue: [""
- self activateWindow: each.
  ^ self]].
- ""
  ^ self new openInWorld!

Item was changed:
  ----- Method: KedamaMorph>>initialize (in category 'initialization') -----
  initialize
 
  super initialize.
  drawRequested := true.
  changePending := false.
+ pixelsPerPatch := (Project current world width min: Project current world height)
+ // (self class defaultDimensions x * 2). "heuristic..."
- pixelsPerPatch := (World width min: World height) // (self class defaultDimensions x * 2). "heuristic..."
  self dimensions: self class defaultDimensions.  "dimensions of this StarSqueak world in patches"
  super extent: dimensions * pixelsPerPatch.
  self assuredPlayer assureUniClass.
  self clearAll.  "be sure this is done once in case setup fails to do it"
  autoChanged := true.
  self leftEdgeMode: #wrap.
  self rightEdgeMode: #wrap.
  self topEdgeMode: #wrap.
  self bottomEdgeMode: #wrap.
 
  turtlesDictSemaphore := Semaphore forMutualExclusion.
  !

Item was changed:
  ----- Method: Morph>>asWearableCostume (in category '*Etoys-support') -----
  asWearableCostume
  "Return a wearable costume for some player"
+ ^(Project current world drawingClass withForm: self imageForm) copyCostumeStateFrom: self!
- ^(World drawingClass withForm: self imageForm) copyCostumeStateFrom: self!

Item was changed:
  ----- Method: Morph>>showDesignationsOfObjects (in category '*Etoys-card in a stack') -----
  showDesignationsOfObjects
  "Momentarily show the designations of objects on the receiver"
 
  | colorToUse |
  self isStackBackground ifFalse: [^self].
  self submorphsDo:
  [:aMorph | | aLabel |
  aLabel :=aMorph renderedMorph holdsSeparateDataForEachInstance
  ifTrue:
  [colorToUse := Color orange.
  aMorph externalName]
  ifFalse:
  [colorToUse := aMorph isShared ifFalse: [Color red] ifTrue: [Color green].
  nil].
  Display
  border: (aMorph fullBoundsInWorld insetBy: -6)
  width: 6
  rule: Form over
  fillColor: colorToUse.
  aLabel ifNotNil:
  [aLabel asString
  displayOn: Display
  at: aMorph fullBoundsInWorld bottomLeft + (0 @ 5)
  textColor: Color blue]].
  Sensor anyButtonPressed
  ifTrue: [Sensor waitNoButton]
  ifFalse: [Sensor waitButton].
+ self world fullRepaintNeeded!
- World fullRepaintNeeded!

Item was changed:
  ----- Method: MovingEyeMorph>>step (in category 'stepping and presenter') -----
  step
  | cp |
+ cp := self globalPointToLocal: self world primaryHand position.
- cp := self globalPointToLocal: World primaryHand position.
  (inner containsPoint: cp)
  ifTrue: [iris position: (cp - (iris extent // 2))]
  ifFalse: [self irisPos: cp].
  self changed "cover up gribblies if embedded in Flash"!

Item was changed:
  ----- Method: OLPCVirtualScreen>>checkForNewScreenSize (in category 'display') -----
  checkForNewScreenSize
  | aPoint |
  aPoint := DisplayScreen actualScreenSize.
  aPoint = display extent ifTrue:[^nil].
  display setExtent: aPoint depth: depth.
  display fillColor: (Color gray: 0.2).
  self setupWarp; forceToScreen.
  display forceToScreen. "to capture the borders"
+ Project current world restoreMorphicDisplay.
+ Project current world repositionFlapsAfterScreenSizeChange.!
- World restoreMorphicDisplay.
- World repositionFlapsAfterScreenSizeChange.!

Item was changed:
  ----- Method: OLPCVirtualScreen>>zoomOut: (in category 'display') -----
  zoomOut: aBoolean
 
  "When the physical display is bigger than the virtual display size, we have two options.  One is to zoom in and maximize the visible area and another is to map a pixel to a pixel and show it in smaller area (at the center of screen).  This flag governs them."
 
  self canZoomOut ifFalse: [^ self].
  zoomOut := aBoolean.
  display fillColor: (Color gray: 0.2).
  self setupWarp; forceToScreen.
  display forceToScreen. "to capture the borders"
+ Project current world restoreMorphicDisplay.
+ Project current world repositionFlapsAfterScreenSizeChange.
- World restoreMorphicDisplay.
- World repositionFlapsAfterScreenSizeChange.
  !

Item was changed:
  ----- Method: Player>>grabPatchMorph (in category 'slot-kedama') -----
  grabPatchMorph
 
+ Project current world primaryHand attachMorph: costume renderedMorph.
- World primaryHand attachMorph: costume renderedMorph.
  !

Item was changed:
  ----- Method: Project class>>interruptName:preemptedProcess: (in category '*Etoys-Squeakland-utilities') -----
  interruptName: labelString preemptedProcess: theInterruptedProcess
  "Create a Notifier on the active scheduling process with the given label."
  | preemptedProcess projectProcess |
  Smalltalk isMorphic ifFalse:
  [^ ScheduledControllers interruptName: labelString].
  ActiveHand ifNotNil:[ActiveHand interrupted].
+ ActiveWorld := Project current world. "reinstall active globals"
+ ActiveHand := ActiveWorld primaryHand.
- ActiveWorld := World. "reinstall active globals"
- ActiveHand := World primaryHand.
  ActiveHand interrupted. "make sure this one's interrupted too"
  ActiveEvent := nil.
 
  projectProcess := self uiProcess. "we still need the accessor for a while"
  preemptedProcess := theInterruptedProcess ifNil: [Processor preemptedProcess].
  "Only debug preempted process if its priority is >= projectProcess' priority"
  preemptedProcess priority < projectProcess priority
  ifTrue:[preemptedProcess := projectProcess].
  preemptedProcess suspend.
  Debugger openInterrupt: labelString onProcess: preemptedProcess
  !

Item was changed:
  ----- Method: ProjectLoading class>>loadSexpProjectDict:stream:fromDirectory:withProjectView: (in category '*etoys') -----
  loadSexpProjectDict: dict stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView
 
      | archive anObject newProj d member memberStream members newSet allNames realName oldSet s |
  (self checkStream: preStream) ifTrue: [^ nil].
  ProgressNotification signal: '0.2'.
  preStream reset.
  archive := preStream isZipArchive
  ifTrue:[ZipArchive new readFrom: preStream]
  ifFalse:[nil].
 
  members := archive  membersMatching: '*.cs'.
  members do: [:e | newSet := ChangeSorter newChangesFromStream: e contentStream named: 'zzTemp', Time totalSeconds printString].
 
  member := (archive membersMatching: '*.sexp') first.
  memberStream := member contentStream.
  (self checkSecurity: member name preStream: preStream projStream: memberStream)
  ifFalse: [^nil].
  self flag: #tfel. "load all projects and save them again in the new format, then get rid of the error block!!"
  s := memberStream basicUpToEnd.
  d := [(DataStream on: memberStream) next] on: Error do: [:e |
  (Smalltalk at: #MSExpParser) parse: s with: #ksexp].
  anObject := d sissReadObjectsAsEtoysProject.
  preStream close.
 
  "anObject := (MSExpParser parse: (archive membersMatching: '*.sexp') first contents with: #ksexp) sissReadObjects."
  anObject ifNil: [^ nil].
+ (anObject isKindOf: PasteUpMorph) ifFalse: [^ Project current world addMorph: anObject].
- (anObject isKindOf: PasteUpMorph) ifFalse: [^ World addMorph: anObject].
  ProgressNotification  signal: '0.7'.
  newProj := MorphicProject new.
  newProj installPasteUpAsWorld: anObject.
  newSet ifNotNil: [oldSet := newProj changeSet.  newProj setChangeSet: newSet. ChangeSorter removeChangeSet: oldSet].
  dict at: 'projectname' ifPresent: [:n |
  allNames := Project allNames.
  realName := Utilities keyLike: n  satisfying:
  [:nn | (allNames includes: nn) not].
  newProj renameTo: realName.
  ].
  anObject valueOfProperty: #projectVersion ifPresentDo: [:v | newProj version: v].
  newProj  noteManifestDetailsIn: dict.
  ProgressNotification  signal: '0.8'.
  ^ newProj.!

Item was changed:
  ----- Method: ScrollableField>>spawn: (in category '*Etoys-Squeakland-as yet unclassified') -----
  spawn: aByteString
  "Hack to open the object catalog when Cmd-O is pressed"
  self setMyText: aByteString.
+ (Project current world commandKeySelectors at: $o) value.
- (World commandKeySelectors at: $o) value.
  !

Item was changed:
  ----- Method: SketchMorph>>asWearableCostume (in category '*Etoys-e-toy support') -----
  asWearableCostume
  "Return a wearable costume for some player"
+ ^(Project current world drawingClass withForm: originalForm) copyCostumeStateFrom: self!
- ^(World drawingClass withForm: originalForm) copyCostumeStateFrom: self!

Item was changed:
  ----- Method: StandardScriptingSystem>>benchmarkCategory (in category '*Etoys-Squeakland-benchmarks') -----
  benchmarkCategory
  "ScriptingSystem benchmarkCategory"
+ | m v result world |
+ world := Project current world.
- | m v result |
  m := Morph new openInWorld.
  m openViewerForArgument.
+ world doOneCycle.
- World doOneCycle.
  v := m player allOpenViewers first submorphs last.
  result := [v chosenCategorySymbol: #geometry.
+ world doOneCycle] timeToRun.
- World doOneCycle] timeToRun.
  m delete.
+ world doOneCycle.
- World doOneCycle.
  ^ result!

Item was changed:
  ----- Method: StandardScriptingSystem>>benchmarkPainter (in category '*Etoys-Squeakland-benchmarks') -----
  benchmarkPainter
  "ScriptingSystem benchmarkPainter"
+ | world result |
+ world := Project current world.
+ result := [world makeNewDrawing: nil at: 400 @ 300.
+ world doOneCycle] timeToRun.
+ (world findA: SketchEditorMorph) cancelOutOfPainting.
+ world doOneCycle.
- | result |
- result := [World makeNewDrawing: nil at: 400 @ 300.
- World doOneCycle] timeToRun.
- (World findA: SketchEditorMorph) cancelOutOfPainting.
- World doOneCycle.
  ^ result!

Item was changed:
  ----- Method: StandardScriptingSystem>>benchmarkScriptor (in category '*Etoys-Squeakland-benchmarks') -----
  benchmarkScriptor
  "ScriptingSystem benchmarkScriptor"
  "(Picking up third one)"
  | result m |
  m := Morph new openInWorld.
  m openViewerForArgument.
  m player assureUniClass.
  m player newScriptorAround: nil.
  m player newScriptorAround: nil.
  result := [(m player newScriptorAround: nil) openInWorld.
+ Project current world doOneCycle] timeToRun.
- World doOneCycle] timeToRun.
  m delete.
+ Project current world doOneCycle.
- World doOneCycle.
  ^ result!

Item was changed:
  ----- Method: StandardScriptingSystem>>benchmarkViewer (in category '*Etoys-Squeakland-benchmarks') -----
  benchmarkViewer
  "ScriptingSystem benchmarkViewer"
+ | result m world |
- | result m |
  m := Morph new openInWorld.
+ world := Project current world.
  result := [m openViewerForArgument.
+ world doOneCycle] timeToRun.
- World doOneCycle] timeToRun.
  m delete.
+ world doOneCycle.
- World doOneCycle.
  ^ result!

Item was changed:
  ----- Method: SugarLauncher>>shutDown (in category 'running') -----
  shutDown
  sharedActivity ifNotNil: [
  self leaveSharedActivity.
  sharedActivity := nil].
  Project allSubInstancesDo: [:prj | prj removeParameter: #sugarId].
  ServerDirectory inImageServers keysAndValuesDo: [:srvrName :srvr |
  (srvr isKindOf: SugarDatastoreDirectory) ifTrue: [
  ServerDirectory removeServerNamed: srvrName ifAbsent: []]].
  Current := nil.
+ Project current world windowEventHandler: nil.
- World windowEventHandler: nil.
  !

Item was changed:
  ----- Method: SugarLauncher>>startUp (in category 'running') -----
  startUp
  self class allInstances do: [:ea | ea shutDown].
 
  Current := self.
 
  SugarNavigatorBar current
  ifNotNil: [:bar | bar startUp].
 
  parameters at: 'ACTIVITY_ID' ifPresent: [ :activityId |
  OLPCVirtualScreen setupIfNeeded.
+ Project current world windowEventHandler: self.
- World windowEventHandler: self.
  (Smalltalk classNamed: 'DBus') ifNotNil: [:dbus |
  dbus sessionBus
  export: (Smalltalk classNamed: 'SugarEtoysActivity') new
  on: 'org.laptop.Activity', activityId
  at: '/org/laptop/Activity/', activityId].
  Utilities authorName: self ownerBuddy nick.
  ServerDirectory
  addServer: (SugarDatastoreDirectory mimetype: 'application/x-squeak-project' extension: '.pr')
  named: SugarLauncher defaultDatastoreDirName.
  self joinSharedActivity.
  self isShared ifFalse: [
  parameters at: 'OBJECT_ID' ifPresent: [:id |
  ^self resumeJournalEntry: id]].
  self isShared ifTrue: [^self].
  ^self welcome: (parameters at: 'URI' ifAbsent: [''])].
 
  self welcome: ''
 
  !

Item was changed:
  ----- Method: SugarLauncher>>viewSource (in category 'commands') -----
  viewSource
    WorldState addDeferredUIMessage: [
+ Project current world showSourceKeyHit]!
- World showSourceKeyHit]!

Item was changed:
  ----- Method: SugarNavigatorBar>>putUpInitialBalloonHelp (in category 'initialization') -----
  putUpInitialBalloonHelp
  "
  SugarNavigatorBar putUpInitialBalloonHelp
  "
 
  | suppliesButton b1 b2 p b |
  suppliesButton := paintButton owner submorphs detect: [:e | e isButton and: [e actionSelector = #toggleSupplies]].
 
  b1 := BalloonMorph string: self paintButtonInitialExplanation for: paintButton corner: #topRight force: false.
  b2 := BalloonMorph string: self suppliesButtonInitialExplanation for: suppliesButton corner: #topLeft force: true.
 
  p := PasteUpMorph new.
  p clipSubmorphs: false.
  p color: Color transparent.
  p borderWidth: 0.
  p addMorph: b1.
  p addMorph: b2.
+ b := BalloonMorph string: p for: self world corner: #bottomLeft.
- b := BalloonMorph string: p for: World corner: #bottomLeft.
  b color: Color transparent.
  b borderWidth: 0.
  [(Delay forSeconds: 1) wait. b popUpForHand: ActiveHand] fork.
  !

Item was changed:
  ----- Method: SugarNavigatorBar>>putUpInitialBalloonHelpFor: (in category 'initialization') -----
  putUpInitialBalloonHelpFor: quads
  "Given a list of quads of the form <selector> <help-msg> <corner> <force-boolean> (see senders for examples), put up initial balloon help for them."
  "
  SugarNavigatorBar someInstance putUpInitialBalloonHelpFor: #((doNewPainting 'make a new painting' topRight false) (toggleSupplies 'open the supplies bin' topLeft true))
  SugarNavigatorBar someInstance putUpInitialBalloonHelpFor: #((showNavBar 'show the tool bar' bottomLeft false) (hideNavBar 'hide the tool bar' bottomLeft false))
 
  "
  |  b1 p b |
 
  p := PasteUpMorph new.
  p clipSubmorphs: false.
  p color: Color transparent.
  p borderWidth: 0.
 
  quads do: [:aQuad |
  (submorphs first submorphs detect: [:e | e isButton and: [e actionSelector = aQuad first]] ifNone: [nil]) ifNotNil:
  [:aButton |
  b1 := BalloonMorph string: aQuad second for: aButton corner: aQuad third force: aQuad fourth.
  p addMorph: b1]].
 
+ b := BalloonMorph string: p for: self world corner: #bottomLeft.
- b := BalloonMorph string: p for: World corner: #bottomLeft.
  b color: Color transparent.
  b borderWidth: 0.
  [(Delay forSeconds: 1) wait. b popUpForHand: ActiveHand] fork.
  !

Item was changed:
  ----- Method: SugarNavigatorBar>>quitSqueak (in category 'button actions') -----
  quitSqueak
  ^SugarLauncher isRunningInSugar
  ifTrue: [SugarLauncher current quit]
  ifFalse: [
  Preferences eToyFriendly
  ifTrue: [super quitSqueak]
  ifFalse: [Smalltalk
  snapshot: (
  UserDialogBoxMorph
  confirm: 'Save changes before quitting?' translated
  orCancel: [ ^self ]
+ at: self world center)
- at: World center)
  andQuit: true]].!