Packages June 2016

packages@lists.squeakfoundation.org

1 participants
85 discussions

The Trunk: 51Deprecated-ul.30.mcz
by commits＠source.squeak.org 02 Jun '16

02 Jun '16

Levente Uzonyi uploaded a new version of 51Deprecated to project The Trunk: http://source.squeak.org/trunk/51Deprecated-ul.30.mcz ==================== Summary ==================== Name: 51Deprecated-ul.30 Author: ul Time: 2 June 2016, 8:28:00.97666 pm UUID: 2a30b91d-0870-412d-8c10-ee96c3c48065 Ancestors: 51Deprecated-mt.29 Deprecated the now unused methods of Heap. =============== Diff against 51Deprecated-mt.29 =============== Item was added: + ----- Method: Heap>>fullySort (in category '*51Deprecated') ----- + fullySort + "Fully sort the heap. + This method preserves the heap invariants and can thus be sent safely" + + self deprecated: 'Use #sort'. + self sort! Item was added: + ----- Method: Heap>>reSort (in category '*51Deprecated') ----- + reSort + "Resort the entire heap" + + self deprecated: 'This method should not be used anymore. Use #sortBlock: if you want to change the sort order.'. + tally <= 1 ifTrue: [ ^self ]. + (tally bitShift: -1) to: 1 by: -1 do: [ :index | self downHeap: index ]! Item was added: + ----- Method: Heap>>sorts:before: (in category '*51Deprecated') ----- + sorts: element1 before: element2 + "Return true if element1 should be sorted before element2. + This method defines the sort order in the receiver" + + self deprecated: 'This method has been inlined for performance.'. + ^sortBlock == nil + ifTrue:[element1 <= element2] + ifFalse:[sortBlock value: element1 value: element2].! Item was added: + ----- Method: Heap>>trim (in category '*51Deprecated') ----- + trim + "Remove any empty slots in the receiver." + + self deprecated: 'Use #compact'. + self compact! Item was added: + ----- Method: Heap>>updateObjectIndex: (in category '*51Deprecated') ----- + updateObjectIndex: index + "If indexUpdateBlock is not nil, notify the object at index of its new position in the heap array." + + self deprecated: 'This method has been inlined for performance.'. + indexUpdateBlock ifNotNil: [ + indexUpdateBlock value: (array at: index) value: index]!

1 0

The Trunk: Morphic-ul.1158.mcz
by commits＠source.squeak.org 02 Jun '16

02 Jun '16

Levente Uzonyi uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ul.1158.mcz ==================== Summary ==================== Name: Morphic-ul.1158 Author: ul Time: 2 June 2016, 8:25:53.664006 pm UUID: 875c3c7f-2813-4bc5-9c85-8ed8eb6f02cb Ancestors: Morphic-mt.1157 - use #sort instead of #fullySort =============== Diff against Morphic-mt.1157 =============== Item was changed: ----- Method: MorphicAlarmQueue>>nextSequenceNumber (in category 'private') ----- nextSequenceNumber (sequenceNumber := sequenceNumber + 1) = 16r3FFFFFFF ifTrue: [ "Sequence number overflow... reassign sequence numbers starting at 1." + heap sort. - heap fullySort. 1 to: heap size do: [ :index | (heap at: index) sequenceNumber: index ]. sequenceNumber := heap size + 1 ]. ^sequenceNumber!

1 0

The Trunk: ToolBuilder-Morphic-mt.166.mcz
by commits＠source.squeak.org 02 Jun '16

02 Jun '16

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.166.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.166 Author: mt Time: 2 June 2016, 6:33:08.27467 pm UUID: f4e7d7b4-c3ba-cf48-aba0-0bf40d5c88eb Ancestors: ToolBuilder-Morphic-mt.165 Fixes tool opening for non-windows. Fixes debugger opening for errors that occur in invisible worlds' event processing chain. Required for writing tests for user input event processing. Always use the project's world to show debuggers. =============== Diff against ToolBuilder-Morphic-mt.165 =============== Item was changed: ----- Method: MorphicToolBuilder>>open:label: (in category 'opening') ----- open: anObject label: aString + "Build an open the object, labeling it appropriately if it is a window. Answer the widget opened." + + | morph | + morph := self open: anObject. + morph isSystemWindow + ifTrue: [morph setLabel: aString] + ifFalse: [morph name: aString]. + ^ morph! - "Build an open the object, labeling it appropriately. Answer the widget opened." - | window | - window := self open: anObject. - window setLabel: aString. - ^window! Item was added: + ----- Method: MorphicToolBuilder>>openDebugger: (in category 'opening') ----- + openDebugger: aSpec + + | morph | + morph := self build: aSpec. + morph openInWorld: Project current world extent: morph extent. + ^ morph! Item was added: + ----- Method: MorphicToolBuilder>>openDebugger:label: (in category 'opening') ----- + openDebugger: aSpec label: aString + + | morph | + morph := self openDebugger: aSpec. + morph isSystemWindow + ifTrue: [morph setLabel: aString] + ifFalse: [morph name: aString]. + ^ morph!

1 0

The Trunk: CollectionsTests-ul.263.mcz
by commits＠source.squeak.org 02 Jun '16

02 Jun '16

