Squeak-dev January 2024

squeak-dev@lists.squeakfoundation.org

22 participants
89 discussions

The Trunk: EToys-dtl.511.mcz
by commits＠source.squeak.org 16 Jan '24

16 Jan '24

David T. Lewis uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-dtl.511.mcz ==================== Summary ==================== Name: EToys-dtl.511 Author: dtl Time: 15 January 2024, 9:15:17.875147 pm UUID: 90eb09b8-4d2c-41c7-b755-df347500f84d Ancestors: EToys-mt.510 Clean up method categoreies in. Combine similarly named categories. Eliminate redundant method package overrides, if a class is in package Etoys then its methods should not have #Etoys- extensions. =============== Diff against EToys-mt.510 =============== Item was changed: + ----- Method: AcceptableCleanTextMorph>>accept (in category 'menu commands') ----- - ----- Method: AcceptableCleanTextMorph>>accept (in category '*Etoys-menu commands') ----- accept "Overridden to allow accept of clean text" | textToAccept ok | textToAccept := textMorph text. ok := setTextSelector isNil or: [setTextSelector numArgs = 2 ifTrue: [model perform: setTextSelector with: textToAccept with: self] ifFalse: [model perform: setTextSelector with: textToAccept]]. ok ifTrue: [self setText: self getText. self hasUnacceptedEdits: false]! Item was changed: + ----- Method: AllPlayersTool class>>allPlayersToolForActiveWorld (in category 'parts bin') ----- - ----- Method: AllPlayersTool class>>allPlayersToolForActiveWorld (in category '*Etoys-Squeakland-parts bin') ----- allPlayersToolForActiveWorld "Launch an AllPlayersTool to view the scripted objects of the active world" | aTool | aTool := self newStandAlone. aTool center: self currentWorld center. ^ aTool " AllPlayersTool allPlayersToolForActiveWorld "! Item was changed: + ----- Method: AllPlayersTool>>helpString (in category 'menus') ----- - ----- Method: AllPlayersTool>>helpString (in category '*Etoys-Squeakland-menus') ----- helpString "Answer a string of help" ^ 'Each row represents an object, or "player" in the project. Click on the menu icon to get a menu of options concerning the player. Click on a player''s picture to reveal its location. Click on the turquoise eye to open the player''s viewer. Click on a player''s name to obtain a tile representing it.' translated.! Item was changed: + ----- Method: AllPlayersTool>>playersOnDisplay (in category 'reinvigoration') ----- - ----- Method: AllPlayersTool>>playersOnDisplay (in category '*Etoys-Squeakland-reinvigoration') ----- playersOnDisplay "Answer a list of the players represented by the rows in the tool." | aList | (submorphs size < 3 or: [(submorphs third isKindOf: ScrollPane) not]) ifTrue: [^ #()]. aList := submorphs third scroller firstSubmorph submorphs collect: [:aRow | aRow playerRepresented]. ^ aList copyWithout: nil! Item was changed: + ----- Method: AllPlayersTool>>updateScrollbar (in category 'initialization') ----- - ----- Method: AllPlayersTool>>updateScrollbar (in category '*Etoys-Squeakland-initialization') ----- updateScrollbar "Every subsystem needs a little bit of inscrutable magic" self setExtentFromHalo: ((self extent x max:300) @ (self extent y max: 400))! Item was changed: + ----- Method: AllScriptsTool>>helpString (in category 'initialization') ----- - ----- Method: AllScriptsTool>>helpString (in category '*Etoys-Squeakland-initialization') ----- helpString "Answer the help string for the all-scripts tool." ^ 'This tool allows you to see all the scripts for all the objects in this project. Sometimes you are only interested in those scripts that are ticking, or that are *ready* to tick when you hit the GO button (which are said to be "paused.") * Check "tickers only" if you only want to see such scripts -- i.e., scripts that are either paused or ticking. * If "tickers only" is *not* checked, then all scripts will be shown, whatever their status. * The other checkbox, labeled "all instances", only comes into play if you have created "multiple sibling instances" (good grief) of the same object, which share the same scripts; if you have such things, it is often convenient to see the scripts of just *one* such sibling, because it will take up less space and require less mindshare -- and note that you can control a script for an object *and* all its siblings from the menu of that one that you see, via menu items such as "propagate status to siblings". * If "all instances" is checked, scripts for all sibling instances will be shown, whereas if "all instances" is *not* checked, only one of each group of siblings will be selected to have its scripts shown. But how do you get "multiple sibling instances" of the same object? There are several ways: (1) Use the "make a sibling instance" or the "make multiple siblings..." menu item in the halo menu of a scripted object. (2) Use the "copy" tile in a script. (3) Request "give me a copy now" from the menu associated with the "copy" item in a Viewer. If you have on your screen multiple sibling instances of the same object, then you may or may want to see them all in the All Scripts tool, and that is what the "all instances" checkbox governs. Set "all instances" if you want a separate entry for each instance, as opposed to a single representative of that kind of object. Note that if you obtain a copy of an object by using the green halo handle, it will *not* be a sibling instance of the original. It will in many ways seem to be, because it will start out its life having the same scripts as the original. But it will then lead an independent life, so that changes to scripts of the original will not be reflected in it, and vice-versa. This is an important distinction, and an unavoidable one because people sometimes want the deep sharing of sibling instances and sometimes they clearly do not. But the truly understandable description of these concepts and distinctions certainly lies *ahead* of us!!' translated! Item was changed: + ----- Method: AssignmentTileMorph>>assignmentRootForParseNode (in category 'initialization') ----- - ----- Method: AssignmentTileMorph>>assignmentRootForParseNode (in category '*Etoys-Squeakland-player viewer') ----- assignmentRootForParseNode "Answer the assignment root" ^ assignmentRoot asSetterSelector! Item was changed: + ----- Method: AssignmentTileMorph>>assignmentSuffix (in category 'accessing') ----- - ----- Method: AssignmentTileMorph>>assignmentSuffix (in category '*Etoys-Squeakland-accessing') ----- assignmentSuffix ^ assignmentSuffix. ! Item was changed: + ----- Method: AssignmentTileMorph>>operatorForSexpAssignmentSuffix: (in category 'code generation') ----- - ----- Method: AssignmentTileMorph>>operatorForSexpAssignmentSuffix: (in category '*Etoys-Squeakland-code generation') ----- operatorForSexpAssignmentSuffix: aString "Answer the operator associated with the receiver, assumed to be one of the compound assignments" | toTest | toTest := aString asString. #( ('Incr:' #Incr:) ('Decr:' #Decr:) ('Mult:' #Mult:) (':' '')) do: [:pair | toTest = pair first ifTrue: [^ pair second]]. ^ toTest "AssignmentTileMorph new operatorForTreeAssignmentSuffix: 'Incr:'"! Item was changed: + ----- Method: AssignmentTileMorph>>parseNodeWith: (in category 'code generation') ----- - ----- Method: AssignmentTileMorph>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') ----- parseNodeWith: encoder self error: 'error'. ! Item was changed: + ----- Method: BooleanScriptEditor>>parseNodeWith: (in category 'other') ----- - ----- Method: BooleanScriptEditor>>parseNodeWith: (in category '*Etoys-Squeakland-other') ----- parseNodeWith: encoder (submorphs notEmpty and: [submorphs first submorphs notEmpty]) ifTrue: [^ super parseNodeWith: encoder]. ^ encoder encodeLiteral: true. ! Item was changed: + ----- Method: BorderedSubpaneDividerMorph class>>forBottomEdge (in category 'instance creation') ----- - ----- Method: BorderedSubpaneDividerMorph class>>forBottomEdge (in category '*Etoys-instance creation') ----- forBottomEdge ^self new horizontal resizingEdge: #bottom! Item was changed: + ----- Method: BorderedSubpaneDividerMorph class>>forTopEdge (in category 'instance creation') ----- - ----- Method: BorderedSubpaneDividerMorph class>>forTopEdge (in category '*Etoys-instance creation') ----- forTopEdge ^self new horizontal resizingEdge: #top! Item was changed: + ----- Method: BorderedSubpaneDividerMorph class>>horizontal (in category 'instance creation') ----- - ----- Method: BorderedSubpaneDividerMorph class>>horizontal (in category '*Etoys-instance creation') ----- horizontal ^self new horizontal! Item was changed: + ----- Method: BorderedSubpaneDividerMorph class>>vertical (in category 'instance creation') ----- - ----- Method: BorderedSubpaneDividerMorph class>>vertical (in category '*Etoys-instance creation') ----- vertical ^self new vertical! Item was changed: + ----- Method: BorderedSubpaneDividerMorph>>defaultBorderWidth (in category 'initialization') ----- - ----- Method: BorderedSubpaneDividerMorph>>defaultBorderWidth (in category '*Etoys-initialization') ----- defaultBorderWidth "answer the default border width for the receiver" ^ 0! Item was changed: + ----- Method: BorderedSubpaneDividerMorph>>defaultColor (in category 'initialization') ----- - ----- Method: BorderedSubpaneDividerMorph>>defaultColor (in category '*Etoys-initialization') ----- defaultColor "answer the default color/fill style for the receiver" ^ Color black! Item was changed: + ----- Method: BorderedSubpaneDividerMorph>>firstEnter: (in category 'private') ----- - ----- Method: BorderedSubpaneDividerMorph>>firstEnter: (in category '*Etoys-private') ----- firstEnter: evt "The first time this divider is activated, find its window and redirect further interaction there." | window | window := self firstOwnerSuchThat: [:m | m respondsTo: #secondaryPaneTransition:divider:]. window ifNil: [ self suspendEventHandler. ^ self ]. "not working out" window secondaryPaneTransition: evt divider: self. self on: #mouseEnter send: #secondaryPaneTransition:divider: to: window. ! Item was changed: + ----- Method: BorderedSubpaneDividerMorph>>horizontal (in category 'layout') ----- - ----- Method: BorderedSubpaneDividerMorph>>horizontal (in category '*Etoys-layout') ----- horizontal self hResizing: #spaceFill.! Item was changed: + ----- Method: BorderedSubpaneDividerMorph>>initialize (in category 'initialization') ----- - ----- Method: BorderedSubpaneDividerMorph>>initialize (in category '*Etoys-initialization') ----- initialize "initialize the state of the receiver" super initialize. "" self extent: 1 @ 1! Item was changed: + ----- Method: BorderedSubpaneDividerMorph>>resizingEdge (in category 'accessing') ----- - ----- Method: BorderedSubpaneDividerMorph>>resizingEdge (in category '*Etoys-accessing') ----- resizingEdge ^resizingEdge ! Item was changed: + ----- Method: BorderedSubpaneDividerMorph>>resizingEdge: (in category 'accessing') ----- - ----- Method: BorderedSubpaneDividerMorph>>resizingEdge: (in category '*Etoys-accessing') ----- resizingEdge: edgeSymbol (#(top bottom) includes: edgeSymbol) ifFalse: [ self error: 'resizingEdge must be #top or #bottom' ]. resizingEdge := edgeSymbol. self on: #mouseEnter send: #firstEnter: to: self. ! Item was changed: + ----- Method: BorderedSubpaneDividerMorph>>vertical (in category 'layout') ----- - ----- Method: BorderedSubpaneDividerMorph>>vertical (in category '*Etoys-layout') ----- vertical self vResizing: #spaceFill.! Item was changed: + ----- Method: BrowserCommentTextMorph>>hideOrShowPane (in category 'displaying') ----- - ----- Method: BrowserCommentTextMorph>>hideOrShowPane (in category '*Etoys-displaying') ----- hideOrShowPane (self model editSelection == #editClass) ifTrue: [ self showPane ] ifFalse: [ self hidePane ]! Item was changed: + ----- Method: BrowserCommentTextMorph>>hidePane (in category 'displaying') ----- - ----- Method: BrowserCommentTextMorph>>hidePane (in category '*Etoys-displaying') ----- hidePane | win | self window ifNotNil: [:window | window removePaneSplitters]. self lowerPane ifNotNil: [ :lp | lp layoutFrame bottomFraction: self layoutFrame bottomFraction. lp layoutFrame bottomOffset: SystemWindow borderWidth negated]. win := self window ifNil: [ ^self ]. self delete. win updatePanesFromSubmorphs. win addPaneSplitters! Item was changed: + ----- Method: BrowserCommentTextMorph>>lowerPane (in category 'accessing') ----- - ----- Method: BrowserCommentTextMorph>>lowerPane (in category '*Etoys-accessing') ----- lowerPane "Answer the AlignmentMorph that I live beneath" ^self valueOfProperty: #browserLowerPane! Item was changed: + ----- Method: BrowserCommentTextMorph>>noteNewOwner: (in category 'updating') ----- - ----- Method: BrowserCommentTextMorph>>noteNewOwner: (in category '*Etoys-updating') ----- noteNewOwner: win super noteNewOwner: win. self setProperty: #browserWindow toValue: win. win ifNil: [ ^self ]. win setProperty: #browserClassCommentPane toValue: self. self setProperty: #browserLowerPane toValue: (win submorphThat: [ :m | m isAlignmentMorph and: [ m layoutFrame bottomFraction notNil and: [ m layoutFrame bottomFraction >= self layoutFrame topFraction ]]] ifNone: [])! Item was changed: + ----- Method: BrowserCommentTextMorph>>showPane (in category 'displaying') ----- - ----- Method: BrowserCommentTextMorph>>showPane (in category '*Etoys-displaying') ----- showPane owner ifNil: [ | win | win := self window ifNil: [ ^self ]. win addMorph: self fullFrame: self layoutFrame. win updatePanesFromSubmorphs ]. self lowerPane ifNotNil: [ :lp | lp layoutFrame bottomFraction: self layoutFrame topFraction ]. self window ifNotNil: [:win | win addPaneSplitters]! Item was changed: + ----- Method: BrowserCommentTextMorph>>update: (in category 'updating') ----- - ----- Method: BrowserCommentTextMorph>>update: (in category '*Etoys-updating') ----- update: anAspect super update: anAspect. anAspect == #editSelection ifFalse: [ ^self ]. self hideOrShowPane! Item was changed: + ----- Method: BrowserCommentTextMorph>>window (in category 'accessing') ----- - ----- Method: BrowserCommentTextMorph>>window (in category '*Etoys-accessing') ----- window ^self owner ifNil: [ self valueOfProperty: #browserWindow ].! Item was changed: + ----- Method: CategoryViewer>>addColorSeesDetailTo: (in category 'editing pane') ----- - ----- Method: CategoryViewer>>addColorSeesDetailTo: (in category '*Etoys-Squeakland-entries') ----- addColorSeesDetailTo: aRow "Special-casee code for the boolean-valued phrase variously known as is-over-color or sees-color." | hotTileForSelf colorMorph | (aRow submorphs last) delete. aRow addMorphBack: (hotTileForSelf := ColorSeerTile new showPalette: false; yourself). aRow addMorphBack: (colorMorph := ColorTileMorph new showPalette: false; typeColor: (ScriptingSystem colorForType: #Color); yourself). colorMorph colorSwatch color: Color blue. hotTileForSelf on: #mouseEnter send: #addGetterFeedback to: aRow. hotTileForSelf on: #mouseLeave send: #removeHighlightFeedback to: aRow. hotTileForSelf on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow. hotTileForSelf on: #mouseDown send: #makeGetter:event:from: to: self withValue: (Array with: #color:sees: with: #Boolean). colorMorph on: #mouseEnter send: #addGetterFeedback to: aRow. colorMorph on: #mouseLeave send: #removeHighlightFeedback to: aRow. colorMorph on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow. colorMorph on: #mouseDown send: #makeGetter:event:from: to: self withValue: (Array with: #color:sees: with: #Boolean). aRow addMorphBack: (Morph new extent: 0@(aRow height)). ! Item was changed: + ----- Method: CategoryViewer>>addPlayerArgumentTo: (in category 'entries') ----- - ----- Method: CategoryViewer>>addPlayerArgumentTo: (in category '*Etoys-Squeakland-entries') ----- addPlayerArgumentTo: aRow "Add, delimited by spacer morphs, a player-valued TileMorph to the row provided." | aTileToRefer | aRow addMorphBack: (Morph new extent: 0@0). "spacer (Is this spacer really needed??? - takashi)" aTileToRefer := self presenter standardPlayer tileToRefer. aTileToRefer on: #mouseEnter send: #addGetterFeedback to: aRow. aTileToRefer on: #mouseLeave send: #removeHighlightFeedback to: aRow. aTileToRefer on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow. aRow addMorphBack: aTileToRefer . aRow addMorphBack: (AlignmentMorph new beTransparent). "flexible spacer" ! Item was changed: + ----- Method: CategoryViewer>>assureCategoryFullyVisible (in category 'categories') ----- - ----- Method: CategoryViewer>>assureCategoryFullyVisible (in category '*Etoys-Squeakland-categories') ----- assureCategoryFullyVisible "Keep deleting categoryviewers other than the receiver until the receiver is fully visible." | ready toDelete | ready := false. [(self bounds bottom > self currentWorld bottom) and: [ready not]] whileTrue: [ owner submorphs size > 2 ifTrue: [ toDelete := owner submorphs allButFirst reversed detect: [:cv | cv ~~ self] ifNone: [^ self]. toDelete delete. self world doOneCycleNow] ifFalse: [ ready := true]].! Item was changed: + ----- Method: CategoryViewer>>booleanPhraseFromNumericGetterWithArgument: (in category 'support') ----- - ----- Method: CategoryViewer>>booleanPhraseFromNumericGetterWithArgument: (in category '*Etoys-Squeakland-as yet unclassified') ----- booleanPhraseFromNumericGetterWithArgument: phrase "Answer a morph derived from the incoming phrase, a bearingTo: or distanceToPlayer: phrase, which will be suitable for dropping into a TEST area. " | outerPhrase rel finalTile | rel := Vocabulary numberVocabulary comparatorForSampleBoolean. outerPhrase := PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: #Number argType: #Number. outerPhrase firstSubmorph addMorph: phrase. outerPhrase firstSubmorph changeTableLayout. finalTile := ScriptingSystem tileForArgType: #Number. "comes with arrows" outerPhrase submorphs last addMorph: finalTile. outerPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: rel). ^ outerPhrase! Item was changed: + ----- Method: CategoryViewer>>categoryNameMorph (in category 'categories') ----- - ----- Method: CategoryViewer>>categoryNameMorph (in category '*Etoys-Squeakland-categories') ----- categoryNameMorph "Answer the StringMorph that holds the current category name." ^ namePane findA: StringMorph! Item was changed: + ----- Method: CategoryViewer>>phraseForTest (in category 'entries') ----- - ----- Method: CategoryViewer>>phraseForTest (in category '*Etoys-Squeakland-entries') ----- phraseForTest "Answer a phrase for the non-slot-like command represented by aMethodInterface - classic tiles" | aPhrase aRow | aPhrase := PhraseTileForTest new. aRow := ViewerLine newRow. aRow addMorphBack: ScriptingSystem buttonSpacer. aRow addMorphBack: self spacerAfterButton. aRow addMorphBack: aPhrase. aRow setBalloonText: 'Press here to tear off a TEST/YES/NO unit which you can drop into your script' translated. ^ aRow. ! Item was changed: + ----- Method: CategoryViewer>>phraseForTimesRepeat (in category 'entries') ----- - ----- Method: CategoryViewer>>phraseForTimesRepeat (in category '*Etoys-Squeakland-entries') ----- phraseForTimesRepeat "Answer a phrase representing times/repeat" | aPhrase aRow | aPhrase := PhraseTileForTimesRepeat new. aRow := ViewerLine newRow. aRow addMorphBack: ScriptingSystem buttonSpacer. aRow addMorphBack: self spacerAfterButton. aRow addMorphBack: aPhrase. aRow setBalloonText: 'Drag here to tear off a Repeat/Times unit which you can drop into your script' translated. ^ aRow. ! Item was changed: + ----- Method: CategoryViewer>>spacerAfterButton (in category 'entries') ----- - ----- Method: CategoryViewer>>spacerAfterButton (in category '*Etoys-Squeakland-entries') ----- spacerAfterButton ^ Morph new extent: 2 @ 0; beTransparent! Item was changed: + ----- Method: CategoryViewer>>universalTilesPhraseForVariableFrom: (in category 'entries') ----- - ----- Method: CategoryViewer>>universalTilesPhraseForVariableFrom: (in category '*Etoys-Squeakland-entries') ----- universalTilesPhraseForVariableFrom: aMethodInterface "The universal-tiles variant of phraseForVariableFrom:... Split out to preserve it, somewhat, though we're not using universal tiles any more, presuambly ever again (indeed we never did) but for convenience moved here so that 'universal' code doesn't becloud #phraseForVariableFrom:" | anArrow slotName getterButton cover inner aRow doc setter tryer | aRow := ViewerLine newRow elementSymbol: (slotName := aMethodInterface selector); wrapCentering: #center; cellPositioning: #leftCenter. (self wantsInfoButtonFor: slotName) ifFalse: [aRow addMorphBack: ScriptingSystem buttonSpacer] ifTrue: [aRow addMorphBack: (self infoButtonFor: slotName)]. aRow addMorphBack: self spacerAfterButton. inner := scriptedPlayer universalTilesForGetterOf: aMethodInterface. cover := Morph new color: Color transparent. cover extent: inner fullBounds extent. (getterButton := cover copy) addMorph: cover; addMorphBack: inner. cover on: #mouseDown send: #makeUniversalTilesGetter:event:from: to: self withValue: aMethodInterface. aRow addMorphFront: (tryer := ScriptingSystem tryButtonFor: inner). tryer color: tryer color lighter lighter. aRow addMorphBack: getterButton. getterButton on: #mouseEnter send: #addGetterFeedback to: aRow. getterButton on: #mouseLeave send: #removeHighlightFeedback to: aRow. getterButton on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow. (doc := aMethodInterface documentation) ifNotNil: [getterButton setBalloonText: doc]. aRow addMorphBack: (AlignmentMorph new beTransparent). "flexible spacer" (setter := aMethodInterface companionSetterSelector) ifNotNil: [aRow addMorphBack: (Morph new color: self color; extent: 2@10). " spacer" anArrow := self arrowSetterButton: #newMakeSetterFromInterface:evt:from: args: aMethodInterface. anArrow beTransparent. aRow addMorphBack: anArrow]. anArrow ifNotNil: [anArrow step]. ^ aRow! Item was changed: + ----- Method: CategoryViewer>>wantsInfoButtonFor: (in category 'entries') ----- - ----- Method: CategoryViewer>>wantsInfoButtonFor: (in category '*Etoys-Squeakland-entries') ----- wantsInfoButtonFor: slotName "Answer whether a menu button is desired in a viewer for a slot of the given name." ^ (#(color:sees: seesColor: overlaps: overlapsAny: touchesA:) includes: slotName) not! Item was changed: + ----- Method: ColorSeerTile>>parseNodeWith: (in category 'code generation') ----- - ----- Method: ColorSeerTile>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') ----- parseNodeWith: encoder self error: 'should not reach here'.! Item was changed: + ----- Method: CompoundTileMorph>>aboutToBeAcceptedInScriptor (in category 'miscellaneous') ----- - ----- Method: CompoundTileMorph>>aboutToBeAcceptedInScriptor (in category '*Etoys-Squeakland-miscellaneous') ----- aboutToBeAcceptedInScriptor "The receiver is about to be accepted in a Scriptor. Adjust state information accordingly." justGrabbedFromViewer := false. self removeProperty: #newPermanentScript. self removeProperty: #newPermanentPlayer. ! Item was changed: + ----- Method: CompoundTileMorph>>addCommandFeedback: (in category 'miscellaneous') ----- - ----- Method: CompoundTileMorph>>addCommandFeedback: (in category '*Etoys-Squeakland-miscellaneous') ----- addCommandFeedback: evt "Add screen feedback showing what would be torn off in a drag" | aMorph | aMorph := RectangleMorph new bounds: self bounds; beTransparent; borderWidth: 2; borderColor: ScriptingSystem commandFeedback; lock; yourself. self currentWorld addHighlightMorph: aMorph for: self outmostScriptEditor.! Item was changed: + ----- Method: CompoundTileMorph>>blockNode:with: (in category 'code generation') ----- - ----- Method: CompoundTileMorph>>blockNode:with: (in category '*Etoys-Squeakland-code generation') ----- blockNode: scriptPart with: encoder ^ BlockNode new arguments: #() statements: (self blockNodeElements: scriptPart with: encoder) returns: false from: encoder. ! Item was changed: + ----- Method: CompoundTileMorph>>blockNodeElements:with: (in category 'code generation') ----- - ----- Method: CompoundTileMorph>>blockNodeElements:with: (in category '*Etoys-Squeakland-code generation') ----- blockNodeElements: scriptPart with: encoder | rows r | rows := scriptPart tileRows. ^ Array streamContents: [:strm | 1 to: rows size do: [:i | r := rows at: i. r do: [:t | strm nextPut: (t parseNodeWith: encoder asStatement: true)]. ]. ]. ! Item was changed: + ----- Method: CompoundTileMorph>>delegatingMouseEnter: (in category 'initialization') ----- - ----- Method: CompoundTileMorph>>delegatingMouseEnter: (in category '*Etoys-Squeakland-initialization') ----- delegatingMouseEnter: evt | o oo | (o := self owner) ifNotNil: [(oo := o owner) ifNotNil: [^ oo mouseEnter: evt]]. ! Item was changed: + ----- Method: CompoundTileMorph>>evaluateOn: (in category 'etoys-debugger') ----- - ----- Method: CompoundTileMorph>>evaluateOn: (in category '*Etoys-Squeakland-etoys-debugger') ----- evaluateOn: anEtoysDebugger ^ anEtoysDebugger evaluateTest: self! Item was changed: + ----- Method: CompoundTileMorph>>evaluateTestPart (in category 'etoys-debugger') ----- - ----- Method: CompoundTileMorph>>evaluateTestPart (in category '*Etoys-Squeakland-etoys-debugger') ----- evaluateTestPart | condition | condition := testPart tiles at: 1 ifAbsent: [^ true]. ^ Compiler evaluate: condition codeString for: (condition associatedPlayer ifNil: [condition topEditor playerScripted]) logged: false! Item was changed: + ----- Method: CompoundTileMorph>>justGrabbedFromViewer (in category 'miscellaneous') ----- - ----- Method: CompoundTileMorph>>justGrabbedFromViewer (in category '*Etoys-Squeakland-miscellaneous') ----- justGrabbedFromViewer "Answer whether the receiver originated in a Viewer. Only tiles that originated in a viewer will ever do that infernal sprouting of a new script around them. The nil branch is only for backward compatibility." ^ justGrabbedFromViewer ifNil: [justGrabbedFromViewer := true]! Item was changed: + ----- Method: CompoundTileMorph>>justGrabbedFromViewer: (in category 'miscellaneous') ----- - ----- Method: CompoundTileMorph>>justGrabbedFromViewer: (in category '*Etoys-Squeakland-miscellaneous') ----- justGrabbedFromViewer: aBoolean "Set the receiver's justGrabbedFromViewer instance variable" justGrabbedFromViewer := aBoolean! Item was changed: + ----- Method: CompoundTileMorph>>justGrabbedFromViewerOrNil (in category 'miscellaneous') ----- - ----- Method: CompoundTileMorph>>justGrabbedFromViewerOrNil (in category '*Etoys-Squeakland-miscellaneous') ----- justGrabbedFromViewerOrNil "Answer the value of the receiver's justGrabbedFromViewer slot. Needed only for conversion methods" ^ justGrabbedFromViewer! Item was changed: + ----- Method: CompoundTileMorph>>labelMorphs (in category 'access') ----- - ----- Method: CompoundTileMorph>>labelMorphs (in category '*Etoys-Squeakland-access') ----- labelMorphs | w | w := WriteStream on: (Array new: 3). w nextPut: self submorphs first submorphs second. w nextPut: self submorphs second submorphs second. w nextPut: self submorphs third submorphs second. ^ w contents. ! Item was changed: + ----- Method: CompoundTileMorph>>noPart (in category 'etoys-debugger') ----- - ----- Method: CompoundTileMorph>>noPart (in category '*Etoys-Squeakland-etoys-debugger') ----- noPart ^ noPart! Item was changed: + ----- Method: CompoundTileMorph>>parseNodeWith: (in category 'code generation') ----- - ----- Method: CompoundTileMorph>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') ----- parseNodeWith: encoder | rec yes no | rec := (self blockNodeElements: testPart with: encoder). rec size > 0 ifTrue: [rec := rec last] ifFalse: [rec := encoder encodeLiteral: true]. yes := self blockNode: yesPart with: encoder. no := self blockNode: noPart with: encoder. ^ MessageNode new receiver: rec selector: #ifTrue:ifFalse: arguments: (Array with: yes with: no) precedence: (#ifTrue:ifFalse: precedence) from: encoder sourceRange: nil. ! Item was changed: + ----- Method: CompoundTileMorph>>parseNodeWith:asStatement: (in category 'code generation') ----- - ----- Method: CompoundTileMorph>>parseNodeWith:asStatement: (in category '*Etoys-Squeakland-code generation') ----- parseNodeWith: encoder asStatement: aBoolean ^ self parseNodeWith: encoder. ! Item was changed: + ----- Method: CompoundTileMorph>>removeHighlightFeedback (in category 'miscellaneous') ----- - ----- Method: CompoundTileMorph>>removeHighlightFeedback (in category '*Etoys-Squeakland-miscellaneous') ----- removeHighlightFeedback "Remove any existing highlight feedback" self world removeHighlightFeedback. ! Item was changed: + ----- Method: CompoundTileMorph>>testPart (in category 'etoys-debugger') ----- - ----- Method: CompoundTileMorph>>testPart (in category '*Etoys-Squeakland-etoys-debugger') ----- testPart ^ testPart! Item was changed: + ----- Method: CompoundTileMorph>>unhibernate (in category 'initialization') ----- - ----- Method: CompoundTileMorph>>unhibernate (in category '*Etoys-Squeakland-initialization') ----- unhibernate self labelMorphs do: [:l | l label: l contents font: Preferences standardEToysFont]. self removeProperty: #needsLayoutFixed. ! Item was changed: + ----- Method: CompoundTileMorph>>yesPart (in category 'etoys-debugger') ----- - ----- Method: CompoundTileMorph>>yesPart (in category '*Etoys-Squeakland-etoys-debugger') ----- yesPart ^ yesPart! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>ageTriplets (in category 'Squeakland-classification accessing') ----- - ----- Method: EToyProjectDetailsMorph class>>ageTriplets (in category '*Etoys-Squeakland-classification accessing') ----- ageTriplets "Answer a list of the triplets characterizing the 'age' categories; each triplet is of the form (<numeric code> <string code> <english version>)" ^ AgeTriplets ifNil: [ AgeTriplets := (self cachedTripletsFor: #age) ifNil: [self defaultAgeTriplets]]! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>cachedTripletsFor: (in category 'Squeakland-classification information') ----- - ----- Method: EToyProjectDetailsMorph class>>cachedTripletsFor: (in category '*Etoys-Squeakland-classification information') ----- cachedTripletsFor: aCategory "Load triplets from file, e.g. '.ageCatList-de.csv' for the 'age' category" | file | [ file := FileStream readOnlyFileNamed: (self tripletsFileNameFor: aCategory). [^self tripletsFrom: file contentsOfEntireFile] ensure: [file close]. ] ifError: []. ^nil ! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>csvLineQuotedDecodedFor: (in category 'Squeakland-utilities') ----- - ----- Method: EToyProjectDetailsMorph class>>csvLineQuotedDecodedFor: (in category '*Etoys-Squeakland-utilities') ----- csvLineQuotedDecodedFor: aString "Given that the string provided consists of items delimited by double-quotes and separated by commas, answer an array containing the individual items with quotes removed." | openQuoteHanging readStream elementStream char | openQuoteHanging := false. ^ Array streamContents: [:writeStream | readStream := aString readStream. elementStream := WriteStream on: ''. [readStream atEnd] whileFalse: [char := readStream next. char = $" ifTrue: [openQuoteHanging ifTrue: [writeStream nextPut: elementStream contents. elementStream := WriteStream on: ''. openQuoteHanging := false] ifFalse: [openQuoteHanging := true]] ifFalse: [openQuoteHanging ifTrue: [elementStream nextPut: char]]]] " (((HTTPSocket httpGet: 'http://squeakland.org/subjectCatList' args: #() user: '' passwd: '')) contents copyReplaceAll: String lf with: String cr) lines collect: [:l | EToyProjectDetailsMorph csvLineQuotedDecodedFor: l] "! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>defaultAgeTriplets (in category 'Squeakland-classification defaults') ----- - ----- Method: EToyProjectDetailsMorph class>>defaultAgeTriplets (in category '*Etoys-Squeakland-classification defaults') ----- defaultAgeTriplets "Answer a default set of triplets characterizing the Age classifications" ^ #( ('556' 'showcase : by age : 6 to 8' 'Ages 6 to 8') ('558' 'showcase : by age : 9 to 11' 'Ages 9 to 11') ('559' 'showcase : by age : 12 to 14' 'Ages 12 to 14') ('560' 'showcase : by age : 15 to 18' 'Ages 15 to 18') )! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>defaultRegionTriplets (in category 'Squeakland-classification defaults') ----- - ----- Method: EToyProjectDetailsMorph class>>defaultRegionTriplets (in category '*Etoys-Squeakland-classification defaults') ----- defaultRegionTriplets "Answer default triplets for the region codes" ^ #( ('619' 'showcase : by region : Africa' 'Africa') ('620' 'showcase : by region : Antarctica' 'Antarctica') ('621' 'showcase : by region : Asia' 'Asia') ('622' 'showcase : by region : Australia' 'Australia') ('623' 'showcase : by region : Caribbean' 'Caribbean') ('624' 'showcase : by region : Central America' 'Central America') ('625' 'showcase : by region : Europe' 'Europe') ('626' 'showcase : by region : North America' 'North America') ('627' 'showcase : by region : Oceania' 'Oceania') ('628' 'showcase : by region : South America' 'South America') ) " EToyProjectDetailsMorph defaultRegionTriplets "! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>defaultSubjectTriplets (in category 'Squeakland-classification defaults') ----- - ----- Method: EToyProjectDetailsMorph class>>defaultSubjectTriplets (in category '*Etoys-Squeakland-classification defaults') ----- defaultSubjectTriplets "Answer a default set of triplets characterizing the Subject classifications" ^ #( ('554' 'showcase : by subject : language arts' 'Language Arts') ('553' 'showcase : by subject : mathemetics' 'Mathematics') ('555' 'showcase : by subject : science' 'Science') ('860' 'showcase : by subject : social studies' 'Social Studies') ('861' 'showcase : by subject : music' 'Music') ('862' 'showcase : by subject : visual arts' 'Visual Arts') ('863' 'showcase : by subject : health' 'Health'))! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>linesIn: (in category 'Squeakland-utilities') ----- - ----- Method: EToyProjectDetailsMorph class>>linesIn: (in category '*Etoys-Squeakland-utilities') ----- linesIn: aString "Answer an array whose elements are strings constituting the lines in the input string." ^ Array streamContents: [:aStream | aString linesDo: [: aLine | aStream nextPut: aLine]] " EToyProjectDetailsMorph linesIn: 'Fred the Bear' "! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>regionTriplets (in category 'Squeakland-classification accessing') ----- - ----- Method: EToyProjectDetailsMorph class>>regionTriplets (in category '*Etoys-Squeakland-classification accessing') ----- regionTriplets "Answer a list of triplets of the form (numberCode stringCode englishName) for the regions." ^ RegionTriplets ifNil: [ RegionTriplets := (self cachedTripletsFor: #region) ifNil: [self defaultRegionTriplets]]! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>restoreDefaultTriplets (in category 'Squeakland-classification defaults') ----- - ----- Method: EToyProjectDetailsMorph class>>restoreDefaultTriplets (in category '*Etoys-Squeakland-classification defaults') ----- restoreDefaultTriplets "Restore the defaults obtained from cold hard code." RegionTriplets := self defaultRegionTriplets. AgeTriplets := self defaultAgeTriplets. SubjectTriplets := self defaultSubjectTriplets " EToyProjectDetailsMorph restoreDefaultTriplets "! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>subjectTriplets (in category 'Squeakland-classification accessing') ----- - ----- Method: EToyProjectDetailsMorph class>>subjectTriplets (in category '*Etoys-Squeakland-classification accessing') ----- subjectTriplets "Answer a list of triplets characterizing the subjects in the current taxonomy." ^ SubjectTriplets ifNil: [ SubjectTriplets := (self cachedTripletsFor: #subject) ifNil: [self defaultSubjectTriplets]]! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>tripletsFileNameFor: (in category 'Squeakland-classification information') ----- - ----- Method: EToyProjectDetailsMorph class>>tripletsFileNameFor: (in category '*Etoys-Squeakland-classification information') ----- tripletsFileNameFor: aCategory "self tripletsFileNameFor: #age" ^ '.', aCategory, 'CatList-', Locale current localeID printString, '.csv' ! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>tripletsFrom: (in category 'Squeakland-classification information') ----- - ----- Method: EToyProjectDetailsMorph class>>tripletsFrom: (in category '*Etoys-Squeakland-classification information') ----- tripletsFrom: csvString | result | [result := (self linesIn: (csvString copyReplaceAll: String lf with: String cr)) collect: [:l | self csvLineQuotedDecodedFor: l] ] on: Error do: [:ex | ^ nil]. (self validateCategoryTriplets: result) ifFalse: [^ nil]. ^result. ! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>tripletsUrlFor: (in category 'Squeakland-classification information') ----- - ----- Method: EToyProjectDetailsMorph class>>tripletsUrlFor: (in category '*Etoys-Squeakland-classification information') ----- tripletsUrlFor: aCategory "self tripletsUrlFor: #age" ^'http://squeakland.org/', aCategory, 'CatList?lang=', Locale current localeID printString! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>updateTripletsFor: (in category 'Squeakland-classification information') ----- - ----- Method: EToyProjectDetailsMorph class>>updateTripletsFor: (in category '*Etoys-Squeakland-classification information') ----- updateTripletsFor: aCategory "Fetch the age-range, subject, or region triplet files from the web site and cache them locally." | contents triplets file filename | contents := (HTTPSocket httpGet: (self tripletsUrlFor: aCategory) args: #() user: '' passwd: '') contents. triplets := self tripletsFrom: contents. triplets ifNotNil: [ self useTriplets: triplets for: aCategory. filename := self tripletsFileNameFor: aCategory. file := FileStream fileNamed: filename. [file truncate; nextPutAll: contents] ensure: [file close]. ]. ! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>updateTripletsFromWebSite (in category 'Squeakland-classification information') ----- - ----- Method: EToyProjectDetailsMorph class>>updateTripletsFromWebSite (in category '*Etoys-Squeakland-classification information') ----- updateTripletsFromWebSite "Attempt to update the age-range, subject, and region triplets cache on file by looking for the latest versions on the web site." #(age subject region) do: [:cat | self updateTripletsFor: cat]! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>updateTripletsFromWebSiteInBackground (in category 'Squeakland-classification information') ----- - ----- Method: EToyProjectDetailsMorph class>>updateTripletsFromWebSiteInBackground (in category '*Etoys-Squeakland-classification information') ----- updateTripletsFromWebSiteInBackground [ [self updateTripletsFromWebSite] ifError: [] ] forkAt: Processor userBackgroundPriority named: 'Etoys category updater'! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>useTriplets:for: (in category 'Squeakland-classification accessing') ----- - ----- Method: EToyProjectDetailsMorph class>>useTriplets:for: (in category '*Etoys-Squeakland-classification accessing') ----- useTriplets: triplets for: aCategory aCategory = #age ifTrue: [AgeTriplets := triplets]. aCategory = #subject ifTrue: [SubjectTriplets := triplets]. aCategory = #region ifTrue: [RegionTriplets := triplets].! Item was changed: + ----- Method: EToyProjectDetailsMorph class>>validateCategoryTriplets: (in category 'Squeakland-classification information') ----- - ----- Method: EToyProjectDetailsMorph class>>validateCategoryTriplets: (in category '*Etoys-Squeakland-classification information') ----- validateCategoryTriplets: aList "The input is a tuple obtained by extracting lines from a string obtained from the squeakland web site. Answer true if the tuple passes the smoke-test for category triplets." (aList isNil or: [aList size < 2]) ifTrue: [^ false]. aList do: [:element | (element isCollection not or: [element size < 3]) ifTrue: [^ false]]. ^ true " self validateCategoryTriplets: RegionTriplets "! Item was changed: + ----- Method: EToyProjectDetailsMorph>>choicesFor: (in category 'Squeakland-utilities') ----- - ----- Method: EToyProjectDetailsMorph>>choicesFor: (in category '*Etoys-Squeakland-utilities') ----- choicesFor: aSymbol "Answer the list of choices to offer for the given symbol, which will be subject, age, or region. Answer nil if the symbol provided is one without enumerated choices." aSymbol = #subject ifTrue: [^ self class subjectTriplets]. aSymbol = #age ifTrue: [^ self class ageTriplets]. aSymbol = #region ifTrue: [^ self class regionTriplets]. ^ nil! Item was changed: + ----- Method: EToyProjectDetailsMorph>>doPopUp:event:for: (in category 'Squeakland-utilities') ----- - ----- Method: EToyProjectDetailsMorph>>doPopUp:event:for: (in category '*Etoys-Squeakland-utilities') ----- doPopUp: aSymbol event: anEvent for: aTextMorph "The user clicked on a pop-up field in the project-info dialog. Put up the pop-up of choices." | aMenu aTitle | aMenu := MenuMorph new defaultTarget: self. aTitle := aTextMorph valueOfProperty: #menuTitle. aTitle ifNotNil: [aMenu addTitle: aTitle translated]. aMenu add: '(none)' translated target: self selector: #setInfoField:to: argumentList: {aSymbol asString. '(none)'}. aMenu addLine. (self choicesFor: aSymbol) do: [:aChoice | aMenu add: aChoice third translated target: self selector: #setInfoField:to: argumentList: {aSymbol. aChoice first}]. aMenu popUpInWorld! Item was changed: + ----- Method: EToyProjectDetailsMorph>>popUpEntryNamed: (in category 'Squeakland-utilities') ----- - ----- Method: EToyProjectDetailsMorph>>popUpEntryNamed: (in category '*Etoys-Squeakland-utilities') ----- popUpEntryNamed: aString "Answer a text morph that will serve as a pop-up" | newField | newField := StaticTextMorph new beAllFont: self myFont; extent: 400 @ 20; contentsWrapped: '(none)' translated. namedFields at: aString put: newField. newField on: #click send: #doPopUp:event:for: to: self withValue: aString. ^ newField! Item was changed: + ----- Method: EToyProjectDetailsMorph>>popUpEntryNamed:menuTitle: (in category 'Squeakland-utilities') ----- - ----- Method: EToyProjectDetailsMorph>>popUpEntryNamed:menuTitle: (in category '*Etoys-Squeakland-utilities') ----- popUpEntryNamed: aString menuTitle: titleInEnglish "Answer a text morph that will serve as a pop-up. The first parameter is the key in the named-fields dictionary, the second is the title (in english) to give to the menu." | newField | newField := StaticTextMorph new beAllFont: self myFont; extent: 400 @ 20; contentsWrapped: '(none)' translated. newField setProperty: #menuTitle toValue: titleInEnglish. namedFields at: aString put: newField. newField on: #click send: #doPopUp:event:for: to: self withValue: aString. ^ newField! Item was changed: + ----- Method: EToyProjectDetailsMorph>>setInfoField:to: (in category 'Squeakland-utilities') ----- - ----- Method: EToyProjectDetailsMorph>>setInfoField:to: (in category '*Etoys-Squeakland-utilities') ----- setInfoField: aFieldName to: aValue "Install a value into an info field of the dialog. Textual fields are filled literally, but enumerated fields (subject, region, etc.) are represented by codes which get mapped into (translated) text to display." | newValue choices | newValue := aValue. choices := self choicesFor: aFieldName. choices ifNotNil: "i.e. one of the fields with enumerated values" [(choices detect: [:c | c first = aValue] ifNone: [nil]) ifNotNil: [:item | newValue := item third translated]]. (namedFields at: aFieldName) contentsWrapped: newValue ! Item was changed: + ----- Method: EToyProjectQueryMorph>>carryOutQuery:onProjectServer: (in category 'Squeakland-query') ----- - ----- Method: EToyProjectQueryMorph>>carryOutQuery:onProjectServer: (in category '*Etoys-Squeakland-query') ----- carryOutQuery: details onProjectServer: aProjectServer "The user submitted a query; the parameter holds the details dictionary. Carry out the query." | criteria clean | criteria := OrderedCollection new. details keysAndValuesDo: [ :k :v | (clean := v withBlanksTrimmed convertToEncoding: SuperSwikiServer defaultEncodingName) isEmpty ifFalse: [criteria add: k,': *',clean,'*']]. aProjectServer queryProjectsAndShow: criteria! Item was changed: + ----- Method: EtoyUpdatingThreePhaseButtonMorph class>>setForms (in category 'accessing') ----- - ----- Method: EtoyUpdatingThreePhaseButtonMorph class>>setForms (in category 'as yet unclassified') ----- setForms CheckedForm := (Form extent: 12@12 depth: 32 fromArray: #( 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 0 0 0 0 0 0 0 0 0 0 4278190081 4278190081 0 0 0 0 0 0 0 0 0 4278190081 4278190081 4278190081 0 0 0 0 0 0 0 0 4278190081 2003331177 4278190081 4278190081 0 0 0 0 0 0 0 4278190081 2003331177 0 4278190081 4278190081 0 0 0 0 0 0 4278190081 2003331177 0 0 4278190081 4278190081 0 4278190081 0 0 0 4278190081 2003331177 0 0 0 4278190081 4278190081 0 2003331177 4278190081 0 4278190081 2003331177 0 0 0 0 4278190081 4278190081 0 0 2003331177 4278190081 2003331177 0 0 0 0 0 4278190081 4278190081 0 0 0 2003331177 0 0 0 0 0 0 4278190081 4278190081 0 0 0 0 0 0 0 0 0 0 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081) offset: 0@0). MouseDownForm := UncheckedForm := (Form extent: 12@12 depth: 32 fromArray: #( 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 0 0 0 0 0 0 0 0 0 0 4278190081 4278190081 0 0 0 0 0 0 0 0 0 0 4278190081 4278190081 0 0 0 0 0 0 0 0 0 0 4278190081 4278190081 0 0 0 0 0 0 0 0 0 0 4278190081 4278190081 0 0 0 0 0 0 0 0 0 0 4278190081 4278190081 0 0 0 0 0 0 0 0 0 0 4278190081 4278190081 0 0 0 0 0 0 0 0 0 0 4278190081 4278190081 0 0 0 0 0 0 0 0 0 0 4278190081 4278190081 0 0 0 0 0 0 0 0 0 0 4278190081 4278190081 0 0 0 0 0 0 0 0 0 0 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081 4278190081) offset: 0@0)! Item was changed: + ----- Method: EtoyUpdatingThreePhaseButtonMorph class>>setForms: (in category 'accessing') ----- - ----- Method: EtoyUpdatingThreePhaseButtonMorph class>>setForms: (in category '*Etoys-Squeakland-as yet unclassified') ----- setForms: size | c | UncheckedForm := Form extent: size@size depth: 16. c := UncheckedForm getCanvas asBalloonCanvas. c frameRectangle: UncheckedForm boundingBox width: (size // 12) color: Color black. MouseDownForm := UncheckedForm deepCopy. CheckedForm := UncheckedForm deepCopy. c := CheckedForm getCanvas asBalloonCanvas. c line: ((size*0.2)(a)(size*0.5)) asIntegerPoint to: ((size*0.4)(a)(size*0.7)) asIntegerPoint width: 2 color: Color gray darker. c line: ((size*0.4)(a)(size*0.7)) asIntegerPoint to: ((size*0.9)(a)(size*0.2)) asIntegerPoint width: 2 color: Color gray darker. ! Item was changed: + ----- Method: GenericPropertiesMorph>>doGraphPaper (in category 'Squeakland-graph paper') ----- - ----- Method: GenericPropertiesMorph>>doGraphPaper (in category '*Etoys-Squeakland-graph paper') ----- doGraphPaper "Switch to graph paper as a fill style." self putUpGraphPaperPanel! Item was changed: + ----- Method: GraphicTile>>parseNodeWith: (in category 'code generation') ----- - ----- Method: GraphicTile>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') ----- parseNodeWith: encoder ^ encoder encodePlayer: literal. ! Item was changed: + ----- Method: KedamaExamplerPlayer>>areOkaySelectors: (in category 'testing') ----- - ----- Method: KedamaExamplerPlayer>>areOkaySelectors: (in category '*Etoys-Squeakland-testing') ----- areOkaySelectors: aCollection aCollection do: [:sel | (#(= & | + - * / \\ // ifTrue:ifFalse:) includes: sel) ifFalse: [^ false]. ]. ^ true. ! Item was changed: + ----- Method: KedamaExamplerPlayer>>containsBreedSelectors: (in category 'private') ----- - ----- Method: KedamaExamplerPlayer>>containsBreedSelectors: (in category '*Etoys-Squeakland-private') ----- containsBreedSelectors: collection collection do: [:e | (#(setTurtleCount: setGrouped:) includes: e) ifTrue: [^ true]. ]. ^ false. ! Item was changed: + ----- Method: KedamaExamplerPlayer>>containsSequentialSelector: (in category 'private') ----- - ----- Method: KedamaExamplerPlayer>>containsSequentialSelector: (in category '*Etoys-Squeakland-private') ----- containsSequentialSelector: aSymbol ^ (#(random random: atRandom) includes: aSymbol)! Item was changed: + ----- Method: KedamaExamplerPlayer>>containsSequentialSelectors: (in category 'private') ----- - ----- Method: KedamaExamplerPlayer>>containsSequentialSelectors: (in category '*Etoys-Squeakland-private') ----- containsSequentialSelectors: collection collection do: [:e | (self containsSequentialSelector: e) ifTrue: [^ true]. ]. ^ false. ! Item was changed: + ----- Method: KedamaExamplerPlayer>>copyAllMethodsAgain2 (in category 'debug support') ----- - ----- Method: KedamaExamplerPlayer>>copyAllMethodsAgain2 (in category '*Etoys-Squeakland-debug support') ----- copyAllMethodsAgain2 | c result | c := turtles class. result := (ClassBuilder new) name: c name inEnvironment: c environment subclassOf: c superclass type: c typeOfClass instanceVariableNames: KedamaTurtleVectorPlayer2 instanceVariablesString classVariableNames: KedamaTurtleVectorPlayer2 classVariablesString poolDictionaries: KedamaTurtleVectorPlayer2 sharedPoolsString category: Object categoryForUniclasses. turtles class copyAllCategoriesUnobtrusivelyFrom: KedamaTurtleVectorPlayer2. sequentialStub ifNotNil: [sequentialStub class copyAllCategoriesUnobtrusivelyFrom: KedamaSequenceExecutionStub]. self flag: #todo. self flag: #uniclasses. "Discuss if we really want to hide uniclasses again" c superclass environment forgetClass: result logged: false. c superclass removeSubclass: result. ! Item was changed: + ----- Method: KedamaExamplerPlayer>>createTurtles2 (in category 'subclass players management') ----- - ----- Method: KedamaExamplerPlayer>>createTurtles2 (in category '*Etoys-Squeakland-subclass players management') ----- createTurtles2 turtles := self class createTurtleSubclass2 new. turtles kedamaWorld: kedamaWorld. turtles exampler: self. ^ turtles. ! Item was changed: + ----- Method: KedamaExamplerPlayer>>isBreedSelector: (in category 'private') ----- - ----- Method: KedamaExamplerPlayer>>isBreedSelector: (in category '*Etoys-Squeakland-private') ----- isBreedSelector: aSymbol ^ #(getTurtleCount setTurtleCount: setGrouped: getGrouped) includes: aSymbol. ! Item was changed: + ----- Method: KedamaExamplerPlayer>>isUserDefinedSelector: (in category 'testing') ----- - ----- Method: KedamaExamplerPlayer>>isUserDefinedSelector: (in category '*Etoys-Squeakland-testing') ----- isUserDefinedSelector: aSymbol ^ self class superclass scripts notNil and: [self class superclass scripts includes: aSymbol].! Item was changed: + ----- Method: KedamaExamplerPlayer>>removeScriptNamed: (in category 'method management') ----- - ----- Method: KedamaExamplerPlayer>>removeScriptNamed: (in category '*Etoys-Squeakland-method management') ----- removeScriptNamed: aScriptName super removeScriptNamed: aScriptName. turtles class removeSelectorSilently: aScriptName. sequentialStub class removeSelectorSilently: aScriptName. ! Item was changed: + ----- Method: KedamaExamplerPlayer>>selectorIncludesSequentialCommand: (in category 'testing') ----- - ----- Method: KedamaExamplerPlayer>>selectorIncludesSequentialCommand: (in category '*Etoys-Squeakland-testing') ----- selectorIncludesSequentialCommand: aSymbol self flag: #todo. "for now we go sequential for any user defined script" ^ self class scripts includesKey: aSymbol "(self class sourceCodeAt: aSymbol) includesSubstring: 'doSequentialCommand:'"! Item was changed: + ----- Method: KedamaExamplerPlayer>>userDefinedSlotGetters (in category 'private') ----- - ----- Method: KedamaExamplerPlayer>>userDefinedSlotGetters (in category '*Etoys-Squeakland-private') ----- userDefinedSlotGetters ^ turtles info keys asArray collect: [:e | e asGetterSelector]. ! Item was changed: + ----- Method: KedamaExamplerPlayer>>userDefinedSlotSetters (in category 'private') ----- - ----- Method: KedamaExamplerPlayer>>userDefinedSlotSetters (in category '*Etoys-Squeakland-private') ----- userDefinedSlotSetters ^ turtles info keys asArray collect: [:e | e asSetterSelector]. ! Item was changed: + ----- Method: KedamaExamplerPlayer>>vectorizableTheseSelectors: (in category 'private') ----- - ----- Method: KedamaExamplerPlayer>>vectorizableTheseSelectors: (in category '*Etoys-Squeakland-private') ----- vectorizableTheseSelectors: collection | removed scripts | scripts := self class scripts keys. removed := collection reject: [:e | (scripts includes: e) or: [#(getTurtleCount setTurtleCount: setGrouped: getGrouped) includes: e]]. removed do: [:e | ((#(getX setX: getY setY: setColor: getColor getVisible setVisible: getTurtleVisible setTurtleVisible: getHeading setHeading: getAngleTo: getDistanceTo: getUphillIn: forward: turn: setPatchValueIn:to: beNotZero: getPatchValueIn:), self userDefinedSlotGetters, self userDefinedSlotSetters) includes: e) ifFalse: [^ false]. ]. ^ true. ! Item was changed: + ----- Method: KedamaFloatArray>>isDivisibleBy: (in category 'arithmetic') ----- - ----- Method: KedamaFloatArray>>isDivisibleBy: (in category '*Etoys-Squeakland-arithmetic') ----- isDivisibleBy: other | result | result := ByteArray new: self size. other isNumber ifTrue: [ ^ self primDVScalar: self and: other into: result. ]. ((other isMemberOf: WordArray) or: [other isMemberOf: KedamaFloatArray]) ifTrue: [ ^ self primDVArray: self and: other into: result. ]. ^ super < other. ! Item was changed: + ----- Method: KedamaFloatArray>>primDVArray:and:into: (in category 'primitives') ----- - ----- Method: KedamaFloatArray>>primDVArray:and:into: (in category '*Etoys-Squeakland-primitives') ----- primDVArray: rcvr and: other into: result "<primitive: 'primitiveDVArrays' module:'KedamaPlugin2'>" "^ KedamaPlugin2 doPrimitive: #primitiveDVArrays." 1 to: rcvr size do: [:i | result at: i put: (((rcvr at: i) isDivisibleBy: (other at: i)) ifTrue: [1] ifFalse: [0]). ]. ^ result. ! Item was changed: + ----- Method: KedamaFloatArray>>primDVScalar:and:into: (in category 'primitives') ----- - ----- Method: KedamaFloatArray>>primDVScalar:and:into: (in category '*Etoys-Squeakland-primitives') ----- primDVScalar: rcvr and: other into: result "<primitive: 'primitiveDVScalar' module:'KedamaPlugin2'>" "^ KedamaPlugin2 doPrimitive: #primitiveDVScalar." 1 to: rcvr size do: [:i | result at: i put: (((rcvr at: i) isDivisibleBy: other) ifTrue: [1] ifFalse: [0]). ]. ^ result. ! Item was changed: + ----- Method: KedamaFloatArray>>primEQArray:and:into: (in category 'primitives') ----- - ----- Method: KedamaFloatArray>>primEQArray:and:into: (in category '*Etoys-Squeakland-primitives') ----- primEQArray: rcvr and: other into: result <primitive: 'primitiveEQArrays' module:'KedamaPlugin2'> "^ KedamaPlugin2 doPrimitive: #primitiveEQArrays." 1 to: rcvr size do: [:i | result at: i put: ((rcvr at: i) = (other at: i) ifTrue: [1] ifFalse: [0]). ]. ^ result. ! Item was changed: + ----- Method: KedamaFloatArray>>primEQScalar:and:into: (in category 'primitives') ----- - ----- Method: KedamaFloatArray>>primEQScalar:and:into: (in category '*Etoys-Squeakland-primitives') ----- primEQScalar: rcvr and: other into: result <primitive: 'primitiveEQScalar' module:'KedamaPlugin2'> "^ KedamaPlugin2 doPrimitive: #primitiveEQScalar." 1 to: rcvr size do: [:i | result at: i put: ((rcvr at: i) = other ifTrue: [1] ifFalse: [0]). ]. ^ result. ! Item was changed: + ----- Method: KedamaFloatArray>>primGEArray:and:into: (in category 'primitives') ----- - ----- Method: KedamaFloatArray>>primGEArray:and:into: (in category '*Etoys-Squeakland-primitives') ----- primGEArray: rcvr and: other into: result <primitive: 'primitiveGEArrays' module:'KedamaPlugin2'> "^ KedamaPlugin2 doPrimitive: #primitiveGEArrays." 1 to: rcvr size do: [:i | result at: i put: ((rcvr at: i) >= (other at: i) ifTrue: [1] ifFalse: [0]). ]. ^ result. ! Item was changed: + ----- Method: KedamaFloatArray>>primGEScalar:and:into: (in category 'primitives') ----- - ----- Method: KedamaFloatArray>>primGEScalar:and:into: (in category '*Etoys-Squeakland-primitives') ----- primGEScalar: rcvr and: other into: result <primitive: 'primitiveGEScalar' module:'KedamaPlugin2'> "^ KedamaPlugin2 doPrimitive: #primitiveGEScalar." 1 to: rcvr size do: [:i | result at: i put: ((rcvr at: i) >= other ifTrue: [1] ifFalse: [0]). ]. ^ result. ! Item was changed: + ----- Method: KedamaFloatArray>>primGTArray:and:into: (in category 'primitives') ----- - ----- Method: KedamaFloatArray>>primGTArray:and:into: (in category '*Etoys-Squeakland-primitives') ----- primGTArray: rcvr and: other into: result <primitive: 'primitiveGTArrays' module:'KedamaPlugin2'> "^ KedamaPlugin2 doPrimitive: #primitiveGTArrays." 1 to: rcvr size do: [:i | result at: i put: ((rcvr at: i) > (other at: i) ifTrue: [1] ifFalse: [0]). ]. ^ result. ! Item was changed: + ----- Method: KedamaFloatArray>>primGTScalar:and:into: (in category 'primitives') ----- - ----- Method: KedamaFloatArray>>primGTScalar:and:into: (in category '*Etoys-Squeakland-primitives') ----- primGTScalar: rcvr and: other into: result <primitive: 'primitiveGTScalar' module:'KedamaPlugin2'> "^ KedamaPlugin2 doPrimitive: #primitiveGTScalar." 1 to: rcvr size do: [:i | result at: i put: ((rcvr at: i) > other ifTrue: [1] ifFalse: [0]). ]. ^ result. ! Item was changed: + ----- Method: KedamaFloatArray>>primLEArray:and:into: (in category 'primitives') ----- - ----- Method: KedamaFloatArray>>primLEArray:and:into: (in category '*Etoys-Squeakland-primitives') ----- primLEArray: rcvr and: other into: result <primitive: 'primitiveLEArrays' module:'KedamaPlugin2'> "^ KedamaPlugin2 doPrimitive: #primitiveLEArrays." 1 to: rcvr size do: [:i | result at: i put: ((rcvr at: i) <= (other at: i) ifTrue: [1] ifFalse: [0]) ]. ^ result. ! Item was changed: + ----- Method: KedamaFloatArray>>primLEScalar:and:into: (in category 'primitives') ----- - ----- Method: KedamaFloatArray>>primLEScalar:and:into: (in category '*Etoys-Squeakland-primitives') ----- primLEScalar: rcvr and: other into: result <primitive: 'primitiveLEScalar' module:'KedamaPlugin2'> "^ KedamaPlugin2 doPrimitive: #primitiveLEScalar." 1 to: rcvr size do: [:i | result at: i put: ((rcvr at: i) <= other ifTrue: [1] ifFalse: [0]). ]. ^ result. ! Item was changed: + ----- Method: KedamaFloatArray>>primLTArray:and:into: (in category 'primitives') ----- - ----- Method: KedamaFloatArray>>primLTArray:and:into: (in category '*Etoys-Squeakland-primitives') ----- primLTArray: rcvr and: other into: result <primitive: 'primitiveLTArrays' module:'KedamaPlugin2'> "^ KedamaPlugin2 doPrimitive: #primitiveLTArrays." 1 to: rcvr size do: [:i | result at: i put: ((rcvr at: i) < (other at: i) ifTrue: [1] ifFalse: [0]) ]. ^ result. ! Item was changed: + ----- Method: KedamaFloatArray>>primLTScalar:and:into: (in category 'primitives') ----- - ----- Method: KedamaFloatArray>>primLTScalar:and:into: (in category '*Etoys-Squeakland-primitives') ----- primLTScalar: rcvr and: other into: result <primitive: 'primitiveLTScalar' module:'KedamaPlugin2'> "^ KedamaPlugin2 doPrimitive: #primitiveLTScalar." 1 to: rcvr size do: [:i | result at: i put: ((rcvr at: i) < other ifTrue: [1] ifFalse: [0]). ]. ^ result. ! Item was changed: + ----- Method: KedamaFloatArray>>primNEArray:and:into: (in category 'primitives') ----- - ----- Method: KedamaFloatArray>>primNEArray:and:into: (in category '*Etoys-Squeakland-primitives') ----- primNEArray: rcvr and: other into: result <primitive: 'primitiveNEArrays' module:'KedamaPlugin2'> "^ KedamaPlugin2 doPrimitive: #primitiveNEArrays." 1 to: rcvr size do: [:i | result at: i put: ((rcvr at: i) ~= (other at: i) ifTrue: [1] ifFalse: [0]) ]. ^ result. ! Item was changed: + ----- Method: KedamaFloatArray>>primNEScalar:and:into: (in category 'primitives') ----- - ----- Method: KedamaFloatArray>>primNEScalar:and:into: (in category '*Etoys-Squeakland-primitives') ----- primNEScalar: rcvr and: other into: result <primitive: 'primitiveNEScalar' module:'KedamaPlugin2'> "^ KedamaPlugin2 doPrimitive: #primitiveNEScalar." 1 to: rcvr size do: [:i | result at: i put: ((rcvr at: i) ~= other ifTrue: [1] ifFalse: [0]). ]. ^ result. ! Item was changed: + ----- Method: KedamaFloatArray>>primRemArray:and:into: (in category 'primitives') ----- - ----- Method: KedamaFloatArray>>primRemArray:and:into: (in category '*Etoys-Squeakland-primitives') ----- primRemArray: rcvr and: other into: result <primitive: 'primitiveRemArrays' module:'KedamaPlugin2'> "^ KedamaPlugin2 doPrimitive: #primitiveRemArrays." 1 to: rcvr size do: [:i | result at: i put: (rcvr at: i) \\ (other at: i) ]. ^ result. ! Item was changed: + ----- Method: KedamaFloatArray>>primRemScalar:and:into: (in category 'primitives') ----- - ----- Method: KedamaFloatArray>>primRemScalar:and:into: (in category '*Etoys-Squeakland-primitives') ----- primRemScalar: rcvr and: other into: result <primitive: 'primitiveRemScalar' module:'KedamaPlugin2'> "^ KedamaPlugin2 doPrimitive: #primitiveRemScalar." 1 to: rcvr size do: [:i | result at: i put: (rcvr at: i) \\ other. ]. ^ result. ! Item was changed: + ----- Method: KedamaFloatArray>>random (in category 'arithmetic') ----- - ----- Method: KedamaFloatArray>>random (in category '*Etoys-Squeakland-arithmetic') ----- random | result | result := KedamaFloatArray new: self size. 1 to: self size do: [:i | result at: i put: ((self at: i) random + (self at: i) fractionPart). ]. ^ result.! Item was changed: + ----- Method: KedamaGetColorComponentTile>>parseNodeWith: (in category 'code generation') ----- - ----- Method: KedamaGetColorComponentTile>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') ----- parseNodeWith: encoder ^ patchTile parseNodeWith: encoder! Item was changed: + ----- Method: KedamaMorph class>>migrateInstancesWithoutChangePending (in category 'class initialization') ----- - ----- Method: KedamaMorph class>>migrateInstancesWithoutChangePending (in category '*Etoys-Squeakland-class initialization') ----- migrateInstancesWithoutChangePending KedamaMorph allInstancesDo: [:each | each migrateInstancesWithoutChangePending. ]. ! Item was changed: + ----- Method: KedamaMorph>>defaultPatch (in category 'drawing') ----- - ----- Method: KedamaMorph>>defaultPatch (in category '*Etoys-Squeakland-drawing') ----- defaultPatch | p | defaultPatch ifNotNil: [^ defaultPatch]. "For older projects, it trys to extract a reasonable answer from somewhere." (self player respondsTo: #getPatch) ifTrue: [ defaultPatch := self player getPatch costume renderedMorph. ^ defaultPatch. ]. p := KedamaPatchMorph new. p kedamaWorld: self. p assuredPlayer. defaultPatch := p. ^ defaultPatch. ! Item was changed: + ----- Method: KedamaMorph>>migrateInstancesWithoutChangePending (in category 'private') ----- - ----- Method: KedamaMorph>>migrateInstancesWithoutChangePending (in category '*Etoys-Squeakland-private') ----- migrateInstancesWithoutChangePending self instVarNamed: 'changePending' put: false. self instVarNamed: 'drawRequested' put: true. self setKedamaWorldToKnownPatches. ! Item was changed: + ----- Method: KedamaMorph>>setKedamaWorldToKnownPatches (in category 'utils') ----- - ----- Method: KedamaMorph>>setKedamaWorldToKnownPatches (in category '*Etoys-Squeakland-utils') ----- setKedamaWorldToKnownPatches patchesToDisplay do: [:e | e kedamaWorld: self. defaultPatch ifNotNil: [^ defaultPatch kedamaWorld: self]. "For older projects, it trys to extract a reasonable answer from somewhere." (self player respondsTo: #getPatch) ifTrue: [ defaultPatch := self player getPatch costume renderedMorph. ^ defaultPatch kedamaWorld: self. ]. ]. ! Item was changed: + ----- Method: KedamaPatchMorph class>>migrateInstancesWithoutChangePending (in category 'class initialization') ----- - ----- Method: KedamaPatchMorph class>>migrateInstancesWithoutChangePending (in category '*Etoys-Squeakland-class initialization') ----- migrateInstancesWithoutChangePending KedamaPatchMorph allInstancesDo: [:each | each migrateInstancesWithoutChangePending. ]. ! Item was changed: + ----- Method: KedamaPatchMorph>>drawRequest (in category 'drawing') ----- - ----- Method: KedamaPatchMorph>>drawRequest (in category '*Etoys-Squeakland-drawing') ----- drawRequest changePending ifFalse: [self changed]. changePending := true. ! Item was changed: + ----- Method: KedamaPatchMorph>>kedamaWorld: (in category 'initialization') ----- - ----- Method: KedamaPatchMorph>>kedamaWorld: (in category '*Etoys-Squeakland-initialization') ----- kedamaWorld: anObject kedamaWorld := anObject. ! Item was changed: + ----- Method: KedamaPatchMorph>>migrateInstancesWithoutChangePending (in category 'private') ----- - ----- Method: KedamaPatchMorph>>migrateInstancesWithoutChangePending (in category '*Etoys-Squeakland-private') ----- migrateInstancesWithoutChangePending self instVarNamed: 'changePending' put: false. ! Item was changed: + ----- Method: KedamaPatchMorph>>primSetPixelsPredicates:xArray:yArray:bits:width:height:value: (in category 'primitives') ----- - ----- Method: KedamaPatchMorph>>primSetPixelsPredicates:xArray:yArray:bits:width:height:value: (in category '*Etoys-Squeakland-primitives') ----- primSetPixelsPredicates: predicates xArray: xArray yArray: yArray bits: bits width: width height: height value: value | v | <primitive: 'primSetPixelsAtXY' module: 'KedamaPlugin2'> " ^ KedamaPlugin2 doPrimitive: #primSetPixelsAtXY." value isNumber ifTrue: [v := value]. 1 to: xArray size do: [:i | (predicates at: i) = 1 ifTrue: [ value isNumber ifFalse: [ v := value at: i. ]. self pixelAtX: (xArray at: i) y: (yArray at: i) put: v. ]. ]. ! Item was changed: + ----- Method: KedamaPatchMorph>>setPixelsPredicates:xArray:yArray:value: (in category 'commands and slots') ----- - ----- Method: KedamaPatchMorph>>setPixelsPredicates:xArray:yArray:value: (in category '*Etoys-Squeakland-commands and slots') ----- setPixelsPredicates: predicates xArray: xArray yArray: yArray value: value form bits class == ByteArray ifTrue: [form unhibernate]. self primSetPixelsPredicates: predicates xArray: xArray yArray: yArray bits: form bits width: form width height: form height value: value. self formChanged. ! Item was changed: + ----- Method: KedamaPatchTile>>useDefaultPatch: (in category 'initialization support') ----- - ----- Method: KedamaPatchTile>>useDefaultPatch: (in category '*Etoys-Squeakland-initialization support') ----- useDefaultPatch: aPatch | aTile displayer | self removeAllMorphs. "literal := aPatch." type := #objRef. aTile := KedamaPatchType basicNew newReadoutTile. displayer := UpdatingStringMorph new getSelector: #yourself; target: 'patch'; growable: true; minimumWidth: 24; putSelector: nil; font: Preferences standardEToysFont. displayer stepTime: 1000. "Note that when typeSymbol = #number, the #target: call above will have dealt with floatPrecision details" displayer useStringFormat. aTile addMorphBack: displayer. aTile setLiteralInitially: ('patch'). self addMorphBack: aTile. ! Item was changed: + ----- Method: KedamaSequenceExecutionStub class>>primForwardAt:xArray:yArray:headingArray:value:destWidth:destHeight:leftEdgeMode:rightEdgeMode:topEdgeMode:bottomEdgeMode: (in category 'kedama') ----- - ----- Method: KedamaSequenceExecutionStub class>>primForwardAt:xArray:yArray:headingArray:value:destWidth:destHeight:leftEdgeMode:rightEdgeMode:topEdgeMode:bottomEdgeMode: (in category '*Etoys-Squeakland-as yet unclassified') ----- primForwardAt: i xArray: xArray yArray: yArray headingArray: headingArray value: value destWidth: destWidth destHeight: destHeight leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode | dist newX newY | <primitive: 'primScalarForward' module:'KedamaPlugin2'> "^ KedamaPlugin doPrimitive: #primScalarForward." dist := value. newX := (xArray at: i) + (dist asFloat * (headingArray at: i) cos). newY := (yArray at: i) - (dist asFloat * (headingArray at: i) sin). KedamaMorph scalarXAt: i xArray: xArray headingArray: headingArray value: newX destWidth: destWidth leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode. KedamaMorph scalarYAt: i yArray: yArray headingArray: headingArray value: newY destHeight: destHeight topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode. ! Item was changed: + ----- Method: KedamaSequenceExecutionStub class>>primGetAngleToX:toY:fromX:fromY: (in category 'kedama') ----- - ----- Method: KedamaSequenceExecutionStub class>>primGetAngleToX:toY:fromX:fromY: (in category '*Etoys-Squeakland-as yet unclassified') ----- primGetAngleToX: toX toY: toY fromX: fromX fromY: fromY | ret | <primitive: 'scalarGetAngleTo' module:'KedamaPlugin2'> ret := ((toX - fromX)@(toY - fromY)) theta radiansToDegrees + 90.0. ret > 360.0 ifTrue: [^ ret - 360.0]. ^ ret. ! Item was changed: + ----- Method: KedamaSequenceExecutionStub class>>primGetDistanceToX:toY:fromX:fromY: (in category 'kedama') ----- - ----- Method: KedamaSequenceExecutionStub class>>primGetDistanceToX:toY:fromX:fromY: (in category '*Etoys-Squeakland-as yet unclassified') ----- primGetDistanceToX: toX toY: toY fromX: fromX fromY: fromY <primitive: 'scalarGetDistanceTo' module:'KedamaPlugin2'> ^ ((fromX - toX) squared + (fromY - toY)) squared sqrt. ! Item was changed: + ----- Method: KedamaSequenceExecutionStub class>>primGetHeadingAt:headingArray: (in category 'kedama') ----- - ----- Method: KedamaSequenceExecutionStub class>>primGetHeadingAt:headingArray: (in category '*Etoys-Squeakland-as yet unclassified') ----- primGetHeadingAt: i headingArray: headingArray | heading | <primitive: 'getScalarHeading' module:'KedamaPlugin2'> "^ KedamaPlugin doPrimitive: #getScalarHeading." heading := headingArray at: i. ^ heading := KedamaMorph radiansToDegrees: heading. ! Item was changed: + ----- Method: KedamaSequenceExecutionStub class>>primSetHeadingAt:headingArray:value: (in category 'kedama') ----- - ----- Method: KedamaSequenceExecutionStub class>>primSetHeadingAt:headingArray:value: (in category '*Etoys-Squeakland-as yet unclassified') ----- primSetHeadingAt: i headingArray: headingArray value: heading | rad | <primitive: 'setScalarHeading' module:'KedamaPlugin2'> "^ KedamaPlugin doPrimitive: #setScalarHeading." rad := KedamaMorph degreesToRadians: heading. headingArray at: i put: rad. ! Item was changed: + ----- Method: KedamaSequenceExecutionStub class>>primSetX:xIndex:headingArray:value:destWidth:leftEdgeMode:rightEdgeMode: (in category 'kedama') ----- - ----- Method: KedamaSequenceExecutionStub class>>primSetX:xIndex:headingArray:value:destWidth:leftEdgeMode:rightEdgeMode: (in category '*Etoys-Squeakland-as yet unclassified') ----- primSetX: xArray xIndex: xIndex headingArray: headingArray value: value destWidth: destWidth leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode <primitive: 'turtleScalarSetX' module:'KedamaPlugin2'> "^ KedamaPlugin doPrimitive: #turtleScalarSetX." KedamaMorph scalarXAt: xIndex xArray: xArray headingArray: headingArray value: value destWidth: destWidth leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode. ! Item was changed: + ----- Method: KedamaSequenceExecutionStub class>>primSetY:yIndex:headingArray:value:destHeight:topEdgeMode:bottomEdgeMode: (in category 'kedama') ----- - ----- Method: KedamaSequenceExecutionStub class>>primSetY:yIndex:headingArray:value:destHeight:topEdgeMode:bottomEdgeMode: (in category '*Etoys-Squeakland-as yet unclassified') ----- primSetY: yArray yIndex: yIndex headingArray: headingArray value: value destHeight: destHeight topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode <primitive: 'turtleScalarSetY' module:'KedamaPlugin2'> "^ KedamaPlugin doPrimitive: #turtleScalarSetY." KedamaMorph scalarYAt: yIndex yArray: yArray headingArray: headingArray value: value destHeight: destHeight topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode. ! Item was changed: + ----- Method: KedamaSetColorComponentTile>>assignmentRootForParseNode (in category 'code generation') ----- - ----- Method: KedamaSetColorComponentTile>>assignmentRootForParseNode (in category '*Etoys-Squeakland-code generation') ----- assignmentRootForParseNode ^ assignmentRoot! Item was changed: + ----- Method: KedamaSetColorComponentTile>>parseNodeWith: (in category 'code generation') ----- - ----- Method: KedamaSetColorComponentTile>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') ----- parseNodeWith: encoder ^ patchTile parseNodeWith: encoder. ! Item was changed: + ----- Method: KedamaSetPixelValueTile>>assignmentRootForParseNode (in category 'tile protocol') ----- - ----- Method: KedamaSetPixelValueTile>>assignmentRootForParseNode (in category '*Etoys-Squeakland-tile protocol') ----- assignmentRootForParseNode ^ 'setPatchValueIn:'. ! Item was changed: + ----- Method: KedamaSetPixelValueTile>>parseNodeWith: (in category 'tile protocol') ----- - ----- Method: KedamaSetPixelValueTile>>parseNodeWith: (in category '*Etoys-Squeakland-tile protocol') ----- parseNodeWith: encoder ^ patchTile parseNodeWith: encoder! Item was changed: + ----- Method: KeyboardBuffer>>commandKeyPressed (in category 'testing') ----- - ----- Method: KeyboardBuffer>>commandKeyPressed (in category '*Etoys-testing') ----- commandKeyPressed ^ event commandKeyPressed! Item was changed: + ----- Method: KeyboardBuffer>>controlKeyPressed (in category 'testing') ----- - ----- Method: KeyboardBuffer>>controlKeyPressed (in category '*Etoys-testing') ----- controlKeyPressed ^ event controlKeyPressed! Item was changed: + ----- Method: KeyboardBuffer>>flushKeyboard (in category 'keyboard control') ----- - ----- Method: KeyboardBuffer>>flushKeyboard (in category '*Etoys-keyboard control') ----- flushKeyboard eventUsed ifFalse: [^ eventUsed := true].! Item was changed: + ----- Method: KeyboardBuffer>>keyboard (in category 'keyboard control') ----- - ----- Method: KeyboardBuffer>>keyboard (in category '*Etoys-keyboard control') ----- keyboard eventUsed ifFalse: [eventUsed := true. ^ event keyCharacter]. ^ nil! Item was changed: + ----- Method: KeyboardBuffer>>keyboardPeek (in category 'keyboard control') ----- - ----- Method: KeyboardBuffer>>keyboardPeek (in category '*Etoys-keyboard control') ----- keyboardPeek eventUsed ifFalse: [^ event keyCharacter]. ^ nil! Item was changed: + ----- Method: KeyboardBuffer>>keyboardPressed (in category 'testing') ----- - ----- Method: KeyboardBuffer>>keyboardPressed (in category '*Etoys-testing') ----- keyboardPressed ^eventUsed not! Item was changed: + ----- Method: KeyboardBuffer>>leftShiftDown (in category 'testing') ----- - ----- Method: KeyboardBuffer>>leftShiftDown (in category '*Etoys-testing') ----- leftShiftDown ^ event shiftPressed! Item was changed: + ----- Method: KeyboardBuffer>>startingEvent: (in category 'private') ----- - ----- Method: KeyboardBuffer>>startingEvent: (in category '*Etoys-private') ----- startingEvent: evt event := evt. eventUsed := false! Item was changed: + ----- Method: MethodHolder class>>isolatedCodePaneForClass:selector: (in category 'Etoys') ----- - ----- Method: MethodHolder class>>isolatedCodePaneForClass:selector: (in category '*Etoys') ----- isolatedCodePaneForClass: aClass selector: aSelector "Answer a MethodMorph on the given class and selector" | aCodePane aMethodHolder | aMethodHolder := self new. aMethodHolder methodClass: aClass methodSelector: aSelector. aCodePane := MethodMorph on: aMethodHolder text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. aMethodHolder addDependent: aCodePane. aCodePane borderWidth: 2; color: Color white. aCodePane scrollBarOnLeft: false. aCodePane width: 300. ^ aCodePane! Item was changed: + ----- Method: MethodHolder class>>makeIsolatedCodePaneForClass:selector: (in category 'Etoys') ----- - ----- Method: MethodHolder class>>makeIsolatedCodePaneForClass:selector: (in category '*Etoys') ----- makeIsolatedCodePaneForClass: aClass selector: aSelector "Create, and place in the morphic Hand, an isolated code pane bearing source code for the given class and selector" (self isolatedCodePaneForClass: aClass selector: aSelector) openInHand! Item was changed: + ----- Method: MethodHolder>>addModelMenuItemsTo:forMorph:hand: (in category 'menu') ----- - ----- Method: MethodHolder>>addModelMenuItemsTo:forMorph:hand: (in category '*Etoys-menu') ----- addModelMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph aCustomMenu addLine. aCustomMenu add: 'whose script is this?' translated target: self action: #identifyScript ! Item was changed: + ----- Method: MethodHolder>>changeMethodSelectorTo: (in category 'miscellaneous') ----- - ----- Method: MethodHolder>>changeMethodSelectorTo: (in category '*Etoys-miscellaneous') ----- changeMethodSelectorTo: aSelector "Change my method selector as noted. Reset currentCompiledMethod" methodSelector := aSelector. currentCompiledMethod := methodClass compiledMethodAt: aSelector ifAbsent: [nil]! Item was changed: + ----- Method: MethodHolder>>compiledMethod (in category 'miscellaneous') ----- - ----- Method: MethodHolder>>compiledMethod (in category '*Etoys-miscellaneous') ----- compiledMethod ^ methodClass compiledMethodAt: methodSelector! Item was changed: + ----- Method: MethodHolder>>contents (in category 'contents') ----- - ----- Method: MethodHolder>>contents (in category '*Etoys-contents') ----- contents "Answer the contents, with due respect for my contentsSymbol" contents := methodClass sourceCodeAt: methodSelector ifAbsent: ['']. currentCompiledMethod := methodClass compiledMethodAt: methodSelector ifAbsent: [nil]. self showingDecompile ifTrue: [^ self decompiledSourceIntoContents]. self showingDocumentation ifTrue: [^ self commentContents]. ^ contents := self sourceStringPrettifiedAndDiffed asText makeSelectorBoldIn: methodClass! Item was changed: + ----- Method: MethodHolder>>contents:notifying: (in category 'contents') ----- - ----- Method: MethodHolder>>contents:notifying: (in category '*Etoys-contents') ----- contents: input notifying: aController | selector | (selector := methodClass newParser parseSelector: input asText) ifNil: [self inform: 'Sorry - invalid format for the method name and arguments -- cannot accept.'. ^ false]. selector == methodSelector ifFalse: [self inform: 'You cannot change the name of the method here -- it must continue to be ', methodSelector. ^ false]. selector := methodClass compile: input asText classified: self selectedMessageCategoryName notifying: aController. selector == nil ifTrue: [^ false]. contents := input asString copy. currentCompiledMethod := methodClass compiledMethodAt: methodSelector. ^ true! Item was changed: + ----- Method: MethodHolder>>contents:notifying:forInstance: (in category 'contents') ----- - ----- Method: MethodHolder>>contents:notifying:forInstance: (in category '*Etoys-Squeakland-contents') ----- contents: input notifying: aController forInstance: aPlayer | selector | (selector := Parser new parseSelector: input asText) ifNil: [self inform: 'Sorry - invalid format for the method name and arguments -- cannot accept.'. ^ false]. selector == methodSelector ifFalse: [self inform: 'You cannot change the name of the method here -- it must continue to be ', methodSelector. ^ false]. selector := methodClass compileSilently: input asText classified: self selectedMessageCategoryName notifying: aController for: aPlayer. selector == nil ifTrue: [^ false]. contents := input asString copy. currentCompiledMethod := methodClass compiledMethodAt: methodSelector. ^ true! Item was changed: + ----- Method: MethodHolder>>identifyScript (in category 'miscellaneous') ----- - ----- Method: MethodHolder>>identifyScript (in category '*Etoys-miscellaneous') ----- identifyScript | msg aPlayer | msg := methodClass isUniClass ifTrue: [aPlayer := methodClass someInstance. aPlayer costume ifNotNil: ['This holds code for a script named ', methodSelector, ' belonging to an object named ', aPlayer externalName] ifNil: ['This formerly held code for a script named ', methodSelector, ' for a Player who once existed but now is moribund.']] ifFalse: ['This holds code for the method named ', methodSelector, ' for class ', methodClass name]. self inform: msg! Item was changed: + ----- Method: MethodHolder>>methodClass:methodSelector: (in category 'miscellaneous') ----- - ----- Method: MethodHolder>>methodClass:methodSelector: (in category '*Etoys-miscellaneous') ----- methodClass: aClass methodSelector: aSelector methodClass := aClass. methodSelector := aSelector. currentCompiledMethod := aClass compiledMethodAt: aSelector ifAbsent: [nil]! Item was changed: + ----- Method: MethodHolder>>selectedClass (in category 'selection') ----- - ----- Method: MethodHolder>>selectedClass (in category '*Etoys-selection') ----- selectedClass ^ methodClass theNonMetaClass! Item was changed: + ----- Method: MethodHolder>>selectedClassOrMetaClass (in category 'selection') ----- - ----- Method: MethodHolder>>selectedClassOrMetaClass (in category '*Etoys-selection') ----- selectedClassOrMetaClass ^ methodClass! Item was changed: + ----- Method: MethodHolder>>selectedMessageCategoryName (in category 'selection') ----- - ----- Method: MethodHolder>>selectedMessageCategoryName (in category '*Etoys-selection') ----- selectedMessageCategoryName ^ methodClass organization categoryOfElement: methodSelector! Item was changed: + ----- Method: MethodHolder>>selectedMessageName (in category 'selection') ----- - ----- Method: MethodHolder>>selectedMessageName (in category '*Etoys-selection') ----- selectedMessageName ^ methodSelector! Item was changed: + ----- Method: MethodHolder>>versions (in category 'miscellaneous') ----- - ----- Method: MethodHolder>>versions (in category '*Etoys-miscellaneous') ----- versions "Return a VersionsBrowser (containing a list of ChangeRecords) of older versions of this method." ^ VersionsBrowser new scanVersionsOf: self compiledMethod class: self selectedClass meta: methodClass isMeta category: self selectedMessageCategoryName "(classOfMethod whichCategoryIncludesSelector: selectorOfMethod)" selector: methodSelector! Item was changed: + ----- Method: MethodWithInterface>>currentScriptEditor (in category 'script editor') ----- - ----- Method: MethodWithInterface>>currentScriptEditor (in category '*Etoys-Squeakland-script editor') ----- currentScriptEditor "Return nil, since there is none. Relates to universal tiles only." ^ nil! Item was changed: + ----- Method: MorphWithSubmorphsWrapper>>contents (in category 'hierarchy') ----- - ----- Method: MorphWithSubmorphsWrapper>>contents (in category '*Etoys-hierarchy') ----- contents ^item submorphs collect: [ :m | self class with: m ]! Item was changed: + ----- Method: NumericReadoutTile>>basicType (in category 'tiles') ----- - ----- Method: NumericReadoutTile>>basicType (in category '*eToys-tiles') ----- basicType "Answer a symbol representing the inherent type I hold" "Number String Boolean player collection sound color etc" ^ #Number! Item was changed: + ----- Method: ObjectPropertiesMorph>>toggleSimplePanel (in category 'Squeakland') ----- - ----- Method: ObjectPropertiesMorph>>toggleSimplePanel (in category '*Etoys-Squeakland-as yet unclassified') ----- toggleSimplePanel simplePanel := simplePanel not. self rebuild! Item was changed: + ----- Method: PaintInvokingMorph class>>authoringPrototype (in category 'scripting') ----- - ----- Method: PaintInvokingMorph class>>authoringPrototype (in category '*Etoys-scripting') ----- authoringPrototype ^ self new image: (ScriptingSystem formAtKey: 'Painting'); markAsPartsDonor; setBalloonText: 'drop this into any playfield or book page to make a new painting there'; yourself! Item was changed: + ----- Method: PaintInvokingMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - ----- Method: PaintInvokingMorph class>>descriptionForPartsBin (in category '*Etoys-parts bin') ----- descriptionForPartsBin ^ self partName: 'Paint' translatedNoop categories: {'Graphics' translatedNoop} documentation: 'Drop this icon to start painting a new object.' translatedNoop! Item was changed: + ----- Method: PaintInvokingMorph class>>initialize (in category 'class initialization') ----- - ----- Method: PaintInvokingMorph class>>initialize (in category '*Etoys-class initialization') ----- initialize self registerInFlapsRegistry.! Item was changed: + ----- Method: PaintInvokingMorph class>>registerInFlapsRegistry (in category 'class initialization') ----- - ----- Method: PaintInvokingMorph class>>registerInFlapsRegistry (in category '*Etoys-class initialization') ----- registerInFlapsRegistry "Register the receiver in the system's flaps registry" self environment at: #Flaps ifPresent: [:cl | cl registerQuad: {#PaintInvokingMorph. #new . 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop} forFlapNamed: 'PlugIn Supplies'. cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop} forFlapNamed: 'Widgets'. cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop} forFlapNamed: 'Scripting']! Item was changed: + ----- Method: PaintInvokingMorph class>>unload (in category 'class initialization') ----- - ----- Method: PaintInvokingMorph class>>unload (in category '*Etoys-class initialization') ----- unload "Unload the receiver from global registries" self environment at: #Flaps ifPresent: [:cl | cl unregisterQuadsWithReceiver: self] ! Item was changed: + ----- Method: PaintInvokingMorph>>initialize (in category 'initialization') ----- - ----- Method: PaintInvokingMorph>>initialize (in category '*Etoys-initialization') ----- initialize super initialize. self image: (ScriptingSystem formAtKey: 'Painting')! Item was changed: + ----- Method: PaintInvokingMorph>>initializeToStandAlone (in category 'parts bin') ----- - ----- Method: PaintInvokingMorph>>initializeToStandAlone (in category '*Etoys-parts bin') ----- initializeToStandAlone super initializeToStandAlone. self image: (ScriptingSystem formAtKey: 'Painting')! Item was changed: + ----- Method: PaintInvokingMorph>>isCandidateForAutomaticViewing (in category 'support') ----- - ----- Method: PaintInvokingMorph>>isCandidateForAutomaticViewing (in category '*Etoys-support') ----- isCandidateForAutomaticViewing ^ self isPartsDonor not! Item was changed: + ----- Method: PaintInvokingMorph>>justDroppedInto:event: (in category 'dropping/grabbing') ----- - ----- Method: PaintInvokingMorph>>justDroppedInto:event: (in category '*Etoys-dropping/grabbing') ----- justDroppedInto: aPasteUpMorph event: anEvent "This message is sent to a dropped morph after it has been dropped on--and been accepted by--a drop-sensitive morph" aPasteUpMorph isPartsBin ifFalse:[ self removeHalo. self delete. ^aPasteUpMorph makeNewDrawing: anEvent]. ^super justDroppedInto: aPasteUpMorph event: anEvent! Item was changed: + ----- Method: PaintInvokingMorph>>wantsToBeDroppedInto: (in category 'dropping/grabbing') ----- - ----- Method: PaintInvokingMorph>>wantsToBeDroppedInto: (in category '*Etoys-dropping/grabbing') ----- wantsToBeDroppedInto: aMorph "Only into PasteUps that are not part bins" ^aMorph isPlayfieldLike! Item was changed: + ----- Method: ParameterTile>>parseNodeWith: (in category 'accessing') ----- - ----- Method: ParameterTile>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') ----- parseNodeWith: encoder ^ encoder encodeVariable: 'parameter' ifUnknown: [encoder encodeLiteral: 1]. ! Item was changed: + ----- Method: ParameterTile>>scriptEditor: (in category 'accessing') ----- - ----- Method: ParameterTile>>scriptEditor: (in category '*Etoys-Squeakland-accessing') ----- scriptEditor: anEditor scriptEditor := anEditor. ! Item was changed: + ----- Method: PhraseTileMorph>>aboutToBeAcceptedInScriptor (in category 'miscellaneous') ----- - ----- Method: PhraseTileMorph>>aboutToBeAcceptedInScriptor (in category '*Etoys-Squeakland-miscellaneous') ----- aboutToBeAcceptedInScriptor "The receiver is about to be accepted in a Scriptor. Adjust state information accordingly." justGrabbedFromViewer := false! Item was changed: + ----- Method: PhraseTileMorph>>addCommandFeedback: (in category 'hilighting') ----- - ----- Method: PhraseTileMorph>>addCommandFeedback: (in category '*Etoys-Squeakland-hilighting') ----- addCommandFeedback: evt "Add screen feedback showing what would be torn off in a drag" | aMorph | (self owner owner isMemberOf: PhraseTileMorph) ifTrue: [self owner owner addCommandFeedback: evt. ^ self]. aMorph := RectangleMorph new bounds: ((self topLeft - (2@1)) corner: ((submorphs at: (2 max: submorphs size)) bottomRight + (2@1))). "inHotZone := evt ifNil: [true] ifNotNil: [rect containsPoint: evt cursorPoint]." aMorph beTransparent; borderWidth: 2; borderColor: ScriptingSystem commandFeedback; lock. Project current world addHighlightMorph: aMorph for: self outmostScriptEditor! Item was changed: + ----- Method: PhraseTileMorph>>assignmentNodeWith: (in category 'code generation') ----- - ----- Method: PhraseTileMorph>>assignmentNodeWith: (in category '*Etoys-Squeakland-code generation') ----- assignmentNodeWith: encoder | suffix rec sel args left op right m | rec := submorphs first parseNodeWith: encoder. suffix := submorphs second operatorForSexpAssignmentSuffix: submorphs second assignmentSuffix. sel := submorphs second assignmentRootForParseNode. args := WriteStream on: (Array new: 3). (submorphs second isMemberOf: AssignmentTileMorph) ifFalse: [ args nextPut: (submorphs second parseNodeWith: encoder). sel := (sel, 'to:') asSymbol. ]. suffix isEmpty ifFalse: [ left := self updatingOperatorNodeWith: encoder. op := (AssignmentTileMorph new operatorForAssignmentSuffix: suffix) asSymbol. right := self convertPrecedenceInParseNode: (submorphs third parseNodeWith: encoder) with: encoder. m := MessageNode new receiver: left selector: op arguments: (Array with: right) precedence: (op precedence) from: encoder sourceRange: nil. args nextPut: m. ] ifTrue: [ args nextPut: (self convertPrecedenceInParseNode: (submorphs third parseNodeWith: encoder) with: encoder). ]. ^ MessageNode new receiver: rec selector: sel arguments: args contents precedence: (sel asSymbol precedence) from: encoder sourceRange: nil.! Item was changed: + ----- Method: PhraseTileMorph>>colorNodeFor:with: (in category 'code generation') ----- - ----- Method: PhraseTileMorph>>colorNodeFor:with: (in category '*Etoys-Squeakland-code generation') ----- colorNodeFor: aColor with: encoder "^ MessageNode new receiver: (encoder encodeVariable: #Color) selector: #r:g:b: arguments: (Array with: (encoder encodeLiteral: aColor red) with: (encoder encodeLiteral: aColor green) with: (encoder encodeLiteral: aColor blue)) precedence: (#r:g:b: precedence) from: encoder sourceRange: nil." ^ encoder encodeLiteral: aColor. ! Item was changed: + ----- Method: PhraseTileMorph>>colorSeerNodeWith: (in category 'code generation') ----- - ----- Method: PhraseTileMorph>>colorSeerNodeWith: (in category '*Etoys-Squeakland-code generation') ----- colorSeerNodeWith: encoder | rec sel args | rec := submorphs first parseNodeWith: encoder. sel := #color:sees:. args := OrderedCollection new: 2. args add: (self colorNodeFor: submorphs second colorSwatch color with: encoder). args add: (submorphs third parseNodeWith: encoder). ^ MessageNode new receiver: rec selector: sel arguments: args asArray precedence: (sel precedence) from: encoder sourceRange: nil. ! Item was changed: + ----- Method: PhraseTileMorph>>convertPrecedenceInParseNode:with: (in category 'code generation') ----- - ----- Method: PhraseTileMorph>>convertPrecedenceInParseNode:with: (in category '*Etoys-Squeakland-code generation') ----- convertPrecedenceInParseNode: message with: encoder | e w list | w := WriteStream on: (Array new: 3). message eToysExpFlattenOn: w. list := w contents. e := EToyExpressionTransformer2 new newNodeFromList: list encoder: encoder. ^ e transform. ! Item was changed: + ----- Method: PhraseTileMorph>>convertPrecedenceOfArgsInParseNode:with: (in category 'code generation') ----- - ----- Method: PhraseTileMorph>>convertPrecedenceOfArgsInParseNode:with: (in category '*Etoys-Squeakland-code generation') ----- convertPrecedenceOfArgsInParseNode: message with: encoder | e r w list | message arguments size > 0 ifTrue: [ w := WriteStream on: (Array new: 3). message arguments first eToysExpFlattenOn: w. list := w contents. e := EToyExpressionTransformer2 new newNodeFromList: list encoder: encoder. r := e transform. message arguments at: 1 put: r. ^ message. ] ifFalse: [ ^ message. ]. ! Item was changed: + ----- Method: PhraseTileMorph>>createMultipleTestScripts: (in category 'mouse') ----- - ----- Method: PhraseTileMorph>>createMultipleTestScripts: (in category '*Etoys-Squeakland-mouse') ----- createMultipleTestScripts: aCount "Simulate the action of dropping a copy of the receiver to launch a new script -- for performance testing. To use: Open an Inspector on some tile command in a Viewer, e.g. on 'Car forward 5'. In the trash pane of that Inspector, then, evaluate expressions like: [self createMultipleTestScripts: 10] timeToRun. and MessageTally spyOn: [self createMultipleTestScripts: 4] " | aPosition | aPosition := 10@10. 1 to: aCount do: [:i | self forceScriptCreationAt: aPosition. aPosition := aPosition + (0 @ 50). "avoid dropping into existing scriptor" Project current world doOneCycle] "refresh viewer"! Item was changed: + ----- Method: PhraseTileMorph>>evaluateOn: (in category 'etoys-debugger') ----- - ----- Method: PhraseTileMorph>>evaluateOn: (in category '*Etoys-Squeakland-etoys-debugger') ----- evaluateOn: anEtoysDebugger ^ anEtoysDebugger evaluatePhrase: self! Item was changed: + ----- Method: PhraseTileMorph>>forceScriptCreationAt: (in category 'mouse') ----- - ----- Method: PhraseTileMorph>>forceScriptCreationAt: (in category '*Etoys-Squeakland-mouse') ----- forceScriptCreationAt: aPosition "For performance testing." | dup | dup := self duplicate. dup eventHandler: nil. "Remove viewer-related evt mouseover feedback" dup formerPosition: self currentHand position. self currentHand attachMorph: dup; simulateMorphDropAt: aPosition.! Item was changed: + ----- Method: PhraseTileMorph>>isAssignment (in category 'code generation') ----- - ----- Method: PhraseTileMorph>>isAssignment (in category '*Etoys-Squeakland-code generation') ----- isAssignment ^ (submorphs at: 2) isKindOf: AssignmentTileMorph. ! Item was changed: + ----- Method: PhraseTileMorph>>isColorSeer (in category 'code generation') ----- - ----- Method: PhraseTileMorph>>isColorSeer (in category '*Etoys-Squeakland-code generation') ----- isColorSeer ^ (submorphs at: 2) isKindOf: ColorSeerTile. ! Item was changed: + ----- Method: PhraseTileMorph>>isGetter: (in category 'code generation') ----- - ----- Method: PhraseTileMorph>>isGetter: (in category '*Etoys-Squeakland-code generation') ----- isGetter: aSymbol ^ (aSymbol beginsWith: 'get'). ! Item was changed: + ----- Method: PhraseTileMorph>>operatorNodeWith: (in category 'code generation') ----- - ----- Method: PhraseTileMorph>>operatorNodeWith: (in category '*Etoys-Squeakland-code generation') ----- operatorNodeWith: encoder | sel rec args | sel := submorphs second operatorOrExpression. sel := (TileMorph classPool at: #EqualityOperators) at: sel ifAbsent: [sel]. rec := submorphs first parseNodeWith: encoder. args := WriteStream on: (Array new: 3). ((submorphs second isMemberOf: TileCommandWithArgumentMorph) or: [ submorphs second isMemberOf: KedamaGetColorComponentTile]) ifTrue: [ args nextPut: (submorphs second parseNodeWith: encoder). ]. (3 to: submorphs size) do: [:e | args nextPut: ((submorphs at: e) parseNodeWith: encoder). ]. ^ MessageNode new receiver: rec selector: sel arguments: args contents precedence: (sel precedence) from: encoder sourceRange: nil. ! Item was changed: + ----- Method: PhraseTileMorph>>parseNodeWith: (in category 'code generation') ----- - ----- Method: PhraseTileMorph>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') ----- parseNodeWith: encoder ^ self parseNodeWith: encoder asStatement: false. ! Item was changed: + ----- Method: PhraseTileMorph>>parseNodeWith:asStatement: (in category 'code generation') ----- - ----- Method: PhraseTileMorph>>parseNodeWith:asStatement: (in category '*Etoys-Squeakland-code generation') ----- parseNodeWith: encoder asStatement: aBoolean | ret | submorphs size >= 2 ifTrue: [ self isAssignment ifTrue: [ ^ self assignmentNodeWith: encoder. ]. self isColorSeer ifTrue: [ ^ self colorSeerNodeWith: encoder. ]. (true) ifTrue: [ ret := self operatorNodeWith: encoder. aBoolean ifTrue: [^ self convertPrecedenceOfArgsInParseNode: ret with: encoder]. ^ ret. ]. ]. ret := submorphs first parseNodeWith: encoder. aBoolean ifTrue: [^ self convertPrecedenceInParseNode: ret with: encoder]. ^ ret. ! Item was changed: + ----- Method: PhraseTileMorph>>removeHighlightFeedback (in category 'hilighting') ----- - ----- Method: PhraseTileMorph>>removeHighlightFeedback (in category '*Etoys-Squeakland-hilighting') ----- removeHighlightFeedback "Remove any existing highlight feedback" ^ Project current world removeHighlightFeedback ! Item was changed: + ----- Method: PhraseTileMorph>>replacePlayerWith: (in category 'kedama') ----- - ----- Method: PhraseTileMorph>>replacePlayerWith: (in category '*Etoys-Squeakland-kedama') ----- replacePlayerWith: aPlayer "Kedama hook." | tile patch | aPlayer isPlayerLike ifFalse: [^ self]. aPlayer isPrototypeTurtlePlayer ifTrue: [ tile := self firstMorphBearingKedamaPlayer. tile ifNil: [^ self]. (tile isMemberOf: TileMorph) ifFalse: [^ self]. tile type = #objRef ifFalse: [^ self]. tile referToSimilarObject: aPlayer. patch := aPlayer costume renderedMorph kedamaWorld defaultPatch player. ] ifFalse: [ (aPlayer costume renderedMorph isMemberOf: KedamaPatchMorph) ifTrue: [ patch := aPlayer. ] ifFalse: [^ self]. ]. self allMorphsDo: [:e | ((e isMemberOf: UpdatingStringMorph) or: [e isMemberOf: UpdatingRectangleMorph]) ifTrue: [ e target isPlayerLike ifTrue: [ e target costume renderedMorph class = aPlayer costume renderedMorph class ifTrue: [ e target: aPlayer ]. ]. ]. (e isMemberOf: KedamaPatchTile) ifTrue: [ e usePatch: patch. ]. ].! Item was changed: + ----- Method: PhraseTileMorph>>updatingOperatorNodeWith: (in category 'code generation') ----- - ----- Method: PhraseTileMorph>>updatingOperatorNodeWith: (in category '*Etoys-Squeakland-code generation') ----- updatingOperatorNodeWith: encoder | sel rec args | sel := submorphs second assignmentRoot asGetterSelector. rec := submorphs first parseNodeWith: encoder. args := WriteStream on: (Array new: 3). ((submorphs second isMemberOf: TileCommandWithArgumentMorph) or: [(submorphs second isMemberOf: KedamaSetColorComponentTile) or: [submorphs second isMemberOf: KedamaSetPixelValueTile]]) ifTrue: [ args nextPut: (submorphs second parseNodeWith: encoder). ]. ^ MessageNode new receiver: rec selector: sel arguments: args contents precedence: (sel precedence) from: encoder sourceRange: nil. ! Item was changed: + ----- Method: Player class>>compile:classified:withStamp:notifying:logSource:for: (in category 'private') ----- - ----- Method: Player class>>compile:classified:withStamp:notifying:logSource:for: (in category '*Etoys-Squeakland-private') ----- compile: text classified: category withStamp: changeStamp notifying: requestor logSource: logSource for: anInstance | methodAndNode trailer | trailer := self defaultMethodTrailer. trailer sourceCode: text. methodAndNode := self basicCompile: text asString notifying: requestor trailer: trailer ifFail: [^nil] for: anInstance. logSource ifTrue: [ self logMethodSource: text forMethodWithNode: methodAndNode inCategory: category withStamp: changeStamp notifying: requestor. ]. self addAndClassifySelector: methodAndNode selector withMethod: methodAndNode method inProtocol: category notifying: requestor. self theNonMetaClass noteCompilationOf: methodAndNode selector meta: self isMeta. ^ methodAndNode selector! Item was changed: + ----- Method: Player class>>createTurtleSubclass2 (in category 'turtles') ----- - ----- Method: Player class>>createTurtleSubclass2 (in category '*Etoys-Squeakland-turtles') ----- createTurtleSubclass2 ^ KedamaTurtleVectorPlayer2 newUniqueClassInstVars: '' classInstVars: ''. ! Item was changed: + ----- Method: Player class>>extraExampleCar (in category 'MorphicExtras-examples') ----- - ----- Method: Player class>>extraExampleCar (in category '*Etoys-*MorphicExtras-examples') ----- extraExampleCar "Player extraExampleCar do: #openInWorld" | trackMorph wheelMorph carMorph carPlayer alertMorph wheelPlayer parent | trackMorph := SketchMorph withForm: (Form extraCarTrack magnifyBy: RealEstateAgent scaleFactor). trackMorph assuredPlayer; name: 'Track'. carMorph := SketchMorph withForm: (Form extraCar magnifyBy: RealEstateAgent scaleFactor). carPlayer := self newSubclass new costume: (carMorph name: #Car); yourself. wheelMorph := SketchMorph withForm: (Form extraWheel magnifyBy: RealEstateAgent scaleFactor). wheelPlayer := self newSubclass new costume: (wheelMorph name: #Wheel); yourself. alertMorph := RectangleMorph new useRoundedCorners; extent: 90 px @ 50 px; color: Color black; assuredPlayer; name: 'Alert'; yourself. {trackMorph. carMorph. wheelMorph. alertMorph} do: [:morph | carPlayer environment at: morph name asSymbol put: morph player]. carPlayer environment at: #Wheel put: wheelPlayer. Utilities useAuthorInitials: 'Objectland' during: [ carPlayer class compile: ((self extraExampleCarSource asString lines allButFirst copyWithFirst: #drive) joinSeparatedBy: Character cr)]. (carPlayer class >> #drive) decompile asScriptEditorFor: carPlayer. carPlayer changeScript: #drive toStatus: #ticking. carPlayer presenter stopRunningScripts. parent := Morph new color: Color transparent; extent: 700 px @ 700 px; addAllMorphsFront: {carMorph. trackMorph. wheelMorph. alertMorph} yourself. trackMorph position: 19 px @ 25 px. wheelMorph center: (trackMorph pointAtFraction: 0.3 @ 1.15). carMorph center: (trackMorph pointAtFraction: 0.45 @ 0.89); rotationDegrees: 100. alertMorph center: (wheelMorph pointAtFraction: 1.75 @ 0.5); addMorph: ('Alert' asTextMorph backgroundColor: (Color paleYellow alpha: 0.6); center: (alertMorph pointAtFraction: 0.5 @ 1.2); yourself). ^ {parent. carPlayer scriptEditorFor: #drive}! Item was changed: + ----- Method: Player class>>extraExampleCarSource (in category 'MorphicExtras-examples') ----- - ----- Method: Player class>>extraExampleCarSource (in category '*Etoys-*MorphicExtras-examples') ----- extraExampleCarSource ^ 'extraExampleDrive self forward: 5. self turn: Wheel getHeading // 5'! Item was changed: + ----- Method: Player class>>isRead: (in category 'turtles') ----- - ----- Method: Player class>>isRead: (in category '*Etoys-Squeakland-turtles') ----- isRead: aSelector ^ (aSelector beginsWith: 'get'). ! Item was changed: + ----- Method: Player class>>isWrite: (in category 'turtles') ----- - ----- Method: Player class>>isWrite: (in category '*Etoys-Squeakland-turtles') ----- isWrite: aSelector ^ (aSelector beginsWith: 'set'). ! Item was changed: + ----- Method: Player class>>myProject (in category 'other') ----- - ----- Method: Player class>>myProject (in category '*Etoys-Squeakland-other') ----- myProject "Find the project I was defined in, or nil" self isSystemDefined ifTrue: [^nil]. Project allProjects do: [:prj | prj world presenter allExtantPlayers do: [:plr | plr class == self ifTrue: [^prj]]]. ^nil ! Item was changed: + ----- Method: Player class>>readOrWriteOrNil: (in category 'turtles') ----- - ----- Method: Player class>>readOrWriteOrNil: (in category '*Etoys-Squeakland-turtles') ----- readOrWriteOrNil: aSymbol (self isRead: aSymbol) ifTrue: [^ #read]. (self isWrite: aSymbol) ifTrue: [^ #write]. ^ nil. ! Item was changed: + ----- Method: PlayerSurrogate>>copyName (in category 'menu') ----- - ----- Method: PlayerSurrogate>>copyName (in category '*Etoys-Squeakland-menu') ----- copyName "Copy the internal name of my referent to the clipboard." Clipboard clipboardText: playerRepresented externalName! Item was changed: + ----- Method: PlayerSurrogate>>destroyThisObject (in category 'scripting') ----- - ----- Method: PlayerSurrogate>>destroyThisObject (in category '*Etoys-Squeakland-as yet unclassified') ----- destroyThisObject "Make an effort to remove this object." playerRepresented isInTrash ifTrue: [^ self inform: 'Already in the Trash' translated]. playerRepresented costume slideToTrash: nil! Item was changed: + ----- Method: PlayerSurrogate>>forciblyRenamePlayer (in category 'scripting') ----- - ----- Method: PlayerSurrogate>>forciblyRenamePlayer (in category '*Etoys-Squeakland-as yet unclassified') ----- forciblyRenamePlayer "Allow the receiver to seize a name already nominally in use in the project." | current reply currentlyBearingName newNameForHim binding | current := playerRepresented knownName. reply := FillInTheBlank request: 'Type the name you insist upon' translated initialAnswer: current. reply isEmptyOrNil ifTrue: [^ self]. Preferences uniquePlayerNames ifFalse: [^ self costume renameTo: reply]. reply := (reply asIdentifier: true) asSymbol. reply = current ifTrue: [^ self inform: 'no change' translated]. binding := Project current world referencePool hasBindingOf: reply. binding ifNotNil: [ currentlyBearingName := binding value. newNameForHim := Utilities keyLike: reply satisfying: [:name | (Project current world referencePool includesKey: name) not]. currentlyBearingName renameTo: newNameForHim]. playerRepresented renameTo: reply. self inform: (binding ifNil: [('There was no conflict; this object is now named {1}' translated format: {reply})] ifNotNil: ['Okay, this object is now named\{1}\and the object formerly known by this name is now called\{2}' translated format: {reply. newNameForHim}]).! Item was changed: + ----- Method: PlayerSurrogate>>inspectPlayer (in category 'menu') ----- - ----- Method: PlayerSurrogate>>inspectPlayer (in category '*Etoys-Squeakland-menu') ----- inspectPlayer "Inspect the player I represent." playerRepresented inspectWithLabel: playerRepresented printString! Item was changed: + ----- Method: PlayerSurrogate>>playerButtonHit (in category 'menu') ----- - ----- Method: PlayerSurrogate>>playerButtonHit (in category '*Etoys-Squeakland-menu') ----- playerButtonHit "The user clicked on the menu icon." | aMenu aString | aMenu := MenuMorph new defaultTarget: self. aString := playerRepresented uniqueNameForReference. aMenu addTitle: aString. aMenu addTranslatedList: #( ('where is this object?' revealThisObject) ('open viewer for this object' viewerForThisObject) ('tile for this object' handMeATile) - ('destroy this object' destroyThisObject) - ('rename object' renamePlayer) ('forcibly rename object' forciblyRenamePlayer 'If you want to give this object a name which conflicts with the name of some other object in the project, use this command. The other object with the same name will in the process be given a different name.') - ('copy object''s name to clipboard' copyName) ('inspect object' inspectPlayer) ) translatedNoop. aMenu popUpInWorld! Item was changed: + ----- Method: PlayerSurrogate>>renamePlayer (in category 'menu') ----- - ----- Method: PlayerSurrogate>>renamePlayer (in category '*Etoys-Squeakland-menu') ----- renamePlayer "Rename the player I represent." | result | result := FillInTheBlank request: 'Type new name:' translated initialAnswer: playerRepresented knownName. result isEmptyOrNil ifFalse: [playerRepresented tryToRenameTo: result]! Item was changed: + ----- Method: PluggableTabButtonMorph class>>on:label: (in category 'instance creation') ----- - ----- Method: PluggableTabButtonMorph class>>on:label: (in category '*Etoys-instance creation') ----- on: anObject label: getTextSelector | instance | instance := super new. instance model: anObject. instance textSelector: getTextSelector. ^ instance ! Item was changed: + ----- Method: PluggableTabButtonMorph>>active (in category 'access') ----- - ----- Method: PluggableTabButtonMorph>>active (in category '*Etoys-access') ----- active active ifNil: [ active := false ]. ^ active! Item was changed: + ----- Method: PluggableTabButtonMorph>>active: (in category 'access') ----- - ----- Method: PluggableTabButtonMorph>>active: (in category '*Etoys-access') ----- active: aBoolean active := aBoolean. self changed.! Item was changed: + ----- Method: PluggableTabButtonMorph>>arcLengths (in category 'private - access') ----- - ----- Method: PluggableTabButtonMorph>>arcLengths (in category '*Etoys-private - access') ----- arcLengths arcLengths ifNil: [ self calculateArcLengths ]. ^ arcLengths! Item was changed: + ----- Method: PluggableTabButtonMorph>>arcLengths: (in category 'private - access') ----- - ----- Method: PluggableTabButtonMorph>>arcLengths: (in category '*Etoys-private - access') ----- arcLengths: anArrayOfIntegers arcLengths := anArrayOfIntegers ! Item was changed: + ----- Method: PluggableTabButtonMorph>>calculateArcLengths (in category 'precalculations') ----- - ----- Method: PluggableTabButtonMorph>>calculateArcLengths (in category '*Etoys-precalculations') ----- calculateArcLengths | array radius | radius := self cornerRadius. array := Array new: radius. 1 to: radius do: [ :i | | x | x := i - 0.5. array at: i put: (radius - ((2 * x * radius) - (x * x)) sqrt) asInteger]. self arcLengths: array! Item was changed: + ----- Method: PluggableTabButtonMorph>>cornerRadius (in category 'private - access') ----- - ----- Method: PluggableTabButtonMorph>>cornerRadius (in category '*Etoys-private - access') ----- cornerRadius ^ 5 ! Item was changed: + ----- Method: PluggableTabButtonMorph>>drawOn: (in category 'drawing') ----- - ----- Method: PluggableTabButtonMorph>>drawOn: (in category '*Etoys-drawing') ----- drawOn: aCanvas self drawTabOn: aCanvas. self drawSubMorphOn: aCanvas! Item was changed: + ----- Method: PluggableTabButtonMorph>>drawSubMorphOn: (in category 'drawing') ----- - ----- Method: PluggableTabButtonMorph>>drawSubMorphOn: (in category '*Etoys-drawing') ----- drawSubMorphOn: aCanvas | morphBounds | morphBounds := self bounds insetBy: (self cornerRadius + 3) @ (self topInactiveGap // 2 + 2). morphBounds := morphBounds translateBy: 0@(self topInactiveGap // 2 + 1). self active ifTrue: [ morphBounds := morphBounds translateBy: 0@((self topInactiveGap // 2 + 1) negated)]. self subMorph bounds height < (morphBounds height) ifTrue: [ morphBounds := morphBounds insetBy: 0@((morphBounds height - self subMorph bounds height) // 2)]. self subMorph bounds width < (morphBounds width) ifTrue: [ morphBounds := morphBounds insetBy: ((morphBounds width - self subMorph bounds width) // 2)@0]. self subMorph bounds: morphBounds. aCanvas drawMorph: self subMorph! Item was changed: + ----- Method: PluggableTabButtonMorph>>drawTabOn: (in category 'drawing') ----- - ----- Method: PluggableTabButtonMorph>>drawTabOn: (in category '*Etoys-drawing') ----- drawTabOn: aCanvas | top myColor cornerRadius myArcLengths myBounds | cornerRadius := self cornerRadius. myBounds := self bounds. self active ifTrue: [ top := myBounds top. myColor := self color ] ifFalse: [ top := myBounds top + self topInactiveGap. myColor := self color whiter whiter ]. aCanvas fillRectangle: ((myBounds left + cornerRadius) @ (top + cornerRadius) corner: (myBounds right - cornerRadius) @ self bottom) color: myColor. aCanvas fillRectangle: ((myBounds left + (cornerRadius * 2)) @ top corner: (myBounds right - (cornerRadius * 2)) @ (top + cornerRadius)) color: myColor. aCanvas fillOval: ((myBounds left + self cornerRadius) @ top corner: (myBounds left + (self cornerRadius * 3)) @ (top + (self cornerRadius * 2))) color: myColor. aCanvas fillOval: ((myBounds right - (self cornerRadius * 3)) @ top corner: (myBounds right - self cornerRadius) @ (top + (self cornerRadius * 2))) color: myColor. myArcLengths := self arcLengths. 1 to: myArcLengths size do: [ :i | | length | length := myArcLengths at: i. aCanvas line: (myBounds left + cornerRadius - i) @ (myBounds bottom - 1 ) to: (myBounds left + cornerRadius - i) @ (myBounds bottom - length - 1) color: myColor. aCanvas line: (myBounds right - cornerRadius + i - 1) @ (myBounds bottom - 1) to: (myBounds right - cornerRadius + i - 1) @ (myBounds bottom - length - 1) color: myColor] ! Item was changed: + ----- Method: PluggableTabButtonMorph>>initialize (in category 'initialization') ----- - ----- Method: PluggableTabButtonMorph>>initialize (in category '*Etoys-initialization') ----- initialize ^ super initialize ! Item was changed: + ----- Method: PluggableTabButtonMorph>>innerExtent: (in category 'access') ----- - ----- Method: PluggableTabButtonMorph>>innerExtent: (in category '*Etoys-access') ----- innerExtent: aPoint "Set the extent based on the primary visible part of the tab. In other words add twice the cornerRadius to this extent" self extent: (aPoint x + (self cornerRadius * 2)) @ (aPoint y)! Item was changed: + ----- Method: PluggableTabButtonMorph>>model (in category 'access') ----- - ----- Method: PluggableTabButtonMorph>>model (in category '*Etoys-access') ----- model ^ model ! Item was changed: + ----- Method: PluggableTabButtonMorph>>model: (in category 'access') ----- - ----- Method: PluggableTabButtonMorph>>model: (in category '*Etoys-access') ----- model: anObject model := anObject! Item was changed: + ----- Method: PluggableTabButtonMorph>>outerGap (in category 'access') ----- - ----- Method: PluggableTabButtonMorph>>outerGap (in category '*Etoys-access') ----- outerGap "The horizontal distance of the outer left and right edges of the tab excluding the inner visible part" ^ self cornerRadius * 2! Item was changed: + ----- Method: PluggableTabButtonMorph>>step (in category 'stepping') ----- - ----- Method: PluggableTabButtonMorph>>step (in category '*Etoys-stepping') ----- step self subMorph step. self changed. ! Item was changed: + ----- Method: PluggableTabButtonMorph>>stepTime (in category 'stepping') ----- - ----- Method: PluggableTabButtonMorph>>stepTime (in category '*Etoys-stepping') ----- stepTime ^ self subMorph stepTime ! Item was changed: + ----- Method: PluggableTabButtonMorph>>subMorph (in category 'private - access') ----- - ----- Method: PluggableTabButtonMorph>>subMorph (in category '*Etoys-private - access') ----- subMorph subMorph ifNil: [ self update: self textSelector ]. ^ subMorph! Item was changed: + ----- Method: PluggableTabButtonMorph>>subMorph: (in category 'private - access') ----- - ----- Method: PluggableTabButtonMorph>>subMorph: (in category '*Etoys-private - access') ----- subMorph: aMorph subMorph := aMorph ! Item was changed: + ----- Method: PluggableTabButtonMorph>>textSelector (in category 'access') ----- - ----- Method: PluggableTabButtonMorph>>textSelector (in category '*Etoys-access') ----- textSelector ^ textSelector ! Item was changed: + ----- Method: PluggableTabButtonMorph>>textSelector: (in category 'access') ----- - ----- Method: PluggableTabButtonMorph>>textSelector: (in category '*Etoys-access') ----- textSelector: aSymbol textSelector := aSymbol! Item was changed: + ----- Method: PluggableTabButtonMorph>>toggle (in category 'actions') ----- - ----- Method: PluggableTabButtonMorph>>toggle (in category '*Etoys-actions') ----- toggle self active: self active not! Item was changed: + ----- Method: PluggableTabButtonMorph>>topInactiveGap (in category 'private - access') ----- - ----- Method: PluggableTabButtonMorph>>topInactiveGap (in category '*Etoys-private - access') ----- topInactiveGap ^ 5! Item was changed: + ----- Method: PluggableTabButtonMorph>>update: (in category 'updating') ----- - ----- Method: PluggableTabButtonMorph>>update: (in category '*Etoys-updating') ----- update: aSelector self textSelector ifNotNil: [ aSelector = self textSelector ifTrue: [ | morph | (aSelector isSymbol and: [model notNil]) ifTrue: [ morph := (self model perform: aSelector) asMorph] ifFalse: [ morph := aSelector value asMorph]. self subMorph: morph]]. self changed! Item was changed: + ----- Method: PluggableTabButtonMorph>>wantsSteps (in category 'stepping') ----- - ----- Method: PluggableTabButtonMorph>>wantsSteps (in category '*Etoys-stepping') ----- wantsSteps ^ self subMorph wantsSteps! Item was changed: + ----- Method: Presenter class>>defaultPresenterClass (in category 'accessing') ----- - ----- Method: Presenter class>>defaultPresenterClass (in category '*Etoys-accessing') ----- defaultPresenterClass "The default presenter class to use" ^DefaultPresenterClass ifNil:[self]! Item was changed: + ----- Method: Presenter class>>defaultPresenterClass: (in category 'accessing') ----- - ----- Method: Presenter class>>defaultPresenterClass: (in category '*Etoys-accessing') ----- defaultPresenterClass: aPresenterClass "The default presenter class to use" DefaultPresenterClass := aPresenterClass! Item was changed: + ----- Method: RandomNumberTile>>basicParseNodeWith: (in category 'code generation') ----- - ----- Method: RandomNumberTile>>basicParseNodeWith: (in category '*Etoys-Squeakland-code generation') ----- basicParseNodeWith: encoder ^ MessageNode new receiver: (encoder encodeLiteral: literal) selector: #atRandom arguments: #() precedence: (#atRandom precedence) from: encoder sourceRange: nil. ! Item was changed: + ----- Method: RandomNumberTile>>kedamaParseNodeWith:actualObject: (in category 'code generation') ----- - ----- Method: RandomNumberTile>>kedamaParseNodeWith:actualObject: (in category '*Etoys-Squeakland-code generation') ----- kedamaParseNodeWith: encoder actualObject: obj ^ MessageNode new receiver: (encoder encodePlayer: obj) selector: #random: arguments: (encoder encodeLiteral: literal) precedence: (#random: precedence) from: encoder sourceRange: nil. ! Item was changed: + ----- Method: RandomNumberTile>>labelMorphs (in category 'misc') ----- - ----- Method: RandomNumberTile>>labelMorphs (in category '*Etoys-Squeakland-misc') ----- labelMorphs ^ submorphs select: [:m | m isKindOf: StringMorph]. ! Item was changed: + ----- Method: RandomNumberTile>>parseNodeWith: (in category 'code generation') ----- - ----- Method: RandomNumberTile>>parseNodeWith: (in category '*Etoys-Squeakland-accessing') ----- parseNodeWith: encoder | phrase player costume | phrase := self outermostMorphThat: [:m| m isKindOf: PhraseTileMorph]. phrase ifNil: [^ self basicParseNodeWith: encoder]. player := phrase associatedPlayer. player ifNil: [^ self basicParseNodeWith: encoder]. costume := player costume. costume ifNil: [^ self basicParseNodeWith: encoder]. (player isKindOf: KedamaExamplerPlayer) ifTrue: [ ^ self kedamaParseNodeWith: encoder actualObject: player costume renderedMorph kedamaWorld player]. (costume renderedMorph isMemberOf: KedamaMorph) ifTrue: [ ^ self kedamaParseNodeWith: encoder actualObject: self]. ^ self basicParseNodeWith: encoder. ! Item was changed: + ----- Method: RandomNumberTile>>unhibernate (in category 'misc') ----- - ----- Method: RandomNumberTile>>unhibernate (in category '*Etoys-Squeakland-misc') ----- unhibernate self labelMorphs do: [:l | l label: l contents font: Preferences standardEToysFont]. self removeProperty: #needsLayoutFixed. ! Item was changed: + ----- Method: ScriptActivationButton>>editButtonsScript (in category 'scripting') ----- - ----- Method: ScriptActivationButton>>editButtonsScript (in category '*Etoys-Squeakland-button') ----- editButtonsScript "Open the scriptor for the script activated by this button." target openUnderlyingScriptorFor: arguments first! Item was changed: + ----- Method: ScriptEditorMorph class>>clearEvaluator (in category 'Tweak-Kedama') ----- - ----- Method: ScriptEditorMorph class>>clearEvaluator (in category '*Etoys-Squeakland-Tweak-Kedama') ----- clearEvaluator " ScriptEditorMorph clearEvaluator. " Evaluator := nil. ! Item was changed: + ----- Method: ScriptEditorMorph class>>generateParseNodeDirectly: (in category 'accessing') ----- - ----- Method: ScriptEditorMorph class>>generateParseNodeDirectly: (in category '*Etoys-Squeakland-accessing') ----- generateParseNodeDirectly: aBoolean "Set the value for the class variable GenerateParseNodeDirectly, which governs an option of how to compile tile scripts." GenerateParseNodeDirectly := aBoolean. " ScriptEditorMorph generateParseNodeDirectly: true ScriptEditorMorph generateParseNodeDirectly: false " ! Item was changed: + ----- Method: ScriptEditorMorph class>>setDefaultEvaluator (in category 'Tweak-Kedama') ----- - ----- Method: ScriptEditorMorph class>>setDefaultEvaluator (in category '*Etoys-Squeakland-Tweak-Kedama') ----- setDefaultEvaluator Evaluator := KedamaAttributeEvaluator new. Evaluator defineSyntaxFrom: KedamaAttributeEvaluator squeakParseNodes. Evaluator readDefinitionsFrom: KedamaTurtleMethodAttributionDefinition2. Evaluator compileEvaluator. ! Item was changed: + ----- Method: ScriptEditorMorph class>>setRewriteFlag: (in category 'Tweak-Kedama') ----- - ----- Method: ScriptEditorMorph class>>setRewriteFlag: (in category '*Etoys-Squeakland-Tweak-Kedama') ----- setRewriteFlag: aBoolean Rewrite := aBoolean. ! Item was changed: + ----- Method: ScriptEditorMorph class>>trackedEditor (in category 'tracking') ----- - ----- Method: ScriptEditorMorph class>>trackedEditor (in category '*Etoys-Squeakland-tracking') ----- trackedEditor ^ TrackedEditor ! Item was changed: + ----- Method: ScriptEditorMorph class>>trackedEditor: (in category 'tracking') ----- - ----- Method: ScriptEditorMorph class>>trackedEditor: (in category '*Etoys-Squeakland-tracking') ----- trackedEditor: anObject TrackedEditor := anObject. ! Item was changed: + ----- Method: ScriptEditorMorph>>addCommandFeedback: (in category 'menu commands') ----- - ----- Method: ScriptEditorMorph>>addCommandFeedback: (in category '*Etoys-Squeakland-menu commands') ----- addCommandFeedback: evt ! Item was changed: + ----- Method: ScriptEditorMorph>>addGoldBoxItemsTo: (in category 'other') ----- - ----- Method: ScriptEditorMorph>>addGoldBoxItemsTo: (in category '*Etoys-Squeakland-other') ----- addGoldBoxItemsTo: aMenu "Add gold-box-related submenu to the scriptor menu" | subMenu | subMenu := MenuMorph new defaultTarget: self. subMenu addTitle: 'gold box' translated. subMenu addTranslatedList: #( ('hand me a test-yest-no tile' addYesNoToHand) ('hand me a "repeat..times" tile' handUserTimesRepeatTile) ('hand me a "random number" tile' handUserRandomTile) ('hand me a "function" tile' handUserFunctionTile) ('hand me a "button up?" tile' handUserButtonUpTile) ('hand me a "button down?" tile' handUserButtonDownTile) ('hand me a tile for self ' handUserTileForSelf) ('hand me a numeric-constant tile' handUserNumericConstantTile) ) translatedNoop. aMenu add: 'gold box items' translated subMenu: subMenu! Item was changed: + ----- Method: ScriptEditorMorph>>buttonToOpenOrCloseThisScript (in category 'customevents-other') ----- - ----- Method: ScriptEditorMorph>>buttonToOpenOrCloseThisScript (in category '*Etoys-Squeakland-customevents-other') ----- buttonToOpenOrCloseThisScript "Hand the user a button which, when clicked, will show or hide this scriptor" | aButton | aButton := ScriptOpeningButtonMorph new. aButton affiliatedScriptor: self. aButton label: aButton standardLabelForButton. aButton color: (Color r: 0.677 g: 0.935 b: 0.484). aButton target: self; actionSelector: #openOrCloseScriptor. aButton setBalloonText: ('show or hide the script named {1} ' translated format: {scriptName}). aButton openInHand! Item was changed: + ----- Method: ScriptEditorMorph>>deleteEtoysDebugger (in category 'etoys-debugger') ----- - ----- Method: ScriptEditorMorph>>deleteEtoysDebugger (in category '*Etoys-Squeakland-etoys-debugger') ----- deleteEtoysDebugger "If present, delete the currently-associated etoysDebugger." | aDebugger | aDebugger := self valueOfProperty: #etoysDebugger ifAbsent: [^ self]. aDebugger delete. "removes the highlighter from the world" self removeProperty: #etoysDebugger! Item was changed: + ----- Method: ScriptEditorMorph>>enforceImplicitSelf (in category 'access') ----- - ----- Method: ScriptEditorMorph>>enforceImplicitSelf (in category '*Etoys-Squeakland-access') ----- enforceImplicitSelf "If the implicitSelf preference is set to true, obscure all unnecessary objRef tiles." self scriptContainer allMorphs do: [:m | ((m isKindOf: TileMorph) and: [m type == #objRef]) ifTrue: [m emblazonPlayerNameOnReferenceTileWithin: self]] ! Item was changed: + ----- Method: ScriptEditorMorph>>etoysDebugger (in category 'etoys-debugger') ----- - ----- Method: ScriptEditorMorph>>etoysDebugger (in category '*Etoys-Squeakland-etoys-debugger') ----- etoysDebugger ^ self valueOfProperty: #etoysDebugger ifAbsentPut: [EtoysDebugger on: self]! Item was changed: + ----- Method: ScriptEditorMorph>>findObject (in category 'menu commands') ----- - ----- Method: ScriptEditorMorph>>findObject (in category '*Etoys-Squeakland-menu commands') ----- findObject "Reveal the object bearing the code " playerScripted revealPlayerIn: Project current world.! Item was changed: + ----- Method: ScriptEditorMorph>>generateParseNodeDirectly (in category 'access') ----- - ----- Method: ScriptEditorMorph>>generateParseNodeDirectly (in category '*Etoys-Squeakland-access') ----- generateParseNodeDirectly ^ GenerateParseNodeDirectly == true. ! Item was changed: + ----- Method: ScriptEditorMorph>>goldBoxMenu (in category 'gold box') ----- - ----- Method: ScriptEditorMorph>>goldBoxMenu (in category '*Etoys-Squeakland-gold box') ----- goldBoxMenu "Answer a graphical menu to be put up in conjunction with the Gold Box" | aBox | aBox := Project current world findA: GoldBoxMenu. aBox ifNil: [aBox := GoldBoxMenu new]. aBox initializeFor: self. ^ aBox! Item was changed: + ----- Method: ScriptEditorMorph>>handUserFunctionTile (in category 'other') ----- - ----- Method: ScriptEditorMorph>>handUserFunctionTile (in category '*Etoys-Squeakland-other') ----- handUserFunctionTile "Hand the user a function tile, presumably to drop in the script" | functionPhrase argTile aPad | functionPhrase := FunctionTile new. argTile := (Vocabulary vocabularyNamed: 'Number') defaultArgumentTile. aPad := TilePadMorph new setType: #Number. aPad addMorphBack: argTile. functionPhrase operator: #abs pad: aPad. functionPhrase openInHand! Item was changed: + ----- Method: ScriptEditorMorph>>handUserNumericConstantTile (in category 'initialize buttons') ----- - ----- Method: ScriptEditorMorph>>handUserNumericConstantTile (in category '*Etoys-Squeakland-initialize buttons') ----- handUserNumericConstantTile "Construct a numeric-constant tile and hand it to the user." | aTile | aTile := Vocabulary numberVocabulary defaultArgumentTile. aTile openInHand! Item was changed: + ----- Method: ScriptEditorMorph>>handUserTimesRepeatTile (in category 'other') ----- - ----- Method: ScriptEditorMorph>>handUserTimesRepeatTile (in category '*Etoys-Squeakland-other') ----- handUserTimesRepeatTile "Hand the user a times-repeat tile, presumably to drop in the script" | aMorph | aMorph := TimesRepeatTile new. self currentHand attachMorph: aMorph. aMorph position: self currentHand position.! Item was changed: + ----- Method: ScriptEditorMorph>>hasKedamaTurtlePlayer (in category 'other') ----- - ----- Method: ScriptEditorMorph>>hasKedamaTurtlePlayer (in category '*Etoys-Squeakland-other') ----- hasKedamaTurtlePlayer self tileRows do: [:row | row do: [:phrase | phrase traverseSearchForKedamaTurtleIfFound: [^ true]]. ]. ^ false. ! Item was changed: + ----- Method: ScriptEditorMorph>>methodNode (in category 'customevents-buttons') ----- - ----- Method: ScriptEditorMorph>>methodNode (in category '*Etoys-Squeakland-customevents-buttons') ----- methodNode "Answer the source-code string for the receiver. This is for use by classic tiles, but is also used in universal tiles to formulate an initial method declaration for a nascent user-defined script; in universalTiles mode, the codeString (at present anyway) is empty -- the actual code derives from the SyntaxMorph in that case" | evaluator rewriter node | (submorphs size = 2 and: [(submorphs second isMemberOf: MethodMorph)]) ifTrue: [ ^ playerScripted class compilerClass new compile: submorphs second model contents in: playerScripted class notifying: nil ifFail: [] for: playerScripted. ]. node := self scriptParseNodeIn: self referenceWorld. self hasKedamaTurtlePlayer ifFalse: [^ node]. Evaluator ifNil: [ self class setDefaultEvaluator. ]. evaluator := Evaluator. evaluator makeAttributedTreeWith: node forReceiver: playerScripted. evaluator addGraphEdgesRoot. evaluator evaluateAllOccurence. Rewrite ifTrue: [ rewriter := KedamaVectorParseTreeRewriter new. rewriter attributedTree: evaluator attributedTree. rewriter parseTree: evaluator attributedTree tree. rewriter setEncoderFor: playerScripted in: self referenceWorld. rewriter visit: evaluator attributedTree tree andParent: nil. ^ playerScripted class compilerClass new compile: rewriter parseTree decompileString in: playerScripted class notifying: nil ifFail: [^nil] for: playerScripted. ] ifFalse: [ evaluator attributedTree inspect. ^ evaluator parseTree ]. ! Item was changed: + ----- Method: ScriptEditorMorph>>nextTile (in category 'etoys-debugger') ----- - ----- Method: ScriptEditorMorph>>nextTile (in category '*Etoys-Squeakland-etoys-debugger') ----- nextTile ^ (self ownerThatIsA: TileLikeMorph orA: ScriptEditorMorph) nextTile ! Item was changed: + ----- Method: ScriptEditorMorph>>nextTileTo: (in category 'etoys-debugger') ----- - ----- Method: ScriptEditorMorph>>nextTileTo: (in category '*Etoys-Squeakland-etoys-debugger') ----- nextTileTo: aTileMorph | tiles index | tiles := self tiles. index := (tiles indexOf: aTileMorph) + 1. index > tiles size ifTrue: [self = self topEditor ifTrue: [^ tiles at: 1] ifFalse: [^ self nextTile]]. ^ tiles at: index! Item was changed: + ----- Method: ScriptEditorMorph>>offerGoldBoxMenu (in category 'gold box') ----- - ----- Method: ScriptEditorMorph>>offerGoldBoxMenu (in category '*Etoys-Squeakland-gold box') ----- offerGoldBoxMenu "Put up a gold-box menu beneath my gold-box icon. This will re-use an existing one" self goldBoxMenu openInWorld; goHome! Item was changed: + ----- Method: ScriptEditorMorph>>offerSimplerScriptorMenu (in category 'other') ----- - ----- Method: ScriptEditorMorph>>offerSimplerScriptorMenu (in category '*Etoys-Squeakland-other') ----- offerSimplerScriptorMenu "Put up a menu in response to the user's clicking in the menu-request area of the scriptor's heaer. This variant is used when eToyFriendly preference is true." | aMenu count | self currentHand showTemporaryCursor: nil. aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: scriptName asString. aMenu addList: (self hasParameter ifTrue: [{ {'remove parameter' translated. #ceaseHavingAParameter}}] ifFalse: [{ {'add parameter' translated. #addParameter}}]). self hasParameter ifFalse: [aMenu addTranslatedList: #( ('button to fire this script' tearOfButtonToFireScript) -) translatedNoop]. 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. self showingMethodPane 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. 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: 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 addLine. aMenu addTranslatedList: #( - ('open viewer' openObjectsViewer 'open the viewer of the object to which this script belongs') - ('destroy this script' destroyScript)) translatedNoop. ^ aMenu popUpInWorld: self currentWorld! Item was changed: + ----- Method: ScriptEditorMorph>>openObjectsViewer (in category 'menu commands') ----- - ----- Method: ScriptEditorMorph>>openObjectsViewer (in category '*Etoys-Squeakland-menu commands') ----- openObjectsViewer "Open the viewer of the player whose code I bear." | aMorph | aMorph := playerScripted costume. aMorph presenter viewMorph: aMorph! Item was changed: + ----- Method: ScriptEditorMorph>>openOrCloseScriptor (in category 'customevents-other') ----- - ----- Method: ScriptEditorMorph>>openOrCloseScriptor (in category '*Etoys-Squeakland-customevents-other') ----- openOrCloseScriptor "Open up the scriptor on the screen" self isInWorld ifTrue: [self delete] ifFalse: [self openInWorld; goHome; comeToFront]! Item was changed: + ----- Method: ScriptEditorMorph>>parseNodeWith: (in category 'scripting') ----- - ----- 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)]]]. statements := statements contents. ret := ReturnNode new expr: (encoder encodeVariable: 'self'). ^ BlockNode new arguments: #() statements: (statements copyWith: ret) returns: true from: encoder.! Item was changed: + ----- Method: ScriptEditorMorph>>removeDropSpaces (in category 'dropping/grabbing') ----- - ----- Method: ScriptEditorMorph>>removeDropSpaces (in category '*Etoys-Squeakland-dropping/grabbing') ----- removeDropSpaces dropSpaces ifNotNil: [dropSpaces do: [:m | m delete]]. ! Item was changed: + ----- Method: ScriptEditorMorph>>scriptContainer (in category 'access') ----- - ----- Method: ScriptEditorMorph>>scriptContainer (in category '*Etoys-Squeakland-access') ----- scriptContainer "Answer the morph that holds the lines of script." ^ self! Item was changed: + ----- Method: ScriptEditorMorph>>scriptParseNodeIn: (in category 'scripting') ----- - ----- Method: ScriptEditorMorph>>scriptParseNodeIn: (in category '*Etoys-Squeakland-other') ----- scriptParseNodeIn: aWorld | n selOrFalse arguments block encoder | encoder := ScriptEncoder new init: playerScripted class context: nil notifying: nil; referenceObject: aWorld. n := MethodNode new. selOrFalse := encoder encodeSelector: scriptName. playerScripted class scripts at: scriptName ifPresent: [:uniclassScript | arguments := uniclassScript argumentVariables asArray collect: [:each | encoder bindArg: each variableName. ]. ]. arguments ifNil: [ "In some sort of transition. Initial creation or name change." scriptName numArgs = 0 ifTrue: [ arguments := #(). ] ifFalse: [ arguments := (Array with: (encoder bindArg: 'parameter')). ]. ]. block := self parseNodeWith: encoder. ^ n selector: selOrFalse arguments: arguments precedence: scriptName precedence temporaries: #() block: block encoder: encoder primitive: 0. ! Item was changed: + ----- Method: ScriptEditorMorph>>setupMethodMorph (in category 'access') ----- - ----- Method: ScriptEditorMorph>>setupMethodMorph (in category '*Etoys-Squeakland-buttons') ----- setupMethodMorph "create textual source instead" | aCodePane | aCodePane := MethodHolder isolatedCodePaneForClass: playerScripted class selector: scriptName. aCodePane hResizing: #spaceFill; vResizing: #spaceFill; minHeight: 100 px. self hResizing: #shrinkWrap; vResizing: #shrinkWrap. self addMorphBack: aCodePane. self fullBounds. self listDirection: #topToBottom; hResizing: #rigid; vResizing: #rigid; rubberBandCells: true; minWidth: self width. showingMethodPane := true. self currentWorld startSteppingSubmorphsOf: self! Item was changed: + ----- Method: ScriptEditorMorph>>showingCarets (in category 'other') ----- - ----- Method: ScriptEditorMorph>>showingCarets (in category '*Etoys-Squeakland-other') ----- showingCarets "Answer whether the receiver is in showing-carets mode." ^ self valueOfProperty: #showingCarets ifAbsentPut: [true]! Item was changed: + ----- Method: ScriptEditorMorph>>showingCaretsString (in category 'other') ----- - ----- Method: ScriptEditorMorph>>showingCaretsString (in category '*Etoys-Squeakland-other') ----- showingCaretsString "Answer a strilng characterizing whether I am showing carets or not." ^ (self showingCarets ifTrue: ['<yes>'] ifFalse: ['<no>']), 'show arrows' translated! Item was changed: + ----- Method: ScriptEditorMorph>>startTracking (in category 'dropping/grabbing') ----- - ----- Method: ScriptEditorMorph>>startTracking (in category '*Etoys-Squeakland-dropping/grabbing') ----- startTracking | ed | ((ed := ScriptEditorMorph trackedEditor) notNil and: [ed ~~ self]) ifTrue: [ ed stopSteppingSelector: #trackDropZones. ed removeSpaces. ]. ScriptEditorMorph trackedEditor: self. self startSteppingSelector: #trackDropZones.! Item was changed: + ----- Method: ScriptEditorMorph>>stepMe (in category 'etoys-debugger') ----- - ----- Method: ScriptEditorMorph>>stepMe (in category '*Etoys-Squeakland-etoys-debugger') ----- stepMe self etoysDebugger evaluateNextTile ! Item was changed: + ----- Method: ScriptEditorMorph>>stopTracking (in category 'dropping/grabbing') ----- - ----- Method: ScriptEditorMorph>>stopTracking (in category '*Etoys-Squeakland-dropping/grabbing') ----- stopTracking | ed | (((ed := ScriptEditorMorph trackedEditor) notNil) and: [ed ~~ self]) ifTrue: [ ed stopSteppingSelector: #trackDropZones. ed removeSpaces. ]. self stopSteppingSelector: #trackDropZones. handWithTile := nil. ScriptEditorMorph trackedEditor: nil. ! Item was changed: + ----- Method: ScriptEditorMorph>>tiles (in category 'etoys-debugger') ----- - ----- Method: ScriptEditorMorph>>tiles (in category '*Etoys-Squeakland-etoys-debugger') ----- tiles ^ self tileRows collect: [:each | each first]! Item was changed: + ----- Method: ScriptEditorMorph>>toggleShowingCarets (in category 'other') ----- - ----- Method: ScriptEditorMorph>>toggleShowingCarets (in category '*Etoys-Squeakland-other') ----- toggleShowingCarets "Toggle whether I'm showing carets." self setProperty: #showingCarets toValue: self showingCarets not. self fixUpCarets. self install! Item was changed: + ----- Method: ScriptEditorMorph>>viewerTile (in category 'access') ----- - ----- Method: ScriptEditorMorph>>viewerTile (in category '*Etoys-Squeakland-access') ----- viewerTile | viewers category viewerline | viewers := playerScripted allOpenViewersOnReceiverAndSiblings. viewers isEmpty ifTrue: [^ nil]. category := viewers first categoryMorphs detect: [:e | e chosenCategorySymbol = #scripts] ifNone: [^ nil]. viewerline := category submorphs detect: [:e | (e isKindOf: ViewerLine) and: [e elementSymbol = scriptName]] ifNone: [^ nil]. viewerline world ifNil: [^ nil]. ^ viewerline! Item was changed: + ----- Method: ScriptInstantiation>>resetTo:ifCurrently: (in category 'customevents-status control') ----- - ----- Method: ScriptInstantiation>>resetTo:ifCurrently: (in category '*Etoys-Squeakland-status control') ----- resetTo: newStatus ifCurrently: aStatus "If my status *had been* aStatus, quietly reset it to newStatus, without tampering with event handlers. But get the physical display of all affected status morphs right" status == aStatus ifTrue: [status := newStatus. self updateAllStatusMorphs]! Item was changed: + ----- Method: ScriptInstantiation>>statusLabel (in category 'customevents-status control') ----- - ----- Method: ScriptInstantiation>>statusLabel (in category '*Etoys-Squeakland-status control') ----- statusLabel ^self translatedStatus! Item was changed: + ----- Method: ScriptStatusControl>>fixUpScriptInstantiation (in category 'access') ----- - ----- Method: ScriptStatusControl>>fixUpScriptInstantiation (in category '*Etoys-Squeakland-access') ----- fixUpScriptInstantiation "If the receiver's scriptInstantiation is broken (owing to a bug also fixed in the update housing this code) fix it up and reply true, else reply false." | myPlayer correctInstantiation result | myPlayer := scriptInstantiation player. correctInstantiation := myPlayer scriptInstantiationForSelector: scriptInstantiation selector. result := correctInstantiation ~~ scriptInstantiation. result ifTrue: [self removeAllMorphs. tickPauseWrapper := nil. tickPauseButtonsShowing := false. self initializeFor: correctInstantiation]. ^ result! Item was changed: + ----- Method: SoundReadoutTile>>choices (in category 'arrows') ----- - ----- Method: SoundReadoutTile>>choices (in category '*Etoys-Squeakland-arrows') ----- choices ^self soundChoices. ! Item was changed: + ----- Method: StackMorph class>>formerDescriptionForPartsBin (in category 'parts bin') ----- - ----- Method: StackMorph class>>formerDescriptionForPartsBin (in category '*Etoys-Squeakland-parts bin') ----- formerDescriptionForPartsBin ^ self partName: 'Stack' translatedNoop categories: #() documentation: 'A database of any sort -- slide show, rolodex, and any point in between' translatedNoop! Item was changed: + ----- Method: StandardScriptingSystem class>>cleanUp: (in category 'class initialization') ----- - ----- Method: StandardScriptingSystem class>>cleanUp: (in category '*Etoys-class initialization') ----- cleanUp: agressive "Clean up unreferenced players. If agressive, reinitialize and nuke players" self removeUnreferencedPlayers. agressive ifTrue:[ References keys do: [:k | References removeKey: k]. ClassVarNamesInUse := nil. self initialize. ].! Item was changed: + ----- Method: StandardScriptingSystem class>>initialize (in category 'class initialization') ----- - ----- Method: StandardScriptingSystem class>>initialize (in category '*Etoys-class initialization') ----- initialize "Initialize the scripting system. Sometimes this method is vacuously changed just to get it in a changeset so that its invocation will occur as part of an update" (self environment at: #ScriptingSystem ifAbsent: [nil]) ifNil: [self environment at: #ScriptingSystem put: self new]. ScriptingSystem initializeHelpStrings. self registerInFlapsRegistry. "StandardScriptingSystem initialize"! Item was changed: + ----- Method: StandardScriptingSystem class>>noteAddedSelector:meta: (in category 'adding/removing methods') ----- - ----- Method: StandardScriptingSystem class>>noteAddedSelector:meta: (in category '*Etoys') ----- noteAddedSelector: aSelector meta: isMeta [aSelector == #wordingForOperator: ifTrue: [Vocabulary changeMadeToViewerAdditions]] on: Error do:[]. super noteAddedSelector: aSelector meta: isMeta! Item was changed: + ----- Method: StandardScriptingSystem class>>registerInFlapsRegistry (in category 'class initialization') ----- - ----- Method: StandardScriptingSystem class>>registerInFlapsRegistry (in category '*Etoys-*MorphicExtras-class initialization') ----- registerInFlapsRegistry "Register the receiver in the system's flaps registry" self environment at: #Flaps ifPresent: [:cl | cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop} forFlapNamed: 'PlugIn Supplies'. cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop} forFlapNamed: 'Supplies'. cl registerQuad: {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop} forFlapNamed: 'Widgets'. cl registerQuad: {#ScriptingSystem. #holderWithAlphabet. 'Alphabet' translatedNoop. 'A source for single-letter objects' translatedNoop} forFlapNamed: 'Widgets'.]! Item was changed: + ----- Method: StandardScriptingSystem class>>removePlayersIn: (in category 'projects') ----- - ----- Method: StandardScriptingSystem class>>removePlayersIn: (in category '*Etoys') ----- removePlayersIn: project "Remove existing player references for project" project world presenter reallyAllExtantPlayers do: [:pl | References removeKey: (project world uniqueNameForReferenceFor: pl) ifAbsent: [] ]. ! Item was changed: + ----- Method: StandardScriptingSystem class>>removeUnreferencedPlayers (in category 'class initialization') ----- - ----- Method: StandardScriptingSystem class>>removeUnreferencedPlayers (in category '*Etoys-class initialization') ----- removeUnreferencedPlayers "Remove existing but unreferenced player references" "StandardScriptingSystem removeUnreferencedPlayers" References keys do: [ : key | | ref | ref := References at: key. ((ref respondsTo: #costume) and: [ ref costume pasteUpMorph isNil ]) ifTrue: [ References removeKey: key ] ]! Item was changed: + ----- Method: StandardScriptingSystem class>>unload (in category 'class initialization') ----- - ----- Method: StandardScriptingSystem class>>unload (in category '*Etoys-*MorphicExtras-class initialization') ----- unload "Unload the receiver from global registries" self environment at: #Flaps ifPresent: [:cl | cl unregisterQuadsWithReceiver: ScriptingSystem] ! Item was changed: + ----- Method: StandardViewer>>assureScriptsCategoryShows (in category 'categories') ----- - ----- Method: StandardViewer>>assureScriptsCategoryShows (in category '*Etoys-Squeakland-categories') ----- assureScriptsCategoryShows "Assure that the receiver is showing a 'scripts' category." | catSyms newCat anIndex | ((catSyms := self symbolsOfCategoriesCurrentlyShowing) includes: ScriptingSystem nameForScriptsCategory) ifFalse: [newCat := self categoryViewerFor: #scripts. anIndex := (catSyms isEmpty or: [(#(search variables) includes: catSyms first) not]) ifTrue: [2] ifFalse: [(catSyms first = #search) ifTrue: [(catSyms size = 1 or: [catSyms second ~= #variables]) ifTrue: [3] ifFalse: [4]] ifFalse: [3]]. self addMorph: newCat asElementNumber: anIndex]! Item was changed: + ----- Method: StandardViewer>>enforceImplicitSelf (in category 'user interface') ----- - ----- Method: StandardViewer>>enforceImplicitSelf (in category '*Etoys-Squeakland-user interface') ----- enforceImplicitSelf "If the implicitSelf preference is set to true, obscure all unnecessary objRef tiles." self allMorphs do: [:m | ((m isKindOf: TileMorph) and: [m type == #objRef]) ifTrue: [m emblazonPlayerNameOnReferenceTileWithin: self]] ! Item was changed: + ----- Method: StandardViewer>>updateScriptsCategory (in category 'categories') ----- - ----- Method: StandardViewer>>updateScriptsCategory (in category '*Etoys-Squeakland-categories') ----- updateScriptsCategory "If any category viewer is showing scripts, relaunch it." self categoryMorphs do: [:m | (m chosenCategorySymbol = #scripts) ifTrue: [m beReplacedByCategory: #scripts]]! Item was changed: + ----- Method: SyntaxMorph>>parseNodeWith:asStatement: (in category 'code generation') ----- - ----- 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]! Item was changed: + ----- Method: SystemQueryPhrase>>addCommandFeedback: (in category 'hilighting') ----- - ----- Method: SystemQueryPhrase>>addCommandFeedback: (in category '*Etoys-Squeakland-hilighting') ----- addCommandFeedback: evt "Add screen feedback showing what would be torn off in a drag. Overridden vacuously here to avoid a crash when super code is applied to a SystemQueryPhrase."! Item was changed: + ----- Method: SystemQueryPhrase>>parseNodeWith: (in category 'code generation') ----- - ----- Method: SystemQueryPhrase>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') ----- parseNodeWith: encoder ^ submorphs first parseNodeWith: encoder! Item was changed: + ----- Method: TextFieldMorph class>>authoringPrototype (in category 'scripting') ----- - ----- Method: TextFieldMorph class>>authoringPrototype (in category '*Etoys-scripting') ----- authoringPrototype "Answer an instance of the receiver that can serve as a prototype for authoring" | proto | proto := super authoringPrototype. proto setProperty: #shared toValue: true. proto extent: 170 @ 30. proto color: Color veryLightGray lighter. proto contents: 'on a clear day you can...'. ^ proto ! Item was changed: + ----- Method: TextFieldMorph class>>exampleBackgroundField (in category 'instance creation') ----- - ----- Method: TextFieldMorph class>>exampleBackgroundField (in category '*eToys-instance creation') ----- exampleBackgroundField "Answer a scrollable background field for a parts bin" | aMorph | aMorph := self authoringPrototype. aMorph contents: 'background field' asText allBold. aMorph setProperty: #shared toValue: true. aMorph setNameTo: 'scrollingField1'. aMorph setProperty: #holdsSeparateDataForEachInstance toValue: true. ^ aMorph! Item was changed: + ----- Method: TextFieldMorph class>>initialize (in category 'class initialization') ----- - ----- Method: TextFieldMorph class>>initialize (in category '*Etoys-class initialization') ----- initialize self registerInFlapsRegistry. ! Item was changed: + ----- Method: TextFieldMorph class>>registerInFlapsRegistry (in category 'class initialization') ----- - ----- Method: TextFieldMorph class>>registerInFlapsRegistry (in category '*Etoys-class initialization') ----- registerInFlapsRegistry "Register the receiver in the system's flaps registry" self environment at: #Flaps ifPresent: [:cl | cl registerQuad: {#TextFieldMorph. #exampleBackgroundField. 'Scrolling Field' translatedNoop. 'A scrolling data field which will have a different value on every card of the background' translatedNoop} forFlapNamed: 'Scripting'.]! Item was changed: + ----- Method: TextFieldMorph class>>unload (in category 'class initialization') ----- - ----- Method: TextFieldMorph class>>unload (in category '*Etoys-class initialization') ----- unload "Unload the receiver from global registries" self environment at: #Flaps ifPresent: [:cl | cl unregisterQuadsWithReceiver: self] ! Item was changed: + ----- Method: TextPropertiesMorph>>applyToWholeText: (in category 'accessing') ----- - ----- Method: TextPropertiesMorph>>applyToWholeText: (in category '*Etoys-Squeakland-accessing') ----- applyToWholeText: anObject "Set the value of applyToWholeText" applyToWholeText := anObject! Item was changed: + ----- Method: TextPropertiesMorph>>establishSelectionInterval (in category 'button actions') ----- - ----- Method: TextPropertiesMorph>>establishSelectionInterval (in category '*Etoys-Squeakland-button actions') ----- establishSelectionInterval "If the active editor has a nonempty selection interval, assimilate it." | activeEditor itsSize | activeEditor := self activeEditor. self applyToWholeText ifTrue: [ ^activeEditor selectAll]. (selectionInterval size > 0) ifTrue: "User set it manually, so remember it" [^activeEditor selectInterval: selectionInterval] ifFalse: [itsSize := self activeTextMorph text string size. selectionInterval := Interval from: selectionInterval start to: (selectionInterval stop min: itsSize). ^activeEditor selectInterval: selectionInterval]! Item was changed: + ----- Method: TextPropertiesMorph>>selectionInterval (in category 'accessing') ----- - ----- Method: TextPropertiesMorph>>selectionInterval (in category '*Etoys-Squeakland-accessing') ----- selectionInterval "Answer the value of selectionInterval" ^ selectionInterval! Item was changed: + ----- Method: TextPropertiesMorph>>selectionInterval: (in category 'accessing') ----- - ----- Method: TextPropertiesMorph>>selectionInterval: (in category '*Etoys-Squeakland-accessing') ----- selectionInterval: anObject "Set the value of selectionInterval" selectionInterval := anObject! Item was changed: + ----- Method: TileLikeMorph>>nextTile (in category 'etoys-debugger') ----- - ----- Method: TileLikeMorph>>nextTile (in category '*Etoys-Squeakland-etoys-debugger') ----- nextTile ^ (self ownerThatIsA: ScriptEditorMorph) nextTileTo: self! Item was changed: + ----- Method: TileMorph class>>addArrowsOn: (in category 'utilities') ----- - ----- Method: TileMorph class>>addArrowsOn: (in category '*Etoys-Squeakland-utilities') ----- addArrowsOn: aMorph "add arrows on a morph, and answer {upArrow. downArrow}" | downArrow upArrow holder | downArrow := ImageMorph new image: TileMorph downPicture. upArrow := ImageMorph new image: TileMorph upPicture. holder := Morph new extent: downArrow width @ (upArrow height + downArrow height + 1). holder beTransparent. upArrow position: holder topLeft. downArrow position: upArrow left @ (upArrow bottom + 1). holder addMorph: upArrow. holder addMorph: downArrow. holder setProperty: #arrows toValue: true. holder clipSubmorphs: true. aMorph addMorphFront: holder. ^ Array with: upArrow with: downArrow! Item was changed: + ----- Method: TileMorph class>>implicitSelfInTilesChanged (in category 'utilities') ----- - ----- Method: TileMorph class>>implicitSelfInTilesChanged (in category '*Etoys-Squeakland-utilities') ----- implicitSelfInTilesChanged "The implicitSelfInTiles preference changed. Caution: although this may appear to have no senders in the image, it is in fact invoked when the implicitSelfInTiles preference is toggled... so please do not delete it." Smalltalk isMorphic ifFalse: [^ self]. Project current world allScriptEditorsInProject do: [:scriptEditor | scriptEditor install]. Project current world allViewersInProject do: [:viewer | viewer enforceImplicitSelf]. " (Preferences buttonForPreference: #implicitSelfInTiles) openInHand. "! Item was changed: + ----- Method: TileMorph class>>updatingOperators (in category 'constants') ----- - ----- Method: TileMorph class>>updatingOperators (in category '*Etoys-Squeakland-constants') ----- updatingOperators ^ UpdatingOperators! Item was changed: + ----- Method: TileMorph>>addCaretsAsAppropriate: (in category 'arrows') ----- - ----- Method: TileMorph>>addCaretsAsAppropriate: (in category '*Etoys-Squeakland-arrows') ----- addCaretsAsAppropriate: showingCarets "If the argument provided is true, make any expected up-down and suffix-retract carets visible; if false, hide them all." self setVisibilityOfUpDownCarets: showingCarets. (showingCarets and: [self couldAddSuffixArrow]) ifFalse: [self rescindSuffixArrow. self rescindRetractArrow] ifTrue: [self addSuffixArrow. self addRetractArrow] "has its own test." ! Item was changed: + ----- Method: TileMorph>>addRetractArrowAnyway (in category 'arrows') ----- - ----- Method: TileMorph>>addRetractArrowAnyway (in category '*Etoys-Squeakland-arrows') ----- addRetractArrowAnyway retractArrow := ImageMorph new image: RetractPicture. suffixArrow ifNotNil: [ self addMorph: retractArrow inFrontOf: suffixArrow]. fullBounds := nil. self extent: self fullBounds extent! Item was changed: + ----- Method: TileMorph>>buildHPopArrows (in category 'arrows popup') ----- - ----- Method: TileMorph>>buildHPopArrows (in category '*Etoys-Squeakland-arrows popup') ----- buildHPopArrows | panel left right | self outmostScriptEditor ifNil: [^ nil]. (retractArrow isNil and: [suffixArrow isNil]) ifTrue: [^ nil]. panel := Morph new. panel cornerStyle: #rounded. left := SketchMorph new form: (ScriptingSystem formAtKey: #LargeLeftArrow). right := SketchMorph new form: (ScriptingSystem formAtKey: #LargeRightArrow). panel color: color. panel sticky: true. panel layoutPolicy: TableLayout new. panel listDirection: #leftToRight. panel hResizing: #shrinkWrap. panel vResizing: #shrinkWrap. panel cellInset: 4 px. panel layoutInset: 2 px. retractArrow ifNotNil: [panel addMorphBack: left]. suffixArrow ifNotNil: [panel addMorphBack: right]. panel on: #mouseLeave send: #hidePopArrows to: self. left on: #mouseUp send: #popArrowRetractArrowHit: to: self. right on: #mouseUp send: #popArrowSuffixArrowHit: to: self. ^ panel! Item was changed: + ----- Method: TileMorph>>buildVPopArrows (in category 'arrows popup') ----- - ----- Method: TileMorph>>buildVPopArrows (in category '*Etoys-Squeakland-arrows popup') ----- buildVPopArrows | panel up down | upArrow ifNil: [^ nil]. panel := Morph new. panel cornerStyle: #rounded. up := SketchMorph new form: (ScriptingSystem formAtKey: #LargeUpArrow). down := SketchMorph new form: (ScriptingSystem formAtKey: #LargeDownArrow). panel color: color. panel sticky: true. panel layoutPolicy: TableLayout new. panel listDirection: #topToBottom. panel hResizing: #shrinkWrap. panel vResizing: #shrinkWrap. panel cellInset: 4 px. panel layoutInset: 2 px. panel addMorphBack: up. panel addMorphBack: down. panel on: #mouseLeave send: #hidePopArrows to: self. up on: #mouseDown send: #popArrowUp: to: self. up on: #mouseMove send: #popArrowMouseMove: to: self. down on: #mouseDown send: #popArrowDown: to: self. down on: #mouseMove send: #popArrowMouseMove: to: self. ^ panel! Item was changed: + ----- Method: TileMorph>>couldAddSuffixArrow (in category 'arrows') ----- - ----- Method: TileMorph>>couldAddSuffixArrow (in category '*Etoys-Squeakland-arrows') ----- couldAddSuffixArrow "Answer whether it is appropriate for the receiver to bear a suffix arrow." | phrase pad | type = #operator ifTrue: [((owner isKindOf: PhraseTileMorph) and: [owner submorphs last == self] and: [#("Point" Number) includes: owner resultType]) ifTrue: [^ true]]. (#(literal function parameter) includes: type) ifFalse: [^ false]. (pad := self ownerThatIsA: TilePadMorph) ifNil: [^ false]. (#("Point" Number) includes: pad type) ifFalse: [^ false]. phrase := pad owner. (phrase isKindOf: TimesRow) ifTrue: [^ true]. "times-repeat situation" (phrase isKindOf: PhraseTileMorph) ifTrue: [^ phrase submorphs last allMorphs includes: self] ifFalse: [^ phrase isKindOf: FunctionTile]! Item was changed: + ----- Method: TileMorph>>decimalPlaces (in category 'mouse handling') ----- - ----- Method: TileMorph>>decimalPlaces (in category '*Etoys-Squeakland-mouse handling') ----- decimalPlaces "Answer the number of decimal places of the contained number" | readout | (readout := self findA: UpdatingStringMorph) ifNotNil: [^readout decimalPlaces ]. ^0! Item was changed: + ----- Method: TileMorph>>downArrow (in category 'accessing') ----- - ----- Method: TileMorph>>downArrow (in category '*Etoys-Squeakland-accessing') ----- downArrow ^ downArrow ! Item was changed: + ----- Method: TileMorph>>emblazonPlayerNameOnReferenceTile (in category 'initialization') ----- - ----- Method: TileMorph>>emblazonPlayerNameOnReferenceTile (in category '*Etoys-Squeakland-initialization') ----- emblazonPlayerNameOnReferenceTile "Make the string within the receiver be the right thing." self emblazonPlayerNameOnReferenceTileWithin: (self outermostMorphThat: [:m | m isTileEditor])! Item was changed: + ----- Method: TileMorph>>emblazonPlayerNameOnReferenceTileWithin: (in category 'initialization') ----- - ----- Method: TileMorph>>emblazonPlayerNameOnReferenceTileWithin: (in category '*Etoys-Squeakland-initialization') ----- emblazonPlayerNameOnReferenceTileWithin: scriptorOrViewer "Make the string within the receiver be the right thing." | newLabel usePad | newLabel := actualObject externalName. Preferences implicitSelfInTiles ifTrue: [scriptorOrViewer ifNotNil: [scriptorOrViewer playerScripted == actualObject ifTrue: [newLabel := '']]]. (newLabel notEmpty and: [self isPossessive]) ifTrue: [newLabel := newLabel, '''s' translated]. self line1: newLabel. usePad := owner isKindOf: TilePadMorph. newLabel ifEmpty: [usePad ifTrue: [owner hResizing: #rigid; width: 0; clipSubmorphs: true]. self hResizing: #rigid; width: 0; borderWidth: 0] ifNotEmpty: [usePad ifTrue: [owner hResizing: #shrinkWrap; clipSubmorphs: false]. self hResizing: #shrinkWrap; borderWidth: 1 px] ! Item was changed: + ----- Method: TileMorph>>hidePopArrows (in category 'arrows popup') ----- - ----- Method: TileMorph>>hidePopArrows (in category '*Etoys-Squeakland-arrows popup') ----- hidePopArrows | popArrows | popArrows := self activeHand valueOfProperty: #popArrows ifAbsent: [^ self]. popArrows second ifNotNil: [popArrows second delete]. popArrows third ifNotNil: [popArrows third delete]. self activeHand removeProperty: #popArrows! Item was changed: + ----- Method: TileMorph>>isPopArrowNeeded (in category 'arrows popup') ----- - ----- Method: TileMorph>>isPopArrowNeeded (in category '*Etoys-Squeakland-arrows popup') ----- isPopArrowNeeded ^ upArrow notNil or: [suffixArrow notNil]! Item was changed: + ----- Method: TileMorph>>parseNodeWith: (in category 'code generation') ----- - ----- Method: TileMorph>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') ----- parseNodeWith: encoder | op playerBearingCode | playerBearingCode := self playerBearingCode. "Must determine whom is scripted for what follows to work; if it's ever nil, we've got trouble" type = #expression ifTrue: [^ (ScriptCompiler newParser parse: 'xxx ', operatorOrExpression class: UndefinedObject) block statements first]. type = #literal ifTrue: [^ encoder encodeLiteral: literal]. type == #objRef ifTrue: [^playerBearingCode == actualObject ifTrue: ["If the object is the method's own 'self' then we MUST, rather than just MAY, put out 'self' rather than the referencer call, though the latter will temporarily work if only one instance of the uniclass exists." ^ encoder encodeVariable: 'self'] ifFalse: [(actualObject isPlayerLike and: [actualObject isSequentialStub]) ifTrue: [ ^ actualObject parseNodeWith: encoder. ] ifFalse: [ ^ encoder encodePlayer: actualObject]]]. type = #operator ifTrue: [op := ((UpdatingOperators includesKey: operatorOrExpression) and: [self precedingTileType = #slotRef]) ifTrue: [UpdatingOperators at: operatorOrExpression] ifFalse: [operatorOrExpression]. ^op isEmpty ifTrue: [self halt.] ifFalse: [^ encoder encodeSelector: (EqualityOperators at: op ifAbsent: [op])]]. ! Item was changed: + ----- Method: TileMorph>>popArrowDown: (in category 'arrows popup') ----- - ----- Method: TileMorph>>popArrowDown: (in category '*Etoys-Squeakland-arrows popup') ----- popArrowDown: evt self setProperty: #previousLiteral toValue: self literalFromContents. self setProperty: #previousPoint toValue: evt position. evt handler ifNotNil: [evt handler on: #mouseStillDown send: #popArrowDown: to: self]. self currentHand releaseKeyboardFocus. self arrowAction: self arrowDelta negated! Item was changed: + ----- Method: TileMorph>>popArrowMouseMove: (in category 'arrows popup') ----- - ----- Method: TileMorph>>popArrowMouseMove: (in category '*Etoys-Squeakland-arrows popup') ----- popArrowMouseMove: evt | popArrows vpanel | popArrows := self activeHand valueOfProperty: #popArrows ifAbsent: [^ self]. vpanel := popArrows second. vpanel ifNotNil: [vpanel submorphs do: [:each | each on: #mouseStillDown send: nil to: nil]]. self mouseMove: evt! Item was changed: + ----- Method: TileMorph>>popArrowRetractArrowHit: (in category 'arrows popup') ----- - ----- Method: TileMorph>>popArrowRetractArrowHit: (in category '*Etoys-Squeakland-arrows popup') ----- popArrowRetractArrowHit: evt self retractArrowHit. self showPopArrows! Item was changed: + ----- Method: TileMorph>>popArrowSuffixArrowHit: (in category 'arrows popup') ----- - ----- Method: TileMorph>>popArrowSuffixArrowHit: (in category '*Etoys-Squeakland-arrows popup') ----- popArrowSuffixArrowHit: evt self showSuffixChoices. self showPopArrows! Item was changed: + ----- Method: TileMorph>>popArrowUp: (in category 'arrows popup') ----- - ----- Method: TileMorph>>popArrowUp: (in category '*Etoys-Squeakland-arrows popup') ----- popArrowUp: evt self setProperty: #previousLiteral toValue: self literalFromContents. self setProperty: #previousPoint toValue: evt position. evt handler ifNotNil: [evt handler on: #mouseStillDown send: #popArrowUp: to: self]. self currentHand releaseKeyboardFocus. self arrowAction: self arrowDelta! Item was changed: + ----- Method: TileMorph>>rescindRetractArrow (in category 'arrows') ----- - ----- Method: TileMorph>>rescindRetractArrow (in category '*Etoys-Squeakland-arrows') ----- rescindRetractArrow "If I have a retract arrow, remove it, and nil out my retractArrow inst var." retractArrow ifNotNil: [retractArrow delete. retractArrow := nil]! Item was changed: + ----- Method: TileMorph>>rescindSuffixArrow (in category 'arrows') ----- - ----- Method: TileMorph>>rescindSuffixArrow (in category '*Etoys-Squeakland-arrows') ----- rescindSuffixArrow "If I have a suffix arrow, remove it, and nil out my suffixArrow inst var." suffixArrow ifNotNil: [suffixArrow delete. suffixArrow := nil]! Item was changed: + ----- Method: TileMorph>>retractArrow (in category 'accessing') ----- - ----- Method: TileMorph>>retractArrow (in category '*Etoys-Squeakland-accessing') ----- retractArrow ^ retractArrow! Item was changed: + ----- Method: TileMorph>>retractArrowHit (in category 'arrows') ----- - ----- Method: TileMorph>>retractArrowHit (in category '*Etoys-Squeakland-arrows') ----- retractArrowHit "The user hit the retract button; carry out the retraction." | phrase pad goodPad | (phrase := self couldRetract) ifNil: [^ self]. pad := phrase ownerThatIsA: TilePadMorph. goodPad := phrase firstSubmorph. pad owner replaceSubmorph: pad by: goodPad. goodPad topEditor scriptEdited! Item was changed: + ----- Method: TileMorph>>setDecimalPlacesFromTypeIn: (in category 'misc') ----- - ----- Method: TileMorph>>setDecimalPlacesFromTypeIn: (in category '*Etoys-Squeakland-misc') ----- setDecimalPlacesFromTypeIn: aString self labelMorph ifNotNil: [:m | m setDecimalPlacesFromTypeIn: aString]! Item was changed: + ----- Method: TileMorph>>setVisibilityOfUpDownCarets: (in category 'arrows') ----- - ----- Method: TileMorph>>setVisibilityOfUpDownCarets: (in category '*Etoys-Squeakland-arrows') ----- setVisibilityOfUpDownCarets: showCarets "If the argument is true, make all the 'up and down' carets, such as those that let you change the value of a number or of a boolean constant, visible; if false, remove them from sight. " (submorphs detect: [:m | m hasProperty: #arrows] ifNone: [nil]) ifNotNil: [:wrapper | showCarets ifTrue: [wrapper width: 9 px] ifFalse: [wrapper width: 0]]! Item was changed: + ----- Method: TileMorph>>showPopArrows (in category 'arrows popup') ----- - ----- Method: TileMorph>>showPopArrows (in category '*Etoys-Squeakland-arrows popup') ----- showPopArrows | vpanel hpanel | self class usePopUpArrows ifFalse: [^ self]. self hidePopArrows. self isPopArrowNeeded ifFalse: [^ self]. vpanel := self buildVPopArrows. hpanel := self buildHPopArrows. self activeHand setProperty: #popArrows toValue: {self. vpanel. hpanel}. self layoutChanged! Item was changed: + ----- Method: TileMorph>>suffixArrow (in category 'accessing') ----- - ----- Method: TileMorph>>suffixArrow (in category '*Etoys-Squeakland-accessing') ----- suffixArrow ^ suffixArrow! Item was changed: + ----- Method: TileMorph>>unhibernate (in category 'scripting') ----- - ----- Method: TileMorph>>unhibernate (in category '*Etoys-Squeakland-as yet unclassified') ----- unhibernate | l | l := self labelMorph. l ifNotNil: [l label: l contents font: Preferences standardEToysFont]. self removeProperty: #needsLayoutFixed. ! Item was changed: + ----- Method: TileMorph>>upArrow (in category 'accessing') ----- - ----- Method: TileMorph>>upArrow (in category '*Etoys-Squeakland-accessing') ----- upArrow ^ upArrow ! Item was changed: + ----- Method: TileMorph>>wrapPhraseInFunction (in category 'arrows') ----- - ----- Method: TileMorph>>wrapPhraseInFunction (in category '*Etoys-Squeakland-arrows') ----- wrapPhraseInFunction "The user made a gesture requesting that the phrase for which the receiver bears the widget hit be wrapped in a function. This applies for the moment only to numeric functions" | pad newPad functionPhrase | pad := self ownerThatIsA: TilePadMorph. "Or something higher than that???" (pad isNil or: [pad type ~= #Number]) ifTrue: [^ Beeper beep]. newPad := TilePadMorph new setType: #Number. newPad hResizing: #shrinkWrap; vResizing: #spaceFill. functionPhrase := FunctionTile new. newPad addMorphBack: functionPhrase. pad owner replaceSubmorph: pad by: newPad. functionPhrase operator: #abs pad: pad. functionPhrase addSuffixArrow. self scriptEdited ! Item was changed: + ----- Method: TilePadMorph>>lastTileMorph (in category 'layout') ----- - ----- Method: TilePadMorph>>lastTileMorph (in category '*Etoys-Squeakland-layout') ----- lastTileMorph "Answer the final TileMorph in the receiver's tree -- this might be at any of three levels deep..." | aMorph lastInPhrase | submorphs ifEmpty: [^ nil]. "But should not normally happen." ((aMorph := submorphs first) isTileMorph) ifTrue: [^ aMorph]. "If first submorph is not a TileMorph, it will be a PhraseTileMorph so..." (lastInPhrase := aMorph submorphs last) isTileMorph ifTrue: [^ lastInPhrase]. "If the last morph in the phrase is not a Tile, then it's a TilePadMorph..." ^ lastInPhrase lastTileMorph! Item was changed: + ----- Method: TilePadMorph>>parseNodeWith: (in category 'code generation') ----- - ----- Method: TilePadMorph>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') ----- parseNodeWith: encoder ^ (submorphs at: 1) parseNodeWith: encoder. ! Item was changed: + ----- Method: TilePadMorph>>scriptEdited (in category 'miscellaneous') ----- - ----- Method: TilePadMorph>>scriptEdited (in category '*Etoys-Squeakland-miscellaneous') ----- scriptEdited "Tell the scriptEditor who I belong to that I have changed." | him | (him := self outermostMorphThat: [:m| m isKindOf: ScriptEditorMorph]) ifNotNil: [him scriptEdited]! Item was changed: + ----- Method: TilePadMorph>>wrapInFunction (in category 'miscellaneous') ----- - ----- Method: TilePadMorph>>wrapInFunction (in category '*Etoys-Squeakland-miscellaneous') ----- wrapInFunction "The user made a gesture requesting that the receiver be wrapped in a (numeric) function." | newPad functionPhrase | newPad := TilePadMorph new setType: #Number. newPad hResizing: #shrinkWrap; vResizing: #spaceFill. functionPhrase := FunctionTile new. newPad addMorphBack: functionPhrase. owner replaceSubmorph: self by: newPad. functionPhrase operator: #abs pad: self. self scriptEdited! Item was changed: + ----- Method: TimesRepeatMorph>>evaluateOn: (in category 'etoys-debugger') ----- - ----- Method: TimesRepeatMorph>>evaluateOn: (in category '*etoys-debugger') ----- evaluateOn: anEtoysDebugger ^ anEtoysDebugger evaluateRepeat: self! Item was changed: + ----- Method: TimesRepeatTile>>calculateTimesToRepeat (in category 'etoys-debugger') ----- - ----- Method: TimesRepeatTile>>calculateTimesToRepeat (in category '*etoys-debugger') ----- calculateTimesToRepeat ^ (Compiler evaluate: (String streamContents: [:stream | self numberOfTimesToRepeatPart submorphs ifEmpty: [stream nextPutAll: '0'] ifNotEmpty: [self numberOfTimesToRepeatPart storeCodeOn: stream indent: 0]]) for: self topEditor playerScripted logged: false)! Item was changed: + ----- Method: TimesRepeatTile>>evaluateOn: (in category 'etoys-debugger') ----- - ----- Method: TimesRepeatTile>>evaluateOn: (in category '*etoys-debugger') ----- evaluateOn: anEtoysDebugger ^ anEtoysDebugger evaluateRepeat: self! Item was changed: + ----- Method: TimesRepeatTile>>nextTile (in category 'etoys-debugger') ----- - ----- Method: TimesRepeatTile>>nextTile (in category '*etoys-debugger') ----- nextTile "Instead of just returning my next tile I return my first tile if I haven't been evaluated enough times" self timesToRepeat <= 0 ifTrue: [^ super nextTile]. self timesToRepeat: self timesToRepeat - 1. ^ self whatToRepeatPart tiles at: 1 ifAbsent: [super nextTile]! Item was changed: + ----- Method: TimesRepeatTile>>timesToRepeat (in category 'etoys-debugger') ----- - ----- Method: TimesRepeatTile>>timesToRepeat (in category '*etoys-debugger') ----- timesToRepeat ^ self topEditor etoysDebugger timesToRepeat! Item was changed: + ----- Method: TimesRepeatTile>>timesToRepeat: (in category 'etoys-debugger') ----- - ----- Method: TimesRepeatTile>>timesToRepeat: (in category '*etoys-debugger') ----- timesToRepeat: aNumber ^ self topEditor etoysDebugger timesToRepeat: aNumber! Item was changed: + ----- Method: TimesRepeatTile>>whatToRepeatPart (in category 'etoys-debugger') ----- - ----- Method: TimesRepeatTile>>whatToRepeatPart (in category '*etoys-debugger') ----- whatToRepeatPart ^ whatToRepeatPart! Item was changed: + ----- Method: TwoWayScrollPane>>colorForInsets (in category 'accessing') ----- - ----- Method: TwoWayScrollPane>>colorForInsets (in category '*Etoys-accessing') ----- colorForInsets "My submorphs use the surrounding color" owner notNil and: [ owner color isColor ifTrue: [ ^ owner color ] ]. ^ Color white! Item was changed: + ----- Method: TwoWayScrollPane>>containsPoint: (in category 'geometry testing') ----- - ----- Method: TwoWayScrollPane>>containsPoint: (in category '*Etoys-geometry testing') ----- containsPoint: aPoint (super containsPoint: aPoint) ifTrue: [^ true]. "Also include scrollbar when it is extended..." "used to handle retractable scrolbar" ^ false! Item was changed: + ----- Method: TwoWayScrollPane>>createScrollBarNamed: (in category 'initialization') ----- - ----- Method: TwoWayScrollPane>>createScrollBarNamed: (in category '*Etoys-initialization') ----- createScrollBarNamed: aString "creates a scroll bar named as aString" | result | result := ScrollBar new model: self slotName: aString. result borderStyle: (BorderStyle inset width: 2). ^ result! Item was changed: + ----- Method: TwoWayScrollPane>>createScroller (in category 'initialization') ----- - ----- Method: TwoWayScrollPane>>createScroller (in category '*Etoys-initialization') ----- createScroller "create a scroller" | result | result := TransformMorph new color: Color transparent. result offset: 0 @ 0. ^ result! Item was changed: + ----- Method: TwoWayScrollPane>>defaultBorderColor (in category 'initialization') ----- - ----- Method: TwoWayScrollPane>>defaultBorderColor (in category '*Etoys-initialization') ----- defaultBorderColor ^ Color transparent! Item was changed: + ----- Method: TwoWayScrollPane>>defaultBorderStyle (in category 'initialization') ----- - ----- Method: TwoWayScrollPane>>defaultBorderStyle (in category '*Etoys-initialization') ----- defaultBorderStyle ^ BorderStyle inset! Item was changed: + ----- Method: TwoWayScrollPane>>doLayoutIn: (in category 'layout') ----- - ----- Method: TwoWayScrollPane>>doLayoutIn: (in category '*Etoys-layout') ----- doLayoutIn: layoutBounds "layout has changed. update scroll deltas or whatever else" (owner notNil and: [owner hasProperty: #autoFitContents]) ifTrue: [self fitContents]. super doLayoutIn: layoutBounds.! Item was changed: + ----- Method: TwoWayScrollPane>>extent: (in category 'geometry') ----- - ----- Method: TwoWayScrollPane>>extent: (in category '*Etoys-geometry') ----- extent: newExtent bounds extent = newExtent ifTrue: [^ self]. super extent: (newExtent max: 36@32). self resizeScrollBar; resizeScroller; setScrollDeltas. ! Item was changed: + ----- Method: TwoWayScrollPane>>fitContents (in category 'layout') ----- - ----- Method: TwoWayScrollPane>>fitContents (in category '*Etoys-layout') ----- fitContents "Adjust my size to fit my contents reasonably snugly" self extent: scroller submorphBounds extent + (yScrollBar width @ xScrollBar height) + (self borderWidth*2) ! Item was changed: + ----- Method: TwoWayScrollPane>>getMenu: (in category 'menu') ----- - ----- Method: TwoWayScrollPane>>getMenu: (in category '*Etoys-menu') ----- getMenu: shiftKeyState "Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key." | menu aMenu aTitle | getMenuSelector isNil ifTrue: [^nil]. menu := MenuMorph new defaultTarget: model. aTitle := getMenuTitleSelector ifNotNil: [model perform: getMenuTitleSelector]. getMenuSelector numArgs = 1 ifTrue: [aMenu := model perform: getMenuSelector with: menu. aTitle ifNotNil: [aMenu addTitle: aTitle]. ^aMenu]. getMenuSelector numArgs = 2 ifTrue: [aMenu := model perform: getMenuSelector with: menu with: shiftKeyState. aTitle ifNotNil: [aMenu addTitle: aTitle]. ^aMenu]. ^self error: 'The getMenuSelector must be a 1- or 2-keyword symbol'! Item was changed: + ----- Method: TwoWayScrollPane>>handlesMouseDown: (in category 'event handling') ----- - ----- Method: TwoWayScrollPane>>handlesMouseDown: (in category '*Etoys-event handling') ----- handlesMouseDown: evt ^ true! Item was changed: + ----- Method: TwoWayScrollPane>>handlesMouseOver: (in category 'event handling') ----- - ----- Method: TwoWayScrollPane>>handlesMouseOver: (in category '*Etoys-event handling') ----- handlesMouseOver: evt ^ true! Item was changed: + ----- Method: TwoWayScrollPane>>hideOrShowScrollBar (in category 'retractable scroll bar') ----- - ----- Method: TwoWayScrollPane>>hideOrShowScrollBar (in category '*Etoys-retractable scroll bar') ----- hideOrShowScrollBar ^self "we don't support retractable at the moment"! Item was changed: + ----- Method: TwoWayScrollPane>>hideOrShowScrollBar:forRange: (in category 'retractable scroll bar') ----- - ----- Method: TwoWayScrollPane>>hideOrShowScrollBar:forRange: (in category '*Etoys-retractable scroll bar') ----- hideOrShowScrollBar: scrollBar forRange: range (self hasProperty: #hideUnneededScrollbars) ifFalse: [^ self]. (submorphs includes: scrollBar) ifTrue: [range <= 0 ifTrue: [scrollBar model: nil; delete]] ifFalse: [range > 0 ifTrue: [scrollBar model: self. self resizeScrollBar; addMorph: scrollBar]] ! Item was changed: + ----- Method: TwoWayScrollPane>>initialize (in category 'initialization') ----- - ----- Method: TwoWayScrollPane>>initialize (in category '*Etoys-initialization') ----- initialize "initialize the state of the receiver" super initialize. "" self addMorph: (yScrollBar := self createScrollBarNamed: 'yScrollBar'); addMorph: (xScrollBar := self createScrollBarNamed: 'xScrollBar'); addMorph: (scroller := self createScroller). "" self extent: 150 @ 120! Item was changed: + ----- Method: TwoWayScrollPane>>keyStroke: (in category 'event handling') ----- - ----- Method: TwoWayScrollPane>>keyStroke: (in category '*Etoys-event handling') ----- keyStroke: evt "If pane is not full, pass the event to the last submorph, assuming it is the most appropriate recipient (!!)" scroller submorphs last keyStroke: evt! Item was changed: + ----- Method: TwoWayScrollPane>>leftOrRight (in category 'menu') ----- - ----- Method: TwoWayScrollPane>>leftOrRight (in category '*Etoys-menu') ----- leftOrRight "Change scroll bar location" "used to handle left vs right scrollbar"! Item was changed: + ----- Method: TwoWayScrollPane>>leftoverScrollRange (in category 'geometry') ----- - ----- Method: TwoWayScrollPane>>leftoverScrollRange (in category '*Etoys-geometry') ----- leftoverScrollRange "Return the entire scrolling range minus the currently viewed area." ^ self totalScrollRange - (self innerBounds extent * 3 // 4) max: 0@0 ! Item was changed: + ----- Method: TwoWayScrollPane>>menuSelector: (in category 'menu') ----- - ----- Method: TwoWayScrollPane>>menuSelector: (in category '*Etoys-menu') ----- menuSelector: aSelector getMenuSelector := aSelector! Item was changed: + ----- Method: TwoWayScrollPane>>menuTitleSelector: (in category 'menu') ----- - ----- Method: TwoWayScrollPane>>menuTitleSelector: (in category '*Etoys-menu') ----- menuTitleSelector: aSelector getMenuTitleSelector := aSelector! Item was changed: + ----- Method: TwoWayScrollPane>>mouseDown: (in category 'event handling') ----- - ----- Method: TwoWayScrollPane>>mouseDown: (in category '*Etoys-event handling') ----- mouseDown: evt evt yellowButtonPressed "First check for option (menu) click" ifTrue: [^ self yellowButtonActivity: evt shiftPressed]. "If pane is not full, pass the event to the last submorph, assuming it is the most appropriate recipient (!!)" scroller hasSubmorphs ifTrue: [scroller submorphs last mouseDown: (evt transformedBy: (scroller transformFrom: self))]! Item was changed: + ----- Method: TwoWayScrollPane>>mouseEnter: (in category 'event handling') ----- - ----- Method: TwoWayScrollPane>>mouseEnter: (in category '*Etoys-event handling') ----- mouseEnter: event "used to handle retractable scrolbar"! Item was changed: + ----- Method: TwoWayScrollPane>>mouseLeave: (in category 'event handling') ----- - ----- Method: TwoWayScrollPane>>mouseLeave: (in category '*Etoys-event handling') ----- mouseLeave: event "used to handle retractable scrolbar"! Item was changed: + ----- Method: TwoWayScrollPane>>mouseMove: (in category 'event handling') ----- - ----- Method: TwoWayScrollPane>>mouseMove: (in category '*Etoys-event handling') ----- mouseMove: evt "If pane is not full, pass the event to the last submorph, assuming it is the most appropriate recipient (!!)" scroller hasSubmorphs ifTrue: [scroller submorphs last mouseMove: (evt transformedBy: (scroller transformFrom: self))]! Item was changed: + ----- Method: TwoWayScrollPane>>mouseUp: (in category 'event handling') ----- - ----- Method: TwoWayScrollPane>>mouseUp: (in category '*Etoys-event handling') ----- mouseUp: evt "If pane is not full, pass the event to the last submorph, assuming it is the most appropriate recipient (!!)" scroller hasSubmorphs ifTrue: [scroller submorphs last mouseUp: (evt transformedBy: (scroller transformFrom: self))]! Item was changed: + ----- Method: TwoWayScrollPane>>rejectsEvent: (in category 'events-processing') ----- - ----- Method: TwoWayScrollPane>>rejectsEvent: (in category '*Etoys-events-processing') ----- rejectsEvent: anEvent scroller submorphs isEmpty ifTrue: [^true]. "something messed up here" scroller firstSubmorph isSyntaxMorph ifTrue: [^ super rejectsEvent: anEvent]. ^self visible not "ignore locked status"! Item was changed: + ----- Method: TwoWayScrollPane>>resizeScrollBar (in category 'geometry') ----- - ----- Method: TwoWayScrollPane>>resizeScrollBar (in category '*Etoys-geometry') ----- resizeScrollBar "used to handle left vs right scrollbar" yScrollBar bounds: (bounds topLeft extent: 16 @ (bounds height - 16)). xScrollBar bounds: ((bounds left + 16) @ (bounds bottom - 16) extent: (bounds width - 16) @ 16). ! Item was changed: + ----- Method: TwoWayScrollPane>>resizeScroller (in category 'geometry') ----- - ----- Method: TwoWayScrollPane>>resizeScroller (in category '*Etoys-geometry') ----- resizeScroller | inner | "used to handle left vs right scrollbar" inner := self innerBounds. scroller bounds: (inner topLeft + (yScrollBar width@0) corner: (inner bottomRight - (0@xScrollBar height)))! Item was changed: + ----- Method: TwoWayScrollPane>>retractableOrNot (in category 'menu') ----- - ----- Method: TwoWayScrollPane>>retractableOrNot (in category '*Etoys-menu') ----- retractableOrNot "Change scroll bar operation" "used to handle retractable scrolbar"! Item was changed: + ----- Method: TwoWayScrollPane>>scrollBarFills: (in category 'geometry') ----- - ----- Method: TwoWayScrollPane>>scrollBarFills: (in category '*Etoys-geometry') ----- scrollBarFills: aRectangle "Return true if a flop-out scrollbar fills the rectangle" "used to handle retractable scrolbar" ^ false! Item was changed: + ----- Method: TwoWayScrollPane>>scrollBarMenuButtonPressed: (in category 'scroll bar events') ----- - ----- Method: TwoWayScrollPane>>scrollBarMenuButtonPressed: (in category '*Etoys-scroll bar events') ----- scrollBarMenuButtonPressed: event ^ self yellowButtonActivity: event shiftPressed! Item was changed: + ----- Method: TwoWayScrollPane>>scrollBarOnLeft: (in category 'menu') ----- - ----- Method: TwoWayScrollPane>>scrollBarOnLeft: (in category '*Etoys-menu') ----- scrollBarOnLeft: aBoolean "used to handle left vs right scrollbar"! Item was changed: + ----- Method: TwoWayScrollPane>>scrollBy: (in category 'geometry') ----- - ----- Method: TwoWayScrollPane>>scrollBy: (in category '*Etoys-geometry') ----- scrollBy: delta "Move the contents in the direction delta." "For now, delta is assumed to have a zero x-component. Used by scrollIntoView:" | r newOffset | newOffset := (scroller offset - delta max: 0@0) min: self leftoverScrollRange. scroller offset: newOffset. r := self leftoverScrollRange. r y = 0 ifTrue: [yScrollBar value: 0.0] ifFalse: [yScrollBar value: newOffset y asFloat / r y]. r x = 0 ifTrue: [xScrollBar value: 0.0] ifFalse: [xScrollBar value: newOffset x asFloat / r x]. ! Item was changed: + ----- Method: TwoWayScrollPane>>scrollIntoView:extra: (in category 'geometry') ----- - ----- Method: TwoWayScrollPane>>scrollIntoView:extra: (in category '*Etoys-geometry') ----- scrollIntoView: desiredRectangle extra: anumber | shift | shift := desiredRectangle deltaToEnsureInOrCentered: ( scroller offset extent: scroller bounds extent ) extra: anumber. shift = (0 @ 0) ifFalse: [self scrollBy: (0@0) - shift]. ! Item was changed: + ----- Method: TwoWayScrollPane>>scroller (in category 'accessing') ----- - ----- Method: TwoWayScrollPane>>scroller (in category '*Etoys-access') ----- scroller ^ scroller! Item was changed: + ----- Method: TwoWayScrollPane>>setScrollDeltas (in category 'geometry') ----- - ----- Method: TwoWayScrollPane>>setScrollDeltas (in category '*Etoys-geometry') ----- setScrollDeltas | range scrollDelta totalRange innerBounds | totalRange := self totalScrollRange ifNil: [^ self]. range := self leftoverScrollRange. innerBounds := self innerBounds. scrollDelta := 10 @ 10. self hideOrShowScrollBar: xScrollBar forRange: totalRange x - (innerBounds width - yScrollBar width). range x <= 0 ifTrue: [xScrollBar scrollDelta: 0.02 pageDelta: 0.2. xScrollBar interval: 1.0] ifFalse: [xScrollBar scrollDelta: (scrollDelta x / range x) asFloat pageDelta: (innerBounds width - scrollDelta x / range x) asFloat. xScrollBar interval: (innerBounds width - scrollDelta x / totalRange x) asFloat]. self hideOrShowScrollBar: yScrollBar forRange: totalRange y - (innerBounds height - xScrollBar height). range y <= 0 ifTrue: [yScrollBar scrollDelta: 0.02 pageDelta: 0.2. yScrollBar interval: 1.0] ifFalse: [yScrollBar scrollDelta: (scrollDelta y / range y) asFloat pageDelta: (innerBounds height - scrollDelta y / range y) asFloat. yScrollBar interval: (innerBounds height - scrollDelta y / totalRange y) asFloat]! Item was changed: + ----- Method: TwoWayScrollPane>>shiftedYellowButtonActivity (in category 'scroll bar events') ----- - ----- Method: TwoWayScrollPane>>shiftedYellowButtonActivity (in category '*Etoys-scroll bar events') ----- shiftedYellowButtonActivity ^ self yellowButtonActivity: true! Item was changed: + ----- Method: TwoWayScrollPane>>totalScrollRange (in category 'geometry') ----- - ----- Method: TwoWayScrollPane>>totalScrollRange (in category '*Etoys-geometry') ----- totalScrollRange "Return the entire scrolling range." ^ ((scroller localSubmorphBounds ifNil: [^nil]) encompass: 0@0) extent ! Item was changed: + ----- Method: TwoWayScrollPane>>unshiftedYellowButtonActivity (in category 'scroll bar events') ----- - ----- Method: TwoWayScrollPane>>unshiftedYellowButtonActivity (in category '*Etoys-scroll bar events') ----- unshiftedYellowButtonActivity ^ self yellowButtonActivity: false! Item was changed: + ----- Method: TwoWayScrollPane>>wantsSlot (in category 'accessing') ----- - ----- Method: TwoWayScrollPane>>wantsSlot (in category '*Etoys-access') ----- wantsSlot "For now do it the old way, until we sort this out" ^ true! Item was changed: + ----- Method: TwoWayScrollPane>>wantsYellowButtonMenu (in category 'menu') ----- - ----- Method: TwoWayScrollPane>>wantsYellowButtonMenu (in category '*Etoys-menu') ----- wantsYellowButtonMenu "Answer true if the receiver wants a yellow button menu" ^ getMenuSelector notNil! Item was changed: + ----- Method: TwoWayScrollPane>>xScrollBarMenuButtonPressed: (in category 'scroll bar events') ----- - ----- Method: TwoWayScrollPane>>xScrollBarMenuButtonPressed: (in category '*Etoys-scroll bar events') ----- xScrollBarMenuButtonPressed: event ^ self yellowButtonActivity: event shiftPressed! Item was changed: + ----- Method: TwoWayScrollPane>>xScrollBarValue: (in category 'scroll bar events') ----- - ----- Method: TwoWayScrollPane>>xScrollBarValue: (in category '*Etoys-scroll bar events') ----- xScrollBarValue: scrollValue "although there appear to be no senders, see Slider>>setValue:" scroller hasSubmorphs ifFalse: [^ self]. scroller offset: self leftoverScrollRange x * scrollValue @ scroller offset y! Item was changed: + ----- Method: TwoWayScrollPane>>xScrollerHeight (in category 'retractable scroll bar') ----- - ----- Method: TwoWayScrollPane>>xScrollerHeight (in category '*Etoys-retractable scroll bar') ----- xScrollerHeight (submorphs includes: xScrollBar) "Sorry the logic is reversed :( " ifFalse: [^ 0 @ 0] "already included" ifTrue: [^ 0 @ xScrollBar height] "leave space for it" ! Item was changed: + ----- Method: TwoWayScrollPane>>yScrollBarMenuButtonPressed: (in category 'scroll bar events') ----- - ----- Method: TwoWayScrollPane>>yScrollBarMenuButtonPressed: (in category '*Etoys-scroll bar events') ----- yScrollBarMenuButtonPressed: event ^ self yellowButtonActivity: event shiftPressed! Item was changed: + ----- Method: TwoWayScrollPane>>yScrollBarValue: (in category 'scroll bar events') ----- - ----- Method: TwoWayScrollPane>>yScrollBarValue: (in category '*Etoys-scroll bar events') ----- yScrollBarValue: scrollValue "although there appear to be no senders, see Slider>>setValue:" scroller hasSubmorphs ifFalse: [^ self]. scroller offset: scroller offset x @ (self leftoverScrollRange y * scrollValue)! Item was changed: + ----- Method: TwoWayScrollPane>>yellowButtonActivity: (in category 'scroll bar events') ----- - ----- Method: TwoWayScrollPane>>yellowButtonActivity: (in category '*Etoys-scroll bar events') ----- yellowButtonActivity: shiftKeyState | menu | (menu := self getMenu: shiftKeyState) ifNotNil: [menu setInvokingView: self. menu popUpEvent: self activeHand lastEvent in: self world]! Item was changed: + ----- Method: TypeListTile>>addCaretsAsAppropriate: (in category 'arrows') ----- - ----- Method: TypeListTile>>addCaretsAsAppropriate: (in category '*Etoys-Squeakland-arrows') ----- addCaretsAsAppropriate: showingCarets "If the argument provided is true, make any expected up-down and suffix-retract carets visible; if false, hide them all." self setVisibilityOfUpDownCarets: true. "regardless of setting..." self addMenuIcon! Item was changed: + ----- Method: UniclassScript>>allScriptGoverningButtons (in category 'script editor') ----- - ----- Method: UniclassScript>>allScriptGoverningButtons (in category '*Etoys-Squeakland-script editor') ----- allScriptGoverningButtons "Answer all the script-activation and script-opening buttons that exist for this interface" ^ (ScriptActivationButton allInstances select: [:aButton | aButton uniclassScript == self]), (ScriptOpeningButtonMorph allInstances select: [:aButton | aButton affiliatedScriptor == currentScriptEditor])! Item was changed: + ----- Method: Viewer class>>innerBorderColor (in category 'constants') ----- - ----- Method: Viewer class>>innerBorderColor (in category '*Etoys-Squeakland-constants') ----- innerBorderColor ^ (UserInterfaceTheme current get: #titleBorderColor for: self) ifNil: [(Color r: 0.6 g: 0.7 b: 1)]! Item was changed: + ----- Method: Viewer>>bearingFromPhrase (in category 'queries') ----- - ----- Method: Viewer>>bearingFromPhrase (in category '*Etoys-Squeakland-special phrases') ----- bearingFromPhrase "Answer a bearing-from phrase to hand to the user." ^ self conjuredUpPhraseWithOperator: #bearingFrom: type: #Number! Item was changed: + ----- Method: Viewer>>bearingToPhrase (in category 'special phrases') ----- - ----- Method: Viewer>>bearingToPhrase (in category '*Etoys-Squeakland-special phrases') ----- bearingToPhrase "Answer a bearing-to phrase to hand to the user." ^ self conjuredUpPhraseWithOperator: #bearingTo: type: #Number! Item was changed: + ----- Method: Viewer>>conjuredUpPhraseWithOperator: (in category 'special phrases') ----- - ----- Method: Viewer>>conjuredUpPhraseWithOperator: (in category '*Etoys-Squeakland-special phrases') ----- conjuredUpPhraseWithOperator: anOperator "Answer a PhraseTileMorph carefully constructed for overlaps, overlaps-any, and touches-a -- all pseudo-slots which take a player-valued argument." | outerPhrase | outerPhrase := PhraseTileMorph new setOperator: #+ type: #Boolean rcvrType: #Player argType: #Player. "temp dummy" (outerPhrase submorphs second) delete. "operator" outerPhrase addMorphBack: (TileMorph new setOperator: anOperator). (outerPhrase submorphs second) goBehind. "Make it third" outerPhrase submorphs last addMorph: self presenter standardPlayer tileToRefer. ^ outerPhrase! Item was changed: + ----- Method: Viewer>>conjuredUpPhraseWithOperator:type: (in category 'special phrases') ----- - ----- Method: Viewer>>conjuredUpPhraseWithOperator:type: (in category '*Etoys-Squeakland-special phrases') ----- conjuredUpPhraseWithOperator: anOperator type: aType "Answer a PhraseTileMorph carefully constructed for overlaps, overlaps-any, and touches-a, distance to, bearing to, bearing from -- all pseudo-slots which take a player-valued argument." | outerPhrase aTile | outerPhrase := PhraseTileMorph new setOperator: #+ type: aType rcvrType: #Player argType: #Player. "temp dummy" (outerPhrase submorphs second) delete. "operator" aTile := TileMorph new. aTile setOperator: anOperator andUseWording: (ScriptingSystem wordingForOperator: anOperator). outerPhrase addMorphBack: aTile. Smalltalk at: #AA put: aTile. aTile addCaretsAsAppropriate: false. (outerPhrase submorphs second) goBehind. "Make it third" outerPhrase submorphs last addMorph: self presenter standardPlayer tileToRefer. ^ outerPhrase! Item was changed: + ----- Method: Viewer>>distanceToPlayerPhrase (in category 'special phrases') ----- - ----- Method: Viewer>>distanceToPlayerPhrase (in category '*Etoys-Squeakland-special phrases') ----- distanceToPlayerPhrase "Answer a distance-to phrase to hand to the user." ^ self conjuredUpPhraseWithOperator: #distanceToPlayer: type: #Number! Item was changed: + ----- Method: ViewerFlapTab class>>defaultNameStemForInstances (in category 'printing') ----- - ----- Method: ViewerFlapTab class>>defaultNameStemForInstances (in category '*Etoys-printing') ----- defaultNameStemForInstances ^ 'viewerFlapTab' translatedNoop! Item was changed: + ----- Method: ViewerFlapTab class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - ----- Method: ViewerFlapTab class>>includeInNewMorphMenu (in category '*Etoys-new-morph participation') ----- includeInNewMorphMenu "Not to be instantiated from the menu" ^ false! Item was changed: + ----- Method: ViewerLine>>addCommandFeedback: (in category 'slot') ----- - ----- Method: ViewerLine>>addCommandFeedback: (in category '*Etoys-Squeakland-slot') ----- addCommandFeedback: evt "Add screen feedback showing what would be torn off in a drag" | aMorph | aMorph := RectangleMorph new bounds: ((submorphs third topLeft - (2@1)) corner: (submorphs last bottomRight) + (2@1)). aMorph beTransparent; borderWidth: 2; borderColor: ScriptingSystem commandFeedback; lock. ^ Project current world addHighlightMorph: aMorph for: nil! Item was changed: + ----- Method: WatcherWrapper>>burnishForReplacing (in category 'copying') ----- - ----- Method: WatcherWrapper>>burnishForReplacing (in category '*Etoys-Squeakland-copying') ----- burnishForReplacing "Final appearance modifications before the receiver is inserted as a replacement for an earlier version of the watcher. This is a hook so that the FollowingWatcher has a chance to get its fonts right."! Item was changed: + ----- Method: WatcherWrapper>>detailedWatcherColor (in category 'initialization') ----- - ----- Method: WatcherWrapper>>detailedWatcherColor (in category '*Etoys-Squeakland-initialization') ----- detailedWatcherColor "Answer the color to use for detailed watcher." ^ (Color r: 0.508 g: 0.663 b: 1.0)! Item was changed: + ----- Method: WatcherWrapper>>getter (in category 'accessing') ----- - ----- Method: WatcherWrapper>>getter (in category '*Etoys-Squeakland-accessing') ----- getter "Answer the selector that serves as the getter for this watcher." ^ self valueOfProperty: #getter ifAbsent: [variableName asGetterSelector]! Item was changed: + ----- Method: WatcherWrapper>>prospectiveReplacement (in category 'copying') ----- - ----- Method: WatcherWrapper>>prospectiveReplacement (in category '*Etoys-Squeakland-copying') ----- prospectiveReplacement "Answer another watcher of the same class which will serve as the replacement for the receiver. This is used when the whole apparatus needs to be rebuilt after, for example, a type change or a name change." | replacement | replacement := self class new. replacement position: self position. ^ replacement! Item was changed: + ----- Method: WatcherWrapper>>variableName (in category 'accessing') ----- - ----- Method: WatcherWrapper>>variableName (in category '*Etoys-Squeakland-accessing') ----- variableName "Answer the name of the variable being watched." ^ variableName!

