--- a/Color.st Tue Apr 12 16:18:42 2016 +0200
+++ b/Color.st Thu Apr 14 12:13:16 2016 +0200
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
@@ -4774,41 +4772,37 @@
"/ the most common cases (already allocated) first
colorId notNil ifTrue:[
-
- "/ is someone validating me before drawing on aDevice ?
-
- aDevice notNil ifTrue:[
- aDevice == device ifTrue:[
- ^ self
- ]
- ].
-
- "/ a special case for pseudo-colors (0 and 1 in bitmaps)
- "/ those have nil r/g/b values, but a nonNil colorId
-
- red isNil ifTrue:[^ self].
-
- "/ want to release color ?
-
- (aDevice isNil and:[device notNil]) ifTrue:[
- "/ trueColor device-colors are not registered
- device visualType ~~ #TrueColor ifTrue:[
- device unregisterColor:newColor.
- device freeColor:colorId
- ].
- device := nil.
- colorId := nil.
- ^ self
- ].
+ "/ is someone validating me before drawing on aDevice ?
+ (aDevice notNil and:[aDevice == device]) ifTrue:[
+ ^ self
+ ].
+
+ "/ a special case for pseudo-colors (0 and 1 in bitmaps)
+ "/ those have nil r/g/b values, but a nonNil colorId
+
+ red isNil ifTrue:[^ self].
+
+ "/ want to release color ?
+
+ (aDevice isNil and:[device notNil]) ifTrue:[
+ "/ trueColor device-colors are not registered
+ device visualType ~~ #TrueColor ifTrue:[
+ device unregisterColor:newColor.
+ device freeColor:colorId
+ ].
+ device := nil.
+ colorId := nil.
+ ^ self
+ ].
].
aDevice isNil ifTrue:[
- ^ self
+ ^ self
].
device == aDevice ifTrue:[
- ditherForm notNil ifTrue:[
- ^ self
- ]
+ ditherForm notNil ifTrue:[
+ ^ self
+ ]
].
"/ on high-resolution true-color systems, dont care for dithering and
@@ -4817,25 +4811,25 @@
deviceDepth := aDevice depth.
(deviceVisual := aDevice visualType) == #TrueColor ifTrue:[
- deviceDepth >= 15 ifTrue:[
- id := aDevice colorScaledRed:red scaledGreen:green scaledBlue:blue.
- id notNil ifTrue:[
- device isNil ifTrue:[
- "/ receiver was not associated - do it now & return mySelf
- colorId := id.
- ditherForm := nil.
- device := aDevice.
- ^ self
- ].
- newColor := (self class basicNew)
- setScaledRed:red
- scaledGreen:green
- scaledBlue:blue
- device:aDevice.
- newColor setColorId:id.
- ^ newColor
- ]
- ]
+ deviceDepth >= 15 ifTrue:[
+ id := aDevice colorScaledRed:red scaledGreen:green scaledBlue:blue.
+ id notNil ifTrue:[
+ device isNil ifTrue:[
+ "/ receiver was not associated - do it now & return mySelf
+ colorId := id.
+ ditherForm := nil.
+ device := aDevice.
+ ^ self
+ ].
+ newColor := (self class basicNew)
+ setScaledRed:red
+ scaledGreen:green
+ scaledBlue:blue
+ device:aDevice.
+ newColor setColorId:id.
+ ^ newColor
+ ]
+ ]
].
"/ round a bit within 1% in red & green, 2% in blue
@@ -4876,37 +4870,37 @@
newColor := Color existingColorScaledRed:rV scaledGreen:gV scaledBlue:bV on:aDevice.
newColor notNil ifTrue:[
- (newColor scaledRed ~~ red
- or:[newColor scaledGreen ~~ green
- or:[newColor scaledBlue ~~ blue]]) ifTrue:[
- Transcript showCR:'Color>>#onDevice: got different color'.
- ].
- ^ newColor
+ (newColor scaledRed ~~ red
+ or:[newColor scaledGreen ~~ green
+ or:[newColor scaledBlue ~~ blue]]) ifTrue:[
+ Transcript showCR:'Color>>#onDevice: got different color'.
+ ].
+ ^ newColor
].
"/ ask that device for the exact color
id := aDevice colorScaledRed:red scaledGreen:green scaledBlue:blue.
id notNil ifTrue:[
- device isNil ifTrue:[
- "/ receiver was not associated - do it now & return mySelf
- colorId := id.
- ditherForm := nil.
- device := aDevice.
- newColor := self.
- ] ifFalse:[
- newColor := (self class basicNew)
- setScaledRed:red
- scaledGreen:green
- scaledBlue:blue
- device:aDevice.
- newColor setColorId:id.
- ].
- id notNil ifTrue:[
- deviceVisual ~~ #TrueColor ifTrue:[
- aDevice registerColor:newColor.
- ]
- ].
- ^ newColor
+ device isNil ifTrue:[
+ "/ receiver was not associated - do it now & return mySelf
+ colorId := id.
+ ditherForm := nil.
+ device := aDevice.
+ newColor := self.
+ ] ifFalse:[
+ newColor := (self class basicNew)
+ setScaledRed:red
+ scaledGreen:green
+ scaledBlue:blue
+ device:aDevice.
+ newColor setColorId:id.
+ ].
+ id notNil ifTrue:[
+ deviceVisual ~~ #TrueColor ifTrue:[
+ aDevice registerColor:newColor.
+ ]
+ ].
+ ^ newColor
].
"/
@@ -4922,131 +4916,131 @@
((rV - greyV) abs <= 655 "/ MaxValue // 100
and:[(gV - greyV) abs <= 655 "/ MaxValue // 100
and:[(bV - greyV) abs <= 1310]]) ifTrue:[ "/ MaxValue // 100 * 2
- rV := gV := bV := greyV.
+ rV := gV := bV := greyV.
] ifFalse:[
- rV := red. gV := green. bV := blue.
+ rV := red. gV := green. bV := blue.
].
aDevice hasColors ifTrue:[
- deviceFixColors := aDevice fixColors.
- deviceFixColors isNil ifTrue:[
- "/ ask that device for the exact color
- id := aDevice colorScaledRed:rV scaledGreen:gV scaledBlue:bV.
- id isNil ifTrue:[
- aDevice isOpen ifFalse:[
- ^ nil
- ].
-
- "/ this is a kludge: scavenge to free unused colors
- "/ and try again ...
- ObjectMemory scavenge; finalize.
- id := aDevice colorScaledRed:rV scaledGreen:gV scaledBlue:bV
- ].
-
- id isNil ifTrue:[
- "/ no such color - try color dithers
-
- self class
- ditherRed:rV green:gV blue:bV
- on:aDevice
- into:[:c :f | newColor := c. form := f].
- newColor notNil ifTrue:[^ newColor].
- ].
- ].
-
- "/ none found ? -> do a hard dither using fixColors
-
- (id isNil and:[form isNil]) ifTrue:[
- deviceFixColors notNil ifTrue:[
- self class
- fixDitherRed:rV green:gV blue:bV
- on:aDevice
- into:[:c :f | newColor := c. form := f].
- newColor notNil ifTrue:[^ newColor].
- ]
- ].
-
- "/ still none found ? -> do a very hard dither using existing colors
-
- (id isNil and:[form isNil]) ifTrue:[
- self class
- complexDitherRed:rV green:gV blue:bV
- on:aDevice
- into:[:c :f | newColor := c. form := f].
- newColor notNil ifTrue:[^ newColor].
- ].
+ deviceFixColors := aDevice fixColors.
+ deviceFixColors isNil ifTrue:[
+ "/ ask that device for the exact color
+ id := aDevice colorScaledRed:rV scaledGreen:gV scaledBlue:bV.
+ id isNil ifTrue:[
+ aDevice isOpen ifFalse:[
+ ^ nil
+ ].
+
+ "/ this is a kludge: scavenge to free unused colors
+ "/ and try again ...
+ ObjectMemory scavenge; finalize.
+ id := aDevice colorScaledRed:rV scaledGreen:gV scaledBlue:bV
+ ].
+
+ id isNil ifTrue:[
+ "/ no such color - try color dithers
+
+ self class
+ ditherRed:rV green:gV blue:bV
+ on:aDevice
+ into:[:c :f | newColor := c. form := f].
+ newColor notNil ifTrue:[^ newColor].
+ ].
+ ].
+
+ "/ none found ? -> do a hard dither using fixColors
+
+ (id isNil and:[form isNil]) ifTrue:[
+ deviceFixColors notNil ifTrue:[
+ self class
+ fixDitherRed:rV green:gV blue:bV
+ on:aDevice
+ into:[:c :f | newColor := c. form := f].
+ newColor notNil ifTrue:[^ newColor].
+ ]
+ ].
+
+ "/ still none found ? -> do a very hard dither using existing colors
+
+ (id isNil and:[form isNil]) ifTrue:[
+ self class
+ complexDitherRed:rV green:gV blue:bV
+ on:aDevice
+ into:[:c :f | newColor := c. form := f].
+ newColor notNil ifTrue:[^ newColor].
+ ].
].
(id isNil and:[form isNil]) ifTrue:[
- "still no result - try graying"
-
- greyV == 0 ifTrue:[
- id := aDevice blackpixel
- ] ifFalse:[
- greyV == MaxValue ifTrue:[
- id := aDevice whitepixel
- ] ifFalse:[
- aDevice hasGrayscales ifTrue:[
- self class
- ditherGrayFor:(greyV / MaxValue)
- on:aDevice
- into:[:c :f | newColor := c. form := f].
- newColor notNil ifTrue:[^ newColor].
- ].
- form isNil ifTrue:[
- "/ still none - dither b&w
- self class
- monoDitherFor:(greyV / MaxValue)
- between:Black and:White
- on:aDevice
- into:[:c :f | newColor := c. form := f].
- newColor notNil ifTrue:[^ newColor].
- form isNil ifTrue:[
- "/ cannot happen
- 'Color [warning]: monoDither failed' errorPrintCR.
- ^ nil
- ]
- ]
- ]
- ].
+ "still no result - try graying"
+
+ greyV == 0 ifTrue:[
+ id := aDevice blackpixel
+ ] ifFalse:[
+ greyV == MaxValue ifTrue:[
+ id := aDevice whitepixel
+ ] ifFalse:[
+ aDevice hasGrayscales ifTrue:[
+ self class
+ ditherGrayFor:(greyV / MaxValue)
+ on:aDevice
+ into:[:c :f | newColor := c. form := f].
+ newColor notNil ifTrue:[^ newColor].
+ ].
+ form isNil ifTrue:[
+ "/ still none - dither b&w
+ self class
+ monoDitherFor:(greyV / MaxValue)
+ between:Black and:White
+ on:aDevice
+ into:[:c :f | newColor := c. form := f].
+ newColor notNil ifTrue:[^ newColor].
+ form isNil ifTrue:[
+ "/ cannot happen
+ 'Color [warning]: monoDither failed' errorPrintCR.
+ ^ nil
+ ]
+ ]
+ ]
+ ].
].
device isNil ifTrue:[
- "/ receiver was not associated - do it now & return mySelf
-
- device := aDevice.
- id isNil ifTrue:[
- ditherForm := form
- ].
- colorId := id.
-
- "/ have to register - otherwise it keeps old info around
-
- id notNil ifTrue:[
- deviceVisual ~~ #TrueColor ifTrue:[
- aDevice registerColor:self.
- ]
- ].
- ^ self
+ "/ receiver was not associated - do it now & return mySelf
+
+ device := aDevice.
+ id isNil ifTrue:[
+ ditherForm := form
+ ].
+ colorId := id.
+
+ "/ have to register - otherwise it keeps old info around
+
+ id notNil ifTrue:[
+ deviceVisual ~~ #TrueColor ifTrue:[
+ aDevice registerColor:self.
+ ]
+ ].
+ ^ self
].
"/ receiver was already associated to another device
"/ - need a new color and return it
newColor := (self class basicNew)
- setScaledRed:red
- scaledGreen:green
- scaledBlue:blue
- device:aDevice.
+ setScaledRed:red
+ scaledGreen:green
+ scaledBlue:blue
+ device:aDevice.
id isNil ifTrue:[
- newColor setDitherForm:form
+ newColor setDitherForm:form
] ifFalse:[
- newColor setColorId:id.
-
- "/ trueColor device-colors are not registered
- deviceVisual ~~ #TrueColor ifTrue:[
- aDevice registerColor:newColor.
- ]
+ newColor setColorId:id.
+
+ "/ trueColor device-colors are not registered
+ deviceVisual ~~ #TrueColor ifTrue:[
+ aDevice registerColor:newColor.
+ ]
].
^ newColor