The Trunk: MorphicExtras-ul.203.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

The Trunk: MorphicExtras-ul.203.mcz

commits-2
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"!