1 0

The Inbox: KernelTests-dtl.449.mcz
by commits＠source.squeak.org 15 Jan '24

15 Jan '24

A new version of KernelTests was added to project The Inbox: http://source.squeak.org/inbox/KernelTests-dtl.449.mcz ==================== Summary ==================== Name: KernelTests-dtl.449 Author: dtl Time: 13 January 2024, 10:25:41.643571 pm UUID: db371749-54f3-4972-8899-65b439f89d10 Ancestors: KernelTests-jar.448 Test to document a mixed arithmetic issue, reference Kernel-mt.1550 and Kernel-mt.1551 =============== Diff against KernelTests-jar.448 =============== Item was added: + ----- Method: FloatTest>>testSmallIntegerDivide (in category 'tests - arithmetic') ----- + testSmallIntegerDivide + "mixed integer and float operation should not introduce loss of precision" + + self should: [Compiler evaluate: '(3 / 5.0) = (3.0 / 5.0)'] + !

3 3

The Trunk: KernelTests-dtl.450.mcz
by commits＠source.squeak.org 15 Jan '24

15 Jan '24

David T. Lewis uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-dtl.450.mcz ==================== Summary ==================== Name: KernelTests-dtl.450 Author: dtl Time: 15 January 2024, 1:20:30.836973 pm UUID: ffa71d27-9f27-49c3-9577-f77022415dd1 Ancestors: KernelTests-jar.449 Test to document a mixed arithmetic issue, reference Kernel-mt.1550 and Kernel-mt.1551 =============== Diff against KernelTests-jar.449 =============== Item was added: + ----- Method: FloatTest>>testSmallIntegerDivide (in category 'tests - arithmetic') ----- + testSmallIntegerDivide + "Mixed integer and float operation should not introduce loss of precision" + + self should: [Compiler evaluate: '(3 / 5.0) = (3.0 / 5.0)'] + !

