[squeak-dev] The Trunk: Morphic-nice.534.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun May 8 11:49:58 UTC 2011
Nicolas Cellier uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-nice.534.mcz
==================== Summary ====================
Name: Morphic-nice.534
Author: nice
Time: 8 May 2011, 1:48:33.956 pm
UUID: 8f3ceb61-7571-439a-add9-26e4284a7442
Ancestors: Morphic-cmm.533, Morphic-nice.531
minor refactorings: use #anySatisfy: #allSatisfy: #noneSatisfy: where it simplifies
=============== Diff against Morphic-cmm.533 ===============
Item was changed:
----- Method: CircleMorph>>initialize (in category 'parts bin') -----
initialize
super initialize.
self extent: 40 at 40;
+ color: Color green lighter!
- color: Color green lighter;
- yourself!
Item was added:
+ ----- Method: FormCanvas>>translucentImage:at:sourceRect: (in category 'drawing-images') -----
+ translucentImage: aForm at: aPoint sourceRect: sourceRect
+ "Workaround because copying 16bits->32bits image does not fill the alpha channel"
+ super translucentImage: aForm at: aPoint sourceRect: sourceRect.
+ aForm isTranslucent ifFalse: [form fixAlpha]!
Item was changed:
----- Method: ListItemWrapper>>hasEquivalentIn: (in category 'as yet unclassified') -----
hasEquivalentIn: aCollection
+ ^aCollection anySatisfy: [ :each |
+ each withoutListWrapper = item withoutListWrapper]!
- aCollection detect: [ :each |
- each withoutListWrapper = item withoutListWrapper
- ] ifNone: [^false].
- ^true!
Item was changed:
----- Method: Morph>>hasSubmorphWithProperty: (in category 'submorphs-accessing') -----
hasSubmorphWithProperty: aSymbol
+ ^submorphs anySatisfy: [:m | m hasProperty: aSymbol]!
- submorphs detect: [:m | m hasProperty: aSymbol] ifNone: [^ false].
- ^ true!
Item was changed:
----- Method: TextEditor>>explain (in category 'menu messages') -----
explain
"Try to shed some light on what kind of entity the current selection is.
The selection must be a single token or construct. Insert the answer after
the selection. Send private messages whose names begin with 'explain'
that return a string if they recognize the selection, else nil."
Cursor execute showWhile:
[ | string numbers delimitors cgVars reply selectors tiVars symbol sorry |
sorry := '"Sorry, I can''t explain that. Please select a single
token, construct, or special character.'.
sorry := sorry , (morph canDiscardEdits
ifFalse: [' Also, please cancel or accept."']
ifTrue: ['"']).
(string := self selection asString) isEmpty
ifTrue: [reply := '']
ifFalse: [string := self explainScan: string.
"Remove space, tab, cr"
"Temps and Instance vars need only test strings that are all letters"
+ (string allSatisfy: [:char | char isLetter or: [char isDigit]])
+ ifTrue:
- (string detect: [:char | (char isLetter or: [char isDigit]) not]
- ifNone: []) ifNil:
[tiVars := self explainTemp: string.
tiVars == nil ifTrue: [tiVars := self explainInst: string]].
(tiVars == nil and: [model respondsTo: #explainSpecial:])
ifTrue: [tiVars := model explainSpecial: string].
tiVars == nil
ifTrue: [tiVars := '']
ifFalse: [tiVars := tiVars , '\' withCRs].
"Context, Class, Pool, and Global vars, and Selectors need
only test symbols"
(Symbol hasInterned: string ifTrue: [:s | symbol := s])
ifTrue: [cgVars := self explainCtxt: symbol.
cgVars == nil
ifTrue: [cgVars := self explainClass: symbol.
cgVars == nil ifTrue: [cgVars := self explainGlobal: symbol]].
"See if it is a Selector (sent here or not)"
selectors := self explainMySel: symbol.
selectors == nil
ifTrue:
[selectors := self explainPartSel: string.
selectors == nil ifTrue: [
selectors := self explainAnySel: symbol]]]
ifFalse: [selectors := self explainPartSel: string].
cgVars == nil
ifTrue: [cgVars := '']
ifFalse: [cgVars := cgVars , '\' withCRs].
selectors == nil
ifTrue: [selectors := '']
ifFalse: [selectors := selectors , '\' withCRs].
string size = 1
ifTrue: ["single special characters"
delimitors := self explainChar: string]
ifFalse: ["matched delimitors"
delimitors := self explainDelimitor: string].
numbers := self explainNumber: string.
numbers == nil ifTrue: [numbers := ''].
delimitors == nil ifTrue: [delimitors := ''].
reply := tiVars , cgVars , selectors , delimitors , numbers].
reply size = 0 ifTrue: [reply := sorry].
self afterSelectionInsertAndSelect: reply]!
Item was changed:
----- Method: TextEditor>>explainGlobal: (in category 'explain') -----
explainGlobal: symbol
"Is symbol a global variable?"
| reply classes |
reply := Smalltalk at: symbol ifAbsent: [^nil].
(reply class == Dictionary or:[reply isKindOf: SharedPool class])
ifTrue:
[classes := Set new.
+ self systemNavigation allBehaviorsDo: [:each | (each sharedPools anySatisfy: [:pool | pool == reply])
+ ifTrue: [classes add: each]].
- self systemNavigation allBehaviorsDo: [:each | (each sharedPools detect: [:pool | pool == reply]
- ifNone: [])
- ~~ nil ifTrue: [classes add: each]].
classes := classes printString.
^'"is a global variable. It is a pool which is used by the following classes ' , (classes allButFirst: 5) , '"'].
(reply isKindOf: Behavior)
ifTrue: [^'"is a global variable. ' , symbol , ' is a class in category ', reply category,
'."', '\' withCRs, 'Browser newOnClass: ' , symbol , '.'].
symbol == #Smalltalk ifTrue: [^'"is a global. Smalltalk is the only instance of SystemDictionary and holds all global variables."'].
^'"is a global variable. ' , symbol , ' is ' , reply printString , '"'!
Item was changed:
----- Method: TextEditor>>explainInst: (in category 'explain') -----
explainInst: string
"Is string an instance variable of this class?"
| classes cls |
(model respondsTo: #selectedClassOrMetaClass) ifTrue: [
cls := model selectedClassOrMetaClass].
cls ifNil: [^ nil]. "no class known"
classes := (Array with: cls)
, cls allSuperclasses.
+ classes := classes detect: [:each | each instVarNames anySatisfy: [:name | name = string]] ifNone: [^nil].
- classes := classes detect: [:each | (each instVarNames
- detect: [:name | name = string] ifNone: [])
- ~~ nil] ifNone: [^nil].
classes := classes printString.
^ '"is an instance variable of the receiver; defined in class ' , classes ,
'"\' withCRs , classes , ' systemNavigation browseAllAccessesTo: ''' , string , ''' from: ', classes, '.'!
Item was changed:
----- Method: TextEditor>>explainMySel: (in category 'explain') -----
explainMySel: symbol
"Is symbol the selector of this method? Is it sent by this method? If
not, then expalin will call (explainPartSel:) to see if it is a fragment of a
selector sent here. If not, explain will call (explainAnySel:) to catch any
selector. "
| lits classes msg |
(model respondsTo: #selectedMessageName) ifFalse: [^ nil].
(msg := model selectedMessageName) ifNil: [^nil]. "not in a message"
classes := self systemNavigation allClassesImplementing: symbol.
classes size > 12
ifTrue: [classes := 'many classes']
ifFalse: [classes := 'these classes ' , classes printString].
msg = symbol
ifTrue: [^ '"' , symbol , ' is the selector of this very method!! It is defined in ',
classes , '. To see the other definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."']
ifFalse:
[lits := (model selectedClassOrMetaClass compiledMethodAt:
msg) messages.
+ (lits anySatisfy: [:each | each == symbol])
+ ifFalse: [^nil].
- (lits detect: [:each | each == symbol]
- ifNone: [])
- == nil ifTrue: [^nil].
^ '"' , symbol , ' is a message selector which is defined in ', classes , '. To see the definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."'].!
Item was changed:
----- Method: TextEditor>>explainPartSel: (in category 'explain') -----
explainPartSel: string
"Is this a fragment of a multiple-argument selector sent in this method?"
| lits whole reply classes s msg |
(model respondsTo: #selectedMessageName) ifFalse: [^ nil].
(msg := model selectedMessageName) ifNil: [^ nil]. "not in a message"
string last == $: ifFalse: [^ nil].
"Name of this method"
lits := Array with: msg.
+ (whole := lits detect: [:each | each keywords anySatisfy: [:frag | frag = string] ]
- (whole := lits detect: [:each | (each keywords detect: [:frag | frag = string]
- ifNone: []) ~~ nil]
ifNone: []) ~~ nil
ifTrue: [reply := ', which is the selector of this very method!!'.
s := '. To see the other definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."']
ifFalse:
["Selectors called from this method"
lits := (model selectedClassOrMetaClass compiledMethodAt:
msg) messages.
(whole := lits detect: [:each | (each keywords detect: [:frag | frag = string]
ifNone: []) ~~ nil]
ifNone: []) ~~ nil
ifFalse: [string = 'primitive:'
ifTrue: [^self explainChar: '<']
ifFalse: [^nil]].
reply := '.'.
s := '. To see the definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."'].
classes := self systemNavigation allClassesImplementing: whole.
classes size > 12
ifTrue: [classes := 'many classes']
ifFalse: [classes := 'these classes ' , classes printString].
^ '"' , string , ' is one part of the message selector ' , whole, reply , ' It is defined in ' , classes , s!
Item was changed:
----- Method: WorldState>>selectHandsToDrawForDamage: (in category 'hands') -----
selectHandsToDrawForDamage: damageList
"Select the set of hands that must be redrawn because either (a) the hand itself has changed or (b) the hand intersects some damage rectangle."
| result |
result := OrderedCollection new.
hands do: [:h |
h needsToBeDrawn ifTrue: [
h hasChanged
ifTrue: [result add: h]
ifFalse: [
| hBnds |
hBnds := h fullBounds.
+ (damageList anySatisfy: [:r | r intersects: hBnds])
+ ifTrue: [result add: h]]]].
- (damageList detect: [:r | r intersects: hBnds] ifNone: [nil])
- ifNotNil: [result add: h]]]].
^ result
!
More information about the Squeak-dev
mailing list
|