[squeak-dev] The Trunk: Morphic-ul.1326.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Mar 13 14:51:40 UTC 2017
Levente Uzonyi uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-ul.1326.mcz
==================== Summary ====================
Name: Morphic-ul.1326
Author: ul
Time: 13 March 2017, 2:41:34.314735 pm
UUID: 9421a504-8921-4b98-92ef-6e6bc66e9144
Ancestors: Morphic-jr.1325
SortedCollection Whack-a-mole
=============== Diff against Morphic-jr.1325 ===============
Item was changed:
----- Method: EventHandler>>messageList (in category 'access') -----
messageList
"Return a list of 'Class selector' for each message I can send. tk
9/13/97"
| list |
self flag: #mref.
"is this still needed? I replaced the one use that I could spot with
#methodRefList "
+ list := OrderedCollection new.
- list := SortedCollection new.
mouseDownRecipient
ifNotNil: [list add: (mouseDownRecipient class whichClassIncludesSelector: mouseDownSelector) name , ' ' , mouseDownSelector].
mouseMoveRecipient
ifNotNil: [list add: (mouseMoveRecipient class whichClassIncludesSelector: mouseMoveSelector) name , ' ' , mouseMoveSelector].
mouseStillDownRecipient
ifNotNil: [list add: (mouseStillDownRecipient class whichClassIncludesSelector: mouseStillDownSelector) name , ' ' , mouseStillDownSelector].
mouseUpRecipient
ifNotNil: [list add: (mouseUpRecipient class whichClassIncludesSelector: mouseUpSelector) name , ' ' , mouseUpSelector].
mouseEnterRecipient
ifNotNil: [list add: (mouseEnterRecipient class whichClassIncludesSelector: mouseEnterSelector) name , ' ' , mouseEnterSelector].
mouseLeaveRecipient
ifNotNil: [list add: (mouseLeaveRecipient class whichClassIncludesSelector: mouseLeaveSelector) name , ' ' , mouseLeaveSelector].
mouseEnterDraggingRecipient
ifNotNil: [list add: (mouseEnterDraggingRecipient class whichClassIncludesSelector: mouseEnterDraggingSelector) name , ' ' , mouseEnterDraggingSelector].
mouseLeaveDraggingRecipient
ifNotNil: [list add: (mouseLeaveDraggingRecipient class whichClassIncludesSelector: mouseLeaveDraggingSelector) name , ' ' , mouseLeaveDraggingSelector].
doubleClickRecipient
ifNotNil: [list add: (doubleClickRecipient class whichClassIncludesSelector: doubleClickSelector) name , ' ' , doubleClickSelector].
keyStrokeRecipient
ifNotNil: [list add: (keyStrokeRecipient class whichClassIncludesSelector: keyStrokeSelector) name , ' ' , keyStrokeSelector].
+ ^ list sort!
- ^ list!
Item was changed:
----- Method: EventHandler>>methodRefList (in category 'access') -----
methodRefList
"Return a MethodReference for each message I can send. tk 9/13/97, raa
5/29/01 "
| list adder |
+ list := OrderedCollection new.
- list := SortedCollection new.
adder := [:recip :sel | recip
ifNotNil: [list
add: (MethodReference new
class: (recip class whichClassIncludesSelector: sel)
selector: sel)]].
adder value: mouseDownRecipient value: mouseDownSelector.
adder value: mouseMoveRecipient value: mouseMoveSelector.
adder value: mouseStillDownRecipient value: mouseStillDownSelector.
adder value: mouseUpRecipient value: mouseUpSelector.
adder value: mouseEnterRecipient value: mouseEnterSelector.
adder value: mouseLeaveRecipient value: mouseLeaveSelector.
adder value: mouseEnterDraggingRecipient value: mouseEnterDraggingSelector.
adder value: mouseLeaveDraggingRecipient value: mouseLeaveDraggingSelector.
adder value: doubleClickRecipient value: doubleClickSelector.
adder value: keyStrokeRecipient value: keyStrokeSelector.
+ ^ list sort!
- ^ list!
Item was changed:
----- Method: Morph>>showActions (in category 'meta-actions') -----
showActions
"Put up a message list browser of all the code that this morph
would run for mouseUp, mouseDown, mouseMove, mouseEnter,
mouseLeave, and
mouseLinger. tk 9/13/97"
| list cls selector adder |
+ list := OrderedCollection new.
- list := SortedCollection new.
adder := [:mrClass :mrSel | list
add: (MethodReference class: mrClass selector: mrSel)].
"the eventHandler"
self eventHandler
ifNotNil: [list := self eventHandler methodRefList.
(self eventHandler handlesMouseDown: nil)
ifFalse: [adder value: HandMorph value: #grabMorph:]].
"If not those, then non-default raw events"
#(#keyStroke: #mouseDown: #mouseEnter: #mouseLeave: #mouseMove: #mouseUp: #doButtonAction )
do: [:sel |
cls := self class whichClassIncludesSelector: sel.
cls
ifNotNil: ["want more than default behavior"
cls == Morph
ifFalse: [adder value: cls value: sel]]].
"The mechanism on a Button"
(self respondsTo: #actionSelector)
ifTrue: ["A button"
selector := self actionSelector.
cls := self target class whichClassIncludesSelector: selector.
cls
ifNotNil: ["want more than default behavior"
cls == Morph
ifFalse: [adder value: cls value: selector]]].
+ MessageSet openMessageList: list sort name: 'Actions
- MessageSet openMessageList: list name: 'Actions
of ' , self printString autoSelect: nil!
Item was changed:
----- Method: MorphicProject>>chooseNaturalLanguage (in category 'language') -----
chooseNaturalLanguage
"Put up a menu allowing the user to choose the natural language for the project"
| aMenu availableLanguages |
aMenu := MenuMorph new defaultTarget: self.
aMenu addTitle: 'choose language' translated.
aMenu lastItem setBalloonText: 'This controls the human language in which tiles should be viewed. It is potentially extensible to be a true localization mechanism, but initially it only works in the classic tile scripting system. Each project has its own private language choice' translated.
Preferences noviceMode
ifFalse:[aMenu addStayUpItem].
availableLanguages := NaturalLanguageTranslator availableLanguageLocaleIDs
+ sorted:[:x :y | x displayName < y displayName].
- asSortedCollection:[:x :y | x displayName < y displayName].
availableLanguages do:
[:localeID |
aMenu addUpdating: #stringForLanguageNameIs: target: Locale selector: #switchAndInstallFontToID: argumentList: {localeID}].
aMenu popUpInWorld
"Project current chooseNaturalLanguage"!
Item was changed:
----- Method: PasteUpMorph>>findWindow: (in category 'world menu') -----
findWindow: evt
"Present a menu names of windows and naked morphs, and activate the one that gets chosen. Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo."
| menu expanded collapsed nakedMorphs |
menu := MenuMorph new.
expanded := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed not].
collapsed := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed].
nakedMorphs := self submorphsSatisfying:
[:m | (m isSystemWindow not and: [(m isStickySketchMorph) not]) and:
[(m isFlapTab) not]].
(expanded isEmpty & (collapsed isEmpty & nakedMorphs isEmpty)) ifTrue: [^ Beeper beep].
+ (expanded sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do:
- (expanded asSortedCollection: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do:
[:w | menu add: w label target: w action: #beKeyWindow.
w model canDiscardEdits ifFalse: [menu lastItem color: Color red]].
(expanded isEmpty | (collapsed isEmpty & nakedMorphs isEmpty)) ifFalse: [menu addLine].
+ (collapsed sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do:
- (collapsed asSortedCollection: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do:
[:w | menu add: w label target: w action: #collapseOrExpand.
w model canDiscardEdits ifFalse: [menu lastItem color: Color red]].
nakedMorphs isEmpty ifFalse: [menu addLine].
+ (nakedMorphs sort: [:w1 :w2 | w1 nameForFindWindowFeature caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) do:
- (nakedMorphs asSortedCollection: [:w1 :w2 | w1 nameForFindWindowFeature caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) do:
[:w | menu add: w nameForFindWindowFeature target: w action: #comeToFrontAndAddHalo].
menu addTitle: 'find window' translated.
menu popUpEvent: evt in: self.!
Item was changed:
----- Method: SelectionMorph>>distributeHorizontally (in category 'halo commands') -----
distributeHorizontally
"Distribute the empty vertical space in a democratic way."
| minLeft maxRight totalWidth currentLeft space |
self selectedItems size > 2
ifFalse: [^ self].
minLeft := self selectedItems anyOne left.
maxRight := self selectedItems anyOne right.
totalWidth := 0.
self selectedItems
do: [:each |
minLeft := minLeft min: each left.
maxRight := maxRight max: each right.
totalWidth := totalWidth + each width].
currentLeft := minLeft.
space := (maxRight - minLeft - totalWidth / (self selectedItems size - 1)) rounded.
(self selectedItems
+ sorted: [:x :y | x left <= y left])
- asSortedCollection: [:x :y | x left <= y left])
do: [:each |
each left: currentLeft.
currentLeft := currentLeft + each width + space].
self changed
!
Item was changed:
----- Method: SelectionMorph>>distributeVertically (in category 'halo commands') -----
distributeVertically
"Distribute the empty vertical space in a democratic way."
| minTop maxBottom totalHeight currentTop space |
self selectedItems size > 2
ifFalse: [^ self].
minTop := self selectedItems anyOne top.
maxBottom := self selectedItems anyOne bottom.
totalHeight := 0.
self selectedItems
do: [:each |
minTop := minTop min: each top.
maxBottom := maxBottom max: each bottom.
totalHeight := totalHeight + each height].
currentTop := minTop.
space := (maxBottom - minTop - totalHeight / (self selectedItems size - 1)) rounded.
+ (self selectedItems sorted:[:x :y | x top <= y top])
- (self selectedItems asSortedCollection:[:x :y | x top <= y top])
do: [:each |
each top: currentTop.
currentTop := currentTop + each height + space].
self changed
!
Item was changed:
----- Method: SelectionMorph>>organizeIntoColumn (in category 'halo commands') -----
organizeIntoColumn
"Place my objects in a column-enforcing container"
+ ((AlignmentMorph inAColumn: (selectedItems sorted: [:x :y | x top < y top])) setNameTo: 'Column'; color: Color orange muchLighter; enableDragNDrop: true; yourself) openInHand
- ((AlignmentMorph inAColumn: (selectedItems asSortedCollection: [:x :y | x top < y top])) setNameTo: 'Column'; color: Color orange muchLighter; enableDragNDrop: true; yourself) openInHand
!
Item was changed:
----- Method: SelectionMorph>>organizeIntoRow (in category 'halo commands') -----
organizeIntoRow
"Place my objects in a row-enforcing container"
+ ((AlignmentMorph inARow: (selectedItems sorted: [:x :y | x left < y left])) setNameTo: 'Row'; color: Color orange muchLighter; enableDragNDrop: true; yourself) openInHand
- ((AlignmentMorph inARow: (selectedItems asSortedCollection: [:x :y | x left < y left])) setNameTo: 'Row'; color: Color orange muchLighter; enableDragNDrop: true; yourself) openInHand
!
Item was changed:
----- Method: SimpleHierarchicalListMorph>>addMorphsTo:from:allowSorting:withExpandedItems:atLevel: (in category 'private') -----
addMorphsTo: morphList from: aCollection allowSorting: sortBoolean withExpandedItems: expandedItems atLevel: newIndent
| priorMorph newCollection firstAddition |
priorMorph := nil.
newCollection := (sortBoolean and: [sortingSelector notNil]) ifTrue: [
+ aCollection sorted: [ :a :b |
+ (a perform: sortingSelector) <= (b perform: sortingSelector)]
- (aCollection asSortedCollection: [ :a :b |
- (a perform: sortingSelector) <= (b perform: sortingSelector)]) asOrderedCollection
] ifFalse: [
aCollection
].
firstAddition := nil.
newCollection do: [:item |
priorMorph := self indentingItemClass basicNew
initWithContents: item
prior: priorMorph
forList: self
indentLevel: newIndent.
priorMorph
color: self textColor;
font: self font;
selectionColor: self selectionColor;
selectionTextColor: self selectionTextColor;
hoverColor: self hoverColor;
highlightTextColor: self highlightTextColor;
filterColor: self filterColor;
filterTextColor: self filterTextColor.
firstAddition ifNil: [firstAddition := priorMorph].
morphList add: priorMorph.
((item hasEquivalentIn: expandedItems) or: [priorMorph isExpanded]) ifTrue: [
priorMorph isExpanded: true.
priorMorph
addChildrenForList: self
addingTo: morphList
withExpandedItems: expandedItems.
].
].
^firstAddition
!
Item was changed:
----- Method: SimpleHierarchicalListMorph>>addSubmorphsAfter:fromCollection:allowSorting: (in category 'private') -----
addSubmorphsAfter: parentMorph fromCollection: aCollection allowSorting: sortBoolean
| priorMorph morphList newCollection |
priorMorph := nil.
newCollection := (sortBoolean and: [sortingSelector notNil]) ifTrue: [
+ aCollection sorted: [ :a :b |
+ (a perform: sortingSelector) <= (b perform: sortingSelector)]
- (aCollection asSortedCollection: [ :a :b |
- (a perform: sortingSelector) <= (b perform: sortingSelector)]) asOrderedCollection
] ifFalse: [
aCollection
].
morphList := OrderedCollection new.
newCollection do: [:item |
priorMorph := self indentingItemClass basicNew
initWithContents: item
prior: priorMorph
forList: self
indentLevel: parentMorph indentLevel + 1.
priorMorph
color: self textColor;
font: self font;
selectionColor: self selectionColor;
selectionTextColor: self selectionTextColor;
hoverColor: self hoverColor;
highlightTextColor: self highlightTextColor;
filterColor: self filterColor;
filterTextColor: self filterTextColor.
morphList add: priorMorph.
].
scroller addAllMorphs: morphList after: parentMorph.
^morphList
!
Item was changed:
----- Method: SketchMorph>>firstIntersectionWithLineFrom:to: (in category 'geometry') -----
firstIntersectionWithLineFrom: start to: end
| intersections last |
intersections := self fullBounds extrapolatedIntersectionsWithLineFrom: start to: end.
intersections size = 1 ifTrue: [ ^intersections anyOne ].
intersections isEmpty ifTrue: [ ^nil ].
+ intersections := intersections sorted: [ :a :b | (start dist: a) < (start dist: b) ].
- intersections := intersections asSortedCollection: [ :a :b | (start dist: a) < (start dist: b) ].
last := intersections first rounded.
last pointsTo: intersections last rounded do: [ :pt |
(self rotatedForm isTransparentAt: (pt - bounds origin)) ifFalse: [ ^last ].
last := pt.
].
^intersections first rounded!
Item was changed:
----- Method: TheWorldMenu>>worldMenuHelp (in category 'commands') -----
worldMenuHelp
| explanation aList |
"self currentWorld primaryHand worldMenuHelp"
aList := OrderedCollection new.
#(helpMenu changesMenu openMenu debugMenu projectMenu scriptingMenu windowsMenu playfieldMenu appearanceMenu flapsMenu)
with:
#('help' 'changes' 'open' 'debug' 'projects' 'authoring tools' 'windows' 'playfield options' 'appearance' 'flaps') do:
[:sel :title | | aMenu |
aMenu := self perform: sel.
aMenu items do:
[:it | | cnts |
(((cnts := it contents) = 'keep this menu up') or: [cnts isEmpty])
ifFalse: [aList add: (cnts, ' - ', title translated)]]].
+ aList sort: [:a :b | a caseInsensitiveLessOrEqual: b ].
- aList := aList asSortedCollection: [:a :b | a asLowercase < b asLowercase].
explanation := String streamContents: [:aStream | aList do:
[:anItem | aStream nextPutAll: anItem; cr]].
(StringHolder new contents: explanation)
openLabel: 'Where in the world menu is...' translated!
More information about the Squeak-dev
mailing list
|