1 0

Squeak 6.0: Sound-mt.91.mcz
by commits＠source.squeak.org 15 Jan '24

15 Jan '24

Marcel Taeumel uploaded a new version of Sound to project Squeak 6.0: http://source.squeak.org/squeak60/Sound-mt.91.mcz ==================== Summary ==================== Name: Sound-mt.91 Author: mt Time: 15 January 2024, 6:44:19.129759 pm UUID: a39767e5-1ef8-9f4f-bb94-edd6bdcc7b29 Ancestors: Sound-mt.90 Fixes regression from Sound-mt.90 (i.e., Sound-tpr.93 from Trunk), which truncated too much during a sound's file-out. =============== Diff against Sound-mt.90 =============== Item was changed: ----- Method: AbstractSound>>storeSampleCount:bigEndian:on: (in category 'file i/o') ----- storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream "Store my samples on the given stream at the current SoundPlayer sampling rate. If bigFlag is true, then each 16-bit sample is stored most-significant byte first (AIFF files), otherwise it is stored least-significant byte first (WAV files). If self isStereo is true, both channels are stored, creating a stereo file. Otherwise, only the left channel is stored, creating a mono file." | bufSize stereoBuffer reverseBytes streamDirect | self reset. bufSize := (2 * self samplingRate rounded) min: samplesToStore. "two second buffer" stereoBuffer := SoundBuffer newStereoSampleCount: bufSize. streamDirect := aBinaryStream isKindOf: StandardFileStream. reverseBytes := (bigEndianFlag xor: Smalltalk isBigEndian) xor: streamDirect not. 'Storing audio...' displayProgressFrom: 0 to: samplesToStore during: [:bar | | remaining out | remaining := samplesToStore. [remaining > 0] whileTrue: [ bar value: samplesToStore - remaining. stereoBuffer primFill: 0. "clear the buffer" self playSampleCount: (bufSize min: remaining) into: stereoBuffer startingAt: 1. out := self isStereo ifTrue: [stereoBuffer] ifFalse: [stereoBuffer extractLeftChannel]. reverseBytes ifTrue: [out reverseEndianness]. streamDirect ifTrue: "optimization for files: write sound buffer directly to file" + [aBinaryStream next: (out size // 2 min: remaining) putAll: out startingAt: 1] "size in words" - [aBinaryStream next: (out size // 2 min: remaining// 2) putAll: out startingAt: 1] "size in words" ifFalse: "for non-file streams:" + [1 to: (out monoSampleCount min: remaining * 2) do: [:i | aBinaryStream int16: (out at: i)]]. - [1 to: (out monoSampleCount min: remaining) do: [:i | aBinaryStream int16: (out at: i)]]. remaining := remaining - bufSize]].!

