Squeak-dev February 2021

squeak-dev@lists.squeakfoundation.org

33 participants
196 discussions

The Trunk: System-mt.1218.mcz
by commits＠source.squeak.org 18 Feb '21

18 Feb '21

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1218.mcz ==================== Summary ==================== Name: System-mt.1218 Author: mt Time: 18 February 2021, 4:54:03.4367 pm UUID: 1cbfb74f-d6b3-6c49-986a-c17bb1760d43 Ancestors: System-mt.1217 Removes dependency of System from EToys with a pragma-based extension. =============== Diff against System-mt.1217 =============== Item was changed: ----- Method: ImageSegment>>comeFullyUpOnReload: (in category 'fileIn') ----- comeFullyUpOnReload: smartRefStream "fix up the objects in the segment that changed size. An object in the segment is the wrong size for the modern version of the class. Construct a fake class that is the old size. Replace the modern class with the old one in outPointers. Load the segment. Traverse the instances, making new instances by copying fields, and running conversion messages. Keep the new instances. Bulk forward become the old to the new. Let go of the fake objects and classes. After the install (below), arrayOfRoots is filled in. Globalize new classes. Caller may want to do some special install on certain objects in arrayOfRoots. May want to write the segment out to disk in its new form." + | mapFakeClassesToReal receiverClasses existing forgetDoItsClass endianness | - | mapFakeClassesToReal receiverClasses rootsToUnhiberhate myProject existing forgetDoItsClass endianness | forgetDoItsClass := Set new. RecentlyRenamedClasses := nil. "in case old data hanging around" mapFakeClassesToReal := smartRefStream reshapedClassesIn: outPointers. "Dictionary of just the ones that change shape. Substitute them in outPointers." self fixCapitalizationOfSymbols. endianness := self endianness. segment := self loadSegmentFrom: segment outPointers: outPointers. arrayOfRoots := segment first. mapFakeClassesToReal isEmpty ifFalse: [ self reshapeClasses: mapFakeClassesToReal refStream: smartRefStream ]. "When a Project is stored, arrayOfRoots has all objects in the project, except those in outPointers" arrayOfRoots do: [:importedObject | ((importedObject isMemberOf: WideString) or: [importedObject isMemberOf: WideSymbol]) ifTrue: [ importedObject mutateJISX0208StringToUnicode. importedObject class = WideSymbol ifTrue: [ "self halt." Symbol hasInterned: importedObject asString ifTrue: [:multiSymbol | multiSymbol == importedObject ifFalse: [ importedObject becomeForward: multiSymbol. ]. ]. ]. ]. (importedObject isMemberOf: TTCFontSet) ifTrue: [ existing := TTCFontSet familyName: importedObject familyName pointSize: importedObject pointSize. "supplies default" existing == importedObject ifFalse: [importedObject becomeForward: existing]. ]. ]. receiverClasses := self restoreEndianness: endianness ~~ Smalltalk endianness. "rehash sets" smartRefStream checkFatalReshape: receiverClasses. "Classes in this segment." arrayOfRoots do: [:importedObject | importedObject class class == Metaclass ifTrue: [forgetDoItsClass add: importedObject. self declare: importedObject]]. - rootsToUnhiberhate := OrderedCollection new. - arrayOfRoots do: [:importedObject | - ((importedObject isMemberOf: ScriptEditorMorph) - or: [(importedObject isKindOf: TileMorph) - or: [(importedObject isMemberOf: ScriptingTileHolder) - or: [importedObject isKindOf: CompoundTileMorph]]]) ifTrue: [ - rootsToUnhiberhate add: importedObject - ]. - (importedObject isMemberOf: Project) ifTrue: [ - myProject := importedObject. - importedObject ensureChangeSetNameUnique. - Project addingProject: importedObject. - importedObject restoreReferences. - self dependentsRestore: importedObject. - ScriptEditorMorph writingUniversalTiles: - ((importedObject projectPreferenceAt: #universalTiles) ifNil: [false])]]. + "Let all extensions work with the current arrayOfRoots." + self processRoots. - myProject ifNotNil: [ - myProject world setProperty: #thingsToUnhibernate toValue: rootsToUnhiberhate asArray. - ]. mapFakeClassesToReal isEmpty ifFalse: [ mapFakeClassesToReal keysAndValuesDo: [:aFake :aReal | aFake removeFromSystemUnlogged. aFake becomeForward: aReal]. SystemOrganization removeEmptyCategories]. forgetDoItsClass do: [:c | self forgetDoItsInClass: c]. "^ self" ! Item was added: + ----- Method: ImageSegment>>processRoots (in category 'fileIn') ----- + processRoots + + ImageSegment methodsDo: [:method | + (method hasPragma: #rootsEnumerator) ifTrue: [ + self executeMethod: method]].!

1 0

The Trunk: EToys-mt.423.mcz
by commits＠source.squeak.org 18 Feb '21

18 Feb '21

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-mt.423.mcz ==================== Summary ==================== Name: EToys-mt.423 Author: mt Time: 18 February 2021, 4:13:47.008082 pm UUID: ce09c0e8-7fc5-ba41-95c8-0dd8a987d38e Ancestors: EToys-mt.422 Support CompiledBlock in error reports. Merges forgotten fix from Etoys 5 to make StandardViewer >> #addHeaderMorphWithBarHeight:includeDismissButton: work again, in case you got costumes. =============== Diff against EToys-mt.422 =============== Item was changed: ----- Method: AlignmentMorph>>addUpDownArrowsFor: (in category '*Etoys-initialization') ----- addUpDownArrowsFor: aMorph "Add a column of up and down arrows that serve to send upArrowHit and downArrowHit to aMorph when they're pressed/held down" + | downArrow upArrow | + (TileMorph addArrowsOn: self) + in: [:array | + upArrow := array first. + downArrow := array second]. - | holder downArrow upArrow | - holder := Morph new extent: 16 @ 16; beTransparent. - downArrow := ImageMorph new image: (ScriptingSystem formAtKey: 'DownArrow'). - upArrow := ImageMorph new image: (ScriptingSystem formAtKey: 'UpArrow'). - upArrow position: holder bounds topLeft + (2 @ 2). - downArrow align: downArrow bottomLeft - with: holder topLeft + (0 @ TileMorph defaultH) + (2 @ -2). - holder addMorph: upArrow. - holder addMorph: downArrow. - self addMorphBack: holder. upArrow on: #mouseDown send: #upArrowHit to: aMorph. upArrow on: #mouseStillDown send: #upArrowHit to: aMorph. downArrow on: #mouseDown send: #downArrowHit to: aMorph. downArrow on: #mouseStillDown send: #downArrowHit to: aMorph.! Item was changed: ----- Method: StandardScriptingSystem>>reportToUser: (in category '*Etoys-utilities') ----- reportToUser: aString "Make a message accessible to the user. " | trigger current baseTriggerer topTriggerer mclass sel topSelector | trigger := Player compiledMethodAt: #triggerScript:. current := thisContext. baseTriggerer := nil. topTriggerer := nil. [current notNil] whileTrue: [ topTriggerer ifNil: [ current receiver class isUniClass ifTrue: [ "Look for the top-most uniclass script in the call chain." + sel := current receiver class selectorAtMethod: current method "aCompiledBlock" method setClass: [:c | mclass := c]. - sel := current receiver class selectorAtMethod: current method setClass: [:c | mclass := c]. mclass = current receiver class ifTrue: [ topTriggerer := current. topSelector := sel. ]. ]. ]. (current method = trigger and: [current isExecutingBlock not]) ifTrue: [ "Look for the bottom-most #triggerScript: and its selector." baseTriggerer := current ]. current := current sender. ]. baseTriggerer ifNotNil: [ (baseTriggerer receiver scriptInstantiationForSelector: (baseTriggerer at: 1)) resetTo: #paused ifCurrently: #ticking. ]. (topTriggerer notNil and: [topSelector notNil]) ifTrue: [ ^ self eToysError: aString, '\', topTriggerer receiver knownName, '\', topSelector. ]. self error: aString!

1 0

The Trunk: Graphics-mt.446.mcz
by commits＠source.squeak.org 18 Feb '21

18 Feb '21

Marcel Taeumel uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-mt.446.mcz ==================== Summary ==================== Name: Graphics-mt.446 Author: mt Time: 18 February 2021, 4:07:36.927082 pm UUID: 7970ec57-0257-ff4c-a2e3-13d3e06d4807 Ancestors: Graphics-dtl.445 Adds new version for LayoutFrame to be able to convert old versions with 'nil' fields. =============== Diff against Graphics-dtl.445 =============== Item was changed: ----- Method: LayoutFrame class>>classVersion (in category 'accessing') ----- classVersion + ^ 2 "fractions and offsets are never 'nil' anymore" - ^1 "changed treatment of bottomOffset and rightOffset" ! Item was added: + ----- Method: LayoutFrame class>>withClassVersion: (in category 'objects from disk') ----- + withClassVersion: aVersion + + aVersion <= self classVersion ifTrue: [^ self]. + ^ super withClassVersion: aVersion! Item was changed: ----- Method: LayoutFrame>>convertToCurrentVersion:refStream: (in category 'objects from disk') ----- convertToCurrentVersion: varDict refStream: smartRefStrm | className oldClassVersion | "JW 2/1/2001" "Since class version isn't passed in varDict, look it up through smartRefSrm." className := varDict at: #ClassName. oldClassVersion := (smartRefStrm structures at: className) first. + (oldClassVersion = 0) ifTrue: [ self negateBottomRightOffsets; fixup ]. + (oldClassVersion = 1) ifTrue: [ self fixup ]. - (oldClassVersion = 0) ifTrue: [ self negateBottomRightOffsets ]. ^super convertToCurrentVersion: varDict refStream: smartRefStrm. ! Item was changed: + ----- Method: LayoutFrame>>fixup (in category 'objects from disk') ----- - ----- Method: LayoutFrame>>fixup (in category 'initialize-release') ----- fixup "Set-up default value for un-initialized layout frames" "LayoutFrame allInstancesDo: [:e | e fixup]." leftFraction ifNil: [leftFraction := 0]. leftOffset ifNil: [leftOffset := 0]. topFraction ifNil: [topFraction := 0]. topOffset ifNil: [topOffset := 0]. rightFraction ifNil: [rightFraction := 0]. rightOffset ifNil: [rightOffset := 0]. bottomFraction ifNil: [bottomFraction := 0]. bottomOffset ifNil: [bottomOffset := 0].!

1 0

The Trunk: EToys-ct.404.mcz
by commits＠source.squeak.org 18 Feb '21

18 Feb '21

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-ct.404.mcz ==================== Summary ==================== Name: EToys-ct.404 Author: ct Time: 17 September 2020, 12:08:06.252813 pm UUID: d9eaf56f-8f92-314a-91b7-f15e0b463c55 Ancestors: EToys-eem.400 Refactors new parse node to tile conversion and revises editor menu intergration. Minor refactorings: Method splitting, renaming, and some typo and layout fixes. Keeps depending on EToys-ct.366, EToys-ct.368, EToys-ct.369, EToys-ct.370, EToys-ct.389, EToys-ct.390. Sorry for the cluttered ancestry, for the next project, I will really use changesets! =============== Diff against EToys-eem.400 =============== 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: 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: MethodWithInterface>>revertTileVersionFrom:for: (in category 'updating') ----- + revertTileVersionFrom: anEditor for: playerScripted + "Only for universal tiles." + + ^ self revertToLastSavedTileVersionFor: anEditor! 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. ActiveHand 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 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 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 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: + ----- 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.!

1 0

The Trunk: EToys-ct.390.mcz
by commits＠source.squeak.org 18 Feb '21

18 Feb '21

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-ct.390.mcz ==================== Summary ==================== Name: EToys-ct.390 Author: ct Time: 27 March 2020, 9:39:10.801235 pm UUID: d54c1d9b-6381-784b-8a2d-497804eab2a7 Ancestors: EToys-eem.388 Refines parsing of SyntaxMorphs, respecting asStatement: aBoolean If a statement is requested, don't return the whole method to avoid nested methods. Also cleans up ScriptEditorMorph >> #parseNodeWith: (strengthening polymorphy). =============== Diff against EToys-eem.388 =============== 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 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!

1 0

The Trunk: EToys-ct.370.mcz
by commits＠source.squeak.org 18 Feb '21

18 Feb '21

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-ct.370.mcz ==================== Summary ==================== Name: EToys-ct.370 Author: ct Time: 15 October 2019, 10:00:31.84083 pm UUID: 8acf5f1b-6545-1146-b173-821ef32c3322 Ancestors: EToys-ct.369 Tests conversion between ParseNodes and tiles =============== Diff against EToys-ct.369 =============== 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.!

1 0

The Trunk: EToys-ct.369.mcz
by commits＠source.squeak.org 18 Feb '21

18 Feb '21

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-ct.369.mcz ==================== Summary ==================== Name: EToys-ct.369 Author: ct Time: 15 October 2019, 9:56:30.25283 pm UUID: 0328de9a-3f0f-fb44-a8d9-12b8bee91796 Ancestors: EToys-ct.366 Refines conversion of MessageNodes into test tiles: Don't fill empty cases with "nil" =============== Diff against EToys-ct.366 =============== Item was changed: ----- Method: BlockNode>>withoutImplicitReturns (in category '*Etoys-tiles') ----- withoutImplicitReturns + (self statements ifEmpty: [^ self]) last isImplicitReturn - (self statements ifEmpty: [^ self]) last isReturnSelf ifFalse: [^ self]. ^ self copy statements: self statements allButLast! Item was changed: ----- 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 yesPart insertTileRow: (trueNode asTileSetForPlayer: aPlayer) after: 0. - compound noPart insertTileRow: (falseNode 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 := #unkown. 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; addMorph: argumentTiles first; hResizing: #shrinkWrap; vResizing: #shrinkWrap]. ^ phrase hResizing: #shrinkWrap; vResizing: #shrinkWrap; yourself! Item was changed: ----- 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: #())] } - [#ifTrue:] -> [self arguments copyWith: BlockNode new]. - [#ifFalse:] -> [self arguments copyWithFirst: BlockNode new] } otherwise: [^ self]. ^ aBlock value: self receiver value: blocks first value: blocks last! Item was added: + ----- Method: ParseNode>>isImplicitReturn (in category '*Etoys-tiles') ----- + isImplicitReturn + + ^false! Item was added: + ----- Method: ReturnNode>>isImplicitReturn (in category '*Etoys-tiles') ----- + isImplicitReturn + + ^ self isReturnSelf! Item was added: + ----- Method: VariableNode>>isImplicitReturn (in category '*Etoys-tiles') ----- + isImplicitReturn + + ^ self = NodeNil!

1 0

The Trunk: EToys-ct.368.mcz
by commits＠source.squeak.org 18 Feb '21

18 Feb '21

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-ct.368.mcz ==================== Summary ==================== Name: EToys-ct.368 Author: ct Time: 15 October 2019, 2:57:44.969129 pm UUID: a02688f9-acfd-4240-a068-bdb24539e268 Ancestors: EToys-ct.366 Changes "revert to tile version" behavior in script editor: Instead of discarding the changed code, always use the new approach and convert the decompiled code back to tiles. =============== Diff against EToys-ct.366 =============== Item was added: + ----- Method: MethodWithInterface>>revertTileVersionFrom:for: (in category 'updating') ----- + revertTileVersionFrom: anEditor for: playerScripted + "Only for universal tiles." + + anEditor removeAllButFirstSubmorph. + anEditor insertUniversalTiles. + anEditor showingMethodPane: false! Item was changed: ----- 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 revertTileVersionFrom: self for: playerScripted. - 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 revertToTileVersion]! - - 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: + ----- 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.!

1 0

The Trunk: EToys-ct.366.mcz
by commits＠source.squeak.org 18 Feb '21

18 Feb '21

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-ct.366.mcz ==================== Summary ==================== Name: EToys-ct.366 Author: ct Time: 15 October 2019, 2:41:49.434129 pm UUID: f77dfa54-471c-9049-bfc8-f03473a25099 Ancestors: EToys-mt.361 Adds basic support for reconverting ParseNodes into EToys tiles Try out: p := World assuredPlayer. e := (Player >> #liftAllPens) decompile asScriptEditorFor: p. e openInHand. =============== Diff against EToys-mt.361 =============== 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 isReturnSelf + 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 asTileSetForPlayer: aPlayer) after: 0. + compound noPart insertTileRow: (falseNode 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 := #unkown. + 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; + 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 new]. + [#ifFalse:] -> [self arguments copyWithFirst: BlockNode new] } + 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; + fullBounds; + 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: 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: ReturnNode>>asTileSetForPlayer: (in category '*Etoys-tiles') ----- + asTileSetForPlayer: aPlayer + + "self isReturnSelf ifTrue: [^ #()]." + ^ self expr asTileSetForPlayer: aPlayer! 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!

1 0

The Trunk: EToys-mt.422.mcz
by commits＠source.squeak.org 18 Feb '21

18 Feb '21

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!

1 0

← Newer
1
...
11
12
13
14
15
16
17
...
20
Older →

Jump to page: