[Pkg] 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 Packages
mailing list