1 0

The Inbox: System-ct.1443.mcz
by commits＠source.squeak.org 15 Jan '24

15 Jan '24

Christoph Thiede uploaded a new version of System to project The Inbox: http://source.squeak.org/inbox/System-ct.1443.mcz ==================== Summary ==================== Name: System-ct.1443 Author: ct Time: 9 January 2024, 7:19:27.926382 pm UUID: 47928ca5-1746-434d-85a6-332abb38a39b Ancestors: System-dtl.1442 Speeds up SpaceTally by >50% by avoiding expensive pushThisContext. Note that this mainly benefits large objects but has no significant effect on systemWideSpaceTally. array := 1000000 timesCollect: [Morph new]. "before:" [SpaceTally new spaceForInstance: array depth: 1] benchFor: 30 seconds '0.628 per second. 1.59 seconds per run. 63.71328 % GC time.' "after:" [SpaceTally new spaceForInstance: array depth: 1] benchFor: 30 seconds. '1.28 per second. 779 milliseconds per run. 42.51465 % GC time.' =============== Diff against System-dtl.1442 =============== Item was changed: Object subclass: #SpaceTally instanceVariableNames: 'results depth' + classVariableNames: 'Mirror' - classVariableNames: '' poolDictionaries: '' category: 'System-Tools'! !SpaceTally commentStamp: '<historical>' prior: 0! I'm responsible to help getting information about system space usage. The information I compute is represented by a spaceTallyItem. Here are some examples to inspect: SpaceTally new spaceTally: (Array with: TextMorph with: Point). SpaceTally new systemWideSpaceTally. SpaceTally new depth: 2; spaceTally: (PackageInfo named: #Morphic) classes. SpaceTally new depth: 1; spaceTally: (PackageInfo named: #Monticello) classes. "Includes cached source code" SpaceTally new spaceForInstancesOf: Form depth: 1. "Includes footprint for bitmaps"! Item was added: + ----- Method: SpaceTally class>>initialize (in category 'class initialization') ----- + initialize + + "Provides access to mirror primitives. Cache this once to avoid expensive thisContext at every access." + Mirror := Context newForMethod: CompiledMethod toReturnSelf. "avoid dangling references to the current context or stack"! Item was changed: ----- Method: SpaceTally>>spaceForInstance:depth:seen: (in category 'instance size') ----- spaceForInstance: anObject depth: anInteger seen: seenObjectsOrNil + | class basicSize currentDepth total | - | ctxt class basicSize currentDepth total | seenObjectsOrNil ifNotNil: [ (seenObjectsOrNil ifAbsentAdd: anObject) ifFalse: [^ 0]]. + class := Mirror objectClass: anObject. - ctxt := thisContext. - class := ctxt objectClass: anObject. basicSize := 0. total := class isVariable + ifTrue: [class byteSizeOfInstanceOfSize: (basicSize := Mirror objectSize: anObject)] - ifTrue: [class byteSizeOfInstanceOfSize: (basicSize := ctxt objectSize: anObject)] ifFalse: [class isImmediateClass ifTrue: [0] ifFalse: [class byteSizeOfInstance]]. (currentDepth := anInteger - 1) >= 0 ifTrue: [ anObject isCompiledCode ifTrue: [ anObject literalsDo: [:literal | total := total + (self spaceForInstance: literal depth: currentDepth seen: seenObjectsOrNil)]] ifFalse: [ (class instSpec between: 2 and: 4) ifTrue: [ "only indexable objects, no bytes etc." 1 to: basicSize do: [:index | + total := total + (self spaceForInstance: (Mirror object: anObject basicAt: index) depth: currentDepth seen: seenObjectsOrNil)]]. - total := total + (self spaceForInstance: (ctxt object: anObject basicAt: index) depth: currentDepth seen: seenObjectsOrNil)]]. 1 to: class instSize do: [:index | + total := total + (self spaceForInstance: (Mirror object: anObject instVarAt: index) depth: currentDepth seen: seenObjectsOrNil)]]]. - total := total + (self spaceForInstance: (ctxt object: anObject instVarAt: index) depth: currentDepth seen: seenObjectsOrNil)]]]. ^ total!

