--- a/Color.st Tue Aug 29 18:11:04 2017 +0200
+++ b/Color.st Tue Aug 29 20:00:40 2017 +0200
@@ -16,10 +16,10 @@
Object subclass:#Color
instanceVariableNames:'red green blue device colorId ditherForm replacementColor
writable'
- classVariableNames:'MaxValue Cells Black White LightGrey Grey DarkGrey Pseudo0
- Pseudo1 PseudoAll Red Green Blue Yellow Orange RetryAllocation
- DitherBits ColorErrorSignal ColorAllocationFailSignal
- InvalidColorNameSignal StandardColorValues Transparent'
+ classVariableNames:'Black Blue Cells ColorAllocationFailSignal ColorErrorSignal
+ DarkGrey DitherBits Green Grey InvalidColorNameSignal LightGrey
+ MaxValue Orange Pseudo0 Pseudo1 PseudoAll Red RetryAllocation
+ StandardColorValues Transparent White Yellow'
poolDictionaries:''
category:'Graphics-Support'
!
@@ -164,404 +164,6 @@
!Color class methodsFor:'initialization'!
-allocateColorsIn:aColorVector on:aDevice
- "{ Pragma: +optSpace }"
-
- "preallocates a nR x nG x nB colorMap for later use in dithering.
- Doing so has the advantage that the system will never run out of colors,
- however, colors may be either inexact or dithered."
-
- |clr round devClr|
-
- round := 0.
- 1 to:aColorVector size do:[:dstIndex |
- clr := aColorVector at:dstIndex.
- devClr := clr exactOn:aDevice.
- devClr isNil ifTrue:[
- round == 0 ifTrue:[
- Logger info:'scavenge to reclaim colors'.
- ObjectMemory scavenge.
- round := 1.
- devClr := clr exactOn:aDevice.
- ].
- devClr isNil ifTrue:[
- round == 1 ifTrue:[
- Logger info:'collect garbage to reclaim colors'.
- ObjectMemory
- garbageCollect; finalize.
- round := 2.
- devClr := clr exactOn:aDevice.
- ].
- devClr isNil ifTrue:[
- round == 2 ifTrue:[
- Logger info:'lowSpaceCleanup and collect garbage to reclaim colors'.
- ObjectMemory
- performLowSpaceCleanup;
- garbageCollect; finalize.
- round := 3.
- devClr := clr exactOn:aDevice.
- ].
- devClr isNil ifTrue:[
- ColorAllocationFailSignal raiseErrorString:'failed to allocate fix color'.
- ^ self
- ].
- ].
- ].
- ].
- aColorVector at:dstIndex put:devClr.
- ].
-
- "Modified: / 02-03-2017 / 17:43:36 / stefan"
-!
-
-colorCubeWithRed:nRed green:nGreen blue:nBlue
- "{ Pragma: +optSpace }"
-
- |nR "{Class: SmallInteger }"
- nG "{Class: SmallInteger }"
- nB "{Class: SmallInteger }"
- dR dG dB red green blue dstIndex clr round
- colorCube|
-
- nR := nRed.
- nG := nGreen.
- nB := nBlue.
-
- dR := 100.0 / (nR - 1).
- dG := 100.0 / (nG - 1).
- dB := 100.0 / (nB - 1).
-
- colorCube := Array new:(nR * nG * nB).
-
- round := 0.
-
- dstIndex := 1.
- 1 to:nR do:[:sR |
- red := dR * (sR - 1).
- 1 to:nG do:[:sG |
- green := dG * (sG - 1).
- 1 to:nB do:[:sB |
- blue := dB * (sB - 1).
- clr := self red:red green:green blue:blue.
- colorCube at:dstIndex put:clr.
- dstIndex := dstIndex + 1
- ]
- ]
- ].
- ^ colorCube
-
- "Created: 11.7.1996 / 17:55:32 / cg"
- "Modified: 10.1.1997 / 15:37:13 / cg"
-!
-
-flushDeviceColors
- "unassign all colors from their device"
-
- self allInstances do:[:aColor |
- aColor restored
- ].
-
- "Modified: 24.2.1997 / 18:27:06 / cg"
-!
-
-flushDeviceColorsFor:aDevice
- self allInstancesDo:[:aColor |
- aColor device == aDevice ifTrue:[
- aColor restored
- ]
- ]
-!
-
-getColors6x6x4
- "{ Pragma: +optSpace }"
-
- "preallocates a 6x6x4 (144) colorMap and later uses those colors only.
- Doing so has the advantage that the system will never run out of colors,
- however, colors may be either inexact or dithered."
-
- self getColorsRed:6 green:6 blue:4
-
- "
- Color getColors6x6x4
- "
-!
-
-getColors6x6x5
- "{ Pragma: +optSpace }"
-
- "preallocates a 6x6x5 (180) colorMap and later uses those colors only.
- Doing so has the advantage that the system will never run out of colors,
- however, colors may be either inexact or dithered."
-
- self getColorsRed:6 green:6 blue:5
-
- "
- Color getColors6x6x5
- "
-!
-
-getColors6x6x6
- "{ Pragma: +optSpace }"
-
- "preallocates a 6x6x6 (196) colorMap and later uses those colors only.
- Doing so has the advantage that the system will never run out of colors,
- however, colors may be either inexact or dithered."
-
- self getColorsRed:6 green:6 blue:6
-
- "
- Color getColors6x6x6
- "
-!
-
-getColors6x7x4
- "{ Pragma: +optSpace }"
-
- "preallocates a 6x7x4 (168) colorMap and later uses those colors only.
- Doing so has the advantage that the system will never run out of colors,
- however, colors may be either inexact or dithered."
-
- self getColorsRed:6 green:7 blue:4
-
- "
- Color getColors6x7x4
- "
-
- "Created: 12.6.1996 / 17:41:57 / cg"
-!
-
-getColors7x8x4
- "{ Pragma: +optSpace }"
-
- "preallocates a 7x8x4 (224) colorMap and later uses those colors only.
- Doing so has the advantage that the system will never run out of colors,
- however, colors may be either inexact or dithered."
-
- self getColorsRed:7 green:8 blue:4
-
- "
- Color getColors7x8x4
- "
-!
-
-getColorsRed:nRed green:nGreen blue:nBlue
- "{ Pragma: +optSpace }"
-
- "preallocates a nR x nG x nB colorMap for later use in dithering.
- Doing so has the advantage that the system will never run out of colors,
- however, colors may be either inexact or dithered."
-
- self getColorsRed:nRed green:nGreen blue:nBlue on:Screen current
-
- "
- Color getColorsRed:2 green:2 blue:2
- "
-
- "Modified: 11.7.1996 / 17:58:09 / cg"
-!
-
-getColorsRed:nRed green:nGreen blue:nBlue on:aDevice
- "{ Pragma: +optSpace }"
-
- "preallocates a nR x nG x nB colorMap for later use in dithering.
- Doing so has the advantage that the system will never run out of colors,
- however, colors may be either inexact or dithered."
-
- |nR "{Class: SmallInteger }"
- nG "{Class: SmallInteger }"
- nB "{Class: SmallInteger }"
- dR dG dB fixColors|
-
- aDevice visualType == #TrueColor ifTrue:[^ self].
-
- nR := nRed.
- nG := nGreen.
- nB := nBlue.
-
- dR := 100.0 / (nR - 1).
- dG := 100.0 / (nG - 1).
- dB := 100.0 / (nB - 1).
-
- fixColors := self colorCubeWithRed:nRed green:nGreen blue:nBlue.
- self allocateColorsIn:fixColors on:aDevice.
-
- aDevice setFixColors:fixColors numRed:nR numGreen:nG numBlue:nB
-
- "
- Color getColorsRed:2 green:2 blue:2 on:Display
- "
-
- "Created: 11.7.1996 / 17:55:32 / cg"
- "Modified: 10.1.1997 / 15:37:13 / cg"
-!
-
-getGrayColors:nGray on:aDevice
- "{ Pragma: +optSpace }"
-
- "preallocates nGray gray colors for later use in dithering.
- Doing so has the advantage that the system will never run out of colors,
- however, colors may be either inexact or dithered."
-
- |nG "{Class: SmallInteger }"
- d fixGrayColors|
-
- aDevice visualType == #TrueColor ifTrue:[^ self].
-
- nG := nGray.
- d := 100.0 / (nG - 1).
-
- fixGrayColors := self grayColorVector:nGray.
- self allocateColorsIn:fixGrayColors on:aDevice.
-
- aDevice setFixGrayColors:fixGrayColors
-
- "
- Color getGrayColors:16 on:Display
- "
-
- "Created: 23.6.1997 / 15:29:50 / cg"
-!
-
-getPrimaryColorsOn:aDevice
- "{ Pragma: +optSpace }"
-
- "preallocate the primary colors.
- Doing so during early startup prevents us from running out
- of (at least those required) colors later.
- This guarantees, that at least some colors are available
- for dithering (although, with only black, white, red, green and blue,
- dithered images look very poor)."
-
- |colors white black red green blue clr dDepth
- lastPix "{ Class: SmallInteger }" |
-
- (aDevice notNil and:[aDevice ditherColors isNil]) ifTrue:[
- white := (self red:100 green:100 blue:100) exactOn:aDevice.
- white colorId isNil ifTrue:[
- 'Color [warning]: cannot allocate white color' errorPrintCR.
- ].
- black := (self red:0 green:0 blue:0) exactOn:aDevice.
- black colorId isNil ifTrue:[
- 'Color [warning]: cannot allocate black color' errorPrintCR.
- ].
-
- aDevice hasColors ifTrue:[
- red := (self red:100 green:0 blue:0) exactOn:aDevice.
- green := (self red:0 green:100 blue:0) exactOn:aDevice.
- blue := (self red:0 green:0 blue:100) exactOn:aDevice.
- (red isNil
- or:[green isNil
- or:[blue isNil
- or:[red colorId isNil
- or:[green colorId isNil
- or:[blue colorId isNil]]]]]) ifTrue:[
- 'Color [warning]: cannot allocate primary color(s)' errorPrintCR.
- dDepth := aDevice depth.
- ((dDepth >= 4) and:[dDepth <= 8]) ifTrue:[
- "/
- "/ see what we have ...
- "/
- lastPix := (1 bitShift:dDepth) - 1.
- 0 to:lastPix do:[:pixel |
- colors := OrderedCollection new.
- aDevice getRGBFrom:pixel into:[:r :g :b |
- colors add:((Color red:r green:g blue:b) exactOn:aDevice).
- ]
- ].
- red := (self red:100 green:0 blue:0) nearestOn:aDevice.
- green := (self red:0 green:100 blue:0) nearestOn:aDevice.
- blue := (self red:0 green:0 blue:100) nearestOn:aDevice.
- ] ifFalse:[
- aDevice hasColors:false.
- aDevice hasGrayscales:false.
- red := green := blue := nil.
- ]
- ]
- ].
-
- aDevice == Display ifTrue:[
- "/ keep those around for the main display
- White := white.
- Black := black.
- Red := red.
- Green := green.
- Blue := blue
- ].
-
- aDevice visualType ~~ #TrueColor ifTrue:[
- aDevice hasColors ifTrue:[
-
- "preallocate some colors for dithering
- - otherwise, they may not be available when we need them ...
- these are: black, white, grey50,
- red, green, blue, yellow, cyan and magenta.
- "
-
- colors := OrderedCollection new.
- clr := (self gray:50) exactOn:aDevice.
- (clr notNil and:[clr colorId notNil]) ifTrue:[
- colors add:clr
- ].
-
- colors add:white; add:black; add:red; add:green; add:blue.
-
- colors add:((self red:100 green:100 blue:0) exactOn:aDevice).
- colors add:((self red:100 green:0 blue:100) exactOn:aDevice).
- colors add:((self red:0 green:100 blue:100) exactOn:aDevice).
- ].
-
- aDevice hasGrayscales ifTrue:[
- aDevice hasColors ifFalse:[
- colors := OrderedCollection new.
- colors add:((self gray:50) exactOn:aDevice).
- colors add:white; add:black.
-
- ].
- colors add:((self gray:25) exactOn:aDevice).
- colors add:((self gray:33) exactOn:aDevice).
- colors add:((self gray:67) exactOn:aDevice).
- colors add:((self gray:75) exactOn:aDevice).
- ].
-
- colors notNil ifTrue:[
- colors := colors select:[:clr | clr notNil and:[clr colorId notNil]].
- aDevice setDitherColors:(colors asArray).
- ]
- ]
- ]
-
- "Created: 11.7.1996 / 18:09:28 / cg"
- "Modified: 21.10.1997 / 02:42:28 / cg"
-!
-
-grayColorVector:nGray
- |nG "{Class: SmallInteger }"
- d gray dstIndex clr round
- grayColors|
-
- nG := nGray.
- d := 100.0 / (nG - 1).
-
- grayColors := Array new:nG.
-
- round := 0.
-
- dstIndex := 1.
- 1 to:nG do:[:sG |
- gray := d * (sG - 1).
- clr := self red:gray green:gray blue:gray.
- grayColors at:dstIndex put:clr.
- dstIndex := dstIndex + 1
- ].
- ^ grayColors
-
- "
- Color getGrayColors:16 on:Display
- "
-
- "Created: 23.6.1997 / 15:29:50 / cg"
-!
-
initialize
"setup tracker of known colors and initialize classvars with
heavily used colors"
@@ -629,30 +231,6 @@
"Modified: 6.3.1997 / 02:28:58 / cg"
!
-standardDitherColorsForDepth8
- "return a set of colors useful for dithering (roughly 200 colors);
- This includes a color cube and the main grayScale colors."
-
- |ditherColors|
-
- ditherColors := self colorCubeWithRed:6 green:8 blue:4.
- ditherColors := ditherColors ,
- (Array
- with:(Color gray:20)
- with:(Color gray:25)
- with:(Color gray:40)
- with:(Color gray:50)
- with:(Color gray:60)
- with:(Color gray:75)
- with:(Color gray:80)
- with:(Color rgbValue:16rBFBFBF)).
- ^ ditherColors
-
- "
- self standardDitherColorsForDepth8
- "
-!
-
update:something with:aParameter from:changedObject
"handle image restarts and flush any device resource handles"
@@ -683,33 +261,6 @@
"Created: 15.6.1996 / 15:14:03 / cg"
"Modified: 24.2.1997 / 22:08:05 / cg"
-!
-
-vgaColors
- "{ Pragma: +optSpace }"
-
- |colors|
-
- colors := Array new:16.
- colors at:1 put:(Color rgbValue:16rFFFFFF).
- colors at:2 put:(Color rgbValue:16rC0C0C0).
- colors at:3 put:(Color rgbValue:16r808080).
- colors at:4 put:(Color rgbValue:16r000000).
- colors at:5 put:(Color rgbValue:16rFF0000).
- colors at:6 put:(Color rgbValue:16r800000).
- colors at:7 put:(Color rgbValue:16r008000).
- colors at:8 put:(Color rgbValue:16r00FF00).
- colors at:9 put:(Color rgbValue:16r0000FF).
- colors at:10 put:(Color rgbValue:16r000080).
- colors at:11 put:(Color rgbValue:16rFF00FF).
- colors at:12 put:(Color rgbValue:16r800080).
- colors at:13 put:(Color rgbValue:16rFFFF00).
- colors at:14 put:(Color rgbValue:16r808000).
- colors at:15 put:(Color rgbValue:16r00FFFF).
- colors at:16 put:(Color rgbValue:16r008080).
- ^ colors
-
- "Created: / 07-07-2006 / 13:36:15 / cg"
! !
!Color class methodsFor:'instance creation'!
@@ -3944,6 +3495,787 @@
"Modified: 11.7.1996 / 18:20:14 / cg"
! !
+!Color class methodsFor:'utilities'!
+
+allocateColorsIn:aColorVector on:aDevice
+ "{ Pragma: +optSpace }"
+
+ "preallocates a nR x nG x nB colorMap for later use in dithering.
+ Doing so has the advantage that the system will never run out of colors,
+ however, colors may be either inexact or dithered."
+
+ |clr round devClr|
+
+ round := 0.
+ 1 to:aColorVector size do:[:dstIndex |
+ clr := aColorVector at:dstIndex.
+ devClr := clr exactOn:aDevice.
+ devClr isNil ifTrue:[
+ round == 0 ifTrue:[
+ Logger info:'scavenge to reclaim colors'.
+ ObjectMemory scavenge.
+ round := 1.
+ devClr := clr exactOn:aDevice.
+ ].
+ devClr isNil ifTrue:[
+ round == 1 ifTrue:[
+ Logger info:'collect garbage to reclaim colors'.
+ ObjectMemory
+ garbageCollect; finalize.
+ round := 2.
+ devClr := clr exactOn:aDevice.
+ ].
+ devClr isNil ifTrue:[
+ round == 2 ifTrue:[
+ Logger info:'lowSpaceCleanup and collect garbage to reclaim colors'.
+ ObjectMemory
+ performLowSpaceCleanup;
+ garbageCollect; finalize.
+ round := 3.
+ devClr := clr exactOn:aDevice.
+ ].
+ devClr isNil ifTrue:[
+ ColorAllocationFailSignal raiseErrorString:'failed to allocate fix color'.
+ ^ self
+ ].
+ ].
+ ].
+ ].
+ aColorVector at:dstIndex put:devClr.
+ ].
+
+ "Modified: / 02-03-2017 / 17:43:36 / stefan"
+!
+
+best:numColors ditherColorsForImage:anImage
+ "work in progress"
+
+ |bigCube boxMax numBits numGray usedColors
+ minRed maxRed minGreen maxGreen minBlue maxBlue
+ boundaryColors boxesSegmented segments boxesToDo enumerateNeighbors
+ firstTry segmentColors|
+
+ ((anImage photometric == #blackIs0) or:[anImage photometric == #whiteIs0]) ifTrue:[
+ numGray := (1 bitShift:anImage depth) min:numColors.
+ ^ self grayColorVector:numGray
+ ].
+ (anImage photometric == #palette) ifTrue:[
+ "/ all gray?
+ (anImage colorMap conform:[:clr | clr isGrayColor]) ifTrue:[
+ numGray := ((1 bitShift:anImage depth) min:anImage colorMap size) min:numColors.
+ ^ self grayColorVector:numGray
+ ].
+ ].
+
+ boxMax := 63.
+ numBits := 6.
+ firstTry := true.
+
+ [
+ "/ first, a rough cube with less precision...
+ bigCube := IntegerArray new:(boxMax+1)*(boxMax+1)*(boxMax+1).
+
+ firstTry ifTrue:[
+ usedColors := Set new.
+ minRed := minGreen := minBlue := 255.
+ maxRed := maxGreen := maxBlue := 0.
+ ].
+
+ anImage
+ rgbValuesFromX:0 y:0
+ toX:(anImage width-1) y:(anImage height-1)
+ do:[:x :y :rgb |
+ |redByte greenByte blueByte r g b idx oldCount|
+
+ redByte := (rgb rightShift:16) bitAnd:16rFF.
+ greenByte := (rgb rightShift:8) bitAnd:16rFF.
+ blueByte := (rgb) bitAnd:16rFF.
+
+ r := redByte rightShift:(8-numBits).
+ g := greenByte rightShift:(8-numBits).
+ b := blueByte rightShift:(8-numBits).
+ idx := (((r * (boxMax+1))+g)*(boxMax+1))+b+1.
+ oldCount := bigCube at:idx.
+
+ firstTry ifTrue:[
+ redByte < minRed ifTrue:[minRed := redByte] ifFalse:[redByte > maxRed ifTrue:[maxRed := redByte]].
+ greenByte < minGreen ifTrue:[minGreen := greenByte] ifFalse:[greenByte > maxGreen ifTrue:[maxGreen := greenByte]].
+ blueByte < minBlue ifTrue:[minBlue := blueByte] ifFalse:[blueByte > maxBlue ifTrue:[maxBlue := blueByte]].
+
+ oldCount == 0 ifTrue:[
+ usedColors add:rgb.
+ ].
+ ].
+ bigCube at:idx put:oldCount+1.
+ ].
+
+ firstTry ifTrue:[
+ usedColors size <= numColors ifTrue:[
+ "/ huh - that will be easy!!
+ ^ usedColors asArray.
+ ].
+
+ "/ if not even the basic colors fit, dither to b&w
+ numColors == 2 ifTrue:[
+ ^ { Color black . Color white }
+ ].
+ "/ if not even the basic colors fit, dither to b&w
+ numColors == 4 ifTrue:[
+ ^ { Color black . Color red . Color green . Color blue. }
+ ].
+
+ "/ we need the at least the 8 corners for dithering, at least...
+ boundaryColors := OrderedCollection new.
+ { minRed . maxRed } do:[:r |
+ { minGreen . maxGreen } do:[:g |
+ { minBlue . maxBlue } do:[:b |
+ boundaryColors add:(Color redByte:r greenByte:g blueByte:b)
+ ].
+ ].
+ ].
+ numColors == 8 ifTrue:[
+ ^ boundaryColors
+ ].
+ ].
+ firstTry := false.
+
+ "/
+ "/ find and generate connected subarea box sets
+ "/
+ boxesSegmented := Set new.
+ segments := OrderedCollection new.
+
+ boxesToDo := OrderedCollection new.
+
+ "/ each box has 9+9+3+3+1+1 neighbors
+ "/
+ enumerateNeighbors :=
+ [:rgb :aBlock|
+ |r g b|
+
+ r := (rgb rightShift:(numBits+numBits)) bitAnd:boxMax.
+ g := (rgb rightShift:numBits) bitAnd:boxMax.
+ b := (rgb) bitAnd:boxMax.
+ r-1 to:r+1 do:[:n_r |
+ (n_r between:0 and:boxMax) ifTrue:[
+ g-1 to:g+1 do:[:n_g |
+ (n_g between:0 and:boxMax) ifTrue:[
+ b-1 to:b+1 do:[:n_b |
+ (n_b between:0 and:boxMax) ifTrue:[
+ ((n_r == r) and:[n_g == g and:[n_b == b]]) ifFalse:[
+ aBlock value:((((n_r * (boxMax+1))+n_g)*(boxMax+1))+n_b).
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ ].
+
+ 0 to:boxMax do:[:r |
+ 0 to:boxMax do:[:g |
+ 0 to:boxMax do:[:b |
+ |rgb|
+
+ rgb := (((r * (boxMax+1))+g)*(boxMax+1))+b.
+ (bigCube at:rgb+1) ~~ 0 ifTrue:[
+ (boxesSegmented includes:rgb) ifFalse:[
+ |currentSegment|
+
+ "/ start a segment
+ currentSegment := OrderedCollection new.
+ segments add:currentSegment.
+
+ boxesToDo add:rgb.
+ boxesSegmented add:rgb.
+
+ [boxesToDo notEmpty] whileTrue:[
+ |rgb|
+
+ rgb := boxesToDo removeLast.
+ currentSegment add:rgb.
+
+ enumerateNeighbors value:rgb value:[:n_rgb |
+ (bigCube at:n_rgb+1) ~~ 0 ifTrue:[
+ "/ neighbor has used pixels as well...
+ (boxesSegmented includes:n_rgb) ifFalse:[
+ "/ neighbor was not processed...
+ boxesSegmented add:rgb.
+ boxesToDo add:n_rgb.
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+ ]
+ ]
+ ].
+
+ (segments size < numColors) ifTrue:[
+ segmentColors := segments
+ collect:[:eachSegment |
+ |n sumRed sumGreen sumBlue centerRed centerGreen centerBlue|
+
+ "/ compute central point
+ "/ as center of mass (taking count per box as weight)
+ "/ this central point will be placed into the colormap.
+ sumRed := sumGreen := sumBlue := 0.
+ n := eachSegment size.
+
+ eachSegment do:[:rgbOfBoxInSegment |
+ |r g b|
+
+ r := (rgbOfBoxInSegment rightShift:(numBits+numBits)) bitAnd:boxMax.
+ g := (rgbOfBoxInSegment rightShift:numBits) bitAnd:boxMax.
+ b := (rgbOfBoxInSegment) bitAnd:boxMax.
+ sumRed :=sumRed + r.
+ sumGreen := sumGreen + g.
+ sumBlue := sumBlue + b.
+ ].
+ centerRed := (sumRed / n) rounded.
+ centerGreen := (sumGreen / n) rounded.
+ centerBlue := (sumBlue / n) rounded.
+
+ centerRed := (centerRed bitShift:(8-numBits))
+ bitOr:(centerRed bitShift:(8-numBits-numBits)).
+ centerGreen := (centerGreen bitShift:(8-numBits))
+ bitOr:(centerGreen bitShift:(8-numBits-numBits)).
+ centerBlue := (centerBlue bitShift:(8-numBits))
+ bitOr:(centerBlue bitShift:(8-numBits-numBits)).
+
+ Color redByte:centerRed greenByte:centerGreen blueByte:centerBlue.
+ ]
+ as:OrderedCollection.
+ "/ can we add black & white?
+ (segmentColors includes:Color white) ifFalse:[
+ segmentColors add:Color white.
+ ].
+ (segmentColors includes:Color black) ifFalse:[
+ segmentColors add:Color black.
+ ].
+ "/ can we add the boundary colors?
+ boundaryColors do:[:each |
+ (segmentColors size < numColors) ifTrue:[
+ (segmentColors includes:each) ifFalse:[
+ segmentColors add:each.
+ ].
+ ].
+ ].
+ ^ segmentColors.
+ ].
+
+ numBits := numBits - 1.
+ boxMax := ((boxMax+1) // 2) - 1.
+
+ numBits == 0 ifTrue:[
+ self error.
+ ].
+ ] loop.
+
+ "
+ Color
+ best:16
+ ditherColorsForImage:(Image fromFile:'../../goodies/bitmaps/pcxImages/lena_depth8_palette.pcx')
+
+ Color
+ best:16
+ ditherColorsForImage:(Image fromFile:'../../goodies/bitmaps/pcxImages/lena_depth24_rgb.pcx')
+
+ Color
+ best:16
+ ditherColorsForImage:((Image fromFile:'../../goodies/bitmaps/pcxImages/lena_depth8_palette.pcx') asGrayImageDepth:8)
+
+ "
+
+ "Created: / 29-08-2017 / 14:31:19 / cg"
+ "Modified (comment): / 29-08-2017 / 20:00:32 / cg"
+!
+
+browserColors
+ "return the palette, known as 'the color cube', 'the Netscape palette',
+ or 'the Browser-Safe palette'.
+ This is familiar to all seasoned Web designers and graphics production specialists;
+ Use this map for low-color-res depth 8 (gif-) images, if old pseudo displays are to be
+ supported."
+
+ ^ self colorCubeWithRed:6 green:6 blue:6.
+
+ "
+ |img|
+
+ img := Image width:(8*6*6)+1 height:(8*6)+1 depth:8.
+ img colorMap:(Color browserColors).
+ img pixelFunction:
+ [:x :y |
+ |r g b|
+
+ (y \\ 8 == 0 ) ifTrue:[
+ 86
+ ] ifFalse:[
+ x \\ 8 == 0 ifTrue:[
+ 86
+ ] ifFalse:[
+ r := g := b := 0.
+ 'y is green component'.
+ g := 5-(y // 8).
+ 'x inside subsquare is blue component'.
+ b := (x \\ (8*6)) // 8.
+ 'subsquare is red component'.
+ r := (x // (8*6)).
+ ((r*6)+g)*6+b
+ ]
+ ].
+ ].
+ img inspect.
+ "
+
+ "Created: / 29-08-2017 / 17:01:23 / cg"
+!
+
+colorCubeWithRed:nRed green:nGreen blue:nBlue
+ "given a number of red, green and blue shades,
+ return a color cube (map) containing those colors.
+ Eg, return a map containing any combination of the
+ nRed, nGreen and nBlue shades.
+ This is used for dithering of deep images onto limited-depth canvases
+ for example: with nRed,nGreen,nBlue == 2,3,2
+ you will get a cube of 2*3*2 = 12 colors, with two shades of red (0 and 255),
+ threed shades of green (0, 127 and 255) and two shades of blue (0 and 255)."
+
+ "{ Pragma: +optSpace }"
+
+ |nR "{Class: SmallInteger }"
+ nG "{Class: SmallInteger }"
+ nB "{Class: SmallInteger }"
+ dR dG dB red green blue dstIndex clr round
+ colorCube|
+
+ nR := nRed.
+ nG := nGreen.
+ nB := nBlue.
+
+ dR := 100.0 / (nR - 1).
+ dG := 100.0 / (nG - 1).
+ dB := 100.0 / (nB - 1).
+
+ colorCube := Array new:(nR * nG * nB).
+
+ round := 0.
+
+ dstIndex := 1.
+ 1 to:nR do:[:sR |
+ red := dR * (sR - 1).
+ 1 to:nG do:[:sG |
+ green := dG * (sG - 1).
+ 1 to:nB do:[:sB |
+ blue := dB * (sB - 1).
+ clr := self red:red green:green blue:blue.
+ colorCube at:dstIndex put:clr.
+ dstIndex := dstIndex + 1
+ ]
+ ]
+ ].
+ ^ colorCube
+
+ "
+ Color colorCubeWithRed:2 green:2 blue:2
+ Color colorCubeWithRed:2 green:3 blue:2
+ Color colorCubeWithRed:3 green:4 blue:3
+ "
+
+ "Created: / 11-07-1996 / 17:55:32 / cg"
+ "Modified: / 10-01-1997 / 15:37:13 / cg"
+ "Modified (comment): / 29-08-2017 / 14:27:58 / cg"
+!
+
+flushDeviceColors
+ "unassign all colors from their device"
+
+ self allInstances do:[:aColor |
+ aColor restored
+ ].
+
+ "Modified: 24.2.1997 / 18:27:06 / cg"
+!
+
+flushDeviceColorsFor:aDevice
+ self allInstancesDo:[:aColor |
+ aColor device == aDevice ifTrue:[
+ aColor restored
+ ]
+ ]
+!
+
+getColors6x6x4
+ "{ Pragma: +optSpace }"
+
+ "preallocates a 6x6x4 (144) colorMap and later uses those colors only
+ on a palette display (pseudoColor visual).
+
+ Doing so has the advantage that the system will never run out of colors,
+ however, colors may be either inexact or dithered."
+
+ self getColorsRed:6 green:6 blue:4
+
+ "
+ Color getColors6x6x4
+ "
+
+ "Modified (comment): / 29-08-2017 / 17:22:22 / cg"
+!
+
+getColors6x6x5
+ "{ Pragma: +optSpace }"
+
+ "preallocates a 6x6x5 (180) colorMap and later uses those colors only
+ on a palette display (pseudoColor visual).
+
+ Doing so has the advantage that the system will never run out of colors,
+ however, colors may be either inexact or dithered."
+
+ self getColorsRed:6 green:6 blue:5
+
+ "
+ Color getColors6x6x5
+ "
+
+ "Modified (comment): / 29-08-2017 / 17:22:17 / cg"
+!
+
+getColors6x6x6
+ "{ Pragma: +optSpace }"
+
+ "preallocates a 6x6x6 (196) colorMap and later uses those colors only
+ on a palette display (pseudoColor visual).
+
+ Doing so has the advantage that the system will never run out of colors,
+ however, colors may be either inexact or dithered."
+
+ self getColorsRed:6 green:6 blue:6
+
+ "
+ Color getColors6x6x6
+ "
+
+ "Modified (comment): / 29-08-2017 / 17:22:10 / cg"
+!
+
+getColors6x7x4
+ "{ Pragma: +optSpace }"
+
+ "preallocates a 6x7x4 (168) colorMap and later uses those colors only
+ on a palette display (pseudoColor visual).
+
+ Doing so has the advantage that the system will never run out of colors,
+ however, colors may be either inexact or dithered."
+
+ self getColorsRed:6 green:7 blue:4
+
+ "
+ Color getColors6x7x4
+ "
+
+ "Created: / 12-06-1996 / 17:41:57 / cg"
+ "Modified (comment): / 29-08-2017 / 17:22:04 / cg"
+!
+
+getColors7x8x4
+ "{ Pragma: +optSpace }"
+
+ "preallocates a 7x8x4 (224) colorMap and later uses those colors only
+ on a palette display (pseudoColor visual).
+
+ Doing so has the advantage that the system will never run out of colors,
+ however, colors may be either inexact or dithered."
+
+ self getColorsRed:7 green:8 blue:4
+
+ "
+ Color getColors7x8x4
+ "
+
+ "Modified (comment): / 29-08-2017 / 17:21:56 / cg"
+!
+
+getColorsRed:nRed green:nGreen blue:nBlue
+ "{ Pragma: +optSpace }"
+
+ "preallocates a nR x nG x nB colorMap for later use in dithering
+ on a palette display (pseudoColor visual).
+
+ Doing so has the advantage that the system will never run out of colors,
+ however, colors may be either inexact or dithered."
+
+ self getColorsRed:nRed green:nGreen blue:nBlue on:Screen current
+
+ "
+ Color getColorsRed:2 green:2 blue:2
+ "
+
+ "Modified: / 11-07-1996 / 17:58:09 / cg"
+ "Modified (comment): / 29-08-2017 / 16:47:34 / cg"
+!
+
+getColorsRed:nRed green:nGreen blue:nBlue on:aDevice
+ "{ Pragma: +optSpace }"
+
+ "preallocates a nR x nG x nB colorMap for later use in dithering
+ on a palette display (pseudoColor visual).
+
+ Doing so has the advantage that the system will never run out of colors,
+ however, colors may be either inexact or dithered."
+
+ |nR "{Class: SmallInteger }"
+ nG "{Class: SmallInteger }"
+ nB "{Class: SmallInteger }"
+ dR dG dB fixColors|
+
+ aDevice visualType == #TrueColor ifTrue:[^ self].
+
+ nR := nRed.
+ nG := nGreen.
+ nB := nBlue.
+
+ dR := 100.0 / (nR - 1).
+ dG := 100.0 / (nG - 1).
+ dB := 100.0 / (nB - 1).
+
+ fixColors := self colorCubeWithRed:nRed green:nGreen blue:nBlue.
+ self allocateColorsIn:fixColors on:aDevice.
+
+ aDevice setFixColors:fixColors numRed:nR numGreen:nG numBlue:nB
+
+ "
+ Color getColorsRed:2 green:2 blue:2 on:Display
+ "
+
+ "Created: / 11-07-1996 / 17:55:32 / cg"
+ "Modified: / 10-01-1997 / 15:37:13 / cg"
+ "Modified (comment): / 29-08-2017 / 16:47:38 / cg"
+!
+
+getGrayColors:nGray on:aDevice
+ "{ Pragma: +optSpace }"
+
+ "preallocates nGray gray colors for later use in dithering
+ on a palette display (pseudoColor visual).
+
+ Doing so has the advantage that the system will never run out of colors,
+ however, colors may be either inexact or dithered."
+
+ |nG "{Class: SmallInteger }"
+ d fixGrayColors|
+
+ aDevice visualType == #TrueColor ifTrue:[^ self].
+
+ nG := nGray.
+ d := 100.0 / (nG - 1).
+
+ fixGrayColors := self grayColorVector:nGray.
+ self allocateColorsIn:fixGrayColors on:aDevice.
+
+ aDevice setFixGrayColors:fixGrayColors
+
+ "
+ Color getGrayColors:16 on:Display
+ "
+
+ "Created: / 23-06-1997 / 15:29:50 / cg"
+ "Modified (comment): / 29-08-2017 / 17:23:18 / cg"
+!
+
+getPrimaryColorsOn:aDevice
+ "{ Pragma: +optSpace }"
+
+ "preallocate the primary colors on a palette display (pseudoColor visual).
+
+ Doing so during early startup prevents us from running out
+ of (at least those required) colors later.
+ This guarantees, that at least some colors are available
+ for dithering (although, with only black, white, red, green and blue,
+ dithered images look very poor)."
+
+ |colors white black red green blue clr dDepth
+ lastPix "{ Class: SmallInteger }" |
+
+ (aDevice notNil and:[aDevice ditherColors isNil]) ifTrue:[
+ white := (self red:100 green:100 blue:100) exactOn:aDevice.
+ white colorId isNil ifTrue:[
+ 'Color [warning]: cannot allocate white color' errorPrintCR.
+ ].
+ black := (self red:0 green:0 blue:0) exactOn:aDevice.
+ black colorId isNil ifTrue:[
+ 'Color [warning]: cannot allocate black color' errorPrintCR.
+ ].
+
+ aDevice hasColors ifTrue:[
+ red := (self red:100 green:0 blue:0) exactOn:aDevice.
+ green := (self red:0 green:100 blue:0) exactOn:aDevice.
+ blue := (self red:0 green:0 blue:100) exactOn:aDevice.
+ (red isNil
+ or:[green isNil
+ or:[blue isNil
+ or:[red colorId isNil
+ or:[green colorId isNil
+ or:[blue colorId isNil]]]]]) ifTrue:[
+ 'Color [warning]: cannot allocate primary color(s)' errorPrintCR.
+ dDepth := aDevice depth.
+ ((dDepth >= 4) and:[dDepth <= 8]) ifTrue:[
+ "/
+ "/ see what we have ...
+ "/
+ lastPix := (1 bitShift:dDepth) - 1.
+ 0 to:lastPix do:[:pixel |
+ colors := OrderedCollection new.
+ aDevice getRGBFrom:pixel into:[:r :g :b |
+ colors add:((Color red:r green:g blue:b) exactOn:aDevice).
+ ]
+ ].
+ red := (self red:100 green:0 blue:0) nearestOn:aDevice.
+ green := (self red:0 green:100 blue:0) nearestOn:aDevice.
+ blue := (self red:0 green:0 blue:100) nearestOn:aDevice.
+ ] ifFalse:[
+ aDevice hasColors:false.
+ aDevice hasGrayscales:false.
+ red := green := blue := nil.
+ ]
+ ]
+ ].
+
+ aDevice == Display ifTrue:[
+ "/ keep those around for the main display
+ White := white.
+ Black := black.
+ Red := red.
+ Green := green.
+ Blue := blue
+ ].
+
+ aDevice visualType ~~ #TrueColor ifTrue:[
+ aDevice hasColors ifTrue:[
+
+ "preallocate some colors for dithering
+ - otherwise, they may not be available when we need them ...
+ these are: black, white, grey50,
+ red, green, blue, yellow, cyan and magenta.
+ "
+
+ colors := OrderedCollection new.
+ clr := (self gray:50) exactOn:aDevice.
+ (clr notNil and:[clr colorId notNil]) ifTrue:[
+ colors add:clr
+ ].
+
+ colors add:white; add:black; add:red; add:green; add:blue.
+
+ colors add:((self red:100 green:100 blue:0) exactOn:aDevice).
+ colors add:((self red:100 green:0 blue:100) exactOn:aDevice).
+ colors add:((self red:0 green:100 blue:100) exactOn:aDevice).
+ ].
+
+ aDevice hasGrayscales ifTrue:[
+ aDevice hasColors ifFalse:[
+ colors := OrderedCollection new.
+ colors add:((self gray:50) exactOn:aDevice).
+ colors add:white; add:black.
+
+ ].
+ colors add:((self gray:25) exactOn:aDevice).
+ colors add:((self gray:33) exactOn:aDevice).
+ colors add:((self gray:67) exactOn:aDevice).
+ colors add:((self gray:75) exactOn:aDevice).
+ ].
+
+ colors notNil ifTrue:[
+ colors := colors select:[:clr | clr notNil and:[clr colorId notNil]].
+ aDevice setDitherColors:(colors asArray).
+ ]
+ ]
+ ]
+
+ "Created: / 11-07-1996 / 18:09:28 / cg"
+ "Modified: / 21-10-1997 / 02:42:28 / cg"
+ "Modified (comment): / 29-08-2017 / 17:23:36 / cg"
+!
+
+grayColorVector:nGray
+ |nG "{Class: SmallInteger }"
+ d gray dstIndex clr round
+ grayColors|
+
+ nG := nGray.
+ d := 100.0 / (nG - 1).
+
+ grayColors := Array new:nG.
+
+ round := 0.
+
+ dstIndex := 1.
+ 1 to:nG do:[:sG |
+ gray := d * (sG - 1).
+ clr := self red:gray green:gray blue:gray.
+ grayColors at:dstIndex put:clr.
+ dstIndex := dstIndex + 1
+ ].
+ ^ grayColors
+
+ "
+ Color getGrayColors:16 on:Display
+ "
+
+ "Created: 23.6.1997 / 15:29:50 / cg"
+!
+
+standardDitherColorsForDepth8
+ "return a set of colors useful for dithering (roughly 200 colors);
+ This includes a color cube and the main grayScale colors."
+
+ |ditherColors|
+
+ ditherColors := self colorCubeWithRed:6 green:8 blue:4.
+ ditherColors := ditherColors ,
+ ( #(10 20 25 30 40 50 60 70 75 80 90)
+ collect:[:grayPercent | Color gray:grayPercent]
+ thenSelect:[:grey | (ditherColors includes:grey) not] )
+ asArray.
+ ^ ditherColors
+
+ "
+ self standardDitherColorsForDepth8
+ "
+
+ "Modified: / 29-08-2017 / 17:29:58 / cg"
+!
+
+vgaColors
+ "{ Pragma: +optSpace }"
+
+ |colors|
+
+ colors := Array new:16.
+ colors at:1 put:(Color rgbValue:16rFFFFFF).
+ colors at:2 put:(Color rgbValue:16rC0C0C0).
+ colors at:3 put:(Color rgbValue:16r808080).
+ colors at:4 put:(Color rgbValue:16r000000).
+ colors at:5 put:(Color rgbValue:16rFF0000).
+ colors at:6 put:(Color rgbValue:16r800000).
+ colors at:7 put:(Color rgbValue:16r008000).
+ colors at:8 put:(Color rgbValue:16r00FF00).
+ colors at:9 put:(Color rgbValue:16r0000FF).
+ colors at:10 put:(Color rgbValue:16r000080).
+ colors at:11 put:(Color rgbValue:16rFF00FF).
+ colors at:12 put:(Color rgbValue:16r800080).
+ colors at:13 put:(Color rgbValue:16rFFFF00).
+ colors at:14 put:(Color rgbValue:16r808000).
+ colors at:15 put:(Color rgbValue:16r00FFFF).
+ colors at:16 put:(Color rgbValue:16r008080).
+ ^ colors
+
+ "Created: / 07-07-2006 / 13:36:15 / cg"
+! !
+
!Color methodsFor:'Compatibility-ST80'!
asDevicePaintOn:aDevice