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]].!