2 1

Review Request: LinkedList copyFromTo.1.cs
by christoph.thiede＠student.hpi.uni-potsdam.de 15 Jan '24

15 Jan '24

=============== Summary =============== Change Set: LinkedList copyFromTo Date: 10 January 2024 Author: Christoph Thiede Adds efficient version of LinkedList>>#copyFrom:to: and tests edge cases. =============== Diff =============== LinkedList>>copyFrom:to: {copying} · ct 1/10/2024 17:55 + copyFrom: startIndex to: stopIndex + "Optimized for copying in O(n) instead of O(n^2)." + + | copy i | + startIndex <= 0 ifTrue: [^ self error: 'startIndex is out of bounds']. + stopIndex < 0 ifTrue: [^ self error: 'stopIndex is out of bounds']. + copy := self class new. + i := 0. + self linksDo: [:link | + (i := i + 1) >= startIndex ifTrue: + [i > stopIndex ifTrue: [^ copy]. + copy addLast: link value]]. + i + 1 < startIndex ifTrue: [^ self error: 'startIndex is out of bounds']. + i >= stopIndex ifTrue: [^ copy]. + ^ self error: 'stopIndex is out of bounds' LinkedListTest>>testCopyFromToBounds {tests - copying part of sequenceable} · ct 1/10/2024 17:31 + testCopyFromToBounds + | collection | + collection := self collectionWithoutEqualElements . + + self + should: [collection copyFrom: 0 to: -1] + raise: Error. + self assert: (collection copyFrom: 1 to: 0) isEmpty. + self assert: (collection copyFrom: 2 to: 1) isEmpty. + self assert: (collection copyFrom: collection size to: collection size - 1) isEmpty. + self assert: (collection copyFrom: collection size + 1 to: collection size) isEmpty. + self + should: [collection copyFrom: collection size + 2 to: collection size + 1] + raise: Error. + + self + should: [collection copyFrom: 0 to: 0] + raise: Error. + self assert: (collection copyFrom: 1 to: 1) asArray = {collection first}. + self assert: (collection copyFrom: collection size to: collection size) asArray = {collection last}. + self + should: [collection copyFrom: collection size + 1 to: collection size + 1] + raise: Error. + + self assert: (collection copyFrom: 1 to: collection size) = collection. + self + should: [collection copyFrom: 0 to: collection size] + raise: Error. + self + should: [collection copyFrom: 1 to: collection size + 1] + raise: Error. + + self + should: [collection copyFrom: 1 to: -1] + raise: Error. + self assert: (collection copyFrom: 2 to: 0) isEmpty. + self assert: (collection copyFrom: collection size + 1 to: collection size - 1) isEmpty. + self + should: [collection copyFrom: collection size + 2 to: collection size] + raise: Error. --- Sent from Squeak Inbox Talk ["LinkedList copyFromTo.1.cs"]

