hg/stx-libview: comparison Color.st

equal deleted inserted replaced

-:e41ea5762606
+:ddbc71885249
 round := 0.
 dstIndex := 1.
 1 to:nR do:[:sR |
-red := dR * (sR - 1).
+	red := dR * (sR - 1).
-1 to:nG do:[:sG |
+	1 to:nG do:[:sG |
-green := dG * (sG - 1).
+	    green := dG * (sG - 1).
-1 to:nB do:[:sB |
+	    1 to:nB do:[:sB |
-blue := dB * (sB - 1).
+		blue := dB * (sB - 1).
-clr := (self red:red green:green blue:blue) exactOn:aDevice.
+		clr := (self red:red green:green blue:blue) exactOn:aDevice.
-clr isNil ifTrue:[
+		clr isNil ifTrue:[
-round == 0 ifTrue:[
+		    round == 0 ifTrue:[
-'COLOR: scavenge to reclaim colors' infoPrintCR.
+			'COLOR: scavenge to reclaim colors' infoPrintCR.
-ObjectMemory scavenge.
+			ObjectMemory scavenge.
-round := 1.
+			round := 1.
-clr := (self red:red green:green blue:blue) exactOn:aDevice.
+			clr := (self red:red green:green blue:blue) exactOn:aDevice.
-].
+		    ].
-].
+		].
-clr isNil ifTrue:[
+		clr isNil ifTrue:[
-round == 1 ifTrue:[
+		    round == 1 ifTrue:[
-'COLOR: collect garbage to reclaim colors' infoPrintCR.
+			'COLOR: collect garbage to reclaim colors' infoPrintCR.
-ObjectMemory performLowSpaceCleanup.
+			ObjectMemory performLowSpaceCleanup.
-ObjectMemory garbageCollect.
+			ObjectMemory garbageCollect.
-round := 2.
+			round := 2.
-clr := (self red:red green:green blue:blue) exactOn:aDevice.
+			clr := (self red:red green:green blue:blue) exactOn:aDevice.
-].
+		   ].
-].
+		].
-clr isNil ifTrue:[
+		clr isNil ifTrue:[
-ColorAllocationFailSignal raiseErrorString:'failed to allocate fix color'.
+		    ColorAllocationFailSignal raiseErrorString:'failed to allocate fix color'.
-^ self
+		    ^ self
-].
+		].
-fixColors at:dstIndex put:clr.
+		fixColors at:dstIndex put:clr.
-dstIndex := dstIndex + 1
+		dstIndex := dstIndex + 1
-]
+	    ]
-]
+	]
 ].
 aDevice setFixColors:fixColors
