[squeak-dev] The Trunk: EToys-mt.368.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Nov 13 11:15:14 UTC 2019


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 at 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 at 0 extent: 1.0 at 1.0).
- 	window openInWorldExtent: (
- 		self extent + (20 at 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 at 0 extent: 1.0 at 1.0).
  	scrollPane scroller addMorph: world.
  	world hostWindow: window.
  	window openInWorld
  !



More information about the Squeak-dev mailing list