3 2

The Trunk: System-dtl.1442.mcz
by commits＠source.squeak.org 15 Jan '24

15 Jan '24

David T. Lewis uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-dtl.1442.mcz ==================== Summary ==================== Name: System-dtl.1442 Author: dtl Time: 4 January 2024, 8:07:18.703979 pm UUID: 2ef3f6e2-a4fd-4d82-a79c-6ed6f4eb05b2 Ancestors: System-ct.1441 Do not fail loading package postscript when calling upscaleDisplayOnHighDPI: if VM is not OSVM =============== Diff against System-ct.1441 =============== Item was changed: ----- Method: SmalltalkImage>>vmVMMakerVersion (in category 'system attributes') ----- vmVMMakerVersion + "Answer the version number of the VMMaker package from which the main VM was compiled, + or zero if the version number cannot be determined." - "Answer the version number of the VMMaker package from which the main VM was compiled." "Smalltalk vmVMMakerVersion" | vmMakerID | + vmMakerID := self vmVersion substrings + detect: [:token| token beginsWith: 'VMMaker'] + ifNone: [ '0' ]. - vmMakerID := self vmVersion substrings detect: [:token| token beginsWith: 'VMMaker']. ^Integer readFrom: (vmMakerID subStrings: '.') last!

4 6

(: Call for Papers :) Programming Experience Workshop PX/24 (hybrid/online)
by Taeumel, Marcel 15 Jan '24

