[squeak-dev] Help needed to test Etoys (was: The Inbox: EToys-dtl.313.mcz)

David T. Lewis lewis at mail.msen.com
Sat Nov 25 15:03:10 UTC 2017


I would appreciate if someone familiar with Etoys can load EToys-dtl.313 from
the inbox into a trunk image, and see if I broke anything with these changes.

This update removes all remaining references to the global World from trunk
with the exception of SyntaxMorph and WiWPasteUpMorph. Updating those morphs
will be simple, but I first need to verify whether they are morphs that always
know their world, and hence can use the "self world" idiom as replacement
for World.

Dave


On Sat, Nov 25, 2017 at 02:54:57PM +0000, commits at source.squeak.org wrote:
> 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]].!
> 
> 


More information about the Squeak-dev mailing list