[squeak-dev] The Trunk: MorphicExtras-ul.203.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Mar 13 14:56:20 UTC 2017


Levente Uzonyi uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-ul.203.mcz

==================== Summary ====================

Name: MorphicExtras-ul.203
Author: ul
Time: 13 March 2017, 2:43:59.238671 pm
UUID: 41adf41a-ecba-44a2-a934-8892647b2b76
Ancestors: MorphicExtras-ul.202

SortedCollection Whack-a-mole

=============== Diff against MorphicExtras-ul.202 ===============

Item was changed:
  ----- Method: BookMorph>>methodHolderVersions (in category 'scripting') -----
  methodHolderVersions
  	| arrayOfVersions vTimes |
  	"Create lists of times of older versions of all code in MethodMorphs in this book."
  
  	arrayOfVersions := MethodHolders collect: [:mh | 
  		mh versions].	"equality, hash for MethodHolders?"
+ 	vTimes := OrderedCollection new.
- 	vTimes := SortedCollection new.
  	arrayOfVersions do: [:versionBrowser |  
  		versionBrowser changeList do: [:cr | | strings | 
  			(strings := cr stamp findTokens: ' ') size > 2 ifTrue: [
  				vTimes add: strings second asDate asSeconds + 
  						strings third asTime asSeconds]]].
  	VersionTimes := Time condenseBunches: vTimes.
  	VersionNames := Time namesForTimes: VersionTimes.
  !

Item was changed:
  ----- Method: BouncingAtomsMorph>>collisionPairs (in category 'other') -----
  collisionPairs
  	"Return a list of pairs of colliding atoms, which are assumed to be
  circles of known radius. This version uses the morph's positions--i.e.
  the top-left of their bounds rectangles--rather than their centers."
  
  	| count sortedAtoms radius twoRadii radiiSquared collisions p1 continue j p2 distSquared m1 m2 |
  	count := submorphs size.
  	sortedAtoms := submorphs 
+ 				sorted: [:mt1 :mt2 | mt1 position x < mt2 position x].
- 				asSortedCollection: [:mt1 :mt2 | mt1 position x < mt2 position x].
  	radius := 8.
  	twoRadii := 2 * radius.
  	radiiSquared := radius squared * 2.
  	collisions := OrderedCollection new.
  	1 to: count - 1
  		do: 
  			[:i | 
  			m1 := sortedAtoms at: i.
  			p1 := m1 position.
  			continue := (j := i + 1) <= count.
  			[continue] whileTrue: 
  					[m2 := sortedAtoms at: j.
  					p2 := m2 position.
  					continue := p2 x - p1 x <= twoRadii  
  								ifTrue: 
  									[distSquared := (p1 x - p2 x) squared + (p1 y - p2 y) squared.
  									distSquared < radiiSquared 
  										ifTrue: [collisions add: (Array with: m1 with: m2)].
  									(j := j + 1) <= count]
  								ifFalse: [false]]].
  	^collisions!

Item was changed:
  ----- Method: Flaps class>>positionVisibleFlapsRightToLeftOnEdge:butPlaceAtLeftFlapsWithIDs: (in category 'shared flaps') -----
  positionVisibleFlapsRightToLeftOnEdge: edgeSymbol butPlaceAtLeftFlapsWithIDs: idList
  	"Lay out flaps along the designated edge right-to-left, while laying left-to-right any flaps found in the exception list
  
  	Flaps positionVisibleFlapsRightToLeftOnEdge: #bottom butPlaceAtLeftFlapWithIDs: {'Navigator' translated. 'Supplies' translated}
  	Flaps sharedFlapsAlongBottom"
  
  	| leftX flapList flapsOnRight flapsOnLeft |
  	flapList := self globalFlapTabsIfAny select:
  		[:aFlapTab | aFlapTab isInWorld and: [aFlapTab edgeToAdhereTo == edgeSymbol]].
+ 	flapsOnLeft := OrderedCollection new.
+ 	flapsOnRight := OrderedCollection new.
+ 	
+ 	flapList do: [:fl | 
+ 		(idList includes: fl flapID)
+ 			ifTrue: [ flapsOnLeft addLast: fl ]
+ 			ifFalse: [ flapsOnRight addLast: fl ] ].
- 	flapsOnLeft := flapList select: [:fl | idList includes: fl flapID].
- 	flapList removeAll: flapsOnLeft.
  
- 	flapsOnRight := flapList asSortedCollection:
- 		[:f1 :f2 | f1 left > f2 left].
  	leftX := ActiveWorld width - 15.
  