15 Jan '24

===== PX/24 Call for Papers ===== Submissions possible until Thu 8 Feb 2024 :) https://easychair.org/my/conference?conf=px24 Welcome to the 10th Edition of the Programming Experience Workshop https://2024.programming-conference.org/home/px-2024 Co-located with <Programming> 2024 in Lund (Sweden) https://2024.programming-conference.org/ ## Abstract Some programming feels fun, other programming feels annoying. Why? For a while now the study of programming has forced improvements to be described through the Fordist lens of usability and productivity, where the thing that matters is how much software can get built, how quickly. But along the way, something has gone missing. What makes programmers feel the way they do when they’re programming? It’s not usually fun to spend an age doing something that could have been done easily, so efficiency and usability still matter, but they’re not the end of the story. Some environments, activities, contexts, languages, infrastructures make programming feel alive, others feel like working in a bureaucracy. This is not purely technologically determined, writing Lisp to do your taxes probably still isn’t fun, but it’s also not technologically neutral, writing XML to produce performance art is still likely to be <bureaucratic></bureaucratic>. Whilst we can probably mostly agree about what isn’t fun, what is remains more personal and without a space within the academy to describe it. PX set its focus on questions like: Do programmers create text that is transformed into running behavior (the old way), or do they operate on behavior directly (“liveness”); are they exploring the live domain to understand the true nature of the requirements; are they like authors creating new worlds; does visualization matter; is the experience immediate, immersive, vivid and continuous; do fluency, literacy, and learning matter; do they build tools, meta-tools; are they creating languages to express new concepts quickly and easily; and curiously, is joy relevant to the experience? In this 10th edition of PX, we will expand its focus to also cover the experience that programmers have. What makes it and what breaks it? For whom? What can we build to share the joy of programming with others? Here is a list of topic areas to get you thinking: - creating programs - experience of programming - exploratory programming - liveness - non-standard tools - visual, auditory, tactile, and other non-textual languages - text and more than text - program understanding - domain-specific languages - psychology of programming - error tolerance - user studies - theories about all that Correctness, performance, standard tools, foundations, and text-as-program are important traditional research areas, but the experience of programming and how to improve and evolve it are the focus of this workshop. We also welcome a wide spectrum of contributions on programming experience. ## Submissions Submissions are solicited for Programming Experience 2024 (PX/24). The thrust of the workshop is to explore the human experience of programming—what it feels like to program, or what it should feel like. The technical topics include exploratory programming, live programming, authoring, representation of active content, visualization, navigation, modularity mechanisms, immediacy, literacy, fluency, learning, tool building, language engineering, and theory building. Submissions by academics, professional programmers, and non-professional programmer are welcome. Submissions can be in any form and format, including but not limited to papers, presentations, demos, videos, panels, debates, essays, writers’ workshops, and art. Presentation slots are expected to be between 20 minutes and one hour (if time allows), depending on quality, form, and relevance to the workshop. Submissions of academic papers directed toward publication should be so marked, and the program committee will engage in peer review for all such papers. All artifacts are to be submitted via EasyChair [2]. Papers and essays must be written in English, provided as PDF documents, and strictly adhere to the ACM Format [3]. ## Review Submissions of academic papers directed toward publication will undergo standard peer review; other submissions will be reviewed for relevance and quality; shepherding will be available. ## Publication Academic papers and essays accepted for publication will be published as part of ACM's Digital Library; video publication on Vimeo or other streaming site; other publication on the PX workshop website. ## Upcoming Deadlines (AoE, UTC-12h) Submissions: Thu 8 Feb 2024 Notifications: Mon 26 Feb 2024 Camera-ready versions: Mon 4 Mar 2024 Workshop (hybrid/online): Mon 11 Mar 2024 ## More Information [1] https://2024.programming-conference.org/home/px-2024 [2] https://easychair.org/my/conference?conf=px24 [3] http://www.acm.org/publications/proceedings-template