-numRed:nR numGreen:nG numBlue:nB
+		  numRed:nR numGreen:nG numBlue:nB
 "
 Color getColorsRed:2 green:2 blue:2 on:Display
 "
 dithered images look very poor)."
 |colors white black red green blue|
 (aDevice notNil and:[aDevice ditherColors isNil]) ifTrue:[
-white := (self red:100 green:100 blue:100) exactOn:aDevice.
+	white := (self red:100 green:100 blue:100) exactOn:aDevice.
-black := (self red:0 green:0 blue:0) exactOn:aDevice.
+	black := (self red:0 green:0 blue:0) exactOn:aDevice.
-aDevice hasColors ifTrue:[
+	aDevice hasColors ifTrue:[
-red := (self red:100 green:0 blue:0) exactOn:aDevice.
+	    red := (self red:100 green:0 blue:0) exactOn:aDevice.
-green := (self red:0 green:100 blue:0) exactOn:aDevice.
+	    green := (self red:0 green:100 blue:0) exactOn:aDevice.
-blue := (self red:0 green:0 blue:100) exactOn:aDevice.
+	    blue := (self red:0 green:0 blue:100) exactOn:aDevice.
-].
+	].
-aDevice == Display ifTrue:[
+	aDevice == Display ifTrue:[
-"/ keep those around for the main display
+	    "/ keep those around for the main display
-White := white.
+	    White := white.
-Black := black.
+	    Black := black.
-Red := red.
+	    Red := red.
-Green := green.
+	    Green := green.
-Blue := blue
+	    Blue := blue
-].
+	].
-aDevice visualType ~~ #TrueColor ifTrue:[
+	aDevice visualType ~~ #TrueColor ifTrue:[
-aDevice hasColors ifTrue:[
+	    aDevice hasColors ifTrue:[
-"preallocate some colors for dithering
+		"preallocate some colors for dithering
-- otherwise, they may not be available when we need them ...
+		 - otherwise, they may not be available when we need them ...
-these are: black, white, grey50,
+		 these are: black, white, grey50,
-red, green, blue, yellow, cyan and magenta.
+			    red, green, blue, yellow, cyan and magenta.
-"
+		"
-colors := OrderedCollection new.
+		colors := OrderedCollection new.
-colors add:((self gray:50) exactOn:aDevice).
+		colors add:((self gray:50) exactOn:aDevice).
-colors add:white; add:black; add:red; add:green; add:blue.
+		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:100 blue:0) exactOn:aDevice).
-colors add:((self red:100 green:0 blue:100) exactOn:aDevice).
+		colors add:((self red:100 green:0 blue:100) exactOn:aDevice).
-colors add:((self red:0 green:100 blue:100) exactOn:aDevice).
+		colors add:((self red:0 green:100 blue:100) exactOn:aDevice).
-colors := colors select:[:clr | clr notNil].
+		colors := colors select:[:clr | clr notNil].
-].
+	    ].
-aDevice hasGreyscales ifTrue:[
+	    aDevice hasGreyscales ifTrue:[
-aDevice hasColors ifFalse:[
+		aDevice hasColors ifFalse:[
-colors := OrderedCollection new.
+		    colors := OrderedCollection new.
-colors add:((self gray:50) exactOn:aDevice).
+		    colors add:((self gray:50) exactOn:aDevice).
-colors add:white; add:black.
+		    colors add:white; add:black.
-].
+		].
-colors add:((self gray:25) exactOn:aDevice).
+		colors add:((self gray:25) exactOn:aDevice).
-colors add:((self gray:33) exactOn:aDevice).
+		colors add:((self gray:33) exactOn:aDevice).
-colors add:((self gray:67) exactOn:aDevice).
+		colors add:((self gray:67) exactOn:aDevice).
-colors add:((self gray:75) exactOn:aDevice).
+		colors add:((self gray:75) exactOn:aDevice).
-colors := colors select:[:clr | clr notNil].
+		colors := colors select:[:clr | clr notNil].
-].
+	    ].
-colors notNil ifTrue:[
+	    colors notNil ifTrue:[
-aDevice setDitherColors:(colors asArray).
+		aDevice setDitherColors:(colors asArray).
-]
+	    ]
-]
+	]
 ]
 "Created: 11.7.1996 / 18:09:28 / cg"
 "Modified: 11.7.1996 / 18:27:39 / cg"
 !
 initialize
 "setup tracker of known colors and initialize classvars with
 heavily used colors"
 ColorAllocationFailSignal isNil ifTrue:[
-ColorAllocationFailSignal := ErrorSignal newSignalMayProceed:true.
+	ColorAllocationFailSignal := ErrorSignal newSignalMayProceed:true.
-ColorAllocationFailSignal nameClass:self message:#colorAllocationFailSignal.
+	ColorAllocationFailSignal nameClass:self message:#colorAllocationFailSignal.
-ColorAllocationFailSignal notifierString:'color allocation failed'.
+	ColorAllocationFailSignal notifierString:'color allocation failed'.
 ].
 Lobby isNil ifTrue:[
-MaxValue := 16rFFFF.
+	MaxValue := 16rFFFF.
-Lobby := Registry new.
+	Lobby := Registry new.
-self getPrimaryColors.
+	self getPrimaryColors.
-"want to be informed when returning from snapshot"
+	"want to be informed when returning from snapshot"
-ObjectMemory addDependent:self.
+	ObjectMemory addDependent:self.
-RetryAllocation := true.
+	RetryAllocation := true.
-DitherBits := self ditherBits
+	DitherBits := self ditherBits
 ].
 "Modified: 11.7.1996 / 18:31:39 / cg"
 !
 update:something with:aParameter from:changedObject
 "handle image restarts and flush any device resource handles"
 (something == #restarted) ifTrue:[
-self flushDeviceColors
+	self flushDeviceColors
 ].
 (something == #returnFromSnapshot) ifTrue:[
-self getPrimaryColors.
+	self getPrimaryColors.
-Display visualType == #TrueColor ifTrue:[
+	Display visualType == #TrueColor ifTrue:[
-Display releaseFixColors
+	    Display releaseFixColors
-] ifFalse:[
+	] ifFalse:[
-Display fixColors notNil ifTrue:[
+	    Display fixColors notNil ifTrue:[
-ColorAllocationFailSignal handle:[:ex |
+		ColorAllocationFailSignal handle:[:ex |
-ex return
+		    ex return
-] do:[
+		] do:[
-|nR nG nB|
+		    |nR nG nB|
-nR := Display numFixRed.
+		    nR := Display numFixRed.
-nG := Display numFixGreen.
+		    nG := Display numFixGreen.
-nB := Display numFixBlue.
+		    nB := Display numFixBlue.
-Display releaseFixColors.
+		    Display releaseFixColors.
-self getColorsRed:nR
+		    self getColorsRed:nR
-green:nG
+				green:nG
-blue:nB
+				 blue:nB
-on:Display
+				   on:Display
-]
+		]
-]
+	    ]
-]
+	]
 ]
 "Created: 15.6.1996 / 15:14:03 / cg"
 "Modified: 11.7.1996 / 18:03:38 / cg"
 ! !
 |colors|
 colors := OrderedCollection new.
 Lobby do:[:clr |
-(clr graphicsDevice == aDevice and:[clr colorId notNil]) ifTrue:[
+	(clr graphicsDevice == aDevice and:[clr colorId notNil]) ifTrue:[
-colors add:clr
+	    colors add:clr
-]
+	]
 ].
 ^ colors asArray
 "
 Color allocatedColorsOn:Display
 rg := (g * 2.0) rounded / 2.0.  "round to 0.5%"
 rb := (b / 2) rounded * 2.      "round to 2%"
 minDelta := 100*100*100.
 Lobby do:[:aColor |
-(aColor graphicsDevice == aDevice) ifTrue:[
+	(aColor graphicsDevice == aDevice) ifTrue:[
 "/            (aColor colorId notNil) ifTrue:[
-dRed := rr - aColor red.
+		dRed := rr - aColor red.
-dRed < 10 ifTrue:[
+		dRed < 10 ifTrue:[
-diff := dRed asInteger squared
+		    diff := dRed asInteger squared
-+ (rg - aColor green) asInteger squared
+			    + (rg - aColor green) asInteger squared
-+ (rb - aColor blue) asInteger squared.
+			    + (rb - aColor blue) asInteger squared.
-diff < minDelta ifTrue:[
+		    diff < minDelta ifTrue:[
-diff = 0 ifTrue:[
+			diff = 0 ifTrue:[
-"got it"
+			    "got it"
-^ aColor
+			    ^ aColor
-].
+			].
-bestColor := aColor.
+			bestColor := aColor.
-minDelta := diff
+			minDelta := diff
-]
+		    ]
-]
+		]
 "/            ]
-]
+	]
 ].
 "allow an error of 10% per component"
 minDelta < (100+100+100) ifTrue:[ ^ bestColor ].
 ^ nil
 existingColorScaledRed:r scaledGreen:g scaledBlue:b on:aDevice
 "return a device color on aDevice with rgb values
 if there is one, nil otherwise."
 Lobby do:[:aColor |
-(r == aColor scaledRed) ifTrue:[
+	(r == aColor scaledRed) ifTrue:[
-(g == aColor scaledGreen) ifTrue:[
+	    (g == aColor scaledGreen) ifTrue:[
-(b == aColor scaledBlue) ifTrue:[
+		(b == aColor scaledBlue) ifTrue:[
-(aColor graphicsDevice == aDevice) ifTrue:[
+		    (aColor graphicsDevice == aDevice) ifTrue:[
-^ aColor
+			^ aColor
-]
+		    ]
-]
+		]
-]
+	    ]
-]
+	]
 ].
 ^ nil
 "Modified: 5.7.1996 / 17:58:15 / cg"
 ! !
 Near is defined as having an error less than the argument
 error (in percent). The error is computed by the color
 vector distance (which may not be the best possible solution)."
 ^ self
