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!