Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-mt.368.mcz
==================== Summary ====================
Name: EToys-mt.368 Author: mt Time: 13 November 2019, 12:15:07.673043 pm UUID: 3f6873fa-5111-ac4a-a108-9031e19e5f40 Ancestors: EToys-kfr.363, EToys-ct.354, EToys-ct.355, EToys-ct.356, EToys-ct.357, EToys-ct.358, EToys-ct.359, EToys-ct.360, EToys-ct.364, EToys-ct.365, EToys-ct.367
Merge! Merge! Merge! Various fixes in Etoys-related places.
=============== Diff against EToys-kfr.363 ===============
Item was added: + ----- Method: Form>>scaledToWidth: (in category '*Etoys-Squeakland-scaling, rotation') ----- + scaledToWidth: newWidth + "Answer the receiver, scaled such that it has the desired width." + + newWidth = self width ifTrue: [^ self]. + ^self magnify: self boundingBox by: (newWidth / self width) smoothing: 2. + !
Item was changed: ----- Method: FreeCell>>help (in category 'actions') ----- help + + self helpText editWithLabel: 'FreeCell Help'.! - | window helpMorph | - window := SystemWindow labelled: 'FreeCell Help' translated. - window model: self. - helpMorph := (PluggableTextMorph new editString: self helpText) lock. - window - addMorph: helpMorph - frame: (0 @ 0 extent: 1 @ 1). - window openInWorld!
Item was added: + ----- Method: MovingEyeMorph>>color: (in category 'accessing') ----- + color: aColor + + super color: aColor. + + "Migrate old instances." + inner color: Color transparent. + + "Keep iris visible." + aColor = iris color + ifTrue: [iris borderWidth: 1; borderColor: aColor negated] + ifFalse: [iris borderWidth: 0].!
Item was changed: ----- Method: MovingEyeMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" inner := EllipseMorph new. + inner color: Color transparent. - inner color: self color. inner extent: (self extent * (1.0 @ 1.0 - IrisSize)) asIntegerPoint. - inner borderColor: self color. inner borderWidth: 0. "" iris := EllipseMorph new. iris color: Color white. iris extent: (self extent * IrisSize) asIntegerPoint. "" self addMorphCentered: inner. inner addMorphCentered: iris. "" self extent: 26 @ 33!
Item was added: + ----- Method: MovingEyeMorph>>irisColor (in category 'accessing') ----- + irisColor + + ^ iris color!
Item was added: + ----- Method: MovingEyeMorph>>irisColor: (in category 'accessing') ----- + irisColor: aColor + + iris color: aColor. + + "Keep iris visible." + aColor = self color + ifTrue: [iris borderWidth: 1; borderColor: aColor negated] + ifFalse: [iris borderWidth: 0].!
Item was added: + ----- Method: MovingEyeMorph>>irisPos (in category 'accessing') ----- + irisPos + + ^ iris position!
Item was changed: + ----- Method: MovingEyeMorph>>irisPos: (in category 'accessing') ----- - ----- Method: MovingEyeMorph>>irisPos: (in category 'as yet unclassified') ----- irisPos: cp
| a b theta x y | theta := (cp - self center) theta. a := inner width // 2. b := inner height // 2. x := a * (theta cos). y := b * (theta sin). iris position: ((x@y) asIntegerPoint) + self center - (iris extent // 2).!
Item was changed: ----- Method: MovingEyeMorph>>step (in category 'stepping and presenter') ----- step | cp | cp := self globalPointToLocal: self world primaryHand position. (inner containsPoint: cp) ifTrue: [iris position: (cp - (iris extent // 2))] + ifFalse: [self irisPos: cp].! - ifFalse: [self irisPos: cp]. - self changed "cover up gribblies if embedded in Flash"!
Item was changed: ----- Method: NewVariableDialogMorph>>decimalPlaces (in category 'accessing') ----- decimalPlaces ^ decimalPlacesButton ifNil: [Utilities decimalPlacesForFloatPrecision: (self targetPlayer + defaultFloatPrecisionFor: self varAcceptableName asSetterSelector)] - defaultFloatPrecisionFor: (Utilities getterSelectorFor: self varAcceptableName))] ifNotNil: [:button| button label asNumber]!
Item was changed: ----- Method: Player>>newScriptorAround: (in category 'viewer') ----- newScriptorAround: aPhrase "Sprout a scriptor around aPhrase, thus making a new script. aPhrase may either be a PhraseTileMorph (classic tiles 1997-2001) or a SyntaxMorph (2001 onward)"
| aScriptEditor aUniclassScript tw blk | Cursor wait showWhile: [ aUniclassScript := self class permanentUserScriptFor: self unusedScriptName player: self. aScriptEditor := aUniclassScript instantiatedScriptEditorForPlayer: self.
Preferences universalTiles ifTrue: [ aScriptEditor install. "aScriptEditor hResizing: #shrinkWrap; vResizing: #shrinkWrap; cellPositioning: #topLeft; setProperty: #autoFitContents toValue: true." aScriptEditor insertUniversalTiles. "Gets an empty SyntaxMorph for a MethodNode" + tw := aScriptEditor findA: ScrollPane. - tw := aScriptEditor findA: TwoWayScrollPane. aPhrase ifNotNil: [blk := (tw scroller findA: SyntaxMorph "MethodNode") findA: BlockNode. blk addMorphFront: aPhrase. aPhrase accept. ]. SyntaxMorph setSize: nil andMakeResizable: aScriptEditor. ] ifFalse: [ aPhrase ifNotNil: [aScriptEditor phrase: aPhrase] "does an install" ifNil: [aScriptEditor install] ]. self class allSubInstancesDo: [:anInst | anInst scriptInstantiationForSelector: aUniclassScript selector]. "The above assures the presence of a ScriptInstantiation for the new selector in all siblings" self updateScriptsCategoryOfViewers. ]. ^ aScriptEditor!
Item was changed: ----- Method: Preferences class>>initializePreferencePanel:in: (in category '*Etoys-Squeakland-preferences panel') ----- initializePreferencePanel: aPanel in: aPasteUpMorph "Initialize the given Preferences panel. in the given pasteup, which is the top-level panel installed in the container window. Also used to reset it after some change requires reformulation"
| tabbedPalette controlPage aColor aFont maxEntriesPerCategory tabsMorph anExtent prefObjects | aPasteUpMorph removeAllMorphs.
aFont := Preferences standardListFont. + aColor := aPanel windowColorToUse. - aColor := aPanel defaultBackgroundColor. tabbedPalette := TabbedPalette newSticky. tabbedPalette dropEnabled: false. (tabsMorph := tabbedPalette tabsMorph) color: aColor darker; highlightColor: Color red regularColor: Color brown darker darker. tabbedPalette on: #mouseDown send: #yourself to: #(). maxEntriesPerCategory := 0. self listOfCategories do: [:aCat | controlPage := AlignmentMorph newColumn beSticky color: aColor. controlPage on: #mouseDown send: #yourself to: #(). controlPage dropEnabled: false. controlPage borderColor: aColor; layoutInset: 4. (prefObjects := self preferenceObjectsInCategory: aCat) do: [:aPreference | | button | button := aPreference representativeButtonWithColor: Color white inPanel: aPanel. button ifNotNil: [controlPage addMorphBack: button]]. controlPage setNameTo: aCat asString. aCat = #? ifTrue: [aPanel addHelpItemsTo: controlPage]. tabbedPalette addTabFor: controlPage font: aFont. aCat = 'search results' ifTrue: [(tabbedPalette tabNamed: aCat) setBalloonText: 'Use the ? category to find preferences by keyword; the results of your search will show up here' translated]. maxEntriesPerCategory := maxEntriesPerCategory max: prefObjects size]. tabbedPalette selectTabNamed: '?'. tabsMorph rowsNoWiderThan: aPasteUpMorph width. aPasteUpMorph on: #mouseDown send: #yourself to: #(). anExtent := aPasteUpMorph width @ (490 max: (25 + tabsMorph height + (24 * maxEntriesPerCategory))). aPasteUpMorph extent: anExtent. aPasteUpMorph color: aColor. aPasteUpMorph addMorphBack: tabbedPalette.!
Item was changed: ----- Method: ScriptEditorMorph>>autoFitOnOff (in category 'menu') ----- autoFitOnOff "Toggle between auto fit to size of code and manual resize with scrolling" | tw | + (tw := self findA: ScrollPane) ifNil: [^ self]. - (tw := self findA: TwoWayScrollPane) ifNil: [^ self]. (self hasProperty: #autoFitContents) ifTrue: [self removeProperty: #autoFitContents. self hResizing: #rigid; vResizing: #rigid] ifFalse: [self setProperty: #autoFitContents toValue: true. self hResizing: #shrinkWrap; vResizing: #shrinkWrap]. tw layoutChanged!
Item was changed: ----- Method: ScriptEditorMorph>>extent: (in category 'other') ----- extent: x
| newExtent tw menu | newExtent := x max: self minWidth @ self minHeight. + (tw := self findA: ScrollPane) ifNil: - (tw := self findA: TwoWayScrollPane) ifNil: ["This was the old behavior" ^ super extent: newExtent].
(self hasProperty: #autoFitContents) ifTrue: [ menu := MenuMorph new defaultTarget: self. menu addUpdating: #autoFitString target: self action: #autoFitOnOff. menu addTitle: 'To resize the script, uncheck the box below' translated. menu popUpEvent: nil in: self world . ^ self].
"Allow the user to resize to any size" tw extent: ((newExtent x max: self firstSubmorph width) @ (newExtent y - self firstSubmorph height)) - (self borderWidth * 2) + (-4 @ -4). "inset?" ^ super extent: newExtent!
Item was changed: ----- Method: ScriptEditorMorph>>hibernate (in category 'other') ----- hibernate "Possibly delete the tiles, but only if using universal tiles."
| tw | Preferences universalTiles ifFalse: [^self]. + (tw := self findA: ScrollPane) isNil - (tw := self findA: TwoWayScrollPane) isNil ifFalse: [self setProperty: #sizeAtHibernate toValue: self extent. "+ tw xScrollerHeight" submorphs size > 1 ifTrue: [tw delete]]!
Item was added: + ----- Method: SpectrumAnalyzerMorph>>fftSize: (in category 'accessing') ----- + fftSize: aSize + + | on | + on := soundInput isRecording. + self stop. + fft := FFT new: aSize. + self resetDisplay. + on ifTrue: [self start].!
Item was changed: ----- Method: SpectrumAnalyzerMorph>>setFFTSize (in category 'menu and buttons') ----- setFFTSize "Set the size of the FFT used for frequency analysis."
+ | aMenu sz | - | aMenu sz on | aMenu := CustomMenu new title: ('FFT size (currently {1})' translated format:{fft n}). ((7 to: 10) collect: [:n | 2 raisedTo: n]) do:[:r | aMenu add: r printString action: r]. sz := aMenu startUp. sz ifNil: [^ self]. + self fftSize: sz.! - on := soundInput isRecording. - self stop. - fft := FFT new: sz. - self resetDisplay. - on ifTrue: [self start]. - !
Item was changed: ----- Method: SyntaxMorph class>>setSize:andMakeResizable: (in category 'as yet unclassified') ----- setSize: oldExtent andMakeResizable: outerMorph | tw | + (tw := outerMorph findA: ScrollPane) ifNil: [^self]. - (tw := outerMorph findA: TwoWayScrollPane) ifNil: [^self]. tw hResizing: #spaceFill; vResizing: #spaceFill; color: Color transparent; setProperty: #hideUnneededScrollbars toValue: true. outerMorph hResizing: #shrinkWrap; vResizing: #shrinkWrap; cellPositioning: #topLeft. outerMorph fullBounds. !
Item was changed: ----- Method: SyntaxMorph>>enclosingPane (in category 'accessing') ----- enclosingPane "The object that owns this script layout"
| oo higher | oo := self owner. [higher := oo isSyntaxMorph. higher := higher or: [oo class == TransformMorph]. + higher := higher or: [oo class == ScrollPane]. - higher := higher or: [oo class == TwoWayScrollPane]. higher ifFalse: [^ oo]. higher] whileTrue: [oo := oo owner]. !
Item was removed: - ----- Method: SyntaxMorph>>inAScrollPane (in category 'initialization') ----- - inAScrollPane - "Answer a scroll pane in which the receiver is scrollable" - - ^ self inATwoWayScrollPane!
Item was changed: ----- Method: SyntaxMorph>>openInWindow (in category 'initialization') ----- openInWindow
+ | sel | - | window widget sel | sel := ''. self firstSubmorph allMorphs do: [:rr | + (rr isKindOf: StringMorph) ifTrue: [sel := sel, rr contents]]. - (rr isKindOf: StringMorph) ifTrue: [sel := sel, rr contents]]. - window := (SystemWindow labelled: 'Tiles for ', self parsedInClass printString, '>>',sel). - widget := self inAScrollPane. - widget color: Color paleOrange. - window - addMorph: widget - frame: (0@0 extent: 1.0@1.0). - window openInWorldExtent: ( - self extent + (20@40) min: (Display boundingBox extent * 0.8) rounded - )
+ ^ self inAScrollPane + color: Color paleOrange; + openInWindowLabeled: 'Tiles for ', self parsedInClass printString, '>>', sel! - !
Item was added: + ----- Method: SyntaxMorph>>parseNodeWith:asStatement: (in category '*Etoys-Squeakland-code generation') ----- + parseNodeWith: encoder asStatement: aBoolean + + ^ self parseNode!
Item was changed: ----- Method: SyntaxMorph>>unhighlightBorder (in category 'highlighting') ----- unhighlightBorder
self currentSelectionDo: [:innerMorph :mouseDownLoc :outerMorph | + (self == outerMorph or: [owner notNil and: [owner isSyntaxMorph not]]) + ifFalse: [self borderColor: self stdBorderColor] + ifTrue: [ + (self hasProperty: #deselectedBorderColor) + ifTrue: [self borderColor: (self valueOfProperty: #deselectedBorderColor)] + ifFalse: [self borderStyle: (BorderStyle raised width: self borderWidth)]] ].! - self borderColor: ( - (self == outerMorph or: [owner notNil and: [owner isSyntaxMorph not]]) - ifFalse: [self borderColor: self stdBorderColor] - ifTrue: [ - (self hasProperty: #deselectedBorderColor) - ifTrue: [self borderColor: (self valueOfProperty: #deselectedBorderColor)] - ifFalse: [self borderStyle: (BorderStyle raised width: self borderWidth)]] )].!
Item was changed: ----- 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. - 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>>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. - 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: VariableNode>>asMorphicSyntaxIn: (in category '*Etoys-tiles') ----- asMorphicSyntaxIn: parent
^ parent addToken: self name type: #variable + on: self shallowCopy "don't hand out the prototype!! See VariableNode>>initialize" - on: self clone "don't hand out the prototype!! See VariableNode>>initialize" !
Item was changed: + ----- Method: WatchMorph class>>fontName:bgColor:centerColor: (in category 'instance creation') ----- - ----- Method: WatchMorph class>>fontName:bgColor:centerColor: (in category 'as yet unclassified') ----- fontName: aString bgColor: aColor centerColor: otherColor ^ self new fontName: aString; color: aColor; centerColor: otherColor!
Item was changed: ----- Method: WorldWindow class>>test2 (in category 'as yet unclassified') ----- test2 "WorldWindow test2."
| window world scrollPane | world := WiWPasteUpMorph newWorldForProject: nil. window := (WorldWindow labelled: 'Scrollable World') model: world. + window addMorph: (scrollPane := ScrollPane new model: world) - window addMorph: (scrollPane := TwoWayScrollPane new model: world) frame: (0@0 extent: 1.0@1.0). scrollPane scroller addMorph: world. world hostWindow: window. window openInWorld !
packages@lists.squeakfoundation.org