[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
|