Issue 3432 in pharo: Color>>fromString fix

Status: FixedWaitingToBePharoed
Owner: stephane.ducasse
Labels: Difficulty-Easy Milestone-1.3

New issue 3432 by stephane.ducasse: Color>>fromString fix
http://code.google.com/p/pharo/issues/detail?id=3432

Levente Uzonyi uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-ul.160.mcz

==================== Summary ====================

Name: Graphics-ul.160
Author: ul
Time: 9 December 2010, 3:05:20.054 am
UUID: 822ecf3f-277b-0d45-94d3-ebc44976be4e
Ancestors: Graphics-ul.159

- fixed: Color class >> #fromString:
- Color's ColorNames is now a Set instead of an OrderedCollection

=============== Diff against Graphics-ul.159 ===============

Item was changed:
  ----- Method: Color class>>fromString: (in category 'instance creation')  
-----
  fromString: aString
        "for HTML color spec: #FFCCAA or white/black"
        "Color fromString: '#FFCCAA'.
         Color fromString: 'white'.
         Color fromString: 'orange'"
+
        | aColorHex |
+       aString isEmptyOrNil ifTrue: [ ^self white ].
-       aString isEmptyOrNil ifTrue: [^ Color white].
        aString first = $#
+               ifTrue: [ aColorHex := aString allButFirst ]
+               ifFalse: [ aColorHex := aString ].
+       (aColorHex size = 6 and: [
+               aColorHex allSatisfy: [ :each | '0123456789ABCDEFabcdef'  
includes: each ] ])
+                       ifTrue: [
+                               | green red blue |
+                               red := (Integer readFrom: (aColorHex first:  
2) base: 16) / 255.
+                               green := (Integer readFrom: (aColorHex  
copyFrom: 3 to: 4) base: 16) / 255.
+                               blue := (Integer readFrom: (aColorHex last:  
2) base: 16) / 255.
+                               ^self r: red g: green b: blue ].
-               ifTrue: [aColorHex := aString copyFrom: 2 to: aString size]
-               ifFalse: [aColorHex := aString].
-       [ | green red blue |
-       aColorHex size = 6
-               ifTrue:
-                       [aColorHex := aColorHex asUppercase.
-                       red := ('16r', (aColorHex copyFrom: 1 to: 2))  
asNumber/255.
-                       green := ('16r', (aColorHex copyFrom: 3 to: 4))  
asNumber/255.
-                       blue := ('16r', (aColorHex copyFrom: 5 to: 6))  
asNumber/255.
-                       ^ self r: red g: green b: blue]]
-       ifError: [:err :rcvr | "not a hex color triplet" ].
-
        "try to match aColorHex with known named colors"