Levente Uzonyi uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-ul.263.mcz ==================== Summary ==================== Name: CollectionsTests-ul.263 Author: ul Time: 2 June 2016, 5:49:02.940363 pm UUID: caaf5382-04e8-47fb-9db3-9b5e97cb3aed Ancestors: CollectionsTests-mt.262 - added a few more heap tests =============== Diff against CollectionsTests-mt.262 =============== Item was changed: ----- Method: HeapTest>>heapSortExample (in category 'examples') ----- + heapSortExample + "Sort a random collection of Floats and compare the results with #quicksort and #sort (using the merge-sort algorithm)." + "HeapTest new heapSortExample" + + | arrayToSort n rnd array time | + Smalltalk garbageCollectMost. + n := 50000. "# of elements to sort" - heapSortExample "HeapTest new heapSortExample" - "Sort a random collection of Floats and compare the results with - SortedCollection (using the quick-sort algorithm) and - ArrayedCollection>>mergeSortFrom:to:by: (using the merge-sort algorithm)." - | n rnd array time sorted | - n := 10000. "# of elements to sort" rnd := Random new. + array := Array new: n. + 1 to: n do: [ :index | array at: index put: rnd next ]. + arrayToSort := array copy. - array := (1 to: n) collect:[:i| rnd next]. "First, the heap version" + self deny: arrayToSort isSorted. + time := [ (Heap on: arrayToSort) sort ] timeToRun. + self assert: arrayToSort isSorted. + Transcript cr; show: 'Time for heap-sort: ', time printString,' msecs'. - time := Time millisecondsToRun:[ - sorted := Heap withAll: array. - 1 to: n do:[:i| sorted removeFirst]. - ]. - Transcript cr; show:'Time for heap-sort: ', time printString,' msecs'. "The quicksort version" + arrayToSort copyFrom: array. + self deny: arrayToSort isSorted. + time := [ arrayToSort quickSort ] timeToRun. + self assert: arrayToSort isSorted. + Transcript cr; show: 'Time for quick-sort: ', time printString,' msecs'. - time := Time millisecondsToRun:[ - sorted := SortedCollection withAll: array. - ]. - Transcript cr; show:'Time for quick-sort: ', time printString,' msecs'. "The merge-sort version" + arrayToSort copyFrom: array. + self deny: arrayToSort isSorted. + time := [ arrayToSort sort ] timeToRun. + self assert: arrayToSort isSorted. + Transcript cr; show: 'Time for merge-sort: ', time printString,' msecs'! - time := Time millisecondsToRun:[ - array mergeSortFrom: 1 to: array size by: [:v1 :v2| v1 <= v2]. - ]. - Transcript cr; show:'Time for merge-sort: ', time printString,' msecs'. - ! Item was changed: + ----- Method: HeapTest>>test1 (in category 'tests') ----- - ----- Method: HeapTest>>test1 (in category 'testing') ----- test1 | data | "The first element of each array is the sort value, and the second will be updated by the heap with the index of the element within the heap." data := (1 to: 8) collect: [:i | {i*2. 0}]. "Repeat with different data ordering." 5 timesRepeat: [ | h | h := Heap new sortBlock: [:e1 :e2 | e1 first < e2 first]. h indexUpdateBlock: [:array :index | array at: 2 put: index]. data shuffled do: [:d | h add: d]. data do: [:d | self should: (h at: d second) == d]. ]! Item was changed: + ----- Method: HeapTest>>testAdd (in category 'tests') ----- - ----- Method: HeapTest>>testAdd (in category 'basic tests') ----- testAdd "self run: #testAdd" | heap | heap := Heap new. self assert: heap size = 0. heap add: 3. self assert: heap size = 1. self assert: heap isEmpty not. self assert: heap first = 3. self assert: (heap at: 1) = 3. heap add: 2. self assert: heap size = 2. self assert: heap first = 2. self assert: (heap at: 2) = 3. ! Item was added: + ----- Method: HeapTest>>testAddAndRemoveFirst (in category 'tests') ----- + testAddAndRemoveFirst + + | random heap validateHeap | + random := Random seed: 36rSqueak. + heap := Heap sortBlock: [ :a :b | a first >= b first ]. + heap indexUpdateBlock: [ :element :newIndex | element at: 2 put: newIndex ]. + validateHeap := [ heap isValidHeap and: [ + heap do: [ :each | self assert: (heap at: each second) == each ] ] ]. + validateHeap value. + self assert: 0 equals: heap size. + self assert: heap isEmpty. + 1 to: 100 do: [ :index | + heap add: { random next. nil }. + self assert: index equals: heap size. + validateHeap value ]. + 1000 timesRepeat: [ + | first | + first := heap removeFirst. + heap do: [ :each | self assert: (heap sortBlock value: first value: each) ]. + heap add: { random next. nil }. + validateHeap value ]! Item was changed: + ----- Method: HeapTest>>testAt (in category 'tests') ----- - ----- Method: HeapTest>>testAt (in category 'basic tests') ----- testAt "self run: #testAt" | heap | heap := Heap new. heap add: 3. self assert: (heap at: 1) = 3. self should: [heap at: 2] raise: Error. heap add: 4. self assert: (heap at: 1) = 3. self assert: (heap at: 2) = 4. ! Item was added: + ----- Method: HeapTest>>testAtRaisesErrorWhenIndexIsInvalid (in category 'tests') ----- + testAtRaisesErrorWhenIndexIsInvalid + " self run: #testAtRaisesErrorWhenIndexIsInvalid " + + | heap | + heap := Heap new. + 1 to: 100 do: [ :index | + 1 to: heap size do: [ :each | + self assert: ((heap at: each) between: 1 and: heap size) ]. + self + should: [ heap at: 0 ] raise: Error; + should: [ heap at: heap size + 1 ] raise: Error. + heap add: index ].! Item was added: + ----- Method: HeapTest>>testCompact (in category 'tests') ----- + testCompact + " self run: #testCompact " + + | heap | + heap := Heap new. + 1 to: 100 do: [ :index | + | copy | + copy := heap copy. + copy compact. + self + assert: copy = heap; + assert: copy capacity <= heap capacity; + assert: copy capacity = copy size. + heap add: index ].! Item was added: + ----- Method: HeapTest>>testCopy (in category 'tests') ----- + testCopy + + | heap | + heap := Heap new. + 1 to: 100 do: [ :index | + | copy | + copy := heap copy. + self + assert: copy = heap; + assert: heap = copy; + deny: copy == heap; + assert: copy sortBlock = heap sortBlock; + deny: copy array == heap array. + heap add: index ].! Item was added: + ----- Method: HeapTest>>testCopyEmpty (in category 'tests') ----- + testCopyEmpty + + | heap | + heap := Heap new. + 1 to: 100 do: [ :index | + | copy | + copy := heap copyEmpty. + self + assert: copy isHeap; + assert: copy isEmpty; + assert: copy sortBlock = heap sortBlock. + heap add: index ].! Item was changed: + ----- Method: HeapTest>>testDo (in category 'tests') ----- - ----- Method: HeapTest>>testDo (in category 'basic tests') ----- testDo "self run: #testDo" | heap coll | heap := Heap withAll: #(1 3 5). coll := OrderedCollection new. heap do: [:each | coll add: each]. self assert: coll = #(1 3 5) asOrderedCollection. ! Item was changed: + ----- Method: HeapTest>>testExamples (in category 'tests') ----- - ----- Method: HeapTest>>testExamples (in category 'testing') ----- testExamples self heapExample. self heapSortExample.! Item was changed: + ----- Method: HeapTest>>testFirst (in category 'tests') ----- - ----- Method: HeapTest>>testFirst (in category 'basic tests') ----- testFirst "self run: #testFirst" | heap | heap := Heap new. heap add: 5. heap add: 12. heap add: 1. self assert: heap first = 1. heap removeFirst. self assert: heap first = 5.! Item was changed: + ----- Method: HeapTest>>testHeap (in category 'tests') ----- - ----- Method: HeapTest>>testHeap (in category 'basic tests') ----- testHeap "self run: #testHeap" | heap | heap := Heap new. self assert: heap isHeap. self assert: heap isEmpty. heap add: 1. self assert: heap isEmpty not ! Item was changed: + ----- Method: HeapTest>>testIfEqualIsTransitive (in category 'tests') ----- - ----- Method: HeapTest>>testIfEqualIsTransitive (in category 'testing') ----- testIfEqualIsTransitive "This is http://bugs.squeak.org/view.php?id=6943" | anArray heap1 heap2 | anArray := #(1 2 3). heap1 := Heap withAll: (1 to: 3) sortBlock: [:a :b | a < b]. heap2 := Heap withAll: (1 to: 3) sortBlock: [:a :b | b > a]. self assert: (heap1 = anArray) & (heap2 = anArray) ==> (heap1 = heap2) description: 'Heap equality should be transitive'! Item was changed: + ----- Method: HeapTest>>testRemove (in category 'tests') ----- - ----- Method: HeapTest>>testRemove (in category 'basic tests') ----- testRemove "self run: #testRemove" | heap | heap := Heap new. self should: [heap removeFirst] raise: Error. heap add: 5. + self assert: 5 equals: heap removeFirst. - heap removeFirst. self assert: heap size = 0. heap add: 5. self should: [heap removeAt: 2] raise: Error.! Item was added: + ----- Method: HeapTest>>testSort (in category 'tests') ----- + testSort + + self testSortUsing: Heap new. + { + nil. + #<=. + [ :a :b | a <= b ]. + [ :a :b | a >= b ] + } do: [ :each | self testSortUsing: (Heap sortBlock: each) ]! Item was changed: + ----- Method: HeapTest>>testSortBlock (in category 'tests') ----- - ----- Method: HeapTest>>testSortBlock (in category 'basic tests') ----- testSortBlock "self run: #testSortBlock" | heap | heap := Heap withAll: #(1 3 5). self assert: heap asArray = #(1 3 5). heap sortBlock: [ :e1 :e2 | e1 >= e2 ]. + self assert: heap isValidHeap. self assert: heap asArray = #(5 3 1) ! Item was added: + ----- Method: HeapTest>>testSortUsing: (in category 'tests') ----- + testSortUsing: aHeap + + | random | + random := Random seed: 36rSqueak. + self assert: aHeap isValidHeap. + 1000 timesRepeat: [ + aHeap add: random next. + self assert: aHeap isValidHeap ]. + self deny: (aHeap asArray isSortedBy: aHeap sortBlock). + aHeap sort. + self assert: aHeap isValidHeap. + self assert: (aHeap asArray isSortedBy: aHeap sortBlock) + ! Item was added: + ----- Method: HeapTest>>testSortWithIndexUpdateBlock (in category 'tests') ----- + testSortWithIndexUpdateBlock + + | random heap validateHeap | + random := Random seed: 36rSqueak. + heap := Heap sortBlock: [ :a :b | a first <= b first ]. + heap indexUpdateBlock: [ :element :newIndex | element at: 2 put: newIndex ]. + validateHeap := [ + heap isHeap + and: [ heap isValidHeap + and: [ heap do: [ :each | self assert: (heap at: each second) == each ] ] ] ]. + validateHeap value. + 1000 timesRepeat: [ + heap add: { random next. nil }. + validateHeap value ]. + self deny: (heap asArray isSortedBy: heap sortBlock). + heap sort. + validateHeap value. + self assert: (heap asArray isSortedBy: heap sortBlock) + !