3 5

Re: [Newbies] Help with keyboard layout when typing a caret
by lewis＠mail.msen.com 15 Jan '24

15 Jan '24

On 2023-12-30 16:51, Ivan Reche wrote: > Hey there! > > Total newbie here. Hello Ivan, Happy holidays and welcome to Squeak! > I'm playing with Squeak on my vacation and I've noticed that, whenever > I try to type a caret (^), which I believe is core to using Smalltalk, > Squeak will insert an interrogation mark (?) in its place. I believe it > must be something related to keyboard layout, but I have no idea on how > to troubleshoot and fix this. > > Here is a screenshot to show what's happening: > > My keyboard layout works just fine on GNOME. Thanks in advance! > > My environment: > OS: Linux (GNOME DE) > Keyboard layout: Portuguese ABNT2 > Squeak version: Squeak6.0-22104-64bit-202206021410-Linux-x64 I do not know the answer to your question, but it may be a complex issue so I am CC'ing the squeak-dev developers' list for help. From what I can gather from a search on the net (https://kbdlayout.info/KBDBR/), the caret key may require some special handling for the Portuguese ABNT2 keyboard. Possibly gnome knows about this and Squeak does not. Does anyone on the squeak-dev list have a tip for how to enter a caret (^) on a Portuguese ABNT2 keyboard? Replies should include to the beginners list please. Screen shots from the original message (I cannot forward them) are at https://lists.squeakfoundation.org/archives/list/beginners@lists.squeakfoun… Dave

5 7

The Trunk: KernelTests-jar.449.mcz
by commits＠source.squeak.org 14 Jan '24

14 Jan '24

Christoph Thiede uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-jar.449.mcz ==================== Summary ==================== Name: KernelTests-jar.449 Author: jar Time: 2 January 2024, 12:28:08.184411 pm UUID: decf5a85-87ad-5849-b692-ee28940eab41 Ancestors: KernelTests-jar.448 Test if #return:from: correctly handles returns to nil contexts =============== Diff against KernelTests-jar.448 =============== Item was added: + ----- Method: ContextTest>>testBlockCannotReturnToNil (in category 'tests') ----- + testBlockCannotReturnToNil + "Test if #return:from: correctly handles returns to dead or nil contexts." + + | context nextContext | + context := [] asContext. + + "assert p is at the last instruction, i.e. a return, and is about to return to a nil context" + self assert: context method selector = thisContext method selector. + self assert: context sender isNil. + self assert: context willReturn. + self assert: context atEnd. + + nextContext := context step. "step into a return to a nil sender" + + self assert: nextContext method selector = #cannotReturn:!

1 0

← Newer
1
2
3
4
5
6
7
8
9
Older →