[vwnc] Heckbert Color Quantization

Hello...

Here's the source code I wrote... whoa... 9 years ago.

Hopefully this helps.

Andres.

'From Squeak 2.3 of January 14, 1999 on 10 June 1999 at 6:13:20 pm'! "Change Set: Color quantization Date: 8 March 1999 Author: Andres Valloud Color reduction for forms using Heckbert's median cut algorithm."! Object subclass: #Cache instanceVariableNames: 'contents ' classVariableNames: '' poolDictionaries: '' category: 'Mathematics-Caches'! Object subclass: #ColorProxy instanceVariableNames: 'red green blue ' classVariableNames: '' poolDictionaries: '' category: 'Mathematics-Colors'! Object subclass: #ColorReducer instanceVariableNames: 'rgbPartition pixelValueTally usesProxies ' classVariableNames: '' poolDictionaries: '' category: 'Mathematics-Colors'! Object subclass: #EuclideanRegion instanceVariableNames: 'start stop ' classVariableNames: '' poolDictionaries: '' category: 'Mathematics-Intervals'! Cache subclass: #KeySortingCache instanceVariableNames: 'keys ' classVariableNames: '' poolDictionaries: '' category: 'Mathematics-Caches'! Object subclass: #QuickSearch instanceVariableNames: 'target collection ' classVariableNames: '' poolDictionaries: '' category: 'Collections-Algorithms'! Object subclass: #RGBSpacePartition instanceVariableNames: 'boxes ' classVariableNames: '' poolDictionaries: '' category: 'Mathematics-Colors'! KeySortingCache subclass: #SortedCache instanceVariableNames: 'qSearch ' classVariableNames: '' poolDictionaries: '' category: 'Mathematics-Caches'! EuclideanRegion subclass: #ThreeDeeBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Mathematics-Intervals'! ThreeDeeBox subclass: #RGBSpaceBox instanceVariableNames: 'colors colorSortCache dominantSpan colorSpan ' classVariableNames: '' poolDictionaries: '' category: 'Mathematics-Colors'! Object subclass: #Tuple instanceVariableNames: 'contents scalarAmbient ' classVariableNames: 'DefaultScalarAmbient ' poolDictionaries: '' category: 'Mathematics-LinearAlgebra: Tuples'! Tuple class instanceVariableNames: 'scalarAmbient '! !Cache reorganize! ('Accessing' at: at:ifAbsentEvaluate: at:put: cachedKeys cachedValueFor: forget:) ('Enumerating' forgetAllThat:) ('Testing' hasCachedValueFor:) ('Private-Accessors' contents contents:) ('Private-Initializing' initialize) ! !Cache methodsFor: 'Accessing' stamp: 'SqR 11/25/97 06:11'! at: anObject "Answer the cached value for anObject. If no value is cached, answer an error" ^self contents at: anObject! ! !Cache methodsFor: 'Accessing' stamp: 'SqR!!!!!!!! 9/11/1998 23:55'! at: aKey ifAbsentEvaluate: aBlock "Answer the cached value for aKey. If no cached value for aKey is present in the receiver, evaluate aBlock, cache its evaluation and answer it" ^contents at: aKey ifAbsent: [self at: aKey put: aBlock value]! ! !Cache methodsFor: 'Accessing' stamp: 'SqR 11/25/97 06:11'! at: anObject put: aValue "Set the cached value to anObject. Answer aValue" ^self contents at: anObject put: aValue! ! !Cache methodsFor: 'Accessing' stamp: 'SqR 11/25/97 06:26'! cachedKeys "Answer a set containing the cached objects in the receiver" ^self contents keys asSet! ! !Cache methodsFor: 'Accessing' stamp: 'SqR 11/25/97 06:17'! cachedValueFor: anObject "Answer the cached value for anObject. If no cached value is available, answer nil" ^self contents at: anObject ifAbsent: []! ! !Cache methodsFor: 'Accessing' stamp: 'SqR 11/25/97 06:27'! forget: anObject "Remove anObject and its cached value from the receiver. Answer the value forgotten" ^self contents removeKey: anObject! ! !Cache methodsFor: 'Enumerating' stamp: 'SqR 11/25/97 06:26'! forgetAllThat: aBlock "Forget all values for objects such that aBlock evaluates true on them" (self cachedKeys select: aBlock) do: [:each | self forget: each] ! ! !Cache methodsFor: 'Testing' stamp: 'SqR 11/25/97 06:14'! hasCachedValueFor: anObject "Answer true if the receiver has a cached value for anObject" ^self contents includesKey: anObject! ! !Cache methodsFor: 'Private-Accessors' stamp: 'SqR 11/25/97 06:06'! contents "Answer the contents" ^contents! ! !Cache methodsFor: 'Private-Accessors' stamp: 'SqR 11/25/97 06:06'! contents: anObject "Set the contents to anObject" contents := anObject! ! !Cache methodsFor: 'Private-Initializing' stamp: 'SqR 11/25/97 06:05'! initialize "Initialize the receiver" self contents: Dictionary new! ! !Cache class reorganize! ('Instance creation' new) ! !Cache class methodsFor: 'Instance creation' stamp: 'SqR 11/25/97 06:05'! new "Answer a new instance of the receiver" ^super new initialize! ! !Color methodsFor: 'queries' stamp: 'SqR!!!! 2/26/1999 22:29'! < aColor "Answer true if, lexicographically in the BGR sense, the receiver is less than aColor" ^rgb < aColor privateRGB! ! !Color methodsFor: 'queries' stamp: 'SqR!!!! 4/9/1999 06:12'! distanceTo5bit: anInteger "Answer the distance to anInteger, ranging from 0 to 3139587 in the RGB cube. This is like || self - aColor ||^2. SqR!! 3/7/1999 21:29. anInteger is [5 bits red][5 bits green][5 bits blue] " | blueSummand greenSummand redSummand | redSummand _ (rgb bitShift: -20) - ((anInteger bitAnd: 16r7C00) bitShift: -5). greenSummand _ ((rgb bitShift: -10) bitAnd: 16r3FF) - (anInteger bitAnd: 16r3E0). blueSummand _ (rgb bitAnd: 16r3FF) - ((anInteger bitAnd: 16r1F) bitShift: 5). ^(redSummand * redSummand) + (greenSummand * greenSummand) + (blueSummand * blueSummand)! ! !Color methodsFor: 'queries' stamp: 'SqR!!!! 3/8/1999 20:49'! distanceTo: aColor "Answer the distance to aColor, ranging from 0 to 3139587 in the RGB cube. This is like || self - aColor ||^2. SqR!! 3/7/1999 21:26" | aRGB blueSummand greenSummand redSummand | aRGB _ aColor privateRGB. redSummand _ (rgb bitShift: -20) - (aRGB bitShift: -20). greenSummand _ ((rgb bitShift: -10) bitAnd: 16r3FF) - ((aRGB bitShift: -10) bitAnd: 16r3FF). blueSummand _ (rgb bitAnd: 16r3FF) - (aRGB bitAnd: 16r3FF). ^(redSummand * redSummand) + (greenSummand * greenSummand) + (blueSummand * blueSummand)! ! !ColorProxy reorganize! ('accessing' blue blue: green green: red red:) ('printing' printOn:) ('testing' = hash) ! !ColorProxy methodsFor: 'accessing' stamp: 'SqR!!!! 3/7/1999 22:33'! blue ^blue! ! !ColorProxy methodsFor: 'accessing' stamp: 'SqR!!!! 3/7/1999 22:33'! blue: aNumber blue _ aNumber! ! !ColorProxy methodsFor: 'accessing' stamp: 'SqR!!!! 3/7/1999 22:33'! green ^green! ! !ColorProxy methodsFor: 'accessing' stamp: 'SqR!!!! 3/7/1999 22:33'! green: aNumber green _ aNumber! ! !ColorProxy methodsFor: 'accessing' stamp: 'SqR!!!! 3/7/1999 22:33'! red ^red! ! !ColorProxy methodsFor: 'accessing' stamp: 'SqR!!!! 3/7/1999 22:33'! red: aNumber red _ aNumber! ! !ColorProxy methodsFor: 'printing' stamp: 'SqR!!!! 3/8/1999 20:33'! printOn: aStream aStream nextPutAll: self class name. aStream nextPutAll: '(r: '. red printOn: aStream. aStream nextPutAll: ', g: '. green printOn: aStream. aStream nextPutAll: ', b: '. blue printOn: aStream. aStream nextPut: $)! ! !ColorProxy methodsFor: 'testing' stamp: 'SqR!!!! 3/23/1999 14:28'! = aColorOrProxy ^red = aColorOrProxy red and: [green = aColorOrProxy green and: [blue = aColorOrProxy blue]]! ! !ColorProxy methodsFor: 'testing' stamp: 'SqR!!!! 3/7/1999 22:40'! hash ^(red*green*blue) hash! ! !ColorProxy class reorganize! ('instance creation' fromColor: r:g:b:) ! !ColorProxy class methodsFor: 'instance creation' stamp: 'SqR!!!! 3/24/1999 13:23'! fromColor: aColor ^self r: aColor privateRed / 1023.0 g: aColor privateGreen / 1023.0 b: aColor privateBlue / 1023.0! ! !ColorProxy class methodsFor: 'instance creation' stamp: 'SqR!!!! 3/7/1999 22:34'! r: r g: g b: b "Answer a new proxy that will mimick Color r: r g: g b: b" ^self new red: r; green: g; blue: b! ! !ColorReducer commentStamp: 'SqR!! 3/8/1999 22:14' prior: 0! Hi. This class' instances take a Form with too many colors and answer a ColorForm with the specified amount of colors. It performs then color quantization of forms. It uses the... Heckbert's median cut color quantization algorithm. Let's see it progressively. 0. There's an RGB partition of the RGB space cube in parallepipeds... rectangular prisms which we'll call boxes. Such boxes contain a number of colors. 1. Box minimizing algorithm. The box is reduced to that it exactly encloses all colors within itself. For instance, the sub box containing r:0.5 g:0.5 b:0.5 and Color white, being the whole RGB cube is reduced to 0.5,0.5,0.5 to 1.0,1.0,1.0. All boxes in a Heckbert partition should comply with this. 2. The dominant dimension of a box is the axis on which it spans more. 3. Median of the dominant dimension. Take all the colors and sort them by the dominant dimension (R, G or B). Odd amount of colors ifTrue: [median is the value of the dominant dimension of the color at the middle] ifFalse: [the average of such values of the two center colors]. 4. Splitting algorithm. Sort the boxes by their span of their dominant dimensions. Take the one which has the greatest span in its dominant dimension. Generate two other minimized boxes by cutting the original one at the median value in the dominant dimension (hint: Heckbert says nothing about this generating a plane instead of a box, coplanar colors... check both variants of box splitting in RGBSpaceBox). Discard the original box and add the two new boxes to the partition. The new boxes contain the colors of the original box. 5. Box representative. Take all colors. Sum all their coordinates separately (ie, generate redSum, greenSum, blueSum). Divide by amount of colors. Answer Color r: redAverage g: greenAverage b: blueAverage. 6. Heckbert color quantization, median cut algorithm. Generate a partition with 1 minimized box containing all colors you want to quantize. If you need n colors, then apply the splitting algorithm n-1 times. Your quantized colors are the representatives of the boxes left. Ok now you have your representatives. All you have to do now is to determine, for all colors present in your source, which representative color is closest to every original color and then perform theBigReplacement. Heckbert doesn't do this, he actually has a big hashing structure and choses something like 'not the most close but close enough so that nobody notices' color. Amazingly enough, he doesn't perform caching (or it's not described in his paper). Furthermore, color reduction can be done in different ways. This class implements direct color reduction, no dithering, no error propagation, no nothing. Then, it can do it in 3 different ways: * Full precision color reduction * BitBlt color reduction * BitBlt color reduction with proxies The first one is intended for super quality results, but it's *VERY* slow. The seconds does all the thing with 15 bit color precision. *VERY* fast, it takes, roughly speaking, one 30th of the time needed to execute the first. Both methods can take advantage of ColorProxies, which are a fast simulation of Color to speed up things. For instance, the second method is about 25% faster when using ColorProxies. But the results are somewhat worse than with regular colors. It shouldn't be like that but I haven't still figured out where's the problem yet. By default, ColorProxies are not used when reducing colors. Andres Valloud. SqR!! 3/8/1999 22:07.! !ColorReducer reorganize! ('color determination' closestColorFrom:to: closestColorIndexFrom:to5bit: closestColorIndexFrom:to: renderColorMapFor:into:) ('color reduction' bitBltReduce:to: directReduce:to: useProxies: usesProxies) ('color quantization' quantizate:to: tallyFillPartition:) ! !ColorReducer methodsFor: 'color determination' stamp: 'SqR!!!! 2/26/1999 22:08'! closestColorFrom: colorArray to: singleColor "Ouch!!" ^colorArray at: (self closestColorIndexFrom: colorArray to: singleColor)! ! !ColorReducer methodsFor: 'color determination' stamp: 'SqR!!!! 4/9/1999 06:03'! closestColorIndexFrom: colorArray to5bit: anInteger "Ouch!!" | minIndex minDistance cDistance | minDistance _ 5000000. "Actually, the max value is 3139587" 1 to: colorArray size do: [:each | (cDistance _ (colorArray at: each) distanceTo5bit: anInteger) < minDistance ifTrue: [minIndex _ each. minDistance _ cDistance]. ]. ^minIndex! ! !ColorReducer methodsFor: 'color determination' stamp: 'SqR!!!! 3/7/1999 22:26'! closestColorIndexFrom: colorArray to: singleColor "Ouch!!" | minIndex minDistance cDistance | minDistance _ 5000000. "Actually, the max value is 3139587" 1 to: colorArray size do: [:each | (cDistance _ singleColor distanceTo: (colorArray at: each)) < minDistance ifTrue: [minIndex _ each. minDistance _ cDistance]. ]. ^minIndex! ! !ColorReducer methodsFor: 'color determination' stamp: 'SqR!!!! 4/11/1999 19:18'! renderColorMapFor: source into: newColors "Answer a color map that translates the colors present in source into the newColors color set" | bitmap | pixelValueTally isNil ifTrue: [pixelValueTally _ source tallyPixelValues]. bitmap _ Bitmap new: pixelValueTally size. 1 to: pixelValueTally size do: [:each | (pixelValueTally at: each) = 0 ifFalse: [bitmap at: each put: (self closestColorIndexFrom: newColors to5bit: each - 1) - 1] ]. ^bitmap! ! !ColorReducer methodsFor: 'color reduction' stamp: 'SqR!!!! 4/11/1999 19:42'! bitBltReduce: aForm to: anInteger "Answer a ColorForm with anInteger colors, the color reduced copy of aForm. Use a direct method for color rendering. Use BitBlt operations, which impose a 15-bit color precision restriction. Very much faster" | newColors source dest aBitBlt colorMap destDepth | destDepth _ (anInteger - 1) highBit. source _ aForm depth = 32 ifTrue: [aForm] ifFalse: [aForm asFormOfDepth: 32]. newColors _ self quantizate: source to: anInteger. colorMap _ self renderColorMapFor: source into: newColors. dest _ ColorForm extent: source extent depth: destDepth. aBitBlt _ BitBlt toForm: dest. aBitBlt sourceForm: source; combinationRule: Form paint; colorMap: colorMap; sourceOrigin: 0@0; destOrigin: 0@0; destRect: source boundingBox; sourceRect: source boundingBox; copyBits. ^dest colors: newColors! ! !ColorReducer methodsFor: 'color reduction' stamp: 'SqR!!!! 3/7/1999 22:25'! directReduce: aForm to: anInteger "Answer a ColorForm with anInteger colors, the color reduced copy of aForm. Use a direct method for color rendering" | newColors answer cPoint colorDistanceCache | newColors _ (self quantizate: aForm to: anInteger) asArray. answer _ (ColorForm extent: aForm extent depth: 8) colors: newColors. colorDistanceCache _ Cache new. cPoint _ 0@0. 0 to: aForm extent y - 1 do: [:eachY | cPoint setY: eachY. 0 to: aForm extent x - 1 do: [:eachX | cPoint setX: eachX. answer pixelValueAt: cPoint put: (colorDistanceCache at: (aForm colorAt: cPoint) ifAbsentEvaluate: [(self closestColorIndexFrom: newColors to: (aForm colorAt: cPoint)) - 1] ) ]. ]. ^answer! ! !ColorReducer methodsFor: 'color reduction' stamp: 'SqR!!!! 3/8/1999 22:05'! useProxies: aBoolean usesProxies _ aBoolean! ! !ColorReducer methodsFor: 'color reduction' stamp: 'SqR!!!! 3/8/1999 22:05'! usesProxies ^usesProxies! ! !ColorReducer methodsFor: 'color quantization' stamp: 'SqR!!!! 4/11/1999 19:53'! quantizate: aForm to: amountOfColors "Answer an amount of colors quantizated from the colors in aForm" "Follow Heckbert's median cut algorithm" | index somethingLeft | rgbPartition _ RGBSpacePartition new. pixelValueTally _ aForm tallyPixelValues. "The first line uses color proxies, somewhat faster but the result is also a bit worse. The second line is slower but the output is better." "Later note: seems I fixed precision loss with the proxies" usesProxies "ifTrue: [aForm colorsUsed do: [:each | rgbPartition addColorProxy: each]]" ifTrue: ["aForm colorsUsed size timesRepeat:" self tallyFillPartition: rgbPartition] ifFalse: [aForm colorsUsed do: [:each | rgbPartition addColor: each]]. rgbPartition initializeHeckbert. index _ 1. somethingLeft _ true. [index = amountOfColors or: [somethingLeft not]] whileFalse: [ somethingLeft _ rgbPartition refineHeckbert. index _ index + 1. ]. ^(rgbPartition boxes collect: [:some | some representative]) asArray! ! !ColorReducer methodsFor: 'color quantization' stamp: 'SqR!!!! 3/23/1999 14:19'! tallyFillPartition: aPartition | bitsPerGun normalizer bitMask redShift greenShift realIndex | bitsPerGun _ (pixelValueTally size - 1) highBit // 3 "5". bitMask _ bitsPerGun ones. normalizer _ bitMask asFloat. greenShift _ 0 - bitsPerGun. redShift _ greenShift + greenShift. 1 to: pixelValueTally size do: [:each | (pixelValueTally at: each) = 0 ifFalse: [ realIndex _ each - 1. aPartition addColor: (ColorProxy r: ((realIndex bitShift: redShift) bitAnd: bitMask) / normalizer g: ((realIndex bitShift: greenShift) bitAnd: bitMask) / normalizer b: (realIndex bitAnd: bitMask) / normalizer ) ] ]! ! !ColorReducer class reorganize! ('instance creation' new) ! !ColorReducer class methodsFor: 'instance creation' stamp: 'SqR!!!! 3/24/1999 12:46'! new ^super new useProxies: true! ! !EuclideanRegion reorganize! ('Accessing' center size start stop) ('Fast access' start:stop:) ('Operating' growSoThatEncloses: growSoThatIncludes:) ('Testing' = hash) ('Private' initialize:to:) ! !EuclideanRegion methodsFor: 'Accessing' stamp: 'SqR!!!! 2/21/1999 23:38'! center "Answer the center of the receiver" ^(start + stop) / 2! ! !EuclideanRegion methodsFor: 'Accessing' stamp: 'SqR!!!! 2/21/1999 23:38'! size ^self subclassResponsibility! ! !EuclideanRegion methodsFor: 'Accessing' stamp: 'SqR!!!! 2/21/1999 23:39'! start ^start! ! !EuclideanRegion methodsFor: 'Accessing' stamp: 'SqR!!!! 2/21/1999 23:39'! stop ^stop! ! !EuclideanRegion methodsFor: 'Testing' stamp: 'SqR!!!! 2/21/1999 23:40'! hash "Answer the hash of the receiver" ^start hash bitXor: stop hash! ! !EuclideanRegion methodsFor: 'Private' stamp: 'SqR!!!! 2/21/1999 23:14'! initialize: otherObject to: someObject "Blah!!" start _ otherObject. stop _ someObject! ! !EuclideanRegion class reorganize! ('Instance creation' from:to:) ! !EuclideanRegion class methodsFor: 'Instance creation' stamp: 'SqR!!!! 2/21/1999 23:14'! from: someObject to: otherObject "Answer a blablabla, you already know" ^super new initialize: someObject to: otherObject! ! !KeySortingCache reorganize! ('Accessing' at:put: forget: sortedCachedKeys) ('Private-Accessors' keys keys:) ('Private-Initializing' initialize) ! !KeySortingCache methodsFor: 'Accessing' stamp: 'SqR 11/25/97 07:12'! at: anObject put: aValue "Set the cached value for anObject to aValue. Answer aValue" self keys add: anObject. ^super at: anObject put: aValue! ! !KeySortingCache methodsFor: 'Accessing' stamp: 'SqR 11/25/97 06:31'! forget: anObject "Forget the cached value for anObject. Answer the forgotten value" super forget: anObject. ^self keys remove: anObject! ! !KeySortingCache methodsFor: 'Accessing' stamp: 'SqR 11/25/97 06:32'! sortedCachedKeys "Answer a sorted collection with the keys of the receiver" ^self keys! ! !KeySortingCache methodsFor: 'Private-Accessors' stamp: 'SqR 11/25/97 06:29'! keys "Answer the keys of the receiver" ^keys! ! !KeySortingCache methodsFor: 'Private-Accessors' stamp: 'SqR 11/25/97 06:29'! keys: anObject "Set the keys of the receiver to anObject" keys := anObject! ! !KeySortingCache methodsFor: 'Private-Initializing' stamp: 'SqR 11/25/97 06:28'! initialize "Initialize the receiver" super initialize. self keys: SortedCollection new! ! !Number methodsFor: 'converting'! , aNumber
        "Answer the tuple (receiver, aNumber)"

        ^Tuple with: (Array with: self with: aNumber)! ! !Integer methodsFor: 'bit manipulation'! ones "Answer an integer which in binary is the receiver ones" ^(1 bitShift: self) - 1! ! !Point methodsFor: 'private' stamp: 'SqR!!!!!!!! 12/5/1998 23:51'! setX: xPoint "SqR!! 12/5/1998 23:51" x _ xPoint.! ! !Point methodsFor: 'private' stamp: 'SqR!!!!!!!! 12/5/1998 23:51'! setY: yPoint "SqR!! 12/5/1998 23:51" y _ yPoint.! ! !QuickSearch reorganize! ('Searching' findFirst: qDupeSearch: qSearch: searchOn:) ('Private-Accessors' collection collection: target target:) ('Private-Initializing' initialize:) ('Private-Searching' dupeSearchFrom:to: findFirstFrom:to: is:leq: qDupeSearchFrom:to: qSearchFrom:to:) ! !QuickSearch methodsFor: 'Searching' stamp: 'SqR 1/14/98 20:05'! findFirst: aBlock "Answer the first element in the collection that makes aBlock evaluate to true. It is assumed that aBlock induces an order in the collection and that such collection is already sorted with respect to aBlock" ^self collection size = 0 ifTrue: [0] ifFalse: [ self target: aBlock; findFirstFrom: 1 to: self collection size ]! ! !QuickSearch methodsFor: 'Searching' stamp: 'SqR 1/14/98 20:03'! qDupeSearch: anObject "Answer the index of anObject in the collection" ^self collection size = 0 ifTrue: [0] ifFalse: [ self target: anObject; qDupeSearchFrom: 1 to: self collection size ]! ! !QuickSearch methodsFor: 'Searching' stamp: 'SqR 1/14/98 20:04'! qSearch: anObject "Answer the index of anObject in the collection" ^self collection size = 0 ifTrue: [0] ifFalse: [ self target: anObject; qSearchFrom: 1 to: self collection size ]! ! !QuickSearch methodsFor: 'Searching'! searchOn: aCollection "Set the collection to be examined to aCollection" self collection: aCollection! ! !QuickSearch methodsFor: 'Private-Accessors' stamp: 'SqR 1/12/98 12:09'! collection ^collection! ! !QuickSearch methodsFor: 'Private-Accessors' stamp: 'SqR 1/12/98 12:09'! collection: anObject collection := anObject! ! !QuickSearch methodsFor: 'Private-Accessors' stamp: 'SqR 1/11/98 15:31'! target ^target! ! !QuickSearch methodsFor: 'Private-Accessors' stamp: 'SqR 1/11/98 15:31'! target: anObject target := anObject! ! !QuickSearch methodsFor: 'Private-Initializing' stamp: 'SqR 1/12/98 12:09'! initialize: aCollection "Initialize the receiver" self collection: aCollection! ! !QuickSearch methodsFor: 'Private-Searching' stamp: 'SqR 1/12/98 13:14'! dupeSearchFrom: first to: last "Search for anObject in the indexes between first and last, except in the index first + last // 2" | testedLeft testedRight candidateLeft candidateRight topLeft topRight | last - first < 16 ifTrue: [^(first to: last) detect: [:one | self target = (self collection at: one)] ifNone: [0]]. testedLeft := testedRight := first semisum: last. topLeft := first. topRight := last. [topLeft = testedLeft] whileFalse: [ candidateLeft := topLeft semisum: testedLeft - 1. (self is: (self collection at: candidateLeft) leq: self target) ifTrue: [ candidateLeft to: testedLeft - 1 do: [:each | self target = (self collection at: each) ifTrue: [^each]]. testedLeft := candidateLeft ] ifFalse: [topLeft := candidateLeft + 1] ]. [topRight = testedRight] whileFalse: [ candidateRight := testedRight + 1 semisum: topRight. (self is: self target leq: (self collection at: candidateRight)) ifTrue: [ testedRight + 1 to: candidateRight do: [:some | self target = (self collection at: some) ifTrue: [^some]]. testedRight := candidateRight. ] ifFalse: [topRight := candidateRight - 1] ]. ^0! ! !QuickSearch methodsFor: 'Private-Searching' stamp: 'SqR 1/14/98 20:40'! findFirstFrom: first to: last "Answer the index of the first element in the collection that makes the target evaluate to true, Search only in the indexes contained between first and last" | pivotIndex | last = first ifTrue: [^(self target value: (self collection at: first)) ifTrue: [first] ifFalse: [0]]. (self target value: (self collection at: (pivotIndex := first semisum: last))) ifTrue: [^self findFirstFrom: first to: pivotIndex] ifFalse: [^self findFirstFrom: pivotIndex + 1 to: last]! ! !QuickSearch methodsFor: 'Private-Searching' stamp: 'SqR 1/12/98 12:09'! is: anObject leq: anotherObject "Answer true if anObject is less than or equal to anotherObject with respect to the sort block of the collection" ^self collection sortBlock value: anObject value: anotherObject! ! !QuickSearch methodsFor: 'Private-Searching' stamp: 'SqR 1/14/98 19:59'! qDupeSearchFrom: first to: last "Answer the index of anObject in the target, Search only in the indexes contained between first and last" | pivotIndex pivotElement | (pivotElement := self collection at: (pivotIndex := first semisum: last)) = self target ifTrue: [^pivotIndex]. last = first ifTrue: [^0]. (self is: self target leq: pivotElement) ifFalse: [^self qDupeSearchFrom: pivotIndex + 1 to: last] ifTrue: [ (self is: pivotElement leq: self target) ifFalse: [^self qDupeSearchFrom: first to: pivotIndex - 1] ifTrue: [^self dupeSearchFrom: first to: last] ]! ! !QuickSearch methodsFor: 'Private-Searching'! qSearchFrom: first to: last "Answer the index of anObject in the target, Search only in the indexes contained between first and last" | bottom top pivot candidate | bottom _ first. top _ last. [bottom > top] whileFalse: [ pivot _ bottom + top // 2. target = (candidate _ collection at: pivot) ifTrue: [^pivot]. (self is: target leq: candidate) ifTrue: [top _ pivot - 1] ifFalse: [bottom _ pivot + 1] ]. ^0! ! !QuickSearch class reorganize! ('Instance creation' new:) ! !QuickSearch class methodsFor: 'Instance creation' stamp: 'SqR 1/11/98 15:50'! new: aSortedCollection "Answer a new instance of the receiver" ^super new initialize: aSortedCollection! ! !RGBSpacePartition reorganize! ('Accessing' addColor: addColorProxy: boxes colorsContained) ('Heckbert' initializeHeckbert refineHeckbert) ('Printing' printOn:) ('Testing' = contains: hash includes: size) ('Private' initialize initializeBoxes) ! !RGBSpacePartition methodsFor: 'Accessing' stamp: 'SqR!!!! 3/17/1999 08:37'! addColor: aColor "Add aColor to the proper box inside you" | box | box _ boxes detect: [:one | one includes: aColor] ifNone: [self notify: 'Color not present in the partition.']. box addColor: aColor! ! !RGBSpacePartition methodsFor: 'Accessing' stamp: 'SqR!!!! 3/8/1999 22:01'! addColorProxy: aColor "Add aColor to the proper box inside you. Use a proxy for faster operation" self addColor: (ColorProxy fromColor: aColor)! ! !RGBSpacePartition methodsFor: 'Accessing' stamp: 'SqR!!!! 2/22/1999 14:53'! boxes ^boxes! ! !RGBSpacePartition methodsFor: 'Accessing' stamp: 'SqR!!!! 2/25/1999 00:47'! colorsContained | answer | answer _ OrderedCollection new. boxes do: [:each | answer addAll: each colorsContained]. ^answer! ! !RGBSpacePartition methodsFor: 'Heckbert' stamp: 'SqR!!!! 2/25/1999 01:31'! initializeHeckbert "Initialize the Heckbert algorithm" | oldBoxes | oldBoxes _ boxes. self initializeBoxes. oldBoxes do: [:each | boxes add: each minimize]! ! !RGBSpacePartition methodsFor: 'Heckbert' stamp: 'SqR!!!! 3/17/1999 08:51'! refineHeckbert "Refine yourself using Heckbert's algorithm. Answer true if did anything, false if no suitable box remains" | cBox | (cBox _ boxes last) colorsContained size > 1 ifTrue: [boxes removeLast; addAll: cBox heckbertSplit. ^true]. ^false! ! !RGBSpacePartition methodsFor: 'Printing' stamp: 'SqR!!!! 3/17/1999 09:05'! printOn: aStream aStream nextPutAll: self class name. aStream nextPut: $(. boxes size printOn: aStream. aStream nextPutAll: ' boxes, '. self colorsContained asSet size printOn: aStream. aStream nextPutAll: ' colors)'! ! !RGBSpacePartition methodsFor: 'Testing' stamp: 'SqR!!!! 2/22/1999 14:53'! = aPartition ^boxes = self boxes! ! !RGBSpacePartition methodsFor: 'Testing' stamp: 'SqR!!!! 3/7/1999 22:37'! contains: aColor "Answer true if the receiver contains aColor, false if not" boxes do: [:each | (each contains: aColor) ifTrue: [^true]]. ^false! ! !RGBSpacePartition methodsFor: 'Testing' stamp: 'SqR!!!! 2/22/1999 14:53'! hash ^boxes hash! ! !RGBSpacePartition methodsFor: 'Testing' stamp: 'SqR!!!! 2/25/1999 01:06'! includes: aColor "Answer true if the receiver includes aColor, false if not" boxes do: [:each | (each includes: aColor) ifTrue: [^true]]. ^false! ! !RGBSpacePartition methodsFor: 'Testing' stamp: 'SqR!!!! 2/25/1999 01:12'! size ^boxes size! ! !RGBSpacePartition methodsFor: 'Private' stamp: 'SqR!!!! 2/25/1999 01:31'! initialize self initializeBoxes. boxes add: (RGBSpaceBox from: 0,0,0 to: 1,1,1)! ! !RGBSpacePartition methodsFor: 'Private' stamp: 'SqR!!!! 2/25/1999 01:31'! initializeBoxes boxes _ SortedCollection sortBlock: [:one :another | one dominantSpanValue < another dominantSpanValue]! ! !RGBSpacePartition class reorganize! ('Instance creation' new) ! !RGBSpacePartition class methodsFor: 'Instance creation' stamp: 'SqR!!!! 2/22/1999 14:49'! new ^super new initialize! ! Smalltalk renameClassNamed: #ColorReductionCache as: #SortedCache! !SortedCache commentStamp: '<historical>' prior: 0! Cache keys should be unique, eh?! !SortedCache reorganize! ('Accessing' at: at:ifAbsentEvaluate: at:put: cachedKeys cachedValueFor: forget: hasCachedValueFor: presize:) ('Private-Initializing' initialize) ! !SortedCache methodsFor: 'Accessing' stamp: 'SqR!!!! 2/28/1999 15:52'! at: aKey ^(contents at: (qSearch qSearch: aKey)) value! ! !SortedCache methodsFor: 'Accessing' stamp: 'SqR!!!! 2/28/1999 21:58'! at: aKey ifAbsentEvaluate: aBlock "Answer the cached value for aKey. If no cached value for aKey is present in the receiver, evaluate aBlock, cache its evaluation and answer it" | index | index _ qSearch qSearch: aKey. ^index = 0 ifTrue: [self at: aKey put: aBlock value] ifFalse: [^(contents at: index) value]! ! !SortedCache methodsFor: 'Accessing' stamp: 'SqR!!!! 2/28/1999 21:58'! at: anObject put: aValue "Set the cached value to anObject. Answer aValue" keys add: anObject. contents add: anObject -> aValue. ^aValue! ! !SortedCache methodsFor: 'Accessing' stamp: 'SqR!!!! 2/28/1999 15:50'! cachedKeys ^keys! ! !SortedCache methodsFor: 'Accessing' stamp: 'SqR!!!! 2/28/1999 15:51'! cachedValueFor: anObject "See proper superclass" | index | index _ qSearch qSearch: anObject. index = 0 ifTrue: [^nil]. ^(contents at: index) value! ! !SortedCache methodsFor: 'Accessing' stamp: 'SqR!!!! 2/28/1999 15:53'! forget: anObject "Remove anObject and its cached value from the receiver. Answer the value forgotten" | index answer | index _ qSearch qSearch: anObject. index = 0 ifTrue: [^nil]. keys removeAt: index. answer _ (contents at: index) value. contents removeAt: index. ^answer! ! !SortedCache methodsFor: 'Accessing' stamp: 'SqR!!!! 2/28/1999 15:53'! hasCachedValueFor: anObject ^(qSearch qSearch: anObject) ~= 0! ! !SortedCache methodsFor: 'Accessing' stamp: 'SqR!!!! 2/28/1999 22:22'! presize: anInteger "Presize the receiver to hold anInteger entries" | newContents newKeys | newContents _ SortedCollection new: anInteger. newKeys _ SortedCollection new: anInteger. newContents sortBlock: contents sortBlock. newKeys sortBlock: keys sortBlock. newContents addAll: contents. newKeys addAll: keys! ! !SortedCache methodsFor: 'Private-Initializing' stamp: 'SqR!!!! 2/28/1999 15:46'! initialize super initialize. contents _ SortedCollection sortBlock: [:one :another | one key < another key]. qSearch _ QuickSearch new: keys! ! !SortedCache commentStamp: '<historical>' prior: 0! Cache keys should be unique, eh?! !SortedCache class methodsFor: 'as yet unclassified' stamp: 'SqR!!!! 2/28/1999 22:24'! new: anInteger ^super new presize: anInteger! ! Smalltalk renameClassNamed: #ThreeDeeColorBox as: #ThreeDeeBox! !ThreeDeeBox commentStamp: 'SqR!! 2/21/1999 23:53' prior: 0! Use tuples of size 3 for start and stop! !ThreeDeeBox reorganize! ('Accessing' size) ('Operating' disectAt:) ('Testing' includes:) ('Printing' printOn:) ! !ThreeDeeBox methodsFor: 'Accessing' stamp: 'SqR!!!! 2/21/1999 23:52'! size | temp | temp _ stop - start. ^(temp at: 1) * (temp at: 2) * (temp at: 3)! ! !ThreeDeeBox methodsFor: 'Operating' stamp: 'SqR!!!! 2/22/1999 00:05'! disectAt: aTuple "Answer the 8 sub boxes of the receiver with common point aTuple" | answer | answer _ Array new: 8. answer at: 1 put: (self class from: start to: aTuple). answer at: 2 put: (self class from: (start copy at: 1 put: (stop at: 1); yourself) to: aTuple). answer at: 3 put: (self class from: (start copy at: 2 put: (stop at: 2); yourself) to: aTuple). answer at: 4 put: (self class from: (start copy at: 3 put: (stop at: 3); yourself) to: aTuple). answer at: 5 put: (self class from: aTuple to: stop). answer at: 6 put: (self class from: aTuple to: (stop copy at: 1 put: (start at: 1); yourself)). answer at: 7 put: (self class from: aTuple to: (stop copy at: 2 put: (start at: 2); yourself)). answer at: 8 put: (self class from: aTuple to: (stop copy at: 3 put: (start at: 3); yourself)). ^answer! ! !ThreeDeeBox methodsFor: 'Testing' stamp: 'SqR!!!! 2/21/1999 23:56'! includes: aTuple ^((aTuple at: 1) between: (start at: 1) and: (stop at: 1)) and: [((aTuple at: 2) between: (start at: 2) and: (stop at: 2)) and: [((aTuple at: 3) between: (start at: 3) and: (stop at: 3))] ]! ! !ThreeDeeBox methodsFor: 'Printing' stamp: 'SqR!!!! 2/25/1999 02:04'! printOn: aStream "& blah" aStream nextPutAll: self class name, '('. start printOn: aStream. aStream nextPutAll: ', '. stop printOn: aStream. aStream nextPut: $)! ! !RGBSpaceBox reorganize! ('Accessing' addColor: blueSpan colorSpan colorsContained greenSpan redSpan representative) ('Heckbert' dominantSpan dominantSpanValue easySplit:and: hardSplit:and: heckbertSplit medianForBlueDominant medianForDominant: medianForGreenDominant medianForRedDominant minimize) ('Printing' printOn:) ('Testing' contains: includes:) ('Private' initialize:to:) ! !RGBSpaceBox methodsFor: 'Accessing' stamp: 'SqR!!!! 3/8/1999 21:59'! addColor: aColor "Add a color to the receiver" colors add: aColor. dominantSpan _ colorSpan _ nil! ! !RGBSpaceBox methodsFor: 'Accessing' stamp: 'SqR!!!! 3/8/1999 20:52'! blueSpan ^self colorSpan at: 1! ! !RGBSpaceBox methodsFor: 'Accessing' stamp: 'SqR!!!! 3/8/1999 20:52'! colorSpan "Answer the color span of the receiver" | minR minG minB maxR maxG maxB | colorSpan isNil ifFalse: [^colorSpan]. minR _ minG _ minB _ 1. maxR _ maxG _ maxB _ 0. colors do: [:each | minR _ minR min: each red. maxR _ maxR max: each red. minG _ minG min: each green. maxG _ maxG max: each green. minB _ minB min: each blue. maxB _ maxB max: each blue ]. ^colorSpan _ Tuple with: (Array with: (maxB - minB) with: (maxG - minG) with: (maxR - minR))! ! !RGBSpaceBox methodsFor: 'Accessing' stamp: 'SqR!!!! 2/25/1999 14:46'! colorsContained ^colors! ! !RGBSpaceBox methodsFor: 'Accessing' stamp: 'SqR!!!! 2/25/1999 14:53'! greenSpan ^self colorSpan at: 2! ! !RGBSpaceBox methodsFor: 'Accessing' stamp: 'SqR!!!! 3/8/1999 20:51'! redSpan ^self colorSpan at: 3! ! !RGBSpaceBox methodsFor: 'Accessing' stamp: 'SqR!!!! 3/8/1999 21:42'! representative "Answer the representative color of the receiver" | totalR totalG totalB | colors size = 0 ifTrue: [^Color black]. totalR _ totalG _ totalB _ 0. colors do: [:each | totalR _ totalR + each red. totalG _ totalG + each green. totalB _ totalB + each blue ]. ^Color r: totalR / colors size g: totalG / colors size b: totalB / colors size! ! !RGBSpaceBox methodsFor: 'Heckbert' stamp: 'SqR!!!! 3/8/1999 20:52'! dominantSpan "Answer 1 if the dominant span is the blue one, 2 if green and 3 if red" | rSpan gSpan bSpan | dominantSpan isNil ifFalse: [^dominantSpan]. rSpan _ self redSpan. gSpan _ self greenSpan. bSpan _ self blueSpan. rSpan > (gSpan max: bSpan) ifTrue: [^dominantSpan _ 3]. "r > (g max: b)?" "No. Then b or g > r, and so the dominant span is the max of g and b" ^dominantSpan _ gSpan > bSpan ifTrue: [2] ifFalse: [1]! ! !RGBSpaceBox methodsFor: 'Heckbert' stamp: 'SqR!!!! 2/25/1999 14:53'! dominantSpanValue "Answer the value of the dominant span" ^self colorSpan at: self dominantSpan! ! !RGBSpaceBox methodsFor: 'Heckbert' stamp: 'SqR!!!! 2/25/1999 22:24'! easySplit: box1 and: box2 "Perform an easy color split on box1 and box2. Used privately by heckbertSplit" colors do: [:each | (box1 includes: each) ifTrue: [box1 addColor: each] ifFalse: [box2 addColor: each] ] ! ! !RGBSpaceBox methodsFor: 'Heckbert' stamp: 'SqR!!!! 3/17/1999 08:02'! hardSplit: box1 and: box2 "Perform an hard color split on box1 and box2. Used privately by heckbertSplit" | pivot | pivot _ colorSortCache size bitShift: -1. 1 to: pivot do: [:each | box1 addColor: (colorSortCache at: each)]. pivot + 1 to: colorSortCache size do: [:some | box2 addColor: (colorSortCache at: some)]! ! !RGBSpaceBox methodsFor: 'Heckbert' stamp: 'SqR!!!! 3/17/1999 08:20'! heckbertSplit "Answer a collection with two nonempty subboxes of yourself, generated as Heckbert says" | box1 box2 median dominantComponent answer pivot | dominantComponent _ 4 -  self dominantSpan. median _ self medianForDominant: self dominantSpan. box1 _ self class from: start to: (stop copy at: dominantComponent put: median; yourself). box2 _ self class from: (start copy at: dominantComponent put: median; yourself) to: stop. pivot _ colorSortCache size bitShift: -1. 1 to: pivot do: [:each | box1 addColor: (colorSortCache at: each)]. pivot + 1 to: colorSortCache size do: [:some | box2 addColor: (colorSortCache at: some)]. answer _ OrderedCollection new. box1 colorsContained size > 0 ifTrue: [answer add: box1 minimize]. box2 colorsContained size > 0 ifTrue: [answer add: box2 minimize]. ^answer! ! !RGBSpaceBox methodsFor: 'Heckbert' stamp: 'SqR!!!! 2/25/1999 22:58'! medianForBlueDominant "Answer the median of the blue coordinate of yourself" colorSortCache _ SortedCollection sortBlock: [:oneB :anotherB | oneB blue < anotherB blue]. colorSortCache addAll: colors. ^colorSortCache size even ifTrue: [ ((colorSortCache at: colorSortCache size // 2) blue) + ((colorSortCache at: colorSortCache size // 2 + 1) blue) / 2 ] ifFalse: [(colorSortCache at: colorSortCache size // 2) blue]! ! !RGBSpaceBox methodsFor: 'Heckbert' stamp: 'SqR!!!! 3/8/1999 21:13'! medianForDominant: x "Answer the median of the x coordinate of yourself" x = 1 ifTrue: [^self medianForBlueDominant]. x = 2 ifTrue: [^self medianForGreenDominant]. ^self medianForRedDominant! ! !RGBSpaceBox methodsFor: 'Heckbert' stamp: 'SqR!!!! 2/25/1999 22:58'! medianForGreenDominant "Answer the median of the green coordinate of yourself" colorSortCache _ SortedCollection sortBlock: [:oneG :anotherG | oneG green < anotherG green]. colorSortCache addAll: colors. ^colorSortCache size even ifTrue: [ ((colorSortCache at: colorSortCache size // 2) green) + ((colorSortCache at: colorSortCache size // 2 + 1) green) / 2 ] ifFalse: [(colorSortCache at: colorSortCache size // 2) green]! ! !RGBSpaceBox methodsFor: 'Heckbert' stamp: 'SqR!!!! 2/25/1999 22:56'! medianForRedDominant "Answer the median of the red coordinate of yourself" colorSortCache _ SortedCollection sortBlock: [:oneR :anotherR | oneR red < anotherR red]. colorSortCache addAll: colors. ^colorSortCache size even ifTrue: [ ((colorSortCache at: colorSortCache size // 2) red) + ((colorSortCache at: colorSortCache size // 2 + 1) red) / 2 ] ifFalse: [(colorSortCache at: colorSortCache size // 2) red]! ! !RGBSpaceBox methodsFor: 'Heckbert' stamp: 'SqR!!!! 3/17/1999 08:41'! minimize "Minimize the receiver" | minR minG minB maxR maxG maxB | minR _ minG _ minB _ 1. maxR _ maxG _ maxB _ 0. colors do: [:each | minR _ minR min: each red. maxR _ maxR max: each red. minG _ minG min: each green. maxG _ maxG max: each green. minB _ minB min: each blue. maxB _ maxB max: each blue ]. start _ Tuple with: (Array with: minR with: minG with: minB). stop _ Tuple with: (Array with: maxR with: maxG with: maxB). colorSpan _ Tuple with: (Array with: (maxB - minB) with: (maxG - minG) with: (maxR - minR))! ! !RGBSpaceBox methodsFor: 'Printing' stamp: 'SqR!!!! 3/17/1999 09:01'! printOn: aStream aStream nextPutAll: self class name. aStream nextPut: $(. (start collect: [:each | each roundTo: 0.0001]) printOn: aStream. aStream nextPutAll: ', '. (stop collect: [:some | some roundTo: 0.0001]) printOn: aStream. aStream nextPut: $)! ! !RGBSpaceBox methodsFor: 'Testing' stamp: 'SqR!!!! 2/25/1999 14:47'! contains: aColor "Answer true if you contain a color" ^colors includes: aColor! ! !RGBSpaceBox methodsFor: 'Testing' stamp: 'SqR!!!! 3/17/1999 08:38'! includes: aColor "Answer true if you include a color" "^super includes: aColor red, aColor green, aColor blue" ^(aColor red between: (start at: 1) and: (stop at: 1)) and: [(aColor green between: (start at: 2) and: (stop at: 2)) and: [aColor blue between: (start at: 3) and: (stop at: 3)] ]! ! !RGBSpaceBox methodsFor: 'Private' stamp: 'SqR!!!! 2/25/1999 14:45'! initialize: x to: y super initialize: x to: y. colors _ OrderedCollection new! ! !ThreeDeeBox commentStamp: 'SqR!! 2/21/1999 23:53' prior: 0! Use tuples of size 3 for start and stop! !Tuple reorganize! ('Accessing' at: at:put: dim) ('Converting' asCol asLinearEquation asLinearForm asRow asSVPoly copy) ('Enumerating' collect: do:) ('Null and identity' scalarIdentity scalarZero) ('Operating' * + , - / = dot: isMulOf: negated transposed) ('Printing' printOn:) ('Testing' hash isColumn isRow norm normSquared) ('Private' contents contents: copyNil initialize:scalarAmbient: scalarAmbient scalarAmbient:) ! !Tuple methodsFor: 'Accessing'! at: anInteger
        "Answer the anIntegerth coordinate of the receiver"

        ^self contents at: anInteger! ! !Tuple methodsFor: 'Accessing'! at: anInteger put: anObject
        "Set the anIntegerth coordinate of the receiver to anObject"

        ^self contents at: anInteger put: anObject! ! !Tuple methodsFor: 'Accessing'! dim
        "Answer the dimension of the receiver"

        ^self contents size! ! !Tuple methodsFor: 'Converting'! asCol "Convert the receiver into a column tuple" ^ColumnTuple with: self contents! ! !Tuple methodsFor: 'Converting'! asLinearEquation "Answer the receiver as a linear equation" ^LinearEquation fromTuple: (Tuple with: (self contents copyFrom: 1 to: self dim - 1) scalarAmbient: scalarAmbient) equalsTo: (self at: self dim)! ! !Tuple methodsFor: 'Converting'! asLinearForm "Convert the receiver into a LinearForm" ^LinearForm new: self! ! !Tuple methodsFor: 'Converting'! asRow "Convert the receiver into a row tuple" ^RowTuple with: self contents! ! !Tuple methodsFor: 'Converting' stamp: 'SqR!!!!!!!! 8/9/1998 16:20'! asSVPoly "Blah, you know!!" | x answer power | x _ SVPolynomial xBy: self scalarIdentity. answer _ SVPolynomial xBy: self scalarZero. power _ self scalarIdentity asMonomial. 1 to: self dim do: [:each | answer _ power * (self at: each) asMonomial + answer. power _ x * power]. ^answer! ! !Tuple methodsFor: 'Converting' stamp: 'SqR!!!! 2/22/1999 00:07'! copy ^self deepCopy! ! !Tuple methodsFor: 'Enumerating' stamp: 'SqR!!!! 2/25/1999 14:43'! collect: aBlock ^self class new contents: (contents collect: aBlock)! ! !Tuple methodsFor: 'Enumerating' stamp: 'SqR!!!! 2/25/1999 14:42'! do: aBlock contents do: aBlock! ! !Tuple methodsFor: 'Null and identity' stamp: 'SqR!!!!!!!! 8/9/1998 16:18'! scalarIdentity "Answer the identity for the receiver" ^self scalarAmbient identity! ! !Tuple methodsFor: 'Null and identity' stamp: 'SqR!!!!!!!! 8/9/1998 16:18'! scalarZero
        "Answer the null coefficient for the receiver"

        ^self scalarAmbient zero! ! !Tuple methodsFor: 'Operating'! * aNumber
        "Answer the receiver multiplied by aNumber"

        ^self copy contents: (self contents collect: [:each | each * aNumber])! ! !Tuple methodsFor: 'Operating'! + aTuple
        "Answer the receiver plus aTuple"

        | answer |

        answer := self copyNil.
        1 to: self dim do: [:each | answer at: each put: (self at: each) + (aTuple at: each)].
        ^answer
                ! ! !Tuple methodsFor: 'Operating'! , aNumber
        "Answer the receiver with aNumber added at the end"

        ^self copy initialize: (self contents copyWith: aNumber) scalarAmbient: self scalarAmbient ! ! !Tuple methodsFor: 'Operating'! - aTuple
        "Answer the receiver minus aTuple"

        ^self + aTuple negated! ! !Tuple methodsFor: 'Operating'! / aNumber
        "Answer the receiver divided by aNumber"

        ^self * aNumber reciprocal! ! !Tuple methodsFor: 'Operating'! = aTuple "Answer true if the receiver is equal to aTuple" 1 to: self dim do: [:each | (self at: each) = (aTuple at: each) ifFalse: [^false]]. ^true! ! !Tuple methodsFor: 'Operating'! dot: aTuple
        "Answer the dot product between the receiver and aTuple"

        | answer |

        self contents with: aTuple contents do: [:each :another | answer == nil ifTrue: [answer _ each * another] ifFalse: [answer _ each * another + answer] ].
        ^answer! ! !Tuple methodsFor: 'Operating'! isMulOf: aTuple "Answer true if the receiver is a multiple of aTuple" | index | index _ self detect: [:one | one ~= scalarAmbient zero] ifNone: [^true]. ^self * ((aTuple at: index) / (self at: index)) = aTuple! ! !Tuple methodsFor: 'Operating'! negated
        "Answer the receiver negated"

        ^self copy contents: (self contents collect: [:each | each negated])! ! !Tuple methodsFor: 'Operating'! transposed "Answer the transposed of the receiver" ^self subclassResponsibility! ! !Tuple methodsFor: 'Printing'! printOn: aStream
        "Append the representation of the receiver into aStream"

        aStream "nextPutAll: self class name;" nextPut: $(.
        self contents
                do: [:each | each printOn: aStream]
                andBetweenDo: [aStream nextPutAll: ', '].
        aStream nextPut: $)! ! !Tuple methodsFor: 'Testing'! hash "Answer the hash of the receiver" ^contents hash! ! !Tuple methodsFor: 'Testing'! isColumn "Answer true if the receiver is a column tuple" ^self subclassResponsibility! ! !Tuple methodsFor: 'Testing'! isRow "Answer true if the receiver is a row tuple" ^self subclassResponsibility! ! !Tuple methodsFor: 'Testing'! norm
        "Answer the norm of the receiver"

        ^self normSquared sqrt! ! !Tuple methodsFor: 'Testing'! normSquared
        "Answer the norm squared of the receiver"

        ^self dot: self! ! !Tuple methodsFor: 'Private'! contents
        "Private - Answer the contents of the receiver"

        ^contents! ! !Tuple methodsFor: 'Private'! contents: anObject
        "Private - Set the contents of the receiver to anObject"

        contents := anObject! ! !Tuple methodsFor: 'Private'! copyNil
        "Private - Answer a copy of the receiver with contents with nil values"

        ^self copy initialize: (Array new: self dim) scalarAmbient: self scalarAmbient! ! !Tuple methodsFor: 'Private'! initialize: anIndexedCollection scalarAmbient: aScalarAmbient
        "Private - Initialize the receiver"

        self contents: anIndexedCollection asArray; scalarAmbient: aScalarAmbient ! ! !Tuple methodsFor: 'Private'! scalarAmbient ^scalarAmbient! ! !Tuple methodsFor: 'Private'! scalarAmbient: aScalarAmbient scalarAmbient := aScalarAmbient! ! !Tuple class reorganize! ('Default scalar ambient' defaultScalarAmbient defaultScalarAmbient:) ('Instance creation' eSub: eSub:scalarAmbient: nullDim: nullDim:scalarAmbient: with: with:scalarAmbient:) ! !Tuple class methodsFor: 'Default scalar ambient' stamp: 'SqR!!!! 3/2/1999 05:09'! defaultScalarAmbient "Answer the default scalar ambient" DefaultScalarAmbient isNil ifTrue: [ DefaultScalarAmbient _ Smalltalk at: #ScalarAmbientRationals ifAbsent: []. DefaultScalarAmbient isNil ifFalse: [DefaultScalarAmbient _ DefaultScalarAmbient new] ]. ^DefaultScalarAmbient! ! !Tuple class methodsFor: 'Default scalar ambient'! defaultScalarAmbient: aScalarAmbient "Set the default scalar ambient to aScalarAmbient" DefaultScalarAmbient := aScalarAmbient! ! !Tuple class methodsFor: 'Instance creation'! eSub: aPoint
        "Answer the aPoint xth canonical tuple of dimension aPoint y"

        ^self eSub: aPoint ambient: self defaultScalarAmbient! ! !Tuple class methodsFor: 'Instance creation'! eSub: aPoint scalarAmbient: aScalarAmbient
        "Answer the aPoint xth canonical tuple of dimension aPoint y. Take the scalar zero and identity from aScalarAmbient"

        | contents | contents := Array new: aPoint y. contents atAllPut: aScalarAmbient zero. contents at: aPoint x put: aScalarAmbient identity. ^self with: contents scalarAmbient: aScalarAmbient! ! !Tuple class methodsFor: 'Instance creation'! nullDim: anInteger "Answer the null tuple of dimension anInteger. Use the default scalar ambient" | contents | contents _ Array new: anInteger. contents atAllPut: self defaultScalarAmbient zero. ^self with: contents scalarAmbient: self defaultScalarAmbient! ! !Tuple class methodsFor: 'Instance creation'! nullDim: anInteger scalarAmbient: aScalarAmbient "Answer the null tuple of dimension anInteger and of scalar ambient aScalarAmbient" | contents | contents _ Array new: anInteger. contents atAllPut: aScalarAmbient zero. ^self with: contents scalarAmbient: aScalarAmbient! ! !Tuple class methodsFor: 'Instance creation'! with: anIndexedCollection
        "Answer a new instance of the receiver with its coordinates taken from anIndexedCollection"
        ^super new initialize: anIndexedCollection scalarAmbient: self defaultScalarAmbient! ! !Tuple class methodsFor: 'Instance creation'! with: anIndexedCollection scalarAmbient: aScalarAmbient
        "Answer a new instance of the receiver with its coordinates taken from anIndexedCollection"
        ^super new initialize: anIndexedCollection scalarAmbient: aScalarAmbient! ! ColorReducer removeSelector: #tallyPixelValuesFor:! ColorReducer removeSelector: #useProxies! ColorReducer removeSelector: #quantizateTrueColor:to:! RGBSpacePartition removeSelector: #addColorproxy:! RGBSpacePartition removeSelector: #refine! RGBSpaceBox removeSelector: #initialize! RGBSpaceBox removeSelector: #span! RGBSpaceBox removeSelector: #size! RGBSpaceBox class removeSelector: #new!
_______________________________________________
vwnc mailing list
[hidden email]
http://lists.cs.uiuc.edu/mailman/listinfo/vwnc