1 0

The Trunk: Collections-ul.696.mcz
by commits＠source.squeak.org 02 Jun '16

02 Jun '16

Levente Uzonyi uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-ul.696.mcz ==================== Summary ==================== Name: Collections-ul.696 Author: ul Time: 2 June 2016, 5:58:47.938458 pm UUID: 0ec3a2e6-cd17-46b2-970f-2c1dc1227411 Ancestors: Collections-ul.695 - added #quickSort and #quickSort: to ArrayedCollection =============== Diff against Collections-ul.695 =============== Item was added: + ----- Method: ArrayedCollection>>quickSort (in category 'sorting') ----- + quickSort + "Sort elements of self to be nondescending according to #<= using an in-place quicksort with simple median-of-three partitioning with guaranteed O(log(n)) space usage." + + self quickSortFrom: 1 to: self size by: nil! Item was added: + ----- Method: ArrayedCollection>>quickSort: (in category 'sorting') ----- + quickSort: sortBlock + "Sort elements of self to be nondescending according to sortBlock using an in-place quicksort with simple median-of-three partitioning with guaranteed O(log(n)) space usage." + + self quickSortFrom: 1 to: self size by: sortBlock!

1 0

The Trunk: Collections-ul.695.mcz
by commits＠source.squeak.org 02 Jun '16

02 Jun '16