+       ^self perform: (ColorNames like: aColorHex asLowercase ifAbsent: [  
#white ])!
-       aColorHex := aColorHex asLowercase.
-
-       ^self perform: (ColorNames detect: [:i | i asString asLowercase =  
aColorHex]
-               ifNone: [#white])!

Item was changed:
  ----- Method: Color class>>initializeNames (in category 'class  
initialization') -----
  initializeNames
        "Name some colors."
        "Color initializeNames"

+       ColorNames := Set new.
-       ColorNames := OrderedCollection new.
        self named: #black put: (Color r: 0 g: 0 b: 0).
        self named: #veryVeryDarkGray put: (Color r: 0.125 g: 0.125 b:  
0.125).
        self named: #veryDarkGray put: (Color r: 0.25 g: 0.25 b: 0.25).
        self named: #darkGray put: (Color r: 0.375 g: 0.375 b: 0.375).
        self named: #gray put: (Color r: 0.5 g: 0.5 b: 0.5).
        self named: #lightGray put: (Color r: 0.625 g: 0.625 b: 0.625).
        self named: #veryLightGray put: (Color r: 0.75 g: 0.75 b: 0.75).
        self named: #veryVeryLightGray put: (Color r: 0.875 g: 0.875 b:  
0.875).
        self named: #white put: (Color r: 1.0 g: 1.0 b: 1.0).
        self named: #red put: (Color r: 1.0 g: 0 b: 0).
        self named: #yellow put: (Color r: 1.0 g: 1.0 b: 0).
        self named: #green put: (Color r: 0 g: 1.0 b: 0).
        self named: #cyan put: (Color r: 0 g: 1.0 b: 1.0).
        self named: #blue put: (Color r: 0 g: 0 b: 1.0).
        self named: #magenta put: (Color r: 1.0 g: 0 b: 1.0).
        self named: #brown put: (Color r: 0.6 g: 0.2 b: 0).
        self named: #orange put: (Color r: 1.0 g: 0.6 b: 0).
        self named: #lightRed put: (Color r: 1.0 g: 0.8 b: 0.8).
        self named: #lightYellow put: (Color r: 1.0 g: 1.0 b: 0.8).
        self named: #lightGreen put: (Color r: 0.8 g: 1.0 b: 0.6).
        self named: #lightCyan put: (Color r: 0.4 g: 1.0 b: 1.0).
        self named: #lightBlue put: (Color r: 0.8 g: 1.0 b: 1.0).
        self named: #lightMagenta put: (Color r: 1.0 g: 0.8 b: 1.0).
        self named: #lightBrown put: (Color r: 1.0 g: 0.6 b: 0.2).
        self named: #lightOrange put: (Color r: 1.0 g: 0.8 b: 0.4).
        self named: #transparent put: (TranslucentColor new alpha: 0.0).
        self named: #paleBuff put: (Color r: 254 g: 250 b: 235 range: 255).
        self named: #paleBlue put: (Color r: 222 g: 249 b: 254 range: 255).
        self named: #paleYellow put: (Color r: 255 g: 255 b: 217 range: 255).
        self named: #paleGreen put: (Color r: 223 g: 255 b: 213 range: 255).
        self named: #paleRed put: (Color r: 255 g: 230 b: 230 range: 255).
        self named: #veryPaleRed put: (Color r: 255 g: 242 b: 242 range:  
255).
        self named: #paleTan put: (Color r: 235 g: 224 b: 199 range: 255).
        self named: #paleMagenta put: (Color r: 255 g: 230 b: 255 range:  
255).
        self named: #paleOrange put: (Color r: 253 g: 237 b: 215 range: 255).
        self named: #palePeach put: (Color r: 255 g: 237 b: 213 range: 255).

  !

Item was changed:
  ----- Method: Color class>>named:put: (in category 'class initialization')  
-----
  named: newName put: aColor
        "Add a new color to the list and create an access message and a  
class variable for it.  The name should start with a lowercase letter.  
(The class variable will start with an uppercase letter.)  (Color  
colorNames) returns a list of all color names.  "
        | str cap sym accessor csym |
        (aColor isKindOf: self) ifFalse: [^ self error: 'not a Color'].
        str := newName asString.
        sym := str asSymbol.
        cap := str capitalized.
        csym := cap asSymbol.
        (self class canUnderstand: sym) ifFalse: [
                "define access message"
                accessor := str, (String with: Character cr with: Character  
tab),                       '^', cap.
                self class compile: accessor
                        classified: 'named colors'].
        (self classPool includesKey: csym) ifFalse: [
                self addClassVarName: cap].
+       ColorNames add: sym.
-       (ColorNames includes: sym) ifFalse: [
-               ColorNames add: sym].
        ^ self classPool at: csym put: aColor!

Item was changed:
  ----- Method: Color>>name (in category 'other') -----
  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 detect: [ :name | (Color perform: name) = self ]  
ifNone: [ nil ]!
-       ColorNames do:
-               [:name | (Color perform: name) = self ifTrue: [^ name]].
-       ^ nil
- !

Item was changed:
  (PackageInfo named: 'Graphics') postscript: '"below, add code to be run  
after the loading of this package"
+ Color initializeNames'!
- StrikeFont installDejaVu.'!

Comment #1 on issue 3432 by stephane.ducasse: Color>>fromString fix
http://code.google.com/p/pharo/issues/detail?id=3432

I wonder why a set is better for ColorNames