+ 	flapsOnRight 
+ 		sort: [:f1 :f2 | f1 left > f2 left];
+ 		do: [:aFlapTab |
- 	flapsOnRight do:
- 		[:aFlapTab |
  			aFlapTab right: leftX - 3.
  			leftX := aFlapTab left].
  
  	leftX := ActiveWorld left.
+ 
+ 	flapsOnLeft
+ 		sort: [:f1 :f2 | f1 left > f2 left];
+ 		do: [:aFlapTab |
- 	flapsOnLeft := flapsOnLeft asSortedCollection:
- 		[:f1 :f2 | f1 left > f2 left].
- 	flapsOnLeft do:
- 		[:aFlapTab |
  			aFlapTab left: leftX + 3.
  			leftX := aFlapTab right].
  
+ 	flapList do:
- 	(flapsOnLeft asOrderedCollection, flapsOnRight asOrderedCollection) do:
  		[:ft | ft computeEdgeFraction.
  		ft flapID = 'Navigator' translated ifTrue:
+ 			[ft referent left: (ft center x - (ft referent width//2) max: 0)]]!
- 			[ft referent left: (ft center x - (ft referent width//2) max: 0)]]
- !

Item was changed:
  ----- Method: ObjectsTool>>installQuads:fromButton: (in category 'alphabetic') -----
  installQuads: quads fromButton: aButton
  	"Install items in the bottom pane that correspond to the given set of quads, as triggered from the given button"
  
  	| aPartsBin sortedQuads oldResizing |
  	aPartsBin := self partsBin.
  	oldResizing := aPartsBin vResizing.
  	aPartsBin removeAllMorphs.
+ 	sortedQuads := ((PartsBin translatedQuads: quads)
+ 		select: [ :each | Smalltalk hasClassNamed: each first ])
+ 		sort: [ :a :b | a third < b third ].
- 	sortedQuads := (PartsBin translatedQuads: quads)
- 							asSortedCollection: [:a :b | a third < b third].
- sortedQuads := sortedQuads select: [ : each | Smalltalk hasClassNamed: each first ].
  	aPartsBin listDirection: #leftToRight quadList: sortedQuads.
  	aButton ifNotNil: [self tabsPane highlightOnlySubmorph: aButton].
  	aPartsBin vResizing: oldResizing.
  	aPartsBin layoutChanged; fullBounds.
  	self isFlap ifFalse: [ self minimizePartsBinSize ].!

Item was changed:
  ----- Method: ObjectsTool>>showCategory:fromButton: (in category 'categories') -----
  showCategory: aCategoryName fromButton: aButton 
  	"Project items from the given category into my lower pane"
  
  	"self partsBin removeAllMorphs. IMHO is redundant, "
  	Cursor wait
  		showWhile: [
  			| quads |
  			quads := OrderedCollection new.
  			Morph withAllSubclasses
  				do: [:aClass | aClass theNonMetaClass
  						addPartsDescriptorQuadsTo: quads
  						if: [:aDescription | aDescription translatedCategories includes: aCategoryName]].
+ 			quads sort: [:q1 :q2 | q1 third <= q2 third].
- 			quads := quads
- 						asSortedCollection: [:q1 :q2 | q1 third <= q2 third].
  			self installQuads: quads fromButton: aButton]!

Item was changed:
  ----- Method: ObjectsTool>>tabsForCategories (in category 'categories') -----
  tabsForCategories
  	"Answer a list of buttons which, when hit, will trigger the choice of a category"
  
  	| buttonList classes categoryList basic |
  	classes := Morph withAllSubclasses.
  	categoryList := Set new.
  	classes do: [:aClass |
  		(aClass class includesSelector: #descriptionForPartsBin) ifTrue:
  			[categoryList addAll: aClass descriptionForPartsBin translatedCategories].
  		(aClass class includesSelector: #supplementaryPartsDescriptions) ifTrue:
  			[aClass supplementaryPartsDescriptions do:
  				[:aDescription | categoryList addAll: aDescription translatedCategories]]].
  
+ 	categoryList := categoryList asOrderedCollection sort.
- 	categoryList := OrderedCollection withAll: (categoryList asSortedArray).
  	
  	basic := categoryList remove: ' Basic' translated ifAbsent: [ ].
  	basic ifNotNil: [ categoryList addFirst: basic ].
  
  	basic := categoryList remove: 'Basic' translated ifAbsent: [ ].
  	basic ifNotNil: [ categoryList addFirst: basic ].
  
  	buttonList := categoryList collect:
  		[:catName |
  			| aButton |
  			aButton := SimpleButtonMorph new label: catName.
  			aButton actWhen: #buttonDown.
  			aButton target: self; actionSelector: #showCategory:fromButton:; arguments: {catName. aButton}].
  	^ buttonList
  
  "ObjectsTool new tabsForCategories"!



More information about the Squeak-dev mailing list