Levente Uzonyi uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-ul.695.mcz ==================== Summary ==================== Name: Collections-ul.695 Author: ul Time: 2 June 2016, 5:48:18.403513 pm UUID: be1e0401-02a2-49e4-827f-fe0fee861114 Ancestors: Collections-topa.694 Heap revamp #1: class side: - Heaps can be created on an existing array with #on: #on:size: and #on:size:sortBlock: - #withAll: and #withAll:sortBlock: avoid creating an extra copy if the argument is already an Array instance side: - imported and improved #= from Pharo - #growTo: won't raise an error when newSize is less than array size (e.g. during compaction) - #sortBlock: restores the heap invariant on its own - improved #select:, #collect, #at:, #removeAt:, #add: - added #sort and #compact; compatible with other collections - #capacity returns the real capacity - inlined #sorts:before: and #indexUpdateBlock: for performance - improved performance and legibility of the heap operations #upHeap: #downHeap: and #downHeapSingle: - added #isValidHeap - added some comments =============== Diff against Collections-topa.694 =============== Item was added: + ----- Method: Heap class>>on: (in category 'instance creation') ----- + on: anArray + "Create a new heap using anArray as the internal array" + + ^self on: anArray size: anArray size sortBlock: nil! Item was added: + ----- Method: Heap class>>on:size: (in category 'instance creation') ----- + on: anArray size: size + "Create a new heap using the first size elements of anArray as the internal array" + + ^self + on: anArray + size: size + sortBlock: nil! Item was added: + ----- Method: Heap class>>on:size:sortBlock: (in category 'instance creation') ----- + on: anArray size: size sortBlock: aBlockOrNil + "Create a new heap using the first size elements of anArray as the internal array and sorted by aBlockOrNil" + + anArray isArray ifFalse: [ self error: 'Array expected.' ]. + anArray size < size ifTrue: [ self error: 'size must not be larger than anArray size' ]. + ^super new + setCollection: anArray tally: size; + sortBlock: aBlockOrNil; + yourself! Item was changed: ----- Method: Heap class>>withAll: (in category 'instance creation') ----- withAll: aCollection "Create a new heap with all the elements from aCollection" + + ^self withAll: aCollection sortBlock: nil! - ^(self basicNew) - setCollection: aCollection asArray copy tally: aCollection size; - reSort; - yourself! Item was changed: ----- Method: Heap class>>withAll:sortBlock: (in category 'instance creation') ----- withAll: aCollection sortBlock: sortBlock + "Create a new heap with all the elements from aCollection, sorted by sortBlock" + + | array | + array := aCollection asArray. + array == aCollection ifTrue: [ array := array copy ]. + ^self on: array size: array size sortBlock: sortBlock! - "Create a new heap with all the elements from aCollection" - ^(self basicNew) - setCollection: aCollection asArray copy tally: aCollection size; - sortBlock: sortBlock; - yourself! Item was changed: ----- Method: Heap>>= (in category 'comparing') ----- = anObject + "Heap are considered to be equal when they have the same sortBlock and the same elements. This method is expensive due to the sorted copies of the arrays. Try not to use it." + self == anObject ifTrue: [ ^true ]. + anObject isHeap ifFalse: [ ^false ]. + anObject size = tally ifFalse: [ ^false ]. + anObject sortBlock = sortBlock ifFalse: [ ^false ]. + ^((array first: tally) sort: sortBlock) = ((anObject array first: tally) sort: sortBlock)! - ^ self == anObject - ifTrue: [true] - ifFalse: [anObject isHeap - ifTrue: [sortBlock = anObject sortBlock and: [super = anObject]] - ifFalse: [super = anObject]]! Item was changed: ----- Method: Heap>>add: (in category 'adding') ----- add: anObject "Include newObject as one of the receiver's elements. Answer newObject." + tally = array size ifTrue:[self grow]. array at: (tally := tally + 1) put: anObject. + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: anObject value: tally ]. - self updateObjectIndex: tally. self upHeap: tally. ^anObject! Item was changed: ----- Method: Heap>>at: (in category 'accessing') ----- at: index "Return the element at the given position within the receiver" + + index > tally ifTrue: [ ^self errorSubscriptBounds: index ]. - (index < 1 or:[index > tally]) ifTrue:[^self errorSubscriptBounds: index]. ^array at: index! Item was added: + ----- Method: Heap>>capacity (in category 'accessing') ----- + capacity + "Answer the current capacity of the receiver." + + ^array size! Item was changed: ----- Method: Heap>>collect: (in category 'enumerating') ----- collect: aBlock + + ^(array first: tally) replace: aBlock! - ^self collect: aBlock as: Array! Item was added: + ----- Method: Heap>>compact (in category 'growing') ----- + compact + "Remove any empty slots in the receiver." + + self growTo: self size.! Item was changed: ----- Method: Heap>>downHeap: (in category 'private-heap') ----- downHeap: anIndex "Check the heap downwards for correctness starting at anIndex. Everything above (i.e. left of) anIndex is ok." + + | childIndex childValue index value | + index := anIndex. - | value k n j | - anIndex = 0 ifTrue:[^self]. - n := tally bitShift: -1. - k := anIndex. value := array at: anIndex. + [ (childIndex := 2 * index) >= tally or: [ + "Select the child with the larger value. We know there are two children." + childValue := array at: childIndex. + (sortBlock + ifNil: [ (array at: childIndex + 1) <= childValue ] + ifNotNil: [ sortBlock value: (array at: childIndex + 1) value: childValue ]) + ifTrue: [ + childValue := array at: (childIndex := childIndex + 1) ]. + "Check if the value at index is at the right position." + sortBlock + ifNil: [ value <= childValue ] + ifNotNil: [ sortBlock value: value value: childValue ] ] ] + whileFalse: [ + "Move value downwards the tree." + array at: index put: childValue. + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: childValue value: index ]. + "Contine from childIndex" + index := childIndex ]. + childIndex = tally ifTrue: [ "Special case: there's only one child." + "Check if the value at index is at the right position." + childValue := array at: childIndex. + (sortBlock + ifNil: [ value <= childValue ] + ifNotNil: [ sortBlock value: value value: childValue ]) + ifFalse: [ + "Move value downwards the tree." + array at: index put: childValue. + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: childValue value: index ]. + "Contine from childIndex" + index := childIndex ] ]. + array at: index put: value. + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: value value: index ]! - [k <= n] whileTrue:[ - j := k + k. - "use max(j,j+1)" - (j < tally and:[self sorts: (array at: j+1) before: (array at: j)]) - ifTrue:[ j := j + 1]. - "check if position k is ok" - (self sorts: value before: (array at: j)) - ifTrue:[ "yes -> break loop" - n := k - 1] - ifFalse:[ "no -> make room at j by moving j-th element to k-th position" - array at: k put: (array at: j). - self updateObjectIndex: k. - "and try again with j" - k := j]]. - array at: k put: value. - self updateObjectIndex: k.! Item was changed: ----- Method: Heap>>downHeapSingle: (in category 'private-heap') ----- downHeapSingle: anIndex "This version is optimized for the case when only one element in the receiver can be at a wrong position. It avoids one comparison at each node when travelling down the heap and checks the heap upwards after the element is at a bottom position. Since the probability for being at the bottom of the heap is much larger than for being somewhere in the middle this version should be faster." + + | childIndex index value | + index := anIndex. - | value k n j | - anIndex = 0 ifTrue:[^self]. - n := tally bitShift: -1. - k := anIndex. value := array at: anIndex. + [ (childIndex := 2 * index) < tally ] whileTrue:[ + "Select the child with the larger value. We know there are two children." + (sortBlock + ifNil: [ (array at: childIndex + 1) <= (array at: childIndex) ] + ifNotNil: [ sortBlock value: (array at: childIndex + 1) value: (array at: childIndex) ]) + ifTrue: [ childIndex := childIndex + 1 ]. + array at: index put: (array at: childIndex). + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: (array at: index) value: index ]. + "and repeat at the next level" + index := childIndex ]. + childIndex = tally ifTrue: [ "Child with no sibling" + array at: index put: (array at: childIndex). + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: (array at: index) value: index ]. + index := childIndex ]. + array at: index put: value. + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: value value: index ]. + self upHeap: index! - [k <= n] whileTrue:[ - j := k + k. - "use max(j,j+1)" - (j < tally and:[self sorts: (array at: j+1) before: (array at: j)]) - ifTrue:[ j := j + 1]. - array at: k put: (array at: j). - self updateObjectIndex: k. - "and try again with j" - k := j]. - array at: k put: value. - self updateObjectIndex: k. - self upHeap: k! Item was changed: ----- Method: Heap>>growTo: (in category 'growing') ----- growTo: newSize "Grow to the requested size." + | newArray | newArray := Array new: (newSize max: tally). + newArray replaceFrom: 1 to: tally with: array startingAt: 1. - newArray replaceFrom: 1 to: array size with: array startingAt: 1. array := newArray! Item was changed: ----- Method: Heap>>indexUpdateBlock: (in category 'accessing') ----- indexUpdateBlock: aBlockOrNil + "aBlockOrNil is either nil or a two argument block. The first argument is the object whose index has changed in the heap, the second is the new index. The block will be evaluated whenever an element is moved in the heap's internal array. If you don't plan to remove elements by index (see #removeAt:), then you should not set this block." indexUpdateBlock := aBlockOrNil. ! Item was added: + ----- Method: Heap>>isValidHeap (in category 'testing') ----- + isValidHeap + + "Check the size first." + (tally between: 0 and: array size) ifFalse: [ ^false ]. + "Check the sort order between parent and child nodes." + 1 to: (tally bitShift: -1) do: [ :index | + | childIndex | + childIndex := 2 * index. + sortBlock + ifNil: [ (array at: index) <= (array at: childIndex) ifFalse: [ ^false ] ] + ifNotNil: [ (sortBlock value: (array at: index) value: (array at: childIndex)) ifFalse: [ ^false ] ]. + childIndex < tally ifTrue: [ + childIndex := childIndex + 1. + sortBlock + ifNil: [ (array at: index) <= (array at: childIndex) ifFalse: [ ^false ] ] + ifNotNil: [ (sortBlock value: (array at: index) value: (array at: childIndex)) ifFalse: [ ^false ] ] ] ]. + "Check for elements left in array after tally." + tally + 1 to: array size do: [ :index | + (array at: index) ifNotNil: [ ^false ] ]. + ^true! Item was changed: ----- Method: Heap>>privateRemoveAt: (in category 'private') ----- privateRemoveAt: index + "Remove the element at the given index and make sure the sorting order is okay. The value of index must not be larger than tally." + - "Remove the element at the given index and make sure the sorting order is okay" | removed | removed := array at: index. + index = tally ifTrue: [ + array at: index put: nil. + tally := tally - 1. + ^removed ]. + array + at: index put: (array at: tally); + at: tally put: nil. - array at: index put: (array at: tally). - array at: tally put: nil. tally := tally - 1. + 2 * index <= tally "The node at index has at least one child." + ifTrue: [ self downHeapSingle: index ] + ifFalse: [ self upHeap: index ]. - index > tally ifFalse:[ - "Use #downHeapSingle: since only one element has been removed" - self downHeapSingle: index]. ^removed! Item was changed: ----- Method: Heap>>privateReverseSort (in category 'private') ----- privateReverseSort "Arrange to have the array sorted in reverse order. WARNING: this method breaks the heap invariants. It's up to the sender to restore them afterwards." + | oldTally | + self deprecated: 'Use #sort if you want to sort.'. oldTally := tally. [tally > 1] whileTrue: [array swap: 1 with: tally. tally := tally - 1. self downHeapSingle: 1]. tally := oldTally! Item was changed: ----- Method: Heap>>removeAt: (in category 'removing') ----- removeAt: index + "Remove the element at the given index and make sure the sorting order is okay." + + index > tally ifTrue: [ self errorSubscriptBounds: index ]. - "Remove the element at given position" - (index < 1 or:[index > tally]) ifTrue:[^self errorSubscriptBounds: index]. ^self privateRemoveAt: index! Item was changed: ----- Method: Heap>>select: (in category 'enumerating') ----- select: aBlock "Evaluate aBlock with each of my elements as the argument. Collect into a new collection like the receiver, only those elements for which aBlock evaluates to true." | newCollection | newCollection := self copyEmpty. + 1 to: tally do: [ :index | + | element | + (aBlock value: (element := array at: index)) ifTrue: [ + newCollection add: element ] ]. - self do: - [:each | - (aBlock value: each) - ifTrue: [newCollection add: each]]. ^ newCollection! Item was added: + ----- Method: Heap>>sort (in category 'sorting') ----- + sort + "Fully sort the heap. This method preserves the heap invariants and can thus be sent safely" + + | start end element originalIndexUpdateBlock | + end := tally. + "Temporarly remove indexUpdateBlock to speed up sorting." + originalIndexUpdateBlock := indexUpdateBlock. + indexUpdateBlock := nil. + [ tally > 1 ] whileTrue: [ + element := array at: tally. + array + at: tally put: (array at: 1); + at: 1 put: element. + tally := tally - 1. + self downHeapSingle: 1 ]. + tally := end. + start := 1. + originalIndexUpdateBlock ifNil: [ + "The was no indexUpdateBlock; just reverse the elements" + [ start < end ] whileTrue: [ + element := array at: start. + array + at: start put: (array at: end); + at: end put: element. + start := start + 1. + end := end - 1 ]. + ^self ]. + "Restore indexUpdateBlock, reverse the elements and update the indices." + indexUpdateBlock := originalIndexUpdateBlock. + start := 1. + [ start < end ] whileTrue: [ + | endValue | + element := array at: start. + endValue := array at: end. + array + at: start put: endValue; + at: end put: element. + indexUpdateBlock + value: endValue value: start; + value: element value: end. + start := start + 1. + end := end - 1 ]. + start = end ifTrue: [ indexUpdateBlock value: (array at: start) value: start ]! Item was changed: ----- Method: Heap>>sortBlock: (in category 'accessing') ----- sortBlock: aBlock + + | oldIndexUpdateBlock | sortBlock := aBlock. + "Restore the heap invariant." + tally <= 1 ifTrue: [ ^self ]. + oldIndexUpdateBlock := indexUpdateBlock. + indexUpdateBlock := nil. + (tally bitShift: -1) to: 1 by: -1 do: [ :index | self downHeap: index ]. + indexUpdateBlock := oldIndexUpdateBlock ifNil: [ ^self ]. + 1 to: tally do: [ :index | + indexUpdateBlock value: (array at: index) value: index ] + + ! - self reSort.! Item was changed: ----- Method: Heap>>upHeap: (in category 'private-heap') ----- upHeap: anIndex "Check the heap upwards for correctness starting at anIndex. Everything below anIndex is ok." + + | index parentValue parentIndex value | + anIndex = 1 ifTrue: [ ^self ]. + value := array at: (index := anIndex). + [ index > 1 and: [ + parentValue := array at: (parentIndex := index bitShift: -1). + sortBlock + ifNil: [ value <= parentValue ] + ifNotNil: [ sortBlock value: value value: parentValue ] ] ] + whileTrue: [ + array at: index put: parentValue. + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: parentValue value: index ]. + index := parentIndex ]. + array at: index put: value. + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: value value: index ]! - | value k kDiv2 tmp | - anIndex = 0 ifTrue:[^self]. - k := anIndex. - value := array at: anIndex. - [ (k > 1) and:[self sorts: value before: (tmp := array at: (kDiv2 := k bitShift: -1))] ] - whileTrue:[ - array at: k put: tmp. - self updateObjectIndex: k. - k := kDiv2]. - array at: k put: value. - self updateObjectIndex: k.!