-nearestColorScaledRed:(r * MaxValue // 100)
+	nearestColorScaledRed:(r * MaxValue // 100)
-scaledGreen:(g * MaxValue // 100)
+		  scaledGreen:(g * MaxValue // 100)
-scaledBlue:(b * MaxValue // 100)
+		   scaledBlue:(b * MaxValue // 100)
-on:aDevice
+			   on:aDevice
-in:colors
+			   in:colors
 "Modified: 11.6.1996 / 18:04:55 / cg"
 "Created: 14.6.1996 / 20:05:13 / cg"
 !
 "
 if there are preallocated colors, things are much easier ...
 "
 (cube := aDevice fixColors) notNil ifTrue:[
-^ self
+	^ self
-nearestColorScaledRed:r
+	    nearestColorScaledRed:r
-scaledGreen:g
+	    scaledGreen:g
-scaledBlue:b
+	    scaledBlue:b
-inCube:cube
+	    inCube:cube
-numRed:(aDevice numFixRed)
+	    numRed:(aDevice numFixRed)
-numGreen:(aDevice numFixGreen)
+	    numGreen:(aDevice numFixGreen)
-numBlue:(aDevice numFixBlue)
+	    numBlue:(aDevice numFixBlue)
 ].
 "
 search in existing colors ...
 "
 ^ self
-nearestColorScaledRed:r
+	nearestColorScaledRed:r
-scaledGreen:g
+	scaledGreen:g
-scaledBlue:b
+	scaledBlue:b
-on:aDevice
+	on:aDevice
-in:Lobby
+	in:Lobby
 "Created: 14.6.1996 / 20:11:18 / cg"
 "Modified: 11.7.1996 / 18:20:50 / cg"
 !
 |delta minDelta bestSoFar|
 minDelta := 9999999.
 colors do:[:aColor |
-|cr cg cb|
+	|cr cg cb|
-(aColor graphicsDevice == aDevice) ifTrue:[
+	(aColor graphicsDevice == aDevice) ifTrue:[
-aColor colorId notNil ifTrue:[
+	    aColor colorId notNil ifTrue:[
-delta := aColor deltaFromScaledRed:r scaledGreen:g scaledBlue:b.
+		delta := aColor deltaFromScaledRed:r scaledGreen:g scaledBlue:b.
-delta < minDelta ifTrue:[
+		delta < minDelta ifTrue:[
-"
+		    "
-an exact fit - no need to continue search
+		     an exact fit - no need to continue search
-"
+		    "
-delta == 0 ifTrue:[^ aColor].
+		    delta == 0 ifTrue:[^ aColor].
-bestSoFar := aColor.
+		    bestSoFar := aColor.
-minDelta := delta
+		    minDelta := delta
-]
+		]
-]
+	    ]
-]
+	]
 ].
 ^ bestSoFar
 "Created: 11.6.1996 / 18:02:12 / cg"
 "
 if there are preallocated colors, thungs are much easier ...
 "
 (cube := aDevice fixColors) ifTrue:[
-^ self
+	^ self
-nearestColorScaledRed:r
+	    nearestColorScaledRed:r
-scaledGreen:g
+	    scaledGreen:g
-scaledBlue:b
+	    scaledBlue:b
-inCube:cube
+	    inCube:cube
-numRed:(aDevice numFixRed)
+	    numRed:(aDevice numFixRed)
-numGreen:(aDevice numFixGreen)
+	    numGreen:(aDevice numFixGreen)
-numBlue:(aDevice numFixBlue)
+	    numBlue:(aDevice numFixBlue)
 ].
 "
 search in existing colors ...
 "
 ^ self nearestColorScaledRed:r
-scaledGreen:g
+		     scaledGreen:g
-scaledBlue:b
+		      scaledBlue:b
-on:aDevice
+			on:aDevice
-in:aDevice availableDitherColors
+			in:aDevice availableDitherColors
 "Created: 14.6.1996 / 20:13:22 / cg"
 "Modified: 11.7.1996 / 18:20:14 / cg"
 ! !
 (newColor notNil and:[newColor ditherForm isNil]) ifTrue:[^ newColor].
 "ask that device for the color"
 id := aDevice colorScaledRed:r scaledGreen:g scaledBlue:b.
 id isNil ifTrue:[
-"/ this is a kludge: scavenge to free unused colors
+	"/ this is a kludge: scavenge to free unused colors
-"/  and try again ...
+	"/  and try again ...
-ObjectMemory scavenge; finalize.
+	ObjectMemory scavenge; finalize.
-id := aDevice colorScaledRed:r scaledGreen:g scaledBlue:b
+	id := aDevice colorScaledRed:r scaledGreen:g scaledBlue:b
 ].
 id isNil ifTrue:[
-"no such color - fail"
+	"no such color - fail"
-"/	'COLOR: no color for ' infoPrint. self displayString infoPrintCR.
+"/      'COLOR: no color for ' infoPrint. self displayString infoPrintCR.
-^ nil
+	^ nil
 ].
 "receiver was not associated - do it now"
 device isNil ifTrue:[
-device := aDevice.
+	device := aDevice.
-colorId := id.
+	colorId := id.
-aDevice visualType ~~ #TrueColor ifTrue:[
+	aDevice visualType ~~ #TrueColor ifTrue:[
-Lobby register:self.
+	    Lobby register:self.
-].
+	].
-^ self
+	^ self
 ].
 "receiver was already associated to another device - need a new color"
 newColor := (self class basicNew) setScaledRed:r scaledGreen:g scaledBlue:b device:aDevice.
 newColor colorId:id.
 aDevice visualType ~~ #TrueColor ifTrue:[
-Lobby register:newColor.
+	Lobby register:newColor.
 ].
 ^ newColor
 "Modified: 17.6.1996 / 16:09:05 / cg"
 !
 newColor notNil ifTrue:[^ newColor].
 "ask that device for the color"
 id := aDevice colorScaledRed:red scaledGreen:green scaledBlue:blue.
 id isNil ifTrue:[
-"this is a kludge:
+	"this is a kludge:
-scavenge to possuby free unused colors and try again ...
+	    scavenge to possuby free unused colors and try again ...
-this is a compromise: actually a full GC is required here,
+	    this is a compromise: actually a full GC is required here,
-but that is too expensive.
+	    but that is too expensive.
-"
+	"
 " "
-ObjectMemory scavenge; finalize.
+	ObjectMemory scavenge; finalize.
-id := aDevice colorScaledRed:red scaledGreen:green scaledBlue:blue
+	id := aDevice colorScaledRed:red scaledGreen:green scaledBlue:blue
 " "
 ].
 id isNil ifTrue:[
-"no color - fail"
+	"no color - fail"
-^ nil
+	^ nil
 ].
 "receiver was not associated - do it now"
 device isNil ifTrue:[
-device := aDevice.
+	device := aDevice.
-colorId := id.
+	colorId := id.
-aDevice visualType ~~ #TrueColor ifTrue:[
+	aDevice visualType ~~ #TrueColor ifTrue:[
-Lobby register:self.
+	    Lobby register:self.
-].
+	].
-^ self
+	^ self
 ].
 "receiver was already associated to another device - need a new color"
 newColor := (self class basicNew) setScaledRed:red scaledGreen:green sclaedBlue:blue device:aDevice.
 newColor colorId:id.
 aDevice visualType ~~ #TrueColor ifTrue:[
-Lobby register:newColor.
+	Lobby register:newColor.
 ].
 ^ newColor
 "Modified: 14.6.1996 / 20:11:22 / cg"
 !
 "/ the most common case first - someone is validating me
 "/ before drawing on aDevice
 aDevice notNil ifTrue:[
-aDevice == device ifTrue:[
+	aDevice == device ifTrue:[
-colorId notNil ifTrue:[
+	    colorId notNil ifTrue:[
-^ self
+		^ self
-]
+	    ]
-]
+	]
 ].
 "/ a special case for pseudo-colors (0 and 1 in bitmaps)
 (red isNil and:[colorId notNil]) ifTrue:[^ self].
 "/ on high-resolution true-color systems, dont care for dithring and/or
 "/ especially freeing colors
 "/ (no need to remember in Lobby)
 (deviceVisual := aDevice visualType) == #TrueColor ifTrue:[
