'From Squeak3.2alpha of 7 December 2001 [latest update: #4586] on 8 December 2001 at 1:51:19 pm'! Object subclass: #Color instanceVariableNames: 'rgb cachedDepth cachedBitPattern ' classVariableNames: 'Black Blue BlueShift Brown CachedColormaps ColorChart ColorNames ComponentMask ComponentMax Cyan DarkGray ExtendedColors Gray GrayToIndexMap Green GreenShift HalfComponentMask HighLightBitmaps IndexedColors LightBlue LightBrown LightCyan LightGray LightGreen LightMagenta LightOrange LightRed LightYellow Magenta MaskingMap Orange PaleBlue PaleBuff PaleGreen PaleMagenta PaleOrange PalePeach PaleRed PaleTan PaleYellow PureBlue PureCyan PureGreen PureMagenta PureRed PureYellow RandomStream Red RedShift TranslucentPatterns Transparent VeryDarkGray VeryLightGray VeryPaleRed VeryVeryDarkGray VeryVeryLightGray White Yellow ' poolDictionaries: '' category: 'Graphics-Primitives'! !Color methodsFor: 'other' stamp: 'BSTJ 12/8/2001 13:34'! name "Return this color's name, or nil if it has no name. Only returns a name if it exactly matches the named color." ColorNames do: [:name | (Color perform: name) = self ifTrue: [^ name]]. "We did not find a selector for the color so we try to find the name in the extended colors" ^Color getNameOfExtendedColor: self. ! ! !Color class methodsFor: 'extended colors' stamp: 'BSTJ 12/8/2001 13:45'! doesNotUnderstand: aMessage "Give the class one last chance and try to see if we can find the selector (color name) in the ExtendedColors dictionary. If we succeed, instantiate the color from the associated hexadecimal color value string (if it has not already been done before). Otherwise, just proceed with the #doesNotUnderstand: . Note that we instantiate the color only when we are asked for this color!! When the class receives a *color name* message for the first time, we create the instance and replace the hex string with it. Subsequent invocations of this color will then just answer that *singleton* color object." | anHexStringOrColor aColor | aMessage arguments size = 0 ifFalse: [^ super doesNotUnderstand: aMessage]. anHexStringOrColor _ self extendedColors at: aMessage selector ifAbsent: []. anHexStringOrColor isNil ifTrue: [^ super doesNotUnderstand: aMessage]. anHexStringOrColor isString ifTrue: [aColor _ self fromString: anHexStringOrColor. self extendedColors at: aMessage selector put: aColor. ^ aColor]. anHexStringOrColor isColor ifTrue: [^ anHexStringOrColor]. "Just a safeguard if we broke everything... We want to be sure we are able to display something!!!!" ^ self lightGray! ! !Color class methodsFor: 'extended colors' stamp: 'BSTJ 12/8/2001 13:33'! extendedColors "Returns the dictionary of extended colors, i.e. -> Also makes sure that its properly initialized if it has not already been!!" self privateExtendedColors isNil ifTrue: [self privateExtendedColors: Dictionary new]. self privateExtendedColors isEmpty ifTrue: [self initializeExtendedColors]. ^ self privateExtendedColors! ! !Color class methodsFor: 'extended colors' stamp: 'BSTJ 12/8/2001 13:45'! getInstantiatedExtendedColors "Returns all the of the extended colors that have been instantiated in the dictionary, i.e. we have replaced the hex string with the real " ^ (self extendedColors select: [:v | v isColor]) values asOrderedCollection! ! !Color class methodsFor: 'extended colors' stamp: 'BSTJ 12/8/2001 13:27'! getNameOfExtendedColor: aColor "Returns the name of the extended color " self extendedColors keysAndValuesDo: [:k :v | v == aColor ifTrue: [^ k]]. ^ nil! ! !Color class methodsFor: 'extended colors' stamp: 'BSTJ 12/8/2001 13:46'! getNamesOfExtendedColors "Answers a of all extended colors names" | sc | sc _ SortedCollection new: 650. self extendedColors keysDo: [:eachKey | sc add: eachKey]. ^ sc! ! !Color class methodsFor: 'extended colors' stamp: 'BSTJ 12/8/2001 13:48'! initializeExtendedColors "Benoit St-Jean