The Inbox: EToys-dtl.313.mcz

> David T. Lewis uploaded a new version of EToys to project The Inbox:
> http://source.squeak.org/inbox/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]].!
>
>