class: DeviceWorkstation
authorClaus Gittinger <cg@exept.de>
Fri, 12 Jun 2015 17:10:04 +0200
changeset 6877 0474874e681a
parent 6876 b1aa2b47d252
child 6879 ffb55919ed0c
class: DeviceWorkstation changed: #getRGBFromName: be robust against short color values (such as #00CCC - eg with a missing 0 on the left). Illegal, but some web pages do contain that.
DeviceWorkstation.st
--- a/DeviceWorkstation.st	Sun May 31 11:29:15 2015 +0200
+++ b/DeviceWorkstation.st	Fri Jun 12 17:10:04 2015 +0200
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
 "
 COPYRIGHT (c) 1993 by Claus Gittinger
 	      All Rights Reserved
@@ -3605,70 +3603,74 @@
 
 !
 
-getRGBFromName:colorName
+getRGBFromName:colorNameArg
     "get rgb components (0..100) of color named colorName,
      and return a 3-element array, containing them.
      The method here only handles some often used colors;
      getRGBFromName should not be used, since colorNames other
      than those below are X specific."
 
-    |idx names triple r g b|
-
+    |colorName idx names triple r g b|
+
+    colorName := colorNameArg.
     (colorName startsWith:$#) ifTrue:[
-	"/ color in r/g/b hex notation
-	r := Integer readFrom:(colorName copyFrom:2 to:3) radix:16.
-	g := Integer readFrom:(colorName copyFrom:4 to:5) radix:16.
-	b := Integer readFrom:(colorName copyFrom:6 to:7) radix:16.
-	r := (r * 100 / 255).
-	g := (g * 100 / 255).
-	b := (b * 100 / 255).
-	^ Array with:r with:g with:b
+        "/ color in r/g/b hex notation
+        colorName size < 7 ifTrue:[
+            "/ that's an error, but some web pages do that
+            colorName := '#',((colorName copyFrom:2) leftPaddedTo:6 with:$0).
+        ].    
+        r := Integer readFrom:(colorName copyFrom:2 to:3) radix:16.
+        g := Integer readFrom:(colorName copyFrom:4 to:5) radix:16.
+        b := Integer readFrom:(colorName copyFrom:6 to:7) radix:16.
+        r := (r * 100 / 255).
+        g := (g * 100 / 255).
+        b := (b * 100 / 255).
+        ^ Array with:r with:g with:b
     ].
 
     names := #(
-		'red'
-		'green'
-		'blue'
-		'yellow'
-		'magenta'
-		'cyan'
-		'white'
-		'black'
-
-		'olive'
-		'teal'
-		'silver'
-		'lime'
-		'fuchsia'
-		'aqua'
-	      ).
+                'red'
+                'green'
+                'blue'
+                'yellow'
+                'magenta'
+                'cyan'
+                'white'
+                'black'
+
+                'olive'
+                'teal'
+                'silver'
+                'lime'
+                'fuchsia'
+                'aqua'
+              ).
     idx := names indexOf:colorName.
     idx == 0 ifTrue:[
-	idx := names indexOf:colorName asLowercase.
+        idx := names indexOf:colorName asLowercase.
     ].
     idx ~~ 0 ifTrue:[
-	triple := #(
-			(100   0   0)  "red"
-			(  0 100   0)  "green"
-			(  0   0 100)  "blue"
-			(100 100   0)  "yellow"
-			(100   0 100)  "magenta"
-			(  0 100 100)  "cyan"
-			(100 100 100)  "white"
-			(  0   0   0)  "black"
-
-			( 50  50   0)  "olive"
-			(  0  50  50)  "teal"
-			( 40  40  40)  "silver"
-			( 20 100   0)  "lime"
-			( 60   3 100)  "fuchsia"
-			( 10 100 100)  "aqua"
-		   ) at:idx.
-
-	^ triple
+        triple := #(
+                        (100   0   0)  "red"
+                        (  0 100   0)  "green"
+                        (  0   0 100)  "blue"
+                        (100 100   0)  "yellow"
+                        (100   0 100)  "magenta"
+                        (  0 100 100)  "cyan"
+                        (100 100 100)  "white"
+                        (  0   0   0)  "black"
+
+                        ( 50  50   0)  "olive"
+                        (  0  50  50)  "teal"
+                        ( 40  40  40)  "silver"
+                        ( 20 100   0)  "lime"
+                        ( 60   3 100)  "fuchsia"
+                        ( 10 100 100)  "aqua"
+                   ) at:idx.
+
+        ^ triple
     ].
     ^ nil
-
 !
 
 getRGBFromName:colorName into:aBlock
@@ -8441,11 +8443,11 @@
 !DeviceWorkstation class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.629 2015-05-06 17:10:29 cg Exp $'
+    ^ '$Header$'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.629 2015-05-06 17:10:29 cg Exp $'
+    ^ '$Header$'
 ! !