[squeak-dev] The Trunk: EToys-mt.422.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Feb 18 13:31:33 UTC 2021


Marcel Taeumel uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-mt.422.mcz

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

Name: EToys-mt.422
Author: mt
Time: 18 February 2021, 2:31:24.938649 pm
UUID: 65503b97-01b4-134f-8b1f-d6967bc024a7
Ancestors: EToys-mt.421, EToys-ct.370, EToys-ct.368, EToys-ct.390, EToys-ct.404

Merges Christoph's (ct) efforts to improve code-to-tile conversion.

=============== Diff against EToys-mt.421 ===============

Item was added:
+ ----- Method: BlockNode>>asTileSetForPlayer: (in category '*Etoys-tiles') -----
+ asTileSetForPlayer: aPlayer
+ 
+ 	^ self statements gather: [:statement |
+ 		[statement asStatementTileSetForPlayer: aPlayer]
+ 			ifError: [{statement asMorphicSyntaxIn: SyntaxMorph new}]]!

Item was added:
+ ----- Method: BlockNode>>withoutImplicitReturns (in category '*Etoys-tiles') -----
+ withoutImplicitReturns
+ 
+ 	(self statements ifEmpty: [^ self]) last isImplicitReturn
+ 		ifFalse: [^ self].
+ 	^ self copy statements: self statements allButLast!

Item was added:
+ ----- Method: CascadeNode>>asStatementTileSetForPlayer: (in category '*Etoys-tiles') -----
+ asStatementTileSetForPlayer: aPlayer
+ 
+ 	^ self asTileSetForPlayer: aPlayer!

Item was added:
+ ----- Method: CascadeNode>>asTileSetForPlayer: (in category '*Etoys-tiles') -----
+ asTileSetForPlayer: aPlayer
+ 
+ 	^ self messages gather: [:message |
+ 		message copy
+ 			receiver: self receiver;
+ 			asTileSetForPlayer: aPlayer]!

Item was added:
+ ----- Method: CommentNode>>asTileSetForPlayer: (in category '*Etoys-tiles') -----
+ asTileSetForPlayer: aPlayer
+ 
+ 	^ #()!