1 0

The Trunk: Graphics-topa.341.mcz
by commits＠source.squeak.org 01 Jun '16

01 Jun '16

Tobias Pape uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-topa.341.mcz ==================== Summary ==================== Name: Graphics-topa.341 Author: topa Time: 1 June 2016, 11:41:14.5378 pm UUID: 6b532963-62f7-4713-8668-99d5d3c7fc5f Ancestors: Graphics-topa.340 Let text styels present themselves =============== Diff against Graphics-topa.340 =============== Item was added: + ----- Method: TextStyle>>asStringOrText (in category 'accessing') ----- + asStringOrText + "be fancy" + ^ self defaultFont familyName asText + addAttribute: (TextFontReference toFont: self defaultFont); + yourself!

1 0

The Trunk: Morphic-mt.1157.mcz
by commits＠source.squeak.org 01 Jun '16

01 Jun '16

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1157.mcz ==================== Summary ==================== Name: Morphic-mt.1157 Author: mt Time: 1 June 2016, 4:45:15.847666 pm UUID: b3500079-b6e7-af43-9e06-7df9250fb1f8 Ancestors: Morphic-mt.1156 Grab the keyboard focus if models request that. Models have to use the respective selectors (get or set) so that the correct widget will grab the keyboard focus. =============== Diff against Morphic-mt.1156 =============== Item was added: + ----- Method: PluggableListMorph>>update:with: (in category 'updating') ----- + update: aSymbol with: arg1 + + (aSymbol == #inputRequested and: [getIndexSelector == arg1 or: [setIndexSelector == arg1]]) + ifTrue: [self activeHand newKeyboardFocus: self]. + + super update: aSymbol with: arg1.! Item was added: + ----- Method: PluggableTextMorph>>setTextSelector (in category 'accessing') ----- + setTextSelector + ^setTextSelector! Item was changed: ----- Method: PluggableTextMorph>>update:with: (in category 'updating') ----- update: aSymbol with: arg1 + aSymbol == #editString ifTrue:[ self editString: arg1. self hasUnacceptedEdits: true. ]. + + (aSymbol == #inputRequested and: [self getTextSelector == arg1 or: [self setTextSelector == arg1]]) + ifTrue: [self activeHand newKeyboardFocus: self]. + ^super update: aSymbol with: arg1!

1 0

The Trunk: ToolBuilder-Morphic-mt.165.mcz
by commits＠source.squeak.org 01 Jun '16

01 Jun '16

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.165.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.165 Author: mt Time: 1 June 2016, 4:43:17.541666 pm UUID: eb5a9bb7-d38f-c84d-bf97-5643786996e8 Ancestors: ToolBuilder-Morphic-cmm.164 Our list choosers use system windows. Request input for specific data. Use that to update the current keyboard focus. See #update:with: in pluggable list and text morphs. =============== Diff against ToolBuilder-Morphic-cmm.164 =============== Item was changed: ----- Method: ListChooser>>chooseItemFrom:title:addAllowed: (in category 'initialize-release') ----- chooseItemFrom: labelList title: aString addAllowed: aBoolean fullList := labelList asOrderedCollection. "coerce everything into an OC" builder := ToolBuilder default. self list: fullList. self title: aString. addAllowed := aBoolean. window := ToolBuilder default open: self. window center: Sensor cursorPoint. window setConstrainedPosition: (Sensor cursorPoint - (window fullBounds extent // 2)) hangOut: false. + + self changed: #inputRequested with: #searchText. + window lookFocused. "Sigh..." + builder runModal: window. ^ result! Item was changed: ----- Method: ListMultipleChooser>>choose (in category 'actions') ----- choose | builder window | builder := ToolBuilder default. window := builder open: self.. window center: Sensor cursorPoint. "Avoid morphic dependency here..." + + self changed: #inputRequested with: #selectedIndex. + window lookFocused. "Sigh..." + builder runModal: window. ^ self selectedValues!

1 0

The Trunk: Morphic-mt.1156.mcz
by commits＠source.squeak.org 01 Jun '16

01 Jun '16

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1156.mcz ==================== Summary ==================== Name: Morphic-mt.1156 Author: mt Time: 1 June 2016, 4:09:34.015287 pm UUID: 522ade56-9b2e-f749-bb5c-cb117aa97c56 Ancestors: Morphic-topa.1155 If #mouseOverForKeyboardFocus is disabled, do not highlight (a.k.a. "look focused") background windows on mouse-enter, even if they are active due to the preference "Windows' Contents Are Always Active". Note that there is still a bug, which I intend to fix if the event filters make it into the trunk. Namely, if you "debug it" and expression via the context menu, the appearing debugger will not be the top window. An additional click is required. Sorry for this inconvenience. =============== Diff against Morphic-topa.1155 =============== Item was changed: MorphicModel subclass: #SystemWindow + instanceVariableNames: 'labelString stripes label closeBox collapseBox paneMorphs paneRects collapsedFrame fullFrame isCollapsed isActive isLookingFocused menuBox mustNotClose labelWidgetAllowance updatablePanes allowReframeHandles labelArea expandBox' - instanceVariableNames: 'labelString stripes label closeBox collapseBox paneMorphs paneRects collapsedFrame fullFrame isCollapsed isActive menuBox mustNotClose labelWidgetAllowance updatablePanes allowReframeHandles labelArea expandBox' classVariableNames: 'ClickOnLabelToEdit CloseBoxFrame CloseBoxImageFlat CloseBoxImageGradient CollapseBoxImageFlat CollapseBoxImageGradient DoubleClickOnLabelToExpand ExpandBoxFrame ExpandBoxImageFlat ExpandBoxImageGradient FocusFollowsMouse GradientWindow HideExpandButton MenuBoxFrame MenuBoxImageFlat MenuBoxImageGradient ResizeAlongEdges ReuseWindows TopWindow WindowTitleActiveOnFirstClick WindowsRaiseOnClick' poolDictionaries: '' category: 'Morphic-Windows'! !SystemWindow commentStamp: '<historical>' prior: 0! SystemWindow is the Morphic equivalent of StandardSystemView -- a labelled container for rectangular views, with iconic facilities for close, collapse/expand, and resizing. The attribute onlyActiveOnTop, if set to true (and any call to activate will set this), determines that only the top member of a collection of such windows on the screen shall be active. To be not active means that a mouse click in any region will only result in bringing the window to the top and then making it active.! Item was added: + ----- Method: SystemWindow>>activateIfNeeded: (in category 'focus') ----- + activateIfNeeded: evt + "Make me the new key window if needed. Ensure that the focus look matches the keyboard focus." + + (self isKeyWindow not + and: [self class windowsRaiseOnClick + or: [self windowDecorations anySatisfy: [:morph | morph bounds containsPoint: evt position]] ]) + ifTrue: [self beKeyWindow] + ifFalse: [self updateFocusLookForKeyboardFocus].! Item was changed: ----- Method: SystemWindow>>handleMouseDown: (in category 'events') ----- handleMouseDown: evt - - "If my submorphs handled the events, we still need to use this hook to raise." - (self isKeyWindow not - and: [self class windowsRaiseOnClick - or: [self windowDecorations anySatisfy: [:morph | morph bounds containsPoint: evt position]] ]) - ifTrue: [self beKeyWindow]. + self activateIfNeeded: evt. ^ super handleMouseDown: evt! Item was added: + ----- Method: SystemWindow>>handleMouseUp: (in category 'events') ----- + handleMouseUp: evt + + self activateIfNeeded: evt. + ^ super handleMouseUp: evt! Item was added: + ----- Method: SystemWindow>>isLookingFocused (in category 'focus') ----- + isLookingFocused + + ^ isLookingFocused ifNil: [false]! Item was added: + ----- Method: SystemWindow>>isLookingFocused: (in category 'focus') ----- + isLookingFocused: aBoolean + + isLookingFocused := aBoolean.! Item was changed: ----- Method: SystemWindow>>lookFocused (in category 'focus') ----- lookFocused + + "Optimize performance." + self isLookingFocused ifTrue: [^ self]. + self isLookingFocused: true. + label ifNotNil: [ label color: Color black ]. (self isKeyWindow or: [self class windowTitleActiveOnFirstClick]) ifTrue: [self undimWindowButtons]. self paneColorToUse in: [ : col | self setStripeColorsFrom: col ; adoptPaneColor: col].! Item was changed: ----- Method: SystemWindow>>lookUnfocused (in category 'focus') ----- lookUnfocused + + "Optimize performance." + self isLookingFocused ifFalse: [^ self]. + self isLookingFocused: false. + label ifNotNil: [ label color: Color darkGray ]. self dimWindowButtons. self paneColorToUseWhenNotActive in: [ : col | self setStripeColorsFrom: col ; adoptPaneColor: col ]! Item was changed: ----- Method: SystemWindow>>mouseEnter: (in category 'events') ----- mouseEnter: anEvent "Handle a mouseEnter event, meaning the mouse just entered my bounds with no button pressed. The default response is to let my eventHandler, if any, handle it." super mouseEnter: anEvent. + (self isActive and: [Preferences mouseOverForKeyboardFocus]) + ifTrue: [self lookFocused].! - self isActive ifTrue: [self lookFocused].! Item was changed: ----- Method: SystemWindow>>mouseLeave: (in category 'events') ----- mouseLeave: anEvent "Handle a mouseEnter event, meaning the mouse just entered my bounds with no button pressed. The default response is to let my eventHandler, if any, handle it." super mouseLeave: anEvent. + (model windowActiveOnFirstClick and: [Preferences mouseOverForKeyboardFocus + or: [anEvent hand keyboardFocus notNil and: [anEvent hand keyboardFocus containingWindow ~= self]]]) + ifTrue: [self lookUnfocused].! - model windowActiveOnFirstClick ifTrue: [self lookUnfocused].! Item was changed: ----- Method: SystemWindow>>mouseLeaveDragging: (in category 'events') ----- mouseLeaveDragging: evt + "Passivate after drop operations if needed. Unfortunately, we get a leave-dragging event for the system window we want to drag. Watch out for it." - "Passivate after drop operations if needed." + ((model windowActiveOnFirstClick and: [(evt hand submorphs includes: self) not]) + or: [self isKeyWindow not]) + ifTrue: [self lookUnfocused]. + - model windowActiveOnFirstClick ifTrue: [self lookUnfocused]. - (self isKeyWindow not and: [evt hand hasSubmorphs]) ifTrue:[ self passivateIfNeeded. evt hand removeMouseListener: self. "no more drop completion possible on submorph" ].! Item was changed: ----- Method: SystemWindow>>openAsIsIn: (in category 'open/close') ----- openAsIsIn: aWorld "This msg and its callees result in the window being activeOnlyOnTop" aWorld addMorph: self. self beKeyWindow. + aWorld startSteppingSubmorphsOf: self.! - aWorld startSteppingSubmorphsOf: self. - self activeHand - releaseKeyboardFocus; - releaseMouseFocus.! Item was changed: ----- Method: SystemWindow>>openInWorld: (in category 'open/close') ----- openInWorld: aWorld "This msg and its callees result in the window being activeOnlyOnTop" + ^ self anyOpenWindowLikeMe - [^ self anyOpenWindowLikeMe ifEmpty: [ self bounds: (RealEstateAgent initialFrameFor: self world: aWorld) ; openAsIsIn: aWorld ] ifNotEmptyDo: [ : windows | windows anyOne expand ; beKeyWindow ; + postAcceptBrowseFor: self ].! - postAcceptBrowseFor: self ]. - ] ensure: [ - self activeHand - releaseKeyboardFocus; - releaseMouseFocus. ]! Item was changed: ----- Method: SystemWindow>>openInWorld:extent: (in category 'open/close') ----- openInWorld: aWorld extent: extent "This msg and its callees result in the window being activeOnlyOnTop" + ^ self anyOpenWindowLikeMe - [^ self anyOpenWindowLikeMe ifEmpty: [ self position: (RealEstateAgent initialFrameFor: self initialExtent: extent world: aWorld) topLeft ; extent: extent. self openAsIsIn: aWorld ] ifNotEmptyDo: [ : windows | windows anyOne expand ; beKeyWindow ; + postAcceptBrowseFor: self ].! - postAcceptBrowseFor: self ]. - ] ensure: [ - self activeHand - releaseKeyboardFocus; - releaseMouseFocus. ]! Item was changed: ----- Method: SystemWindow>>passivate (in category 'focus') ----- passivate "Reconfigure my focus according to preferences." self isActive ifFalse: [^ self]. self isActive: false. self isCollapsed ifFalse: [model modelSleep]. self submorphsDo: [:each | each lock]. + self activeHand keyboardFocus ifNotNil: [:morph | + morph containingWindow == self + ifTrue: [self activeHand releaseKeyboardFocus]]. + self lookUnfocused.! Item was changed: ----- Method: SystemWindow>>updateFocusLookAtHand (in category 'focus') ----- updateFocusLookAtHand "If there is more than one active window, look for the mouse cursor and update the window focus look accordingly. This method is not on the class-side because we need our world and some active hand." + (model windowActiveOnFirstClick and: [Preferences mouseOverForKeyboardFocus]) + ifFalse: [self updateFocusLookForKeyboardFocus] + ifTrue: [ + ((self class windowsIn: self world) + do: [:window | window lookUnfocused]; + select: [:window | window bounds containsPoint: self activeHand position]) + ifNotEmpty: [:windowsPointed | windowsPointed first lookFocused "only to foremost window"]].! - model windowActiveOnFirstClick ifFalse: [^ self]. - - ((self class windowsIn: self world) - do: [:window | window lookUnfocused]; - select: [:window | window bounds containsPoint: self activeHand position]) - ifNotEmpty: [:windowsPointed | windowsPointed first lookFocused "only to foremost window"].! Item was added: + ----- Method: SystemWindow>>updateFocusLookForKeyboardFocus (in category 'focus') ----- + updateFocusLookForKeyboardFocus + + | f w | + (((f := self activeHand keyboardFocus) notNil and: [(w := f containingWindow) notNil]) + and: [w isActive]) + ifTrue: [ + (self class windowsIn: self world) do: [:window | window lookUnfocused]. + w lookFocused]!

1 0

← Newer
1
2
3
4
5
6
7
8
9
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages June 2016