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"! |
Free forum by Nabble | Edit this page |