Item was changed:
  ----- Method: EtoysDebugger>>evaluateNextTile (in category 'evaluating') -----
  evaluateNextTile
        (scriptEditor isTextuallyCoded) ifTrue:[^ self inform: 'You can''t step through textually coded scripts.\Use a script''s tile-based representation instead.' withCRs translated].
  	[next = (scriptEditor tiles at: 1 ifAbsent: [nil])
  		ifTrue: ["We are about to evaluate the first tile"
  			self updateStartingPosition].
+ 	(self trailMorph ifNotNil: #batchPenTrails ifNil: [false])
- 	self trailMorph batchPenTrails
  		ifTrue: [self evaluateNextTileWithBatchPenTrails]
  		ifFalse: [next evaluateOn: self]]
  		on: Error do: [:err || newNext |
  			newNext := scriptEditor tiles at: 1 ifAbsent: [^ self].
  			newNext = next
  				ifTrue: [err pass]
  				ifFalse: [next := newNext].
  			self evaluateNextTile]
  
  !

Item was added:
+ ----- Method: LiteralNode>>asTileForPlayer: (in category '*Etoys-tiles') -----
+ asTileForPlayer: aPlayer
+ 
+ 	^ aPlayer presenter constantTile: self literalValue!

Item was added:
+ ----- Method: MessageNode>>asStatementTileSetForPlayer: (in category '*Etoys-tiles') -----
+ asStatementTileSetForPlayer: aPlayer
+ 
+ 	^ self asTileSetForPlayer: aPlayer!

Item was added:
+ ----- Method: MessageNode>>asTileForPlayer: (in category '*Etoys-tiles') -----
+ asTileForPlayer: aPlayer
+ 
+ 	| receiverType argumentType resultType phrase receiverTiles |
+ 	"Catch edge case: Color tile"
+ 	(self receiver isVariableNode and: [self receiver key = (Smalltalk bindingOf: #Color)])
+ 		ifTrue: [ | source result |
+ 			source := String streamContents: (MessageSend receiver: self selector: #shortPrintOn:).
+ 			result := [Compiler evaluate: source] ifError: [nil].
+ 			result isColor ifTrue: [^ result newTileMorphRepresentative]].
+ 	
+ 	"Catch edge case: Test tile"
+ 	self ifConditionNormalizeAndDo: [:conditionNode :trueNode :falseNode | | compound |
+ 		compound := StandardScriptingSystem new yesNoComplexOfTiles.
+ 		compound testPart insertTileRow: (conditionNode asTileSetForPlayer: aPlayer) after: 0.
+ 		compound yesPart insertTileRow: (trueNode withoutImplicitReturns asTileSetForPlayer: aPlayer) after: 0.
+ 		compound noPart insertTileRow: (falseNode withoutImplicitReturns asTileSetForPlayer: aPlayer) after: 0.
+ 		compound enforceTileColorPolicy; layoutChanged; fullBounds.
+ 		^ compound].
+ 	
+ 	"Otherwise, try to build a phrase tile"
+ 	self arguments size < 2 ifFalse: [^ self convertToTileError].
+ 	
+ 	receiverType := #unknown.
+ 	argumentType := self arguments ifEmpty: [nil] ifNotEmpty: [#unknown].
+ 	resultType := #unknown.
+ 	phrase := PhraseTileMorph new.
+ 	phrase
+ 		setOperator: self selector key
+ 		type: resultType
+ 		rcvrType: receiverType
+ 		argType: argumentType.
+ 	receiverTiles := self receiver asTileSetForPlayer: aPlayer.
+ 	receiverTiles size = 1 ifFalse: [^ self convertToTileError].
+ 	phrase firstSubmorph
+ 		addMorph: receiverTiles first;
+ 		hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ 	self arguments ifNotEmpty: [ | argumentTiles |
+ 		argumentTiles := self arguments first asTileSetForPlayer: aPlayer.
+ 		argumentTiles size = 1 ifFalse: [^ self convertToTileError].
+ 		phrase lastSubmorph
+ 			setType: argumentType;
+ 			changeTableLayout;
+ 			addMorph: argumentTiles first;
+ 			hResizing: #shrinkWrap; vResizing: #shrinkWrap].
+ 	
+ 	^ phrase
+ 		hResizing: #shrinkWrap; vResizing: #shrinkWrap;
+ 		yourself!

Item was added:
+ ----- Method: MessageNode>>ifConditionNormalizeAndDo: (in category '*Etoys-tiles') -----
+ ifConditionNormalizeAndDo: aBlock
+ 
+ 	| blocks |
+ 	blocks := self selector key
+ 		caseOf: { 
+ 			[#ifTrue:ifFalse:] -> [arguments].
+ 			[#ifFalse:ifTrue:] -> [self arguments reversed].
+ 			[#ifTrue:] -> [self arguments copyWith: (BlockNode statements: #() returns: #())].
+ 			[#ifFalse:] -> [self arguments copyWithFirst: (BlockNode statements: #() returns: #())] }
+ 		otherwise: [^ self].
+ 	^ aBlock value: self receiver value: blocks first value: blocks last!

Item was added:
+ ----- Method: MethodNode>>asScriptEditorFor: (in category '*Etoys-tiles') -----
+ asScriptEditorFor: aPlayer
+ 	
+ 	| editor |
+ 	editor := ScriptEditorMorph new.
+ 	editor
+ 		playerScripted: aPlayer;
+ 		setMorph: aPlayer costume scriptName: self selector.
+ 	
+ 	(self asTileSetForPlayer: aPlayer)
+ 		withIndexDo: [:tile :index |
+ 			editor insertTileRow: {tile} after: index].
+ 	editor
+ 		removeSpaces;
+ 		enforceTileColorPolicy;
+ 		scriptEdited;
+ 		allMorphsDo: #layoutChanged.
+ 	^ editor!

Item was added:
+ ----- Method: MethodNode>>asTileSetForPlayer: (in category '*Etoys-tiles') -----
+ asTileSetForPlayer: aPlayer
+ 	
+ 	^ self block withoutImplicitReturns asTileSetForPlayer: aPlayer!

Item was added:
+ ----- Method: MethodTempsNode>>asTileSetForPlayer: (in category '*Etoys-tiles') -----
+ asTileSetForPlayer: aPlayer
+ 
+ 	^ #()!

Item was added:
+ ----- Method: MethodWithInterface>>revertTileVersionFrom:for: (in category 'updating') -----
+ revertTileVersionFrom: anEditor for: playerScripted
+ 	"Only for universal tiles."
+ 
+ 	^ self revertToLastSavedTileVersionFor: anEditor!

Item was added:
+ ----- Method: ParseNode>>asStatementTileSetForPlayer: (in category '*Etoys-tiles') -----
+ asStatementTileSetForPlayer: aPlayer
+ 
+ 	^ self convertToTileError!

Item was added:
+ ----- Method: ParseNode>>asTileForPlayer: (in category '*Etoys-tiles') -----
+ asTileForPlayer: aPlayer
+ 	"Private. Better call #asTileMorphsForPlayer:."
+ 
+ 	^ self convertToTileError!

Item was added:
+ ----- Method: ParseNode>>asTileSetForPlayer: (in category '*Etoys-tiles') -----
+ asTileSetForPlayer: aPlayer
+ 
+ 	^ {self asTileForPlayer: aPlayer}!

Item was added:
+ ----- Method: ParseNode>>convertToTileError (in category '*Etoys-tiles') -----
+ convertToTileError
+ 
+ 	^ self error: 'Cannot convert this expression to a tile'!

Item was added:
+ ----- Method: ParseNode>>isImplicitReturn (in category '*Etoys-tiles') -----
+ isImplicitReturn
+ 
+ 	^false!

Item was added:
+ ----- Method: ReturnNode>>asTileSetForPlayer: (in category '*Etoys-tiles') -----
+ asTileSetForPlayer: aPlayer
+ 
+ 	"self isReturnSelf ifTrue: [^ #()]."
+ 	^ self expr asTileSetForPlayer: aPlayer!

Item was added:
+ ----- Method: ReturnNode>>isImplicitReturn (in category '*Etoys-tiles') -----
+ isImplicitReturn
+ 
+ 	^ self isReturnSelf!

Item was added:
+ ----- Method: ScriptEditorMorph>>convertToTileVersion (in category 'save & revert') -----
+ convertToTileVersion
+ 	"The receiver, currently showing textual code, is asked to revert to the last-saved tile version"
+ 
+ 	| aUserScript |
+ 	
+ 	self 
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #shrinkWrap.
+ 	aUserScript := playerScripted class userScriptForPlayer: playerScripted selector: scriptName.
+ 	aUserScript revertTileVersionFrom: self for: playerScripted.
+ 	self currentWorld startSteppingSubmorphsOf: self!

Item was changed:
  ----- Method: ScriptEditorMorph>>offerScriptorMenu (in category 'other') -----
  offerScriptorMenu
  	"Put up a menu in response to the user's clicking in the menu-request area of the scriptor's heaer"
  
  	| aMenu count |
- 
  	self modernize.
  	self currentHand showTemporaryCursor: nil.
+ 	
- 
  	Preferences eToyFriendly ifTrue: [^ self offerSimplerScriptorMenu].
+ 	
- 
  	aMenu := MenuMorph new defaultTarget: self.
  	aMenu addTitle: scriptName asString.
  	aMenu addStayUpItem.  "NB:  the kids version in #offerSimplerScriptorMenu does not deploy the stay-up item"
+ 	
- 
  	aMenu addList: (self hasParameter
  		ifTrue: [{
  			{'remove parameter' translated.					#ceaseHavingAParameter}}]
  		ifFalse: [{
  			{'add parameter' translated.						#addParameter}}]).
  
  	self hasParameter ifFalse:
  		[aMenu addTranslatedList: {
  			{'button to fire this script' translatedNoop. #tearOfButtonToFireScript}.
  			{'fires per tick...' translatedNoop. #chooseFrequency}.
  			#-
  		}].
+ 	
+ 	aMenu addUpdating: #showingCaretsString target: self action: #toggleShowingCarets.
- 
- 	aMenu addUpdating: #showingCaretsString  target: self action: #toggleShowingCarets.
  	aMenu addLine.
  	aMenu addList: {
  		{'edit balloon help for this script' translated.		#editMethodDescription}.
  		{'explain status alternatives' translated. 			#explainStatusAlternatives}.
  		{'button to show/hide this script' translated.			#buttonToOpenOrCloseThisScript}.
  		#-
  	}.
+ 	
+ 	Preferences universalTiles ifFalse: [
+ 		count := self savedTileVersionsCount.
- 
- 
- 	Preferences universalTiles ifFalse:
- 		[count := self savedTileVersionsCount.
  		self showingMethodPane
+ 			ifFalse: [ "currently showing tiles"
+ 				aMenu add: 'show code textually' translated action: #showSourceInScriptor.
+ 				count > 0 ifTrue: [
+ 					aMenu add: 'revert to tile version...' translated action: #revertScriptVersion].
+ 				aMenu add: 'save this version' translated action: #saveScriptVersion ]
+ 			ifTrue: [ "current showing textual source"
+ 				aMenu add: 'convert to tile version' translated action: #toggleWhetherShowingTiles.
+ 				count > 0 ifTrue:
+ 					[aMenu add: 'revert to tile version...' translated action: #revertScriptVersion]] ].
+ 	
- 			ifFalse:				"currently showing tiles"
- 				[aMenu add: 'show code textually' translated action: #toggleWhetherShowingTiles.
- 				count > 0 ifTrue: 
- 					[aMenu add: 'revert to tile version...' translated action:	 #revertScriptVersion].
- 				aMenu add: 'save this version' translated	action: #saveScriptVersion]
- 
- 			ifTrue:				"current showing textual source"
- 				[count >= 1 ifTrue:
- 					[aMenu add: 'revert to tile version' translated action: #toggleWhetherShowingTiles]]].
- 
  	"aMenu addLine.
  	self addGoldBoxItemsTo: aMenu."
+ 	
- 
  	aMenu addLine.
  	
+ 	aMenu add: 'grab this object' translated target: playerScripted selector: #grabPlayerIn: argument: ActiveWorld.
- 	aMenu add: 'grab this object' translated target: playerScripted selector: #grabPlayerIn: argument: self currentWorld.
  	aMenu balloonTextForLastItem: 'This will actually pick up the object bearing this script and hand it to you.  Click the (left) button to drop it' translated.
+ 	
+ 	aMenu add: 'reveal this object' translated target: playerScripted selector: #revealPlayerIn: argument: ActiveWorld.
- 
- 	aMenu add: 'reveal this object' translated target: playerScripted selector: #revealPlayerIn: argument: self currentWorld.
  	aMenu balloonTextForLastItem: 'If you have misplaced the object bearing this script, use this item to (try to) make it visible' translated.
+ 	
- 
  	aMenu add: 'tile representing this object' translated target: playerScripted action: #tearOffTileForSelf.
  	aMenu balloonTextForLastItem: 'choose this to obtain a tile which represents the object associated with this script' translated.
+ 	
- 
  	aMenu addTranslatedList: {
  		#-.
  		{'open viewer' translatedNoop. #openObjectsViewer.  'open the viewer of the object to which this script belongs' translatedNoop}.
  		{'detached method pane' translatedNoop. #makeIsolatedCodePane. 'open a little window that shows the Smalltalk code underlying this script.' translatedNoop}.
  		#-.
  		{'destroy this script' translatedNoop. #destroyScript}
  	}.
+ 	
+ 	aMenu popUpInWorld: self currentWorld.!
- 
- 
- 	^ aMenu popUpInWorld: self currentWorld!

Item was changed:
  ----- Method: ScriptEditorMorph>>parseNodeWith: (in category '*Etoys-Squeakland-other') -----
  parseNodeWith: encoder
  
  	| statements ret |
  	statements := WriteStream on: (Array new: self tileRows size).
+ 	self tileRows do: [:row | 
+ 		row do: [:morph |
+ 			(morph respondsTo: #parseNodeWith:asStatement:) ifTrue: [
+ 				statements nextPut: (morph parseNodeWith: encoder asStatement: true)]]].
- 	self tileRows do: [:r | 
- 		r do: [:m | 
- 			((m isKindOf: TileMorph) 
- 				or: [(m isKindOf: CompoundTileMorph)
- 					or: [m isKindOf: PhraseTileMorph]]) ifTrue: [
- 						statements nextPut: (m parseNodeWith: encoder asStatement: true)]]].
  	statements := statements contents.
  	ret := ReturnNode new expr: (encoder encodeVariable: 'self').
+ 	^ BlockNode new
+ 		arguments: #() 
+ 		statements: (statements copyWith: ret)
+ 		returns: true
+ 		from: encoder.!
- 	^ BlockNode new arguments: #() statements: (statements copyWith: ret) returns: true from: encoder.
- !

Item was removed:
- ----- Method: ScriptEditorMorph>>revertToTileVersion (in category 'save & revert') -----
- revertToTileVersion
- 	"The receiver, currently showing textual code,  is asked to revert to the last-saved tile version"
- 
- 	| aUserScript |
- 
- 	self 
- 		hResizing: #shrinkWrap;
- 		vResizing: #shrinkWrap.
- 	aUserScript := playerScripted class userScriptForPlayer: playerScripted selector: scriptName.
- 	aUserScript revertToLastSavedTileVersionFor: self.
- 	self currentWorld startSteppingSubmorphsOf: self!

Item was changed:
  ----- Method: ScriptEditorMorph>>toggleWhetherShowingTiles (in category 'other') -----
  toggleWhetherShowingTiles
  	"Toggle between showing the method pane and showing the tiles pane"
+ 	
- 
  	self showingMethodPane
+ 		ifFalse: [ "currently showing tiles"
+ 			self showSourceInScriptor ]
+ 		ifTrue: [ "currently showing textual source"
+ 			self convertToTileVersion ].!
- 		ifFalse:				"currently showing tiles"
- 			[self showSourceInScriptor]
- 
- 		ifTrue:				"current showing textual source"
- 			[Preferences universalTiles
- 				ifTrue: [^ self revertToTileVersion].
- 			self savedTileVersionsCount >= 1
- 				ifTrue:
- 					[(self userScriptObject lastSourceString = (playerScripted class sourceCodeAt: scriptName))
- 						ifFalse:
- 							[(self confirm: 
- 'Caution -- this script was changed
- textually; if you revert to tiles at this
- point you will lose all the changes you
- may have made textually.  Do you
- really want to do this?' translated) ifFalse: [^ self]].
- 					self revertToTileVersion]
- 				ifFalse:
- 					[Beeper beep]]!

Item was added:
+ TestCase subclass: #ScriptEditorMorphTest
+ 	instanceVariableNames: 'editor minimalMethod player'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Tests'!

Item was added:
+ ----- Method: ScriptEditorMorphTest>>exampleMinimalPlayerCode (in category 'accessing') -----
+ exampleMinimalPlayerCode
+ 
+ 	self forward: 6 * 7.
+ 	self turn: 6.
+ 	self forward: 7.
+ 	self getIsUnderMouse ifFalse: [self abandon].
+ 	"self color: (Color r: 1 g: 0.6 b: 0).
+ 	[[''''''''] cull: 42] onDNU: #foo do: #ba."!

Item was added:
+ ----- Method: ScriptEditorMorphTest>>examplePlayerCode (in category 'accessing') -----
+ examplePlayerCode
+ 
+ 	self forward: 6 * 7.
+ 	self
+ 		turn: 6;
+ 		forward: 7.
+ 	self getIsUnderMouse ifFalse: [self abandon].
+ 	"self color: (Color fromString: '#ff9900').
+ 	[[''''''''] cull: 42] onDNU: #foo do: #ba."!

Item was added:
+ ----- Method: ScriptEditorMorphTest>>setUp (in category 'running') -----
+ setUp
+ 
+ 	super setUp.
+ 	
+ 	player := Morph new assuredPlayer.
+ 	minimalMethod := (self class lookupSelector: #exampleMinimalPlayerCode) decompile.!

Item was added:
+ ----- Method: ScriptEditorMorphTest>>tearDown (in category 'running') -----
+ tearDown
+ 
+ 	[editor ifNotNil: #destroyScript] valueSuppressingMessages: #('*destroy*').
+ 	super tearDown.!

Item was added:
+ ----- Method: ScriptEditorMorphTest>>testCodeToTileAndBack (in category 'testing') -----
+ testCodeToTileAndBack
+ 
+ 	| templateMethod |
+ 	templateMethod := (self class lookupSelector: #examplePlayerCode) decompile.
+ 	editor := templateMethod asScriptEditorFor: player.
+ 	self
+ 		assert: minimalMethod block printString
+ 		equals: (player class lookupSelector: #examplePlayerCode) decompile block printString!

Item was added:
+ ----- Method: ScriptEditorMorphTest>>testMinimalCodeToTileAndBack (in category 'testing') -----
+ testMinimalCodeToTileAndBack
+ 
+ 	editor := minimalMethod asScriptEditorFor: player.
+ 	self
+ 		assert: minimalMethod block printString
+ 		equals: (player class lookupSelector: #exampleMinimalPlayerCode) decompile block printString.!

Item was changed:
  ----- Method: SyntaxMorph>>parseNodeWith:asStatement: (in category '*Etoys-Squeakland-code generation') -----
  parseNodeWith: encoder asStatement: aBoolean
  
+ 	| methodNode |
+ 	methodNode := self parseNodeWith: encoder.
+ 	^ aBoolean
+ 		ifFalse: [methodNode]
+ 		ifTrue: [methodNode block]!
- 	^ self parseNode!

Item was added:
+ ----- Method: UniclassScript>>revertTileVersionFrom:for: (in category 'updating') -----
+ revertTileVersionFrom: anEditor for: playerScripted
+ 
+ 	anEditor removeAllButFirstSubmorph.
+ 	Preferences universalTiles
+ 		ifFalse: [
+ 			((self playerClass >> self selector) decompile asTileSetForPlayer: playerScripted)
+ 				withIndexDo: [:tile :index |
+ 					anEditor insertTileRow: {tile} after: index].
+ 			anEditor allMorphsDo: #layoutChanged]
+ 		ifTrue: [
+ 			anEditor insertUniversalTiles].
+ 	anEditor showingMethodPane: false.
+ 	isTextuallyCoded := false.!

Item was added:
+ ----- Method: UserScript>>revertTileVersionFrom:for: (in category 'versions') -----
+ revertTileVersionFrom: anEditor for: playerScripted
+ 
+ 	anEditor removeAllButFirstSubmorph.
+ 	((self playerClass >> self selector) decompile asTileSetForPlayer: playerScripted)
+ 		withIndexDo: [:tile :index |
+ 			anEditor insertTileRow: {tile} after: index].
+ 	anEditor allMorphsDo: #layoutChanged.
+ 	anEditor showingMethodPane: false.
+ 	self becomeTextuallyCoded.!

Item was added:
+ ----- Method: VariableNode>>asTileForPlayer: (in category '*Etoys-tiles') -----
+ asTileForPlayer: aPlayer
+ 
+ 	| target |
+ 	self isSelfPseudoVariable
+ 		ifTrue: [^ aPlayer tileToRefer].
+ 	target := self key isVariableBinding
+ 		ifTrue: [aPlayer environment at: self key key]
+ 		ifFalse: [self key].
+ 	^ TileMorph new
+ 		setToReferTo: target;
+ 		yourself!

Item was added:
+ ----- Method: VariableNode>>isImplicitReturn (in category '*Etoys-tiles') -----
+ isImplicitReturn
+ 
+ 	^ self = NodeNil!



More information about the Squeak-dev mailing list