-aDevice depth >= 15 ifTrue:[
+	aDevice depth >= 15 ifTrue:[
-id := aDevice colorScaledRed:red scaledGreen:green scaledBlue:blue.
+	    id := aDevice colorScaledRed:red scaledGreen:green scaledBlue:blue.
-id notNil ifTrue:[
+	    id notNil ifTrue:[
-device isNil ifTrue:[
+		device isNil ifTrue:[
-colorId := id.
+		    colorId := id.
-ditherForm := nil.
+		    ditherForm := nil.
-^ self
+		    ^ self
-] ifFalse:[
+		] ifFalse:[
-newColor := (self class basicNew)
+		    newColor := (self class basicNew)
-setScaledRed:red
+					setScaledRed:red
-scaledGreen:green
+					scaledGreen:green
-scaledBlue:blue
+					scaledBlue:blue
-device:aDevice.
+					device:aDevice.
-newColor colorId:id.
+		    newColor colorId:id.
-^ newColor
+		    ^ newColor
-]
+		]
-]
+	    ]
-]
+	]
 ].
 "/ want to release color ?
 (aDevice isNil and:[device notNil and:[colorId notNil]]) ifTrue:[
-deviceVisual ~~ #TrueColor ifTrue:[
+	deviceVisual ~~ #TrueColor ifTrue:[
-(device notNil and:[colorId notNil]) ifTrue:[
+	    (device notNil and:[colorId notNil]) ifTrue:[
-Lobby unregister:self.
+		Lobby unregister:self.
-device freeColor:colorId
+		device freeColor:colorId
-].
+	    ].
-].
+	].
-device := nil.
+	device := nil.
-colorId := nil.
+	colorId := nil.
-^ self
+	^ self
 ].
 "/ round a bit within 1% in red & green, 2% in blue
 rV := (red / 100.0) rounded * 100.
 "/ if Iam already assigned to that device ...
 (device == aDevice) ifTrue:[
-"/ mhmh - if I was dithered the last time (not enough colors then)
+	"/ mhmh - if I was dithered the last time (not enough colors then)
-"/ try again - maybe some colors were reclaimed in the meanwhile
+	"/ try again - maybe some colors were reclaimed in the meanwhile
-(ditherForm notNil
+	(ditherForm notNil
-and:[aDevice fixColors isNil
+	 and:[aDevice fixColors isNil
-and:[RetryAllocation]]) ifTrue:[
+	 and:[RetryAllocation]]) ifTrue:[
-aDevice depth > 2 ifTrue:[
+	    aDevice depth > 2 ifTrue:[
-"
+		"
-if I was dithered, try again
+		 if I was dithered, try again
-(but there is no chance on b&w displays - so don't try)
+		 (but there is no chance on b&w displays - so don't try)
-"
+		"
-id := aDevice colorScaledRed:rV scaledGreen:gV scaledBlue:bV.
+		id := aDevice colorScaledRed:rV scaledGreen:gV scaledBlue:bV.
-id notNil ifTrue:[
+		id notNil ifTrue:[
-colorId := id.
+		    colorId := id.
-ditherForm := nil.
+		    ditherForm := nil.
-Lobby register:self
+		    Lobby register:self
-]
+		]
-]
+	    ]
-].
+	].
-^ self
+	^ self
 ].
 newColor := Color existingColorScaledRed:rV scaledGreen:gV scaledBlue:bV on:aDevice.
 newColor notNil ifTrue:[^ newColor].
 "/ allow an error of 1% in red & green, 2% in blue
 ((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:[
-aDevice fixColors isNil ifTrue:[
+	aDevice fixColors isNil ifTrue:[
-"/ ask that device for the exact color
+	    "/ ask that device for the exact color
-id := aDevice colorScaledRed:rV scaledGreen:gV scaledBlue:bV.
+	    id := aDevice colorScaledRed:rV scaledGreen:gV scaledBlue:bV.
-id isNil ifTrue:[
+	    id isNil ifTrue:[
-"/ this is a kludge: scavenge to free unused colors
+		"/ this is a kludge: scavenge to free unused colors
-"/ and try again ...
+		"/ and try again ...
-ObjectMemory scavenge; finalize.
+		ObjectMemory scavenge; finalize.
-id := aDevice colorScaledRed:rV scaledGreen:gV scaledBlue:bV
+		id := aDevice colorScaledRed:rV scaledGreen:gV scaledBlue:bV
-].
+	    ].
-id isNil ifTrue:[
+	    id isNil ifTrue:[
-"/ no such color - try color dithers
+		"/ no such color - try color dithers
-self ditherRed:rV green:gV blue:bV on:aDevice
+		self ditherRed:rV green:gV blue:bV on:aDevice
-into:[:c :f | newColor := c. form := f].
+			  into:[:c :f | newColor := c. form := f].
-newColor notNil ifTrue:[^ newColor].
+		newColor notNil ifTrue:[^ newColor].
-].
+	    ].
-].
+	].
-"/ none found ? -> do a hard dither using fixColors
+	"/ none found ? -> do a hard dither using fixColors
-(id isNil and:[form isNil]) ifTrue:[
+	(id isNil and:[form isNil]) ifTrue:[
-(aDevice fixColors notNil and:[aDevice == Display]) ifTrue:[
+	    (aDevice fixColors notNil and:[aDevice == Display]) ifTrue:[
-self fixDitherRed:rV green:gV blue:bV on:aDevice
+		self fixDitherRed:rV green:gV blue:bV on:aDevice
-into:[:c :f | newColor := c. form := f].
+			     into:[:c :f | newColor := c. form := f].
-newColor notNil ifTrue:[^ newColor].
+		newColor notNil ifTrue:[^ newColor].
-]
+	    ]
-].
+	].
-"/ still none found ? -> do a very hard dither using existing colors
+	"/ still none found ? -> do a very hard dither using existing colors
-(id isNil and:[form isNil]) ifTrue:[
+	(id isNil and:[form isNil]) ifTrue:[
-self complexDitherRed:rV green:gV blue:bV on:aDevice
+	    self complexDitherRed:rV green:gV blue:bV on:aDevice
-into:[:c :f | newColor := c. form := f].
+		      into:[:c :f | newColor := c. form := f].
-newColor notNil ifTrue:[^ newColor].
+	    newColor notNil ifTrue:[^ newColor].
-].
+	].
 ].
 (id isNil and:[form isNil]) ifTrue:[
-"still no result - try greying"
+	"still no result - try greying"
-greyV == 0 ifTrue:[
+	greyV == 0 ifTrue:[
-id := aDevice blackpixel
+	    id := aDevice blackpixel
-] ifFalse:[
+	] ifFalse:[
-greyV == MaxValue ifTrue:[
+	    greyV == MaxValue ifTrue:[
-id := aDevice whitepixel
+		id := aDevice whitepixel
-] ifFalse:[
+	    ] ifFalse:[
-aDevice hasGrayscales ifTrue:[
+		aDevice hasGrayscales ifTrue:[
-self ditherGrayFor:(greyV / MaxValue)
+		    self ditherGrayFor:(greyV / MaxValue)
-on:aDevice
+				    on:aDevice
-into:[:c :f | newColor := c. form := f].
+				  into:[:c :f | newColor := c. form := f].
-newColor notNil ifTrue:[^ newColor].
+		    newColor notNil ifTrue:[^ newColor].
-].
+		].
-]
+	    ]
-].
+	].
 ].
 device isNil ifTrue:[
-"/ receiver was not associated - do it now & return mySelf
+	"/ receiver was not associated - do it now & return mySelf
-device := aDevice.
+	device := aDevice.
-id isNil ifTrue:[
+	id isNil ifTrue:[
-ditherForm := form
+	    ditherForm := form
-].
+	].
-colorId := id.
+	colorId := id.
-"/ have to tell Lobby - otherwise it keeps old info around
+	"/ have to tell Lobby - otherwise it keeps old info around
-id notNil ifTrue:[
+	id notNil ifTrue:[
-deviceVisual ~~ #TrueColor ifTrue:[
+	    deviceVisual ~~ #TrueColor ifTrue:[
-Lobby register:self
+		Lobby register:self
-]
+	    ]
-].
+	].
-^ self
+	^ self
 ].
 "/ receiver was already associated to another device
 "/ - need a new color and return it
 newColor := (self class basicNew)
-setScaledRed:red
+			setScaledRed:red
-scaledGreen:green
+			scaledGreen:green
-scaledBlue:blue
+			scaledBlue:blue
-device:aDevice.
+			device:aDevice.
 id isNil ifTrue:[
-newColor ditherForm:form
+	newColor ditherForm:form
 ] ifFalse:[
-newColor colorId:id.
+	newColor colorId:id.
-deviceVisual ~~ #TrueColor ifTrue:[
+	deviceVisual ~~ #TrueColor ifTrue:[
-Lobby register:newColor.
+	    Lobby register:newColor.
-]
+	]
 ].
 ^ newColor
 "Created: 16.11.1995 / 20:16:42 / cg"
 "Modified: 11.7.1996 / 18:31:12 / cg"
 "get a form and clear it"
 f := Form width:4 height:4 depth:(aDevice depth) on:aDevice.
 map := IdentityDictionary new.
 0 to:3 do:[:x |
-x even ifTrue:[
+	x even ifTrue:[
-dir := 1.
+	    dir := 1.
-start := 0.
+	    start := 0.
-end := 3.
+	    end := 3.
-] ifFalse:[
+	] ifFalse:[
-dir := -1.
+	    dir := -1.
-start := 3.
+	    start := 3.
-end := 0.
+	    end := 0.
-].
+	].
-start to:end by:dir do:[:y |
+	start to:end by:dir do:[:y |
-wantR := red + errR.
+	    wantR := red + errR.
-wantR > MaxValue ifTrue:[
+	    wantR > MaxValue ifTrue:[
-wantR := MaxValue
+		wantR := MaxValue
-] ifFalse:[ wantR < 0 ifTrue:[
+	    ] ifFalse:[ wantR < 0 ifTrue:[
-wantR := 0
+		wantR := 0
-]].
+	    ]].
-wantG := green + errG.
+	    wantG := green + errG.
-wantG > MaxValue ifTrue:[
+	    wantG > MaxValue ifTrue:[
-wantG := MaxValue
+		wantG := MaxValue
-] ifFalse:[ wantG < 0 ifTrue:[
+	    ] ifFalse:[ wantG < 0 ifTrue:[
-wantG := 0
+		wantG := 0
-]].
+	    ]].
-wantB := blue + errB.
+	    wantB := blue + errB.
-wantB > MaxValue ifTrue:[
+	    wantB > MaxValue ifTrue:[
-wantB := MaxValue
+		wantB := MaxValue
-] ifFalse:[ wantB < 0 ifTrue:[
+	    ] ifFalse:[ wantB < 0 ifTrue:[
-wantB := 0
+		wantB := 0
-]].
+	    ]].
-"find the nearest color"
+	    "find the nearest color"
 " "
-clr := Color quickNearestColorScaledRed:wantR scaledGreen:wantG scaledBlue:wantB on:aDevice.
+	    clr := Color quickNearestColorScaledRed:wantR scaledGreen:wantG scaledBlue:wantB on:aDevice.
 " "
 "
-clr := Color nearestColorScaledRed:wantR green:wantG blue:wantB on:aDevice.
+	    clr := Color nearestColorScaledRed:wantR green:wantG blue:wantB on:aDevice.
 "
-clr isNil ifTrue:[
+	    clr isNil ifTrue:[
-clr := Color scaledRed:wantR scaledGreen:wantG scaledBlue:wantB.
+		clr := Color scaledRed:wantR scaledGreen:wantG scaledBlue:wantB.
-clr brightness > 0.5 ifTrue:[
+		clr brightness > 0.5 ifTrue:[
-clr := Color white on:aDevice
+		    clr := Color white on:aDevice
-] ifFalse:[
+		] ifFalse:[
-clr := Color black on:aDevice
+		    clr := Color black on:aDevice
-]
+		]
 "
-^ aBlock value:nil value:nil
+		^ aBlock value:nil value:nil
 "
-].
+	    ].
-f paint:clr.
+	    f paint:clr.
-f displayPointX:x y:y.
+	    f displayPointX:x y:y.
-map at:clr colorId + 1 put:clr.
+	    map at:clr colorId + 1 put:clr.
-"compute the new error"
+	    "compute the new error"
-errR := wantR - clr scaledRed.
+	    errR := wantR - clr scaledRed.
-errG := wantG - clr scaledGreen.
+	    errG := wantG - clr scaledGreen.
-errB := wantB - clr scaledBlue.
+	    errB := wantB - clr scaledBlue.
-].
+	].
 ].
 f colorMap:map.
 "
 'hard dither' printNewline.
 lastIdx mx
 dS   "{ Class: SmallInteger }"
 cube|
 (cube := aDevice fixColors) notNil ifTrue:[
-dS := 4.
+	dS := 4.
-f := Form width:dS height:dS depth:(aDevice depth) on:aDevice.
+	f := Form width:dS height:dS depth:(aDevice depth) on:aDevice.
-f initGC.
+	f initGC.
-mx := MaxValue asFloat.
+	mx := MaxValue asFloat.
-nR := aDevice numFixRed.
+	nR := aDevice numFixRed.
-nG := aDevice numFixGreen.
+	nG := aDevice numFixGreen.
-nB := aDevice numFixBlue.
+	nB := aDevice numFixBlue.
-hR := nR // 2.
+	hR := nR // 2.
-hG := nG // 2.
+	hG := nG // 2.
-hB := nB // 2.
+	hB := nB // 2.
-eR := eG := eB := 0.
+	eR := eG := eB := 0.
-r := redVal.
+	r := redVal.
-g := greenVal.
+	g := greenVal.
-b := blueVal.
+	b := blueVal.
-step := -1.
+	step := -1.
-0 to:dS-1 do:[:y |
+	0 to:dS-1 do:[:y |
-step == -1 ifTrue:[
+	    step == -1 ifTrue:[
-x1 := 0. x2 := dS-1. step := 1.
+		x1 := 0. x2 := dS-1. step := 1.
-] ifFalse:[
+	    ] ifFalse:[
-x1 := dS-1. x2 := 0. step := -1.
+		x1 := dS-1. x2 := 0. step := -1.
-].
+	    ].
-x1 to:x2 by:step do:[:x |
+	    x1 to:x2 by:step do:[:x |
-"/ the nearest along the grid
+		"/ the nearest along the grid
-r := redVal + eR.
+		r := redVal + eR.
-r > MaxValue ifTrue:[r := MaxValue]
+		r > MaxValue ifTrue:[r := MaxValue]
-ifFalse:[r < 0 ifTrue:[r := 0]].
+			     ifFalse:[r < 0 ifTrue:[r := 0]].
-g := greenVal + eG.
+		g := greenVal + eG.
-g > MaxValue ifTrue:[g := MaxValue]
+		g > MaxValue ifTrue:[g := MaxValue]
-ifFalse:[g < 0 ifTrue:[g := 0]].
+			     ifFalse:[g < 0 ifTrue:[g := 0]].
-b := blueVal + eB.
+		b := blueVal + eB.
-b > MaxValue ifTrue:[b := MaxValue]
+		b > MaxValue ifTrue:[b := MaxValue]
-ifFalse:[b < 0 ifTrue:[b := 0]].
+			     ifFalse:[b < 0 ifTrue:[b := 0]].
-rI := (r * (nR-1) + hR / mx) rounded.
+		rI := (r * (nR-1) + hR / mx) rounded.
-gI := (g * (nG-1) + hG / mx) rounded .
+		gI := (g * (nG-1) + hG / mx) rounded .
-bI := (b * (nB-1) + hB / mx) rounded .
+		bI := (b * (nB-1) + hB / mx) rounded .
-idx := (((rI * nG) + gI) * nB + bI) + 1.
+		idx := (((rI * nG) + gI) * nB + bI) + 1.
-clr := (cube at:idx) exactOn:aDevice.
+		clr := (cube at:idx) exactOn:aDevice.
-lastIdx isNil ifTrue:[lastIdx := idx]
+		lastIdx isNil ifTrue:[lastIdx := idx]
-ifFalse:[lastIdx ~~ idx ifTrue:[lastIdx := -1]].
+		ifFalse:[lastIdx ~~ idx ifTrue:[lastIdx := -1]].
-f foreground:clr.
+		f foreground:clr.
-f displayPointX:x y:y.
+		f displayPointX:x y:y.
-eR := r  - clr scaledRed.
+		eR := r  - clr scaledRed.
-eG := g  - clr scaledGreen.
+		eG := g  - clr scaledGreen.
-eB := b  - clr scaledBlue.
+		eB := b  - clr scaledBlue.
-].
+	    ].
-].
+	].
-f releaseGC.
+	f releaseGC.
-lastIdx ~~ -1 ifTrue:[
+	lastIdx ~~ -1 ifTrue:[
-^ aBlock value:clr value:nil
+	    ^ aBlock value:clr value:nil
-].
+	].
-^ aBlock value:nil value:f
+	^ aBlock value:nil value:f
 ].
 ^ aBlock value:nil value:nil
 ! !
 !Color  class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libview/Color.st,v 1.71 1996-08-15 15:48:57 cg Exp $'
+^ '$Header: /cvs/stx/stx/libview/Color.st,v 1.72 1996-08-15 16:05:46 cg Exp $'
 ! !
 Color initialize!

changeset 1023	ddbc71885249
parent 1021	291076ae3fe0
child 1144	07f3de59864d