author | Jan Vrany <jan.vrany@fit.cvut.cz> |
Thu, 14 Sep 2017 09:28:09 +0100 | |
branch | jv |
changeset 8182 | c730140a0156 |
parent 7798 | 8af654223c89 |
child 7830 | fa41edb7876a |
child 9044 | 02110132774b |
permissions | -rw-r--r-- |
1023 | 1 |
" |
2 |
COPYRIGHT (c) 1992 by Claus Gittinger |
|
6353 | 3 |
All Rights Reserved |
1023 | 4 |
|
5 |
This software is furnished under a license and may be used |
|
6 |
only in accordance with the terms of that license and with the |
|
7 |
inclusion of the above copyright notice. This software may not |
|
8 |
be provided or otherwise made available to, or used by, any |
|
9 |
other person. No title to or ownership of the software is |
|
10 |
hereby transferred. |
|
11 |
" |
|
3213 | 12 |
"{ Package: 'stx:libview' }" |
13 |
||
6785 | 14 |
"{ NameSpace: Smalltalk }" |
15 |
||
1023 | 16 |
Object subclass:#Color |
3757 | 17 |
instanceVariableNames:'red green blue device colorId ditherForm replacementColor |
18 |
writable' |
|
19 |
classVariableNames:'MaxValue Cells Black White LightGrey Grey DarkGrey Pseudo0 |
|
7642 | 20 |
Pseudo1 PseudoAll Red Green Blue Yellow Orange RetryAllocation |
21 |
DitherBits ColorErrorSignal ColorAllocationFailSignal |
|
22 |
InvalidColorNameSignal StandardColorValues Transparent' |
|
3757 | 23 |
poolDictionaries:'' |
24 |
category:'Graphics-Support' |
|
1023 | 25 |
! |
26 |
||
1907
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
27 |
Object subclass:#DeviceColorHandle |
3757 | 28 |
instanceVariableNames:'device colorId' |
29 |
classVariableNames:'' |
|
30 |
poolDictionaries:'' |
|
31 |
privateIn:Color |
|
1907
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
32 |
! |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
33 |
|
1144 | 34 |
!Color class methodsFor:'documentation'! |
1023 | 35 |
|
36 |
copyright |
|
37 |
" |
|
38 |
COPYRIGHT (c) 1992 by Claus Gittinger |
|
6353 | 39 |
All Rights Reserved |
1023 | 40 |
|
41 |
This software is furnished under a license and may be used |
|
42 |
only in accordance with the terms of that license and with the |
|
43 |
inclusion of the above copyright notice. This software may not |
|
44 |
be provided or otherwise made available to, or used by, any |
|
45 |
other person. No title to or ownership of the software is |
|
46 |
hereby transferred. |
|
47 |
" |
|
48 |
! |
|
49 |
||
50 |
documentation |
|
51 |
" |
|
7782 | 52 |
Color represents colors in a device independent manner. |
53 |
The main info I keep in mySelf are the red, green and blue components scaled into 0 .. MaxValue. |
|
54 |
||
55 |
A device specific color can be acquired by sending a color the 'onDevice:aDevice' message, |
|
56 |
which will return a color with the same r/g/b values as the receiver but with a specific |
|
57 |
colorID for that device (which may or may not imply a colormap slot allocation on that device). |
|
58 |
A device-specific color index (i.e. palette-ID) is then found in the newly allocated color's colorID slot. |
|
59 |
||
60 |
Most of the device dependent coding was to support limited graphics devices (non truecolor, eg. palette) |
|
6553 | 61 |
in a transparent way. This was required at that time (late 80's, early 90's), |
7782 | 62 |
but is now almost obsolete, as these days, virtually any graphic systems supports true colors. |
6553 | 63 |
It is arguably, if that stuff should remain here, or if we should simply give up support |
7782 | 64 |
for old VGA-like displays |
65 |
(actually, there are still such limited displays around, for example in the embedded area. |
|
66 |
So we will leave that support in for another few years ;-) ). |
|
67 |
||
68 |
On such limited devices, colors can be pure or dithered, depending on the capabilities of the device. |
|
1023 | 69 |
For plain colors, the colorId-instvar is a handle (usually lookup-table entry) for that |
70 |
device. For dithered colors, the colorId is nil and ditherForm specifies the form |
|
71 |
used to dither that color. The ditherForm can be either a depth-1 bitmap or a pixmap |
|
72 |
with the devices depth. The plain colors needed by the ditherForm are found in its |
|
73 |
colormap (as usual for bitmaps). |
|
74 |
||
75 |
The default algorithm for color allocation is to ask the display for colors as |
|
76 |
new colors are created. When running out of colors, dithered colors will be used, |
|
7620 | 77 |
using existing nearest colors and a dither pattern to approximate the color. |
1023 | 78 |
There could be situations, where no good colors are available for the dither, leading |
79 |
to ugly looking dither colors. |
|
80 |
This can be avoided by preallocating a set of colors over the complete range, which |
|
81 |
makes certain that appropriate colors are later available for the dither process. |
|
82 |
To do so, add a statement like: 'Color getColors5x5x5' to the startup.rc file. |
|
83 |
(beside 5x5x5, there are various other size combinations available). |
|
84 |
However, doing so may make things worse when displaying bitmap images, since this |
|
85 |
preallocated table may steal colors from the image ... |
|
86 |
||
87 |
[Instance variables:] |
|
88 |
||
89 |
red <Integer> the red component (0..MaxValue) |
|
90 |
green <Integer> the green component (0..MaxValue) |
|
91 |
blue <Integer> the blue component (0..MaxValue) |
|
92 |
||
93 |
device <Device> the device I am on, or nil |
|
94 |
colorId <Object> some device dependent identifier (or nil if dithered) |
|
95 |
ditherForm <Form> the Form to dither this color (if non-nil) |
|
96 |
writable <Boolean> true if this is for a writable color cell |
|
97 |
||
98 |
[Class variables:] |
|
99 |
||
100 |
MaxValue <Integer> r/g/b components are scaled relative to this maximum |
|
101 |
||
102 |
Lobby <Registry> all colors in use - keeps track of already allocated |
|
6553 | 103 |
colors for reuse and finalization. |
7650 | 104 |
(don't use it: this will be moved to the device) |
1229 | 105 |
|
1023 | 106 |
Cells <Registry> keeps track of allocated writable color cells |
7650 | 107 |
(don't use it: this will be moved to the device) |
1023 | 108 |
|
109 |
FixColors <Array> preallocated colors for dithering on Display |
|
110 |
NumRedFix <Integer> number of distinct red values in FixColors |
|
111 |
NumGreenFix <Integer> number of distinct green values in FixColors |
|
112 |
NumBlueFix <Integer> number of distinct blue values in FixColors |
|
6353 | 113 |
|
1023 | 114 |
Black <Color> for fast return of black |
115 |
White <Color> for fast return of white |
|
116 |
Grey <Color> for fast return of grey |
|
117 |
LightGrey <Color> for fast return of lightGrey |
|
118 |
DarkGrey <Color> for fast return of darkGrey |
|
119 |
||
120 |
Pseudo0 <Color> a color with 0 as handle (for forms and bitblit) |
|
121 |
Pseudo1 <Color> a color with 1 as handle (for forms) |
|
122 |
PseudoAll <Color> a color with allPlanes as handle (for bitblit) |
|
123 |
||
124 |
Red <Color> red, needed for dithering |
|
125 |
Green <Color> green, for dithering |
|
126 |
Blue <Color> blue, for dithering |
|
127 |
||
128 |
DitherColors <Collection> some preallocated colors for dithering |
|
6553 | 129 |
(kept, so they are available when needed) |
1023 | 130 |
|
131 |
RetryAllocation <Boolean> this flag controls how a request for a |
|
6553 | 132 |
color should be handled which failed previously. |
133 |
I.e. a color is asked for, which was dithered |
|
134 |
the last time. Since it could happen, that in |
|
135 |
the meantime more colors became free, the request |
|
136 |
might succeed this time - however, your screen may |
|
137 |
look a bit funny, due to having both dithered and |
|
138 |
undithered versions around. |
|
139 |
The default is true, which means: do retry |
|
1023 | 140 |
|
141 |
compatibility issues: |
|
142 |
||
6553 | 143 |
ST-80 seems to represent colors internally with scaled smallInteger |
144 |
components (this can be guessed from uses of |
|
145 |
scaledRed:scaledGreen:scaledBlue:). The main instance creation method is |
|
146 |
via 'ColorValue red:green:blue:', passing components in 0..1. |
|
147 |
In ST/X, component are internally represented as percent. |
|
148 |
For more compatibility (when subclassing color), these internals may |
|
149 |
change in the near future. For migration, a compatibility subclass |
|
150 |
called ColorValue is provided. |
|
151 |
After the change, Color will be renamed to ColorValue and Color |
|
152 |
be made a subclass of ColorValue (offering the 0..100 interface for |
|
153 |
backward compatibility). |
|
1023 | 154 |
|
155 |
[see also:] |
|
6553 | 156 |
DeviceWorkstation |
157 |
GraphicsContext DeviceDrawable Form Image Colormap |
|
158 |
Font Cursor |
|
1023 | 159 |
|
160 |
[author:] |
|
6553 | 161 |
Claus Gittinger |
1023 | 162 |
" |
163 |
! ! |
|
164 |
||
1144 | 165 |
!Color class methodsFor:'initialization'! |
1023 | 166 |
|
3903 | 167 |
allocateColorsIn:aColorVector on:aDevice |
168 |
"{ Pragma: +optSpace }" |
|
169 |
||
170 |
"preallocates a nR x nG x nB colorMap for later use in dithering. |
|
171 |
Doing so has the advantage that the system will never run out of colors, |
|
172 |
however, colors may be either inexact or dithered." |
|
173 |
||
174 |
|clr round |
|
175 |
devClr| |
|
176 |
||
177 |
round := 0. |
|
178 |
1 to:aColorVector size do:[:dstIndex | |
|
6353 | 179 |
clr := aColorVector at:dstIndex. |
180 |
devClr := clr exactOn:aDevice. |
|
181 |
devClr isNil ifTrue:[ |
|
182 |
round == 0 ifTrue:[ |
|
183 |
'Color [info]: scavenge to reclaim colors' infoPrintCR. |
|
184 |
ObjectMemory scavenge. |
|
185 |
round := 1. |
|
186 |
devClr := clr exactOn:aDevice. |
|
187 |
]. |
|
188 |
]. |
|
189 |
devClr isNil ifTrue:[ |
|
190 |
round == 1 ifTrue:[ |
|
191 |
'Color [info]: collect garbage to reclaim colors' infoPrintCR. |
|
192 |
ObjectMemory performLowSpaceCleanup. |
|
193 |
ObjectMemory garbageCollect; finalize. |
|
194 |
round := 2. |
|
195 |
devClr := clr exactOn:aDevice. |
|
196 |
]. |
|
197 |
]. |
|
198 |
devClr isNil ifTrue:[ |
|
199 |
ColorAllocationFailSignal raiseErrorString:'failed to allocate fix color'. |
|
200 |
^ self |
|
201 |
]. |
|
202 |
aColorVector at:dstIndex put:devClr. |
|
3903 | 203 |
]. |
204 |
! |
|
205 |
||
206 |
colorCubeWithRed:nRed green:nGreen blue:nBlue |
|
207 |
"{ Pragma: +optSpace }" |
|
208 |
||
209 |
|nR "{Class: SmallInteger }" |
|
210 |
nG "{Class: SmallInteger }" |
|
211 |
nB "{Class: SmallInteger }" |
|
212 |
dR dG dB red green blue dstIndex clr round |
|
213 |
colorCube| |
|
214 |
||
215 |
nR := nRed. |
|
216 |
nG := nGreen. |
|
217 |
nB := nBlue. |
|
218 |
||
219 |
dR := 100.0 / (nR - 1). |
|
220 |
dG := 100.0 / (nG - 1). |
|
221 |
dB := 100.0 / (nB - 1). |
|
222 |
||
223 |
colorCube := Array new:(nR * nG * nB). |
|
224 |
||
225 |
round := 0. |
|
226 |
||
227 |
dstIndex := 1. |
|
228 |
1 to:nR do:[:sR | |
|
6353 | 229 |
red := dR * (sR - 1). |
230 |
1 to:nG do:[:sG | |
|
231 |
green := dG * (sG - 1). |
|
232 |
1 to:nB do:[:sB | |
|
233 |
blue := dB * (sB - 1). |
|
234 |
clr := self red:red green:green blue:blue. |
|
235 |
colorCube at:dstIndex put:clr. |
|
236 |
dstIndex := dstIndex + 1 |
|
237 |
] |
|
238 |
] |
|
3903 | 239 |
]. |
3904 | 240 |
^ colorCube |
3903 | 241 |
|
242 |
"Created: 11.7.1996 / 17:55:32 / cg" |
|
243 |
"Modified: 10.1.1997 / 15:37:13 / cg" |
|
244 |
! |
|
245 |
||
1023 | 246 |
flushDeviceColors |
247 |
"unassign all colors from their device" |
|
248 |
||
249 |
self allInstances do:[:aColor | |
|
6353 | 250 |
aColor restored |
1023 | 251 |
]. |
252 |
||
1365
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
253 |
"Modified: 24.2.1997 / 18:27:06 / cg" |
1023 | 254 |
! |
255 |
||
3240
c93e33069fb5
color reinitialization when coming up on another device
Claus Gittinger <cg@exept.de>
parents:
3213
diff
changeset
|
256 |
flushDeviceColorsFor:aDevice |
c93e33069fb5
color reinitialization when coming up on another device
Claus Gittinger <cg@exept.de>
parents:
3213
diff
changeset
|
257 |
self allInstancesDo:[:aColor | |
6353 | 258 |
aColor device == aDevice ifTrue:[ |
259 |
aColor restored |
|
260 |
] |
|
3240
c93e33069fb5
color reinitialization when coming up on another device
Claus Gittinger <cg@exept.de>
parents:
3213
diff
changeset
|
261 |
] |
c93e33069fb5
color reinitialization when coming up on another device
Claus Gittinger <cg@exept.de>
parents:
3213
diff
changeset
|
262 |
! |
c93e33069fb5
color reinitialization when coming up on another device
Claus Gittinger <cg@exept.de>
parents:
3213
diff
changeset
|
263 |
|
1023 | 264 |
getColors6x6x4 |
1929 | 265 |
"{ Pragma: +optSpace }" |
266 |
||
1023 | 267 |
"preallocates a 6x6x4 (144) colorMap and later uses those colors only. |
268 |
Doing so has the advantage that the system will never run out of colors, |
|
269 |
however, colors may be either inexact or dithered." |
|
270 |
||
271 |
self getColorsRed:6 green:6 blue:4 |
|
272 |
||
273 |
" |
|
274 |
Color getColors6x6x4 |
|
275 |
" |
|
276 |
! |
|
277 |
||
278 |
getColors6x6x5 |
|
1929 | 279 |
"{ Pragma: +optSpace }" |
280 |
||
1023 | 281 |
"preallocates a 6x6x5 (180) colorMap and later uses those colors only. |
282 |
Doing so has the advantage that the system will never run out of colors, |
|
283 |
however, colors may be either inexact or dithered." |
|
284 |
||
285 |
self getColorsRed:6 green:6 blue:5 |
|
286 |
||
287 |
" |
|
288 |
Color getColors6x6x5 |
|
289 |
" |
|
290 |
! |
|
291 |
||
292 |
getColors6x6x6 |
|
1929 | 293 |
"{ Pragma: +optSpace }" |
294 |
||
1023 | 295 |
"preallocates a 6x6x6 (196) colorMap and later uses those colors only. |
296 |
Doing so has the advantage that the system will never run out of colors, |
|
297 |
however, colors may be either inexact or dithered." |
|
298 |
||
299 |
self getColorsRed:6 green:6 blue:6 |
|
300 |
||
301 |
" |
|
302 |
Color getColors6x6x6 |
|
303 |
" |
|
304 |
! |
|
305 |
||
306 |
getColors6x7x4 |
|
1929 | 307 |
"{ Pragma: +optSpace }" |
308 |
||
1023 | 309 |
"preallocates a 6x7x4 (168) colorMap and later uses those colors only. |
310 |
Doing so has the advantage that the system will never run out of colors, |
|
311 |
however, colors may be either inexact or dithered." |
|
312 |
||
313 |
self getColorsRed:6 green:7 blue:4 |
|
314 |
||
315 |
" |
|
316 |
Color getColors6x7x4 |
|
317 |
" |
|
318 |
||
319 |
"Created: 12.6.1996 / 17:41:57 / cg" |
|
320 |
! |
|
321 |
||
322 |
getColors7x8x4 |
|
1929 | 323 |
"{ Pragma: +optSpace }" |
324 |
||
1023 | 325 |
"preallocates a 7x8x4 (224) colorMap and later uses those colors only. |
326 |
Doing so has the advantage that the system will never run out of colors, |
|
327 |
however, colors may be either inexact or dithered." |
|
328 |
||
329 |
self getColorsRed:7 green:8 blue:4 |
|
330 |
||
331 |
" |
|
332 |
Color getColors7x8x4 |
|
333 |
" |
|
334 |
! |
|
335 |
||
336 |
getColorsRed:nRed green:nGreen blue:nBlue |
|
1929 | 337 |
"{ Pragma: +optSpace }" |
338 |
||
1023 | 339 |
"preallocates a nR x nG x nB colorMap for later use in dithering. |
340 |
Doing so has the advantage that the system will never run out of colors, |
|
341 |
however, colors may be either inexact or dithered." |
|
342 |
||
2999
5e9272beef1b
eliminated refs to Display - must use Screen current
Stefan Vogel <sv@exept.de>
parents:
2976
diff
changeset
|
343 |
self getColorsRed:nRed green:nGreen blue:nBlue on:Screen current |
1023 | 344 |
|
345 |
" |
|
346 |
Color getColorsRed:2 green:2 blue:2 |
|
347 |
" |
|
348 |
||
349 |
"Modified: 11.7.1996 / 17:58:09 / cg" |
|
350 |
! |
|
351 |
||
352 |
getColorsRed:nRed green:nGreen blue:nBlue on:aDevice |
|
1929 | 353 |
"{ Pragma: +optSpace }" |
354 |
||
1023 | 355 |
"preallocates a nR x nG x nB colorMap for later use in dithering. |
356 |
Doing so has the advantage that the system will never run out of colors, |
|
357 |
however, colors may be either inexact or dithered." |
|
358 |
||
359 |
|nR "{Class: SmallInteger }" |
|
360 |
nG "{Class: SmallInteger }" |
|
361 |
nB "{Class: SmallInteger }" |
|
3903 | 362 |
dR dG dB fixColors| |
1023 | 363 |
|
364 |
aDevice visualType == #TrueColor ifTrue:[^ self]. |
|
365 |
||
366 |
nR := nRed. |
|
367 |
nG := nGreen. |
|
368 |
nB := nBlue. |
|
369 |
||
370 |
dR := 100.0 / (nR - 1). |
|
371 |
dG := 100.0 / (nG - 1). |
|
372 |
dB := 100.0 / (nB - 1). |
|
373 |
||
3903 | 374 |
fixColors := self colorCubeWithRed:nRed green:nGreen blue:nBlue. |
375 |
self allocateColorsIn:fixColors on:aDevice. |
|
376 |
||
377 |
aDevice setFixColors:fixColors numRed:nR numGreen:nG numBlue:nB |
|
1023 | 378 |
|
379 |
" |
|
380 |
Color getColorsRed:2 green:2 blue:2 on:Display |
|
381 |
" |
|
382 |
||
383 |
"Created: 11.7.1996 / 17:55:32 / cg" |
|
1165 | 384 |
"Modified: 10.1.1997 / 15:37:13 / cg" |
1023 | 385 |
! |
386 |
||
1770 | 387 |
getGrayColors:nGray on:aDevice |
1929 | 388 |
"{ Pragma: +optSpace }" |
389 |
||
1770 | 390 |
"preallocates nGray gray colors for later use in dithering. |
391 |
Doing so has the advantage that the system will never run out of colors, |
|
392 |
however, colors may be either inexact or dithered." |
|
393 |
||
394 |
|nG "{Class: SmallInteger }" |
|
3903 | 395 |
d fixGrayColors| |
1770 | 396 |
|
397 |
aDevice visualType == #TrueColor ifTrue:[^ self]. |
|
398 |
||
399 |
nG := nGray. |
|
400 |
d := 100.0 / (nG - 1). |
|
401 |
||
3903 | 402 |
fixGrayColors := self grayColorVector:nGray. |
403 |
self allocateColorsIn:fixGrayColors on:aDevice. |
|
404 |
||
1770 | 405 |
aDevice setFixGrayColors:fixGrayColors |
406 |
||
407 |
" |
|
408 |
Color getGrayColors:16 on:Display |
|
409 |
" |
|
410 |
||
411 |
"Created: 23.6.1997 / 15:29:50 / cg" |
|
412 |
! |
|
413 |
||
1023 | 414 |
getPrimaryColorsOn:aDevice |
1929 | 415 |
"{ Pragma: +optSpace }" |
416 |
||
1023 | 417 |
"preallocate the primary colors. |
418 |
Doing so during early startup prevents us from running out |
|
419 |
of (at least those required) colors later. |
|
420 |
This guarantees, that at least some colors are available |
|
421 |
for dithering (although, with only black, white, red, green and blue, |
|
422 |
dithered images look very poor)." |
|
423 |
||
1929 | 424 |
|colors white black red green blue clr dDepth |
425 |
lastPix "{ Class: SmallInteger }" | |
|
1023 | 426 |
|
427 |
(aDevice notNil and:[aDevice ditherColors isNil]) ifTrue:[ |
|
6353 | 428 |
white := (self red:100 green:100 blue:100) exactOn:aDevice. |
429 |
white colorId isNil ifTrue:[ |
|
430 |
'Color [warning]: cannot allocate white color' errorPrintCR. |
|
431 |
]. |
|
432 |
black := (self red:0 green:0 blue:0) exactOn:aDevice. |
|
433 |
black colorId isNil ifTrue:[ |
|
434 |
'Color [warning]: cannot allocate black color' errorPrintCR. |
|
435 |
]. |
|
436 |
||
437 |
aDevice hasColors ifTrue:[ |
|
438 |
red := (self red:100 green:0 blue:0) exactOn:aDevice. |
|
439 |
green := (self red:0 green:100 blue:0) exactOn:aDevice. |
|
440 |
blue := (self red:0 green:0 blue:100) exactOn:aDevice. |
|
441 |
(red isNil |
|
442 |
or:[green isNil |
|
443 |
or:[blue isNil |
|
444 |
or:[red colorId isNil |
|
445 |
or:[green colorId isNil |
|
446 |
or:[blue colorId isNil]]]]]) ifTrue:[ |
|
447 |
'Color [warning]: cannot allocate primary color(s)' errorPrintCR. |
|
448 |
dDepth := aDevice depth. |
|
449 |
((dDepth >= 4) and:[dDepth <= 8]) ifTrue:[ |
|
450 |
"/ |
|
451 |
"/ see what we have ... |
|
452 |
"/ |
|
453 |
lastPix := (1 bitShift:dDepth) - 1. |
|
454 |
0 to:lastPix do:[:pixel | |
|
455 |
colors := OrderedCollection new. |
|
456 |
aDevice getRGBFrom:pixel into:[:r :g :b | |
|
457 |
colors add:((Color red:r green:g blue:b) exactOn:aDevice). |
|
458 |
] |
|
459 |
]. |
|
460 |
red := (self red:100 green:0 blue:0) nearestOn:aDevice. |
|
461 |
green := (self red:0 green:100 blue:0) nearestOn:aDevice. |
|
462 |
blue := (self red:0 green:0 blue:100) nearestOn:aDevice. |
|
463 |
] ifFalse:[ |
|
464 |
aDevice hasColors:false. |
|
465 |
aDevice hasGrayscales:false. |
|
466 |
red := green := blue := nil. |
|
467 |
] |
|
468 |
] |
|
469 |
]. |
|
470 |
||
471 |
aDevice == Display ifTrue:[ |
|
472 |
"/ keep those around for the main display |
|
473 |
White := white. |
|
474 |
Black := black. |
|
475 |
Red := red. |
|
476 |
Green := green. |
|
477 |
Blue := blue |
|
478 |
]. |
|
479 |
||
480 |
aDevice visualType ~~ #TrueColor ifTrue:[ |
|
481 |
aDevice hasColors ifTrue:[ |
|
482 |
||
483 |
"preallocate some colors for dithering |
|
484 |
- otherwise, they may not be available when we need them ... |
|
485 |
these are: black, white, grey50, |
|
486 |
red, green, blue, yellow, cyan and magenta. |
|
487 |
" |
|
488 |
||
489 |
colors := OrderedCollection new. |
|
490 |
clr := (self gray:50) exactOn:aDevice. |
|
491 |
(clr notNil and:[clr colorId notNil]) ifTrue:[ |
|
492 |
colors add:clr |
|
493 |
]. |
|
494 |
||
495 |
colors add:white; add:black; add:red; add:green; add:blue. |
|
496 |
||
497 |
colors add:((self red:100 green:100 blue:0) exactOn:aDevice). |
|
498 |
colors add:((self red:100 green:0 blue:100) exactOn:aDevice). |
|
499 |
colors add:((self red:0 green:100 blue:100) exactOn:aDevice). |
|
500 |
]. |
|
501 |
||
502 |
aDevice hasGrayscales ifTrue:[ |
|
503 |
aDevice hasColors ifFalse:[ |
|
504 |
colors := OrderedCollection new. |
|
505 |
colors add:((self gray:50) exactOn:aDevice). |
|
506 |
colors add:white; add:black. |
|
507 |
||
508 |
]. |
|
509 |
colors add:((self gray:25) exactOn:aDevice). |
|
510 |
colors add:((self gray:33) exactOn:aDevice). |
|
511 |
colors add:((self gray:67) exactOn:aDevice). |
|
512 |
colors add:((self gray:75) exactOn:aDevice). |
|
513 |
]. |
|
514 |
||
515 |
colors notNil ifTrue:[ |
|
516 |
colors := colors select:[:clr | clr notNil and:[clr colorId notNil]]. |
|
517 |
aDevice setDitherColors:(colors asArray). |
|
518 |
] |
|
519 |
] |
|
1023 | 520 |
] |
521 |
||
522 |
"Created: 11.7.1996 / 18:09:28 / cg" |
|
1929 | 523 |
"Modified: 21.10.1997 / 02:42:28 / cg" |
1023 | 524 |
! |
525 |
||
3903 | 526 |
grayColorVector:nGray |
527 |
|nG "{Class: SmallInteger }" |
|
528 |
d gray dstIndex clr round |
|
529 |
grayColors| |
|
530 |
||
531 |
nG := nGray. |
|
532 |
d := 100.0 / (nG - 1). |
|
533 |
||
534 |
grayColors := Array new:nG. |
|
535 |
||
536 |
round := 0. |
|
537 |
||
538 |
dstIndex := 1. |
|
539 |
1 to:nG do:[:sG | |
|
6353 | 540 |
gray := d * (sG - 1). |
541 |
clr := self red:gray green:gray blue:gray. |
|
542 |
grayColors at:dstIndex put:clr. |
|
543 |
dstIndex := dstIndex + 1 |
|
3903 | 544 |
]. |
3904 | 545 |
^ grayColors |
3903 | 546 |
|
547 |
" |
|
548 |
Color getGrayColors:16 on:Display |
|
549 |
" |
|
550 |
||
551 |
"Created: 23.6.1997 / 15:29:50 / cg" |
|
552 |
! |
|
553 |
||
1023 | 554 |
initialize |
555 |
"setup tracker of known colors and initialize classvars with |
|
556 |
heavily used colors" |
|
557 |
||
2379
b2a844aabc93
made my signals children of a common colorErrorSignal
Claus Gittinger <cg@exept.de>
parents:
2375
diff
changeset
|
558 |
ColorErrorSignal isNil ifTrue:[ |
6353 | 559 |
ColorErrorSignal := Error newSignalMayProceed:true. |
560 |
ColorErrorSignal nameClass:self message:#colorErrorSignal. |
|
561 |
ColorErrorSignal notifierString:'color error'. |
|
562 |
||
563 |
ColorAllocationFailSignal := ColorErrorSignal newSignalMayProceed:true. |
|
564 |
ColorAllocationFailSignal nameClass:self message:#colorAllocationFailSignal. |
|
565 |
ColorAllocationFailSignal notifierString:'color allocation failed'. |
|
566 |
||
567 |
InvalidColorNameSignal := ColorErrorSignal newSignalMayProceed:true. |
|
568 |
InvalidColorNameSignal nameClass:self message:#invalidColorNameSignal. |
|
569 |
InvalidColorNameSignal notifierString:'invalid color name'. |
|
570 |
||
571 |
MaxValue := 16rFFFF. |
|
572 |
||
573 |
"want to be informed when returning from snapshot" |
|
574 |
ObjectMemory addDependent:self. |
|
575 |
||
576 |
RetryAllocation := true. |
|
577 |
||
578 |
DitherBits := self ditherBits. |
|
579 |
self initializeStandardColorNames. |
|
1023 | 580 |
]. |
581 |
||
1365
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
582 |
" |
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
583 |
Color initialize |
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
584 |
" |
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
585 |
|
2379
b2a844aabc93
made my signals children of a common colorErrorSignal
Claus Gittinger <cg@exept.de>
parents:
2375
diff
changeset
|
586 |
"Modified: / 30.9.1998 / 21:56:50 / cg" |
1428 | 587 |
! |
588 |
||
589 |
initializeStandardColorNames |
|
1929 | 590 |
"{ Pragma: +optSpace }" |
591 |
||
1428 | 592 |
"setup standard colors" |
593 |
||
594 |
StandardColorValues := Dictionary new. |
|
595 |
#( |
|
6353 | 596 |
'red' (16rFFFF 16r0000 16r0000) |
597 |
'green' (16r0000 16rFFFF 16r0000) |
|
598 |
'blue' (16r0000 16r0000 16rFFFF) |
|
599 |
'yellow' (16rFFFF 16rFFFF 16r0000) |
|
600 |
'magenta' (16rFFFF 16r0000 16rFFFF) |
|
601 |
'cyan' (16r0000 16rFFFF 16rFFFF) |
|
602 |
'white' (16rFFFF 16rFFFF 16rFFFF) |
|
603 |
'black' (16r0000 16r0000 16r0000) |
|
604 |
'olive' (16r7FFF 16r7FFF 16r0000) |
|
605 |
'teal' (16r0000 16r7FFF 16r7FFF) |
|
606 |
'silver' (16r6666 16r6666 16r6666) |
|
607 |
'lime' (16r3333 16rFFFF 16r0000) |
|
608 |
'fuchsia' (16r9999 16r07ae 16rFFFF) |
|
609 |
'aqua' (16r199a 16rFFFF 16rFFFF) |
|
1428 | 610 |
) pairWiseDo:[:name :value | |
6353 | 611 |
StandardColorValues at:name put:value |
1428 | 612 |
]. |
613 |
||
614 |
" |
|
615 |
Color initializeStandardColorNames |
|
616 |
" |
|
617 |
||
618 |
"Modified: 6.3.1997 / 02:28:58 / cg" |
|
1023 | 619 |
! |
620 |
||
3930
1eb2b8d1d01d
+standardDitherColorsForDepth8
Claus Gittinger <cg@exept.de>
parents:
3904
diff
changeset
|
621 |
standardDitherColorsForDepth8 |
3931
417757ef9695
+standardDitherColorsForDepth8
Claus Gittinger <cg@exept.de>
parents:
3930
diff
changeset
|
622 |
"return a set of colors useful for dithering (roughly 200 colors); |
417757ef9695
+standardDitherColorsForDepth8
Claus Gittinger <cg@exept.de>
parents:
3930
diff
changeset
|
623 |
This includes a color cube and the main grayScale colors." |
417757ef9695
+standardDitherColorsForDepth8
Claus Gittinger <cg@exept.de>
parents:
3930
diff
changeset
|
624 |
|
3930
1eb2b8d1d01d
+standardDitherColorsForDepth8
Claus Gittinger <cg@exept.de>
parents:
3904
diff
changeset
|
625 |
|ditherColors| |
1eb2b8d1d01d
+standardDitherColorsForDepth8
Claus Gittinger <cg@exept.de>
parents:
3904
diff
changeset
|
626 |
|
1eb2b8d1d01d
+standardDitherColorsForDepth8
Claus Gittinger <cg@exept.de>
parents:
3904
diff
changeset
|
627 |
ditherColors := self colorCubeWithRed:6 green:8 blue:4. |
1eb2b8d1d01d
+standardDitherColorsForDepth8
Claus Gittinger <cg@exept.de>
parents:
3904
diff
changeset
|
628 |
ditherColors := ditherColors , |
6353 | 629 |
(Array |
630 |
with:(Color gray:20) |
|
631 |
with:(Color gray:25) |
|
632 |
with:(Color gray:40) |
|
633 |
with:(Color gray:50) |
|
634 |
with:(Color gray:60) |
|
635 |
with:(Color gray:75) |
|
636 |
with:(Color gray:80) |
|
637 |
with:(Color rgbValue:16rBFBFBF)). |
|
3930
1eb2b8d1d01d
+standardDitherColorsForDepth8
Claus Gittinger <cg@exept.de>
parents:
3904
diff
changeset
|
638 |
^ ditherColors |
3931
417757ef9695
+standardDitherColorsForDepth8
Claus Gittinger <cg@exept.de>
parents:
3930
diff
changeset
|
639 |
|
417757ef9695
+standardDitherColorsForDepth8
Claus Gittinger <cg@exept.de>
parents:
3930
diff
changeset
|
640 |
" |
417757ef9695
+standardDitherColorsForDepth8
Claus Gittinger <cg@exept.de>
parents:
3930
diff
changeset
|
641 |
self standardDitherColorsForDepth8 |
417757ef9695
+standardDitherColorsForDepth8
Claus Gittinger <cg@exept.de>
parents:
3930
diff
changeset
|
642 |
" |
3930
1eb2b8d1d01d
+standardDitherColorsForDepth8
Claus Gittinger <cg@exept.de>
parents:
3904
diff
changeset
|
643 |
! |
1eb2b8d1d01d
+standardDitherColorsForDepth8
Claus Gittinger <cg@exept.de>
parents:
3904
diff
changeset
|
644 |
|
1023 | 645 |
update:something with:aParameter from:changedObject |
646 |
"handle image restarts and flush any device resource handles" |
|
647 |
||
648 |
(something == #returnFromSnapshot) ifTrue:[ |
|
6353 | 649 |
Display notNil ifTrue:[ |
650 |
Display visualType == #TrueColor ifTrue:[ |
|
651 |
Display releaseFixColors |
|
652 |
] ifFalse:[ |
|
653 |
Display fixColors notNil ifTrue:[ |
|
654 |
ColorAllocationFailSignal handle:[:ex | |
|
655 |
ex return |
|
656 |
] do:[ |
|
657 |
|nR nG nB| |
|
658 |
||
659 |
nR := Display numFixRed. |
|
660 |
nG := Display numFixGreen. |
|
661 |
nB := Display numFixBlue. |
|
662 |
Display releaseFixColors. |
|
663 |
self getColorsRed:nR |
|
664 |
green:nG |
|
665 |
blue:nB |
|
666 |
on:Display |
|
667 |
] |
|
668 |
] |
|
669 |
] |
|
670 |
] |
|
1023 | 671 |
] |
672 |
||
673 |
"Created: 15.6.1996 / 15:14:03 / cg" |
|
1370
37dfdffdd4b6
getPrimaryColors now invoked from device
Claus Gittinger <cg@exept.de>
parents:
1368
diff
changeset
|
674 |
"Modified: 24.2.1997 / 22:08:05 / cg" |
4535 | 675 |
! |
676 |
||
677 |
vgaColors |
|
678 |
"{ Pragma: +optSpace }" |
|
679 |
||
680 |
|colors| |
|
681 |
||
682 |
colors := Array new:16. |
|
683 |
colors at:1 put:(Color rgbValue:16rFFFFFF). |
|
684 |
colors at:2 put:(Color rgbValue:16rC0C0C0). |
|
685 |
colors at:3 put:(Color rgbValue:16r808080). |
|
686 |
colors at:4 put:(Color rgbValue:16r000000). |
|
687 |
colors at:5 put:(Color rgbValue:16rFF0000). |
|
688 |
colors at:6 put:(Color rgbValue:16r800000). |
|
689 |
colors at:7 put:(Color rgbValue:16r008000). |
|
690 |
colors at:8 put:(Color rgbValue:16r00FF00). |
|
691 |
colors at:9 put:(Color rgbValue:16r0000FF). |
|
692 |
colors at:10 put:(Color rgbValue:16r000080). |
|
693 |
colors at:11 put:(Color rgbValue:16rFF00FF). |
|
694 |
colors at:12 put:(Color rgbValue:16r800080). |
|
695 |
colors at:13 put:(Color rgbValue:16rFFFF00). |
|
696 |
colors at:14 put:(Color rgbValue:16r808000). |
|
697 |
colors at:15 put:(Color rgbValue:16r00FFFF). |
|
698 |
colors at:16 put:(Color rgbValue:16r008080). |
|
699 |
^ colors |
|
700 |
||
701 |
"Created: / 07-07-2006 / 13:36:15 / cg" |
|
1023 | 702 |
! ! |
703 |
||
1144 | 704 |
!Color class methodsFor:'instance creation'! |
1023 | 705 |
|
706 |
allColor |
|
707 |
"return a special color which, when used for bit-blitting will |
|
708 |
behave like a all-1-color (i.e. have a device-pixel value of all-1s)" |
|
709 |
||
710 |
PseudoAll isNil ifTrue:[ |
|
6353 | 711 |
PseudoAll := self basicNew setColorId:-1 |
1023 | 712 |
]. |
713 |
^ PseudoAll |
|
1238
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
714 |
|
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
715 |
"Modified: 17.1.1997 / 00:05:36 / cg" |
1023 | 716 |
! |
717 |
||
2455 | 718 |
bgrValue:bgr |
3005 | 719 |
"return a color from a 24bit BGR value (intentionally not RGB); |
2455 | 720 |
The value is composed of b<<16 + g<<8 + r. |
721 |
(this byte-order is sometimes encountered with windows systems (progs)" |
|
722 |
||
723 |
|r g b| |
|
724 |
||
725 |
b := (bgr bitShift:-16) bitAnd:16rFF. |
|
726 |
g := (bgr bitShift:-8) bitAnd:16rFF. |
|
727 |
r := (bgr) bitAnd:16rFF. |
|
728 |
^ self redByte:r greenByte:g blueByte:b |
|
729 |
||
730 |
! |
|
731 |
||
1985 | 732 |
blue: blue |
733 |
"return a color from blue value; |
|
734 |
the argument green is interpreted as percent (0..100)" |
|
735 |
||
6353 | 736 |
^ here |
737 |
scaledRed:0 scaledGreen:0 scaledBlue:(blue * MaxValue // 100) |
|
3005 | 738 |
|
739 |
" |
|
740 |
(Color blue:50) inspect |
|
741 |
" |
|
742 |
||
1985 | 743 |
! |
744 |
||
1023 | 745 |
brightness:brightness |
746 |
"create a gray color with given brightness (0..1). |
|
747 |
ST-80 compatibility." |
|
748 |
||
3264 | 749 |
^ self scaledGray:(brightness * MaxValue) rounded |
1023 | 750 |
! |
751 |
||
752 |
colorId:id |
|
753 |
"return a color for a specific colorid without associating it to a |
|
754 |
specific device. Use this only for bitmaps which want 0- or 1-color, |
|
755 |
or for bitblits if you want to manipulate a specific colorplane." |
|
756 |
||
757 |
id == 0 ifTrue:[ |
|
6353 | 758 |
^ self noColor |
1023 | 759 |
]. |
760 |
id == 1 ifTrue:[ |
|
6353 | 761 |
Pseudo1 isNil ifTrue:[ |
762 |
Pseudo1 := self basicNew setColorId:1 |
|
763 |
]. |
|
764 |
^ Pseudo1 |
|
1023 | 765 |
]. |
766 |
id == -1 ifTrue:[ |
|
6353 | 767 |
^ self allColor |
1023 | 768 |
]. |
1365
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
769 |
|
1238
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
770 |
^ self basicNew setColorId:id |
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
771 |
|
1365
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
772 |
"Modified: 24.2.1997 / 18:16:30 / cg" |
1023 | 773 |
! |
774 |
||
775 |
cyan:c magenta:m yellow:y |
|
776 |
"return a color from cyan, magenta and yellow values. |
|
777 |
all values are given in percent (0..100)" |
|
778 |
||
779 |
^ self |
|
6353 | 780 |
redPercent:(100 - c) |
781 |
greenPercent:(100 - m) |
|
782 |
bluePercent:(100 - y) |
|
783 |
||
784 |
" |
|
785 |
Color cyan:100 magenta:0 yellow:0 - cyan |
|
786 |
Color cyan:100 magenta:100 yellow:0 - blue |
|
787 |
Color cyan:100 magenta:0 yellow:100 - green |
|
788 |
Color cyan:100 magenta:100 yellow:100 - black |
|
1023 | 789 |
" |
790 |
||
791 |
"Modified: 11.6.1996 / 18:29:15 / cg" |
|
792 |
! |
|
793 |
||
2888
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
794 |
cyan:c magenta:m yellow:y black:k |
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
795 |
"return a color from cyan, magenta, yellow and black values. |
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
796 |
all values are given in percent (0..100). |
2889 | 797 |
The value returned here is questionable. |
798 |
TODO: we loose information about one component here, |
|
799 |
and should actually return an instance of CMYK color, which keeps this |
|
800 |
information internally for later use (when saving)." |
|
2888
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
801 |
|
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
802 |
|scale r g b| |
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
803 |
|
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
804 |
"/ mhmh - how should we scale black into the components ? |
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
805 |
|
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
806 |
r := (100 - c). |
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
807 |
g := (100 - m). |
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
808 |
b := (100 - y). |
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
809 |
k ~~ 0 ifTrue:[ |
6353 | 810 |
"/ more black - darker |
811 |
scale := (100-k) max:0. |
|
812 |
scale := scale / 100. |
|
813 |
r := r * scale. |
|
814 |
g := g * scale. |
|
815 |
b := b * scale. |
|
2888
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
816 |
]. |
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
817 |
|
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
818 |
^ self redPercent:r greenPercent:g bluePercent:b |
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
819 |
|
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
820 |
" |
6353 | 821 |
Color cyan:100 magenta:0 yellow:0 black:0 - cyan |
822 |
Color cyan:100 magenta:0 yellow:0 black:50 - cyan darkened |
|
823 |
Color cyan:100 magenta:50 yellow:50 black:0 - cyan darkened |
|
824 |
Color cyan:0 magenta:0 yellow:0 black:100 - black |
|
2888
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
825 |
" |
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
826 |
|
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
827 |
"Modified: 11.6.1996 / 18:29:15 / cg" |
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
828 |
! |
ce7e932e7cf6
added cyan:magenta:yellow:black
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
829 |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
830 |
dither:fraction between:color1 and:color2 on:aDevice |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
831 |
"create a dithered Color which dithers between color1 and color2. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
832 |
Fraction must be 0..1, color1 and color2 must be real (i.e. undithered) |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
833 |
colors. |
6353 | 834 |
Useful, if you explicitely want a dithered color |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
835 |
(for example, to not use up too many colors, or for special effects)" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
836 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
837 |
|newColor form c1 c2| |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
838 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
839 |
"/ both must be true device colors |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
840 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
841 |
c1 := color1 exactOn:aDevice. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
842 |
c2 := color2 exactOn:aDevice. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
843 |
(c1 isNil or:[c2 isNil]) ifTrue:[ |
6353 | 844 |
'Color [warning]: monoDither failed - no real colors given' errorPrintCR. |
845 |
^ nil |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
846 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
847 |
|
6353 | 848 |
self |
849 |
monoDitherFor:fraction |
|
850 |
between:c1 |
|
851 |
and:c2 |
|
852 |
on:aDevice |
|
853 |
into:[:c :f | newColor := c. form := f]. |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
854 |
newColor notNil ifTrue:[^ newColor]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
855 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
856 |
form isNil ifTrue:[ |
6353 | 857 |
"/ cannot happen |
858 |
'Color [warning]: monoDither failed' errorPrintCR. |
|
859 |
^ nil |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
860 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
861 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
862 |
newColor := self basicNew |
6353 | 863 |
setScaledRed:nil |
864 |
scaledGreen:nil |
|
865 |
scaledBlue:nil |
|
866 |
device:aDevice. |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
867 |
newColor setDitherForm:form. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
868 |
newColor setDevice:aDevice colorId:nil. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
869 |
^ newColor |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
870 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
871 |
" |
3005 | 872 |
(Color dither:0.25 between:Color red and:Color yellow on:Display) inspect |
873 |
(Color dither:0.5 between:Color red and:Color yellow on:Display) inspect |
|
874 |
(Color dither:0.75 between:Color red and:Color yellow on:Display) inspect |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
875 |
" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
876 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
877 |
"Created: 3.5.1997 / 10:54:32 / cg" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
878 |
"Modified: 3.5.1997 / 11:10:51 / cg" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
879 |
! |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
880 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
881 |
dithered:fraction between:color1 and:color2 on:aDevice |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
882 |
"create a dithered Color which dithers between color1 and color2. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
883 |
Fraction must be 0..1, color1 and color2 must be real (i.e. undithered) |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
884 |
colors. |
6353 | 885 |
Useful, if you explicitely want a dithered color |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
886 |
(for example, to not use up too many colors, or for special effects)" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
887 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
888 |
|newColor form c1 c2| |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
889 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
890 |
"/ both must be true device colors |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
891 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
892 |
c1 := color1 exactOn:aDevice. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
893 |
c2 := color2 exactOn:aDevice. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
894 |
(c1 isNil or:[c2 isNil]) ifTrue:[ |
6353 | 895 |
'Color [warning]: monoDither failed - no real colors given' errorPrintCR. |
896 |
^ nil |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
897 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
898 |
|
6353 | 899 |
self |
900 |
monoDitherFor:fraction |
|
901 |
between:c1 |
|
902 |
and:c2 |
|
903 |
on:aDevice |
|
904 |
into:[:c :f | newColor := c. form := f]. |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
905 |
newColor notNil ifTrue:[^ newColor]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
906 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
907 |
form isNil ifTrue:[ |
6353 | 908 |
"/ cannot happen |
909 |
'Color [warning]: monoDither failed' errorPrintCR. |
|
910 |
^ nil |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
911 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
912 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
913 |
newColor := self basicNew |
6353 | 914 |
setScaledRed:nil |
915 |
scaledGreen:nil |
|
916 |
scaledBlue:nil |
|
917 |
device:aDevice. |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
918 |
newColor setDitherForm:form. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
919 |
newColor setDevice:aDevice colorId:nil. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
920 |
^ newColor |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
921 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
922 |
" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
923 |
|c| |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
924 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
925 |
c := Color dithered:0.5 between:Color red and:Color yellow on:Display. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
926 |
c inspect. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
927 |
" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
928 |
" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
929 |
|v c| |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
930 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
931 |
v := StandardSystemView new. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
932 |
v extent:100@100. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
933 |
v openAndWait. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
934 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
935 |
c := Color dithered:0.5 between:Color red and:Color yellow on:Display. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
936 |
v paint:c. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
937 |
v fillRectangle:(10@10 corner:90@90). |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
938 |
" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
939 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
940 |
"Created: 3.5.1997 / 10:54:32 / cg" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
941 |
"Modified: 3.5.1997 / 11:13:12 / cg" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
942 |
! |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
943 |
|
1023 | 944 |
fromUser |
1929 | 945 |
"{ Pragma: +optSpace }" |
946 |
||
1023 | 947 |
"let user point on a screen pixel. |
948 |
Return an instance for that pixels color" |
|
949 |
||
4896
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
950 |
^ self fromUserWithFeedBack:nil |
1023 | 951 |
|
952 |
" |
|
953 |
Color fromUser |
|
954 |
" |
|
955 |
||
1976
fcf9afd72f0f
Do not use obsolete method Color>>at:
Stefan Vogel <sv@exept.de>
parents:
1971
diff
changeset
|
956 |
"Modified: / 31.8.1995 / 01:34:22 / claus" |
fcf9afd72f0f
Do not use obsolete method Color>>at:
Stefan Vogel <sv@exept.de>
parents:
1971
diff
changeset
|
957 |
"Modified: / 9.1.1998 / 20:48:58 / stefan" |
1023 | 958 |
! |
959 |
||
4896
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
960 |
fromUserWithFeedBack:feedbackBlockOrNil |
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
961 |
"{ Pragma: +optSpace }" |
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
962 |
|
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
963 |
"let user point on a screen pixel. |
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
964 |
Return an instance for that pixels color" |
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
965 |
|
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
966 |
|p screen| |
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
967 |
|
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
968 |
screen := Screen current. |
6353 | 969 |
p := screen |
970 |
pointFromUserShowing:(Cursor crossHair) |
|
971 |
positionFeedback:[:p | |
|
972 |
feedbackBlockOrNil notNil ifTrue:[ |
|
973 |
feedbackBlockOrNil value:(screen colorAt:p) |
|
974 |
] |
|
975 |
]. |
|
4896
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
976 |
^ screen colorAt:p |
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
977 |
|
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
978 |
" |
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
979 |
Color fromUserWithFeedBack:nil |
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
980 |
" |
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
981 |
|
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
982 |
"Modified: / 31.8.1995 / 01:34:22 / claus" |
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
983 |
"Modified: / 9.1.1998 / 20:48:58 / stefan" |
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
984 |
! |
bd1f161a578a
added feedback option in color-fromUser
Claus Gittinger <cg@exept.de>
parents:
4851
diff
changeset
|
985 |
|
3005 | 986 |
green:green |
1985 | 987 |
"return a color from green value; |
988 |
the argument green is interpreted as percent (0..100)" |
|
989 |
||
6353 | 990 |
^ here |
991 |
scaledRed:0 scaledGreen:(green * MaxValue // 100) scaledBlue:0 |
|
3005 | 992 |
|
993 |
" |
|
994 |
(Color green:50) inspect |
|
995 |
" |
|
996 |
||
1985 | 997 |
! |
998 |
||
1023 | 999 |
hue:h light:l saturation:s |
1000 |
"return a color from hue, light and saturation values. |
|
7569 | 1001 |
Hue is in degrees (0..360); light and saturation are |
1023 | 1002 |
in percent (0..100)" |
1003 |
||
1004 |
self withRGBFromHue:h light:l saturation:s do:[:r :g :b | |
|
7569 | 1005 |
^ self |
1006 |
redPercent:(r clampBetween:0 and:100) |
|
1007 |
greenPercent:(g clampBetween:0 and:100) |
|
1008 |
bluePercent:(b clampBetween:0 and:100) |
|
1023 | 1009 |
] |
1010 |
||
1011 |
" |
|
1012 |
Color hue:0 light:50 saturation:100 - red |
|
1013 |
Color hue:60 light:50 saturation:100 - yellow |
|
1014 |
Color hue:120 light:50 saturation:100 - green |
|
1015 |
Color hue:120 light:75 saturation:100 - bright green |
|
1016 |
Color hue:120 light:25 saturation:100 - dark green |
|
1017 |
Color hue:120 light:50 saturation:50 - greyish dark green |
|
1018 |
Color hue:120 light:50 saturation:0 - b&w television dark green |
|
1019 |
" |
|
1020 |
||
1021 |
"Modified: 23.4.1996 / 13:22:22 / cg" |
|
1022 |
! |
|
1023 |
||
1233 | 1024 |
name:colorName |
1023 | 1025 |
"Return a named color (either exact or dithered). |
1026 |
Report an error, if aString is not a valid color name. |
|
1027 |
||
1028 |
We hereby only guarantee that the 8 basic colors are supported |
|
1029 |
on every device (X uses the Xcolor database, so it supports more |
|
1030 |
names - other devices use a builtIn name table containing only the |
|
6353 | 1031 |
common names) |
1032 |
- use with special names (such as 'mediumGoldenRod' is not recommended). |
|
3005 | 1033 |
Better use: #name:ifIllegal: and provide a fallBack." |
1023 | 1034 |
|
6353 | 1035 |
^ self |
1036 |
name:colorName |
|
1037 |
ifIllegal:[ |
|
1038 |
InvalidColorNameSignal |
|
1039 |
raiseRequestWith:colorName errorString:' : ' , colorName |
|
1040 |
] |
|
1041 |
||
1042 |
" |
|
1043 |
Color name:'brown' |
|
1044 |
Color name:'snow' |
|
1023 | 1045 |
Color name:'foo' |
1046 |
" |
|
1047 |
||
1534 | 1048 |
"Modified: 4.4.1997 / 15:32:33 / cg" |
1023 | 1049 |
! |
1050 |
||
1233 | 1051 |
name:colorName ifIllegal:errorBlock |
1023 | 1052 |
"Return a named color (either exact or dithered). |
6353 | 1053 |
If aString is not a valid color name, |
1233 | 1054 |
return the result from evaluating errorBlock." |
1055 |
||
3399
02a4018f9549
care for no-display case when asking for a color-by-name
Claus Gittinger <cg@exept.de>
parents:
3396
diff
changeset
|
1056 |
|triple r g b currScreen| |
1428 | 1057 |
|
1058 |
triple := StandardColorValues at:colorName asString ifAbsent:nil. |
|
1059 |
triple notNil ifTrue:[ |
|
6353 | 1060 |
r := triple at:1. |
1061 |
g := triple at:2. |
|
1062 |
b := triple at:3. |
|
1428 | 1063 |
] ifFalse:[ |
6353 | 1064 |
"/ ask display (if there is one) ... |
1065 |
||
1066 |
(Screen notNil |
|
1067 |
and:[ (currScreen := Screen current) notNil]) |
|
1068 |
ifTrue:[ |
|
1069 |
currScreen |
|
1070 |
getScaledRGBFromName:colorName |
|
1071 |
into:[:rr :gg :bb | |
|
1072 |
r := rr. |
|
1073 |
g := gg. |
|
1074 |
b := bb |
|
1075 |
]. |
|
1076 |
] |
|
1428 | 1077 |
]. |
1233 | 1078 |
r notNil ifTrue:[ |
6353 | 1079 |
^ here scaledRed:r scaledGreen:g scaledBlue:b |
1233 | 1080 |
]. |
1081 |
^ errorBlock value |
|
1023 | 1082 |
|
1083 |
" |
|
1084 |
Color name:'brown' ifIllegal:[Color black] |
|
6353 | 1085 |
Color name:'red' ifIllegal:[Color black] |
1086 |
Color name:'fuchsia' ifIllegal:[Color black] |
|
1087 |
Color name:'foo' ifIllegal:[Color black] |
|
1088 |
Color name:'foo' ifIllegal:[nil] |
|
1023 | 1089 |
" |
1090 |
||
1428 | 1091 |
"Modified: 6.3.1997 / 02:32:41 / cg" |
1023 | 1092 |
! |
1093 |
||
1094 |
noColor |
|
1095 |
"return a special color which, when used for bit-blitting will |
|
1096 |
behave like a 0-color (i.e. have a device-pixel value of all-0s)" |
|
1097 |
||
1098 |
Pseudo0 isNil ifTrue:[ |
|
6353 | 1099 |
Pseudo0 := self basicNew setColorId:0 |
1023 | 1100 |
]. |
1101 |
^ Pseudo0 |
|
1238
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
1102 |
|
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
1103 |
"Modified: 17.1.1997 / 00:06:49 / cg" |
1023 | 1104 |
! |
1105 |
||
3005 | 1106 |
red:red |
1985 | 1107 |
"return a color from red value; |
1108 |
the argument r is interpreted as percent (0..100)" |
|
1109 |
||
6353 | 1110 |
^ here |
1111 |
scaledRed:(red * MaxValue // 100) scaledGreen:0 scaledBlue:0 |
|
3005 | 1112 |
|
1113 |
" |
|
1114 |
(Color red:50) inspect |
|
1115 |
" |
|
1985 | 1116 |
! |
1117 |
||
1023 | 1118 |
red:r green:g blue:b |
1119 |
"return a color from red, green and blue values; |
|
1120 |
the arguments, r, g and b are interpreted as percent (0..100)" |
|
1121 |
||
1348 | 1122 |
^ here scaledRed:(r * MaxValue // 100) |
6353 | 1123 |
scaledGreen:(g * MaxValue // 100) |
1124 |
scaledBlue:(b * MaxValue // 100) |
|
1023 | 1125 |
! |
1126 |
||
1237 | 1127 |
redByte:r greenByte:g blueByte:b |
1128 |
"return a color from red, green and blue values; |
|
1129 |
the arguments, r, g and b are interpreted as byte values (0..255)" |
|
1130 |
||
1348 | 1131 |
^ here scaledRed:(r * MaxValue // 255) |
6353 | 1132 |
scaledGreen:(g * MaxValue // 255) |
1133 |
scaledBlue:(b * MaxValue // 255) |
|
1237 | 1134 |
|
1135 |
" |
|
1136 |
(Color redByte:255 greenByte:0 blueByte:0) inspect |
|
1137 |
(Color redByte:255 greenByte:255 blueByte:255) inspect |
|
1138 |
(Color redByte:0 greenByte:0 blueByte:0) inspect |
|
1139 |
" |
|
1140 |
||
1141 |
"Modified: 16.1.1997 / 23:32:43 / cg" |
|
1142 |
! |
|
1143 |
||
4789 | 1144 |
redByte:r greenByte:g blueByte:b alphaByte:a |
1145 |
"return a color from red, green, blue and alpha values; |
|
1146 |
the arguments, r, g, b and a are interpreted as byte values (0..255)" |
|
1147 |
||
1148 |
^ (here scaledRed:(r * MaxValue // 255) |
|
6353 | 1149 |
scaledGreen:(g * MaxValue // 255) |
1150 |
scaledBlue:(b * MaxValue // 255)) |
|
1151 |
alpha:(a / 255) |
|
4789 | 1152 |
|
1153 |
" |
|
1154 |
(Color redByte:255 greenByte:0 blueByte:0 alphaByte:127) inspect |
|
1155 |
" |
|
1156 |
||
1157 |
"Created: / 06-06-2007 / 11:15:47 / cg" |
|
1158 |
! |
|
1159 |
||
5144 | 1160 |
redFraction:r greenFraction:g blueFraction:b |
1161 |
"return a color from red, green and blue values; |
|
1162 |
the arguments, r, g and b are interpreted as fraction (0..1)" |
|
1163 |
||
1164 |
^ here scaledRed:(r * MaxValue) rounded |
|
6353 | 1165 |
scaledGreen:(g * MaxValue) rounded |
1166 |
scaledBlue:(b * MaxValue) rounded |
|
5144 | 1167 |
! |
1168 |
||
1348 | 1169 |
redPercent:r greenPercent:g bluePercent:b |
1170 |
"return a color from red, green and blue values; |
|
1171 |
the arguments, r, g and b are interpreted as percent (0..100)" |
|
1172 |
||
1173 |
^ here scaledRed:(r * MaxValue // 100) |
|
6353 | 1174 |
scaledGreen:(g * MaxValue // 100) |
1175 |
scaledBlue:(b * MaxValue // 100) |
|
1348 | 1176 |
! |
1177 |
||
5127
40d2ac51c76d
color conversions fixed (16bit images)
Claus Gittinger <cg@exept.de>
parents:
4986
diff
changeset
|
1178 |
redPercent:r greenPercent:g bluePercent:b alphaPercent:a |
40d2ac51c76d
color conversions fixed (16bit images)
Claus Gittinger <cg@exept.de>
parents:
4986
diff
changeset
|
1179 |
"return a color from red, green and blue values; |
40d2ac51c76d
color conversions fixed (16bit images)
Claus Gittinger <cg@exept.de>
parents:
4986
diff
changeset
|
1180 |
the arguments, r, g and b are interpreted as percent (0..100)" |
40d2ac51c76d
color conversions fixed (16bit images)
Claus Gittinger <cg@exept.de>
parents:
4986
diff
changeset
|
1181 |
|
40d2ac51c76d
color conversions fixed (16bit images)
Claus Gittinger <cg@exept.de>
parents:
4986
diff
changeset
|
1182 |
^ (here scaledRed:(r * MaxValue // 100) |
6353 | 1183 |
scaledGreen:(g * MaxValue // 100) |
1184 |
scaledBlue:(b * MaxValue // 100)) |
|
1185 |
alpha:(a * 255 // 100) |
|
5127
40d2ac51c76d
color conversions fixed (16bit images)
Claus Gittinger <cg@exept.de>
parents:
4986
diff
changeset
|
1186 |
! |
40d2ac51c76d
color conversions fixed (16bit images)
Claus Gittinger <cg@exept.de>
parents:
4986
diff
changeset
|
1187 |
|
3956
74f5434f3e38
+redShort:greenShort:blueShort:
Claus Gittinger <cg@exept.de>
parents:
3935
diff
changeset
|
1188 |
redShort:r greenShort:g blueShort:b |
74f5434f3e38
+redShort:greenShort:blueShort:
Claus Gittinger <cg@exept.de>
parents:
3935
diff
changeset
|
1189 |
"return a color from red, green and blue short values; |
74f5434f3e38
+redShort:greenShort:blueShort:
Claus Gittinger <cg@exept.de>
parents:
3935
diff
changeset
|
1190 |
the arguments, r, g and b are interpreted as unsigned short values (0..16rFFFF)" |
74f5434f3e38
+redShort:greenShort:blueShort:
Claus Gittinger <cg@exept.de>
parents:
3935
diff
changeset
|
1191 |
|
74f5434f3e38
+redShort:greenShort:blueShort:
Claus Gittinger <cg@exept.de>
parents:
3935
diff
changeset
|
1192 |
^ here scaledRed:(r * MaxValue // 16rFFFF) |
6353 | 1193 |
scaledGreen:(g * MaxValue // 16rFFFF) |
1194 |
scaledBlue:(b * MaxValue // 16rFFFF) |
|
3956
74f5434f3e38
+redShort:greenShort:blueShort:
Claus Gittinger <cg@exept.de>
parents:
3935
diff
changeset
|
1195 |
|
74f5434f3e38
+redShort:greenShort:blueShort:
Claus Gittinger <cg@exept.de>
parents:
3935
diff
changeset
|
1196 |
" |
74f5434f3e38
+redShort:greenShort:blueShort:
Claus Gittinger <cg@exept.de>
parents:
3935
diff
changeset
|
1197 |
(Color redShort:16rFFFF greenShort:0 blueShort:0) inspect |
74f5434f3e38
+redShort:greenShort:blueShort:
Claus Gittinger <cg@exept.de>
parents:
3935
diff
changeset
|
1198 |
" |
74f5434f3e38
+redShort:greenShort:blueShort:
Claus Gittinger <cg@exept.de>
parents:
3935
diff
changeset
|
1199 |
! |
74f5434f3e38
+redShort:greenShort:blueShort:
Claus Gittinger <cg@exept.de>
parents:
3935
diff
changeset
|
1200 |
|
1859 | 1201 |
rgbValue:rgb |
3005 | 1202 |
"return a color from a 24bit RGB value; |
1859 | 1203 |
The value is composed of r<<16 + g<<8 + b." |
1204 |
||
1205 |
|r g b| |
|
1206 |
||
1207 |
r := (rgb bitShift:-16) bitAnd:16rFF. |
|
1208 |
g := (rgb bitShift:-8) bitAnd:16rFF. |
|
1209 |
b := (rgb) bitAnd:16rFF. |
|
1210 |
^ self redByte:r greenByte:g blueByte:b |
|
1211 |
||
1212 |
" |
|
1213 |
(Color rgbValue:16rFF0000) inspect |
|
1214 |
(Color rgbValue:16r00FF00) inspect |
|
1215 |
(Color rgbValue:16r0000FF) inspect |
|
1216 |
(Color rgbValue:16rFF00FF) inspect |
|
1217 |
" |
|
1218 |
||
1219 |
"Modified: 13.8.1997 / 20:24:37 / cg" |
|
1220 |
! |
|
1221 |
||
1023 | 1222 |
scaledGray:aGrayValue |
1223 |
"return a gray color with a scaled gray value (0..MaxValue)" |
|
1224 |
||
1225 |
^ self scaledRed:aGrayValue scaledGreen:aGrayValue scaledBlue:aGrayValue |
|
1226 |
||
1227 |
"Modified: 11.6.1996 / 16:31:42 / cg" |
|
1228 |
! |
|
1229 |
||
1230 |
scaledRed:r scaledGreen:g scaledBlue:b |
|
1231 |
"return a color from red, green and blue values; |
|
1232 |
the arguments, r, g and b are interpreted as (0..MaxValue)" |
|
1233 |
||
1234 |
|newColor| |
|
1235 |
||
1365
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
1236 |
"/ "look if already known" |
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
1237 |
"/ |
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
1238 |
"/ aDevice deviceColors do:[:aColor | |
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
1239 |
"/ (r == aColor scaledRed) ifTrue:[ |
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
1240 |
"/ (g == aColor scaledGreen) ifTrue:[ |
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
1241 |
"/ (b == aColor scaledBlue) ifTrue:[ |
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
1242 |
"/ ^ aColor |
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
1243 |
"/ ] |
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
1244 |
"/ ] |
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
1245 |
"/ ] |
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
1246 |
"/ ]. |
1023 | 1247 |
newColor := self basicNew setScaledRed:r scaledGreen:g scaledBlue:b device:nil. |
1248 |
^ newColor |
|
1249 |
||
1250 |
" |
|
1251 |
(Color red:100 green:0 blue:0) inspect |
|
1252 |
(Color red:100 green:50 blue:50) inspect |
|
1253 |
(Color red:50 green:0 blue:0) inspect |
|
1254 |
" |
|
1255 |
||
1256 |
"Modified: 2.5.1996 / 13:40:51 / stefan" |
|
1365
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
1257 |
"Modified: 24.2.1997 / 18:18:47 / cg" |
1023 | 1258 |
! |
1259 |
||
1260 |
variableColorOn:aDevice |
|
1261 |
"return a variable color (i.e. allocate a writable colorcell) on |
|
1262 |
aDevice. The returned color is not shared and its rgb components |
|
1263 |
are initially undefined. The components can be set to any value |
|
1264 |
using Color>>red:green:blue. Care should be taken, since this call |
|
1265 |
fails on static color or b&w displays (i.e. it depends on the device |
|
1266 |
being a pseudocolor device using colormaps). |
|
1267 |
Returns nil, if no more colorCells are available, or the display |
|
1268 |
uses a fix colormap (i.e. is a directColor or staticColor pr b&w device). |
|
1269 |
Because of this, you should not write your application to depend on |
|
1270 |
writable colors to be available (i.e. add fallBack code to redraw |
|
1271 |
things in another color)" |
|
1272 |
||
1273 |
|c lutIndex| |
|
1274 |
||
1275 |
lutIndex := aDevice colorCell. |
|
1276 |
lutIndex isNil ifTrue:[^ nil]. |
|
1277 |
||
1278 |
c := self new. |
|
1934 | 1279 |
c setDevice:aDevice colorId:lutIndex writable:true. |
1023 | 1280 |
Cells isNil ifTrue:[ |
6353 | 1281 |
Cells := Registry new. |
1023 | 1282 |
]. |
1283 |
Cells register:c. |
|
1284 |
^ c |
|
1285 |
||
1286 |
" |
|
1287 |
|l cell| |
|
1288 |
||
1289 |
l := Label new. |
|
1290 |
l label:('hello' asText allBold). |
|
1291 |
||
1292 |
cell := Color variableColorOn:(Screen current). |
|
1293 |
l foregroundColor:cell. |
|
1294 |
[ |
|
6353 | 1295 |
1 to:40 do:[:i| |
1296 |
i odd ifTrue:[ |
|
1297 |
cell red:100 green:0 blue:0 |
|
1298 |
] ifFalse:[ |
|
1299 |
cell red:0 green:0 blue:0 |
|
1300 |
]. |
|
1301 |
Display flush. |
|
1302 |
(Delay forSeconds:0.4) wait |
|
1303 |
]. |
|
1304 |
l destroy. |
|
1023 | 1305 |
] fork. |
1306 |
l open |
|
1307 |
" |
|
1308 |
||
1309 |
"Modified: 13.5.1996 / 12:41:53 / cg" |
|
1310 |
! ! |
|
1311 |
||
3892 | 1312 |
!Color class methodsFor:'Compatibility-Squeak'! |
2934 | 1313 |
|
3021 | 1314 |
colorPaletteForDepth: depth extent: chartExtent |
6353 | 1315 |
"Squeak mimicri: |
1316 |
Display a palette of colors sorted horizontally by hue and vertically by lightness. Useful for eyeballing the color gamut of the display, or for choosing a color interactively." |
|
1317 |
||
1318 |
"Note: It is slow to build this palette, so it should be cached for quick access." |
|
1319 |
"(Color colorPaletteForDepth: 16 extent: 190@60) display" |
|
1320 |
||
1321 |
| basicHue x y c startHue palette transHt vSteps transCaption grayWidth hSteps | |
|
3324 | 1322 |
|
1323 |
"/ Smalltalk isSmalltalkX ifTrue:[ |
|
6353 | 1324 |
palette := Image extent:chartExtent depth:24. |
1325 |
palette photometric:#rgb. |
|
1326 |
palette bits:(ByteArray new:chartExtent x * chartExtent y * 3). |
|
3324 | 1327 |
"/ ] ifFalse:[ |
1328 |
"/ palette := Form extent: chartExtent depth: depth. |
|
1329 |
"/ ]. |
|
6353 | 1330 |
transCaption := "(DisplayText text: 'no color' asText textStyle: (TextConstants at: #ComicPlain)) form storeString" |
1331 |
(Form extent: 34@9 depth: 1 |
|
1332 |
fromArray: #(0 0 256 0 256 0 3808663859 2147483648 2491688266 2147483648 2491688266 0 2491688266 0 2466486578 0 0 0) |
|
1333 |
offset: 0@0). |
|
1334 |
transHt := transCaption height. |
|
1335 |
palette fillWhite: (0@0 extent: palette width@transHt). |
|
1336 |
palette fillBlack: (0@transHt extent: palette width@1). |
|
3021 | 1337 |
"/ transCaption displayOn: palette at: palette boundingBox topCenter - ((transCaption width // 2)@0). |
6353 | 1338 |
grayWidth := 10. |
1339 |
startHue := 338.0. |
|
1340 |
vSteps := palette height - transHt // 2. |
|
1341 |
hSteps := palette width - grayWidth. |
|
1342 |
x := 0. |
|
1343 |
startHue to: startHue + 360.0 by: 360.0/hSteps do: [:h | |
|
1344 |
basicHue := Color h: h asFloat s: 1.0 v: 1.0. |
|
1345 |
y := transHt+1. |
|
1346 |
0 to: vSteps do: [:n | |
|
1347 |
c := basicHue mixed: (n asFloat / vSteps asFloat) with: Color white. |
|
1348 |
palette fill: (x@y extent: 1@1) fillColor: c. |
|
1349 |
y := y + 1]. |
|
1350 |
1 to: vSteps do: [:n | |
|
1351 |
c := Color black mixed: (n asFloat / vSteps asFloat) with: basicHue. |
|
1352 |
y < palette height ifTrue:[ |
|
1353 |
palette fill: (x@y extent: 1@1) fillColor: c. |
|
1354 |
]. |
|
1355 |
y := y + 1]. |
|
1356 |
x := x + 1]. |
|
1357 |
y := transHt + 1. |
|
1358 |
1 to: vSteps * 2 do: [:n | |
|
1359 |
c := Color black mixed: (n asFloat / (vSteps*2) asFloat) with: Color white. |
|
1360 |
palette fill: (x@y corner:(((x@y) +(10@1))min:palette extent)) fillColor: c. |
|
1361 |
y := y + 1]. |
|
1362 |
^ palette |
|
3021 | 1363 |
! |
1364 |
||
3024 | 1365 |
fromRgbTriplet:aTriple |
1366 |
^ self r:(aTriple at:1) |
|
6353 | 1367 |
g:(aTriple at:2) |
1368 |
b:(aTriple at:3) |
|
3024 | 1369 |
|
1370 |
! |
|
1371 |
||
3021 | 1372 |
h:hue s:saturation v:brightness |
1373 |
"Squeak mimicri: |
|
6353 | 1374 |
Create a color with the given hue, saturation, and brightness. |
3021 | 1375 |
Hue is given as the angle in degrees of the color on the color circle, |
6353 | 1376 |
where red is zero degrees. |
3021 | 1377 |
Saturation and brightness are numbers in [0.0..1.0], |
6353 | 1378 |
where larger values are more saturated or brighter colors. |
3021 | 1379 |
For example, (Color h: 0 s: 1 v: 1) is pure red." |
1380 |
||
7411 | 1381 |
"Note: By convention, brightness is abbreviated 'v' to avoid confusion with blue." |
3021 | 1382 |
|
3024 | 1383 |
^ self hue:hue light:(brightness*50) saturation:(saturation*100) |
1384 |
! |
|
1385 |
||
4986 | 1386 |
indexedColors |
1387 |
"Build an array of colors corresponding to the fixed colormap used |
|
1388 |
for display depths of 1, 2, 4, or 8 bits." |
|
1389 |
"Color indexedColors" |
|
1390 |
||
1391 |
| a index grayVal | |
|
1392 |
||
1393 |
a := Array new: 256. |
|
1394 |
||
1395 |
"1-bit colors (monochrome)" |
|
1396 |
a at: 1 put: (Color r: 1.0 g: 1.0 b: 1.0). "white or transparent" |
|
1397 |
a at: 2 put: (Color r: 0.0 g: 0.0 b: 0.0). "black" |
|
1398 |
||
1399 |
"additional colors for 2-bit color" |
|
1400 |
a at: 3 put: (Color r: 1.0 g: 1.0 b: 1.0). "opaque white" |
|
1401 |
a at: 4 put: (Color r: 0.5 g: 0.5 b: 0.5). "1/2 gray" |
|
1402 |
||
1403 |
"additional colors for 4-bit color" |
|
1404 |
a at: 5 put: (Color r: 1.0 g: 0.0 b: 0.0). "red" |
|
1405 |
a at: 6 put: (Color r: 0.0 g: 1.0 b: 0.0). "green" |
|
1406 |
a at: 7 put: (Color r: 0.0 g: 0.0 b: 1.0). "blue" |
|
1407 |
a at: 8 put: (Color r: 0.0 g: 1.0 b: 1.0). "cyan" |
|
1408 |
a at: 9 put: (Color r: 1.0 g: 1.0 b: 0.0). "yellow" |
|
1409 |
a at: 10 put: (Color r: 1.0 g: 0.0 b: 1.0). "magenta" |
|
1410 |
||
1411 |
a at: 11 put: (Color r: 0.125 g: 0.125 b: 0.125). "1/8 gray" |
|
1412 |
a at: 12 put: (Color r: 0.25 g: 0.25 b: 0.25). "2/8 gray" |
|
1413 |
a at: 13 put: (Color r: 0.375 g: 0.375 b: 0.375). "3/8 gray" |
|
1414 |
a at: 14 put: (Color r: 0.625 g: 0.625 b: 0.625). "5/8 gray" |
|
1415 |
a at: 15 put: (Color r: 0.75 g: 0.75 b: 0.75). "6/8 gray" |
|
1416 |
a at: 16 put: (Color r: 0.875 g: 0.875 b: 0.875). "7/8 gray" |
|
1417 |
||
1418 |
"additional colors for 8-bit color" |
|
1419 |
"24 more shades of gray (1/32 increments but not repeating 1/8 increments)" |
|
1420 |
index := 17. |
|
1421 |
1 to: 31 do: [:v | |
|
6353 | 1422 |
(v \\ 4) = 0 ifFalse: [ |
1423 |
grayVal := v / 32.0. |
|
1424 |
a at: index put: (Color r: grayVal g: grayVal b: grayVal). |
|
1425 |
index := index + 1]]. |
|
4986 | 1426 |
|
1427 |
"The remainder of color table defines a color cube with six steps |
|
1428 |
for each primary color. Note that the corners of this cube repeat |
|
1429 |
previous colors, but this simplifies the mapping between RGB colors |
|
1430 |
and color map indices. This color cube spans indices 40 through 255 |
|
1431 |
(indices 41-256 in this 1-based array)." |
|
1432 |
0 to: 5 do: [:r | |
|
6353 | 1433 |
0 to: 5 do: [:g | |
1434 |
0 to: 5 do: [:b | |
|
1435 |
index := 41 + ((36 * r) + (6 * b) + g). |
|
1436 |
index > 256 ifTrue: [ |
|
1437 |
self error: 'index out of range in color table compuation']. |
|
1438 |
a at: index put: (Color r: r g: g b: b range: 5)]]]. |
|
4986 | 1439 |
|
1440 |
^ a. |
|
1441 |
! |
|
1442 |
||
3893 | 1443 |
paleBlue |
1444 |
^ self r:0.75 g:0.75 b:1 |
|
1445 |
! |
|
1446 |
||
3024 | 1447 |
pixelScreenForDepth: depth |
3898
368c43005b5a
isSmalltalkX -> dialectName comparison (CS-Compatibility)
Claus Gittinger <cg@exept.de>
parents:
3893
diff
changeset
|
1448 |
"Return a 50% stipple containing alternating pixels of all-zeros and all-ones to be used as a mask at the given depth." |
368c43005b5a
isSmalltalkX -> dialectName comparison (CS-Compatibility)
Claus Gittinger <cg@exept.de>
parents:
3893
diff
changeset
|
1449 |
|
368c43005b5a
isSmalltalkX -> dialectName comparison (CS-Compatibility)
Claus Gittinger <cg@exept.de>
parents:
3893
diff
changeset
|
1450 |
| mask bits | |
368c43005b5a
isSmalltalkX -> dialectName comparison (CS-Compatibility)
Claus Gittinger <cg@exept.de>
parents:
3893
diff
changeset
|
1451 |
|
6584 | 1452 |
(Smalltalk isSmalltalkX) ifTrue:[ |
1453 |
depth == 1 ifTrue:[ |
|
1454 |
^ Form mediumGreyFormOn:Screen current |
|
1455 |
]. |
|
1456 |
self shouldImplement. |
|
3898
368c43005b5a
isSmalltalkX -> dialectName comparison (CS-Compatibility)
Claus Gittinger <cg@exept.de>
parents:
3893
diff
changeset
|
1457 |
]. |
368c43005b5a
isSmalltalkX -> dialectName comparison (CS-Compatibility)
Claus Gittinger <cg@exept.de>
parents:
3893
diff
changeset
|
1458 |
|
368c43005b5a
isSmalltalkX -> dialectName comparison (CS-Compatibility)
Claus Gittinger <cg@exept.de>
parents:
3893
diff
changeset
|
1459 |
mask := (1 bitShift: depth) - 1. |
368c43005b5a
isSmalltalkX -> dialectName comparison (CS-Compatibility)
Claus Gittinger <cg@exept.de>
parents:
3893
diff
changeset
|
1460 |
bits := 2 * depth. |
368c43005b5a
isSmalltalkX -> dialectName comparison (CS-Compatibility)
Claus Gittinger <cg@exept.de>
parents:
3893
diff
changeset
|
1461 |
[bits >= 32] whileFalse: [ |
6584 | 1462 |
mask := mask bitOr: (mask bitShift: bits). "double the length of mask" |
1463 |
bits := bits + bits |
|
3898
368c43005b5a
isSmalltalkX -> dialectName comparison (CS-Compatibility)
Claus Gittinger <cg@exept.de>
parents:
3893
diff
changeset
|
1464 |
]. |
368c43005b5a
isSmalltalkX -> dialectName comparison (CS-Compatibility)
Claus Gittinger <cg@exept.de>
parents:
3893
diff
changeset
|
1465 |
^ Bitmap with: mask with: mask bitInvert32 |
368c43005b5a
isSmalltalkX -> dialectName comparison (CS-Compatibility)
Claus Gittinger <cg@exept.de>
parents:
3893
diff
changeset
|
1466 |
|
368c43005b5a
isSmalltalkX -> dialectName comparison (CS-Compatibility)
Claus Gittinger <cg@exept.de>
parents:
3893
diff
changeset
|
1467 |
" |
368c43005b5a
isSmalltalkX -> dialectName comparison (CS-Compatibility)
Claus Gittinger <cg@exept.de>
parents:
3893
diff
changeset
|
1468 |
self pixelScreenForDepth: depth |
368c43005b5a
isSmalltalkX -> dialectName comparison (CS-Compatibility)
Claus Gittinger <cg@exept.de>
parents:
3893
diff
changeset
|
1469 |
" |
3021 | 1470 |
! |
1471 |
||
2934 | 1472 |
r:redFraction g:greenFraction b:blueFraction |
3021 | 1473 |
"Squeak mimicri: |
1474 |
return a color from red, green and blue fractional values; |
|
4789 | 1475 |
the arguments, r, g and b must be in (0..1)" |
2934 | 1476 |
|
2937 | 1477 |
^ here scaledRed:(redFraction * MaxValue) rounded |
6353 | 1478 |
scaledGreen:(greenFraction * MaxValue) rounded |
1479 |
scaledBlue:(blueFraction * MaxValue) rounded |
|
4789 | 1480 |
|
1481 |
"Modified: / 06-06-2007 / 11:19:53 / cg" |
|
1482 |
! |
|
1483 |
||
1484 |
r:r g:g b:b alpha:alphaValue |
|
1485 |
"return a color from red, green and blue values; |
|
1486 |
the arguments, r, g, b and alpha must be in 0..1" |
|
1487 |
||
1488 |
^ (self r:r g:g b:b) alpha:alphaValue |
|
1489 |
||
1490 |
" |
|
1491 |
(Color r:1 g:0 b:0 alpha:0) inspect |
|
1492 |
(Color r:0 g:1 b:0 alpha:0.5) inspect |
|
1493 |
(Color r:0 g:0 b:1 alpha:1) inspect |
|
1494 |
" |
|
1495 |
||
1496 |
"Created: / 06-06-2007 / 10:48:21 / cg" |
|
3396 | 1497 |
! |
1498 |
||
4202 | 1499 |
r:r g:g b:b range:componentMax |
1500 |
"return a color from red, green and blue values; |
|
1501 |
the arguments, r, g and b are interpreted as values (0..componentMax)" |
|
1502 |
||
1503 |
^ here scaledRed:(r * MaxValue // componentMax) |
|
6353 | 1504 |
scaledGreen:(g * MaxValue // componentMax) |
1505 |
scaledBlue:(b * MaxValue // componentMax) |
|
4202 | 1506 |
|
1507 |
" |
|
1508 |
(Color r:1023 g:0 b:0 range:1023) inspect |
|
1509 |
(Color r:1023 g:1023 b:1023 range:1023) inspect |
|
1510 |
(Color r:0 g:0 b:0 range:1023) inspect |
|
1511 |
" |
|
1512 |
! |
|
1513 |
||
3396 | 1514 |
showColors: colorList |
6353 | 1515 |
"Display the given collection of colors across the top of the Display." |
1516 |
||
1517 |
| w r | |
|
1518 |
w := Screen current width // colorList size. |
|
1519 |
r := 0@0 extent: w@((w min: 30) max: 10). |
|
1520 |
colorList do: [:c | |
|
1521 |
Screen current fill: r fillColor: c. |
|
1522 |
r := r translateBy: w@0]. |
|
3396 | 1523 |
! |
1524 |
||
1525 |
wheel: thisMany |
|
1526 |
"Return a collection of thisMany colors evenly spaced around the color wheel." |
|
1527 |
"Color showColors: (Color wheel: 12)" |
|
1528 |
||
1529 |
^ Color wheel: thisMany saturation: 0.9 brightness: 0.7 |
|
1530 |
! |
|
1531 |
||
1532 |
wheel: thisMany saturation: s brightness: v |
|
6353 | 1533 |
"Return a collection of thisMany colors evenly spaced around the color wheel, |
4789 | 1534 |
all of the given saturation and brightness." |
3396 | 1535 |
"Color showColors: (Color wheel: 12 saturation: 0.4 brightness: 1.0)" |
1536 |
"Color showColors: (Color wheel: 12 saturation: 0.8 brightness: 0.5)" |
|
1537 |
||
1538 |
^ (Color h: 0.0 s: s v: v) wheel: thisMany |
|
4789 | 1539 |
|
1540 |
"Modified: / 06-06-2007 / 11:20:59 / cg" |
|
2934 | 1541 |
! ! |
1542 |
||
1144 | 1543 |
!Color class methodsFor:'Signal constants'! |
1023 | 1544 |
|
1545 |
colorAllocationFailSignal |
|
1546 |
"return the signal raised when a color allocation failed." |
|
1547 |
||
1548 |
^ ColorAllocationFailSignal |
|
1549 |
||
1550 |
"Created: 12.6.1996 / 17:44:49 / cg" |
|
1269
f0777b2cc08a
use a signal for invalid color names
Claus Gittinger <cg@exept.de>
parents:
1239
diff
changeset
|
1551 |
! |
f0777b2cc08a
use a signal for invalid color names
Claus Gittinger <cg@exept.de>
parents:
1239
diff
changeset
|
1552 |
|
2379
b2a844aabc93
made my signals children of a common colorErrorSignal
Claus Gittinger <cg@exept.de>
parents:
2375
diff
changeset
|
1553 |
colorErrorSignal |
b2a844aabc93
made my signals children of a common colorErrorSignal
Claus Gittinger <cg@exept.de>
parents:
2375
diff
changeset
|
1554 |
"return the parent signal of all color error signals." |
b2a844aabc93
made my signals children of a common colorErrorSignal
Claus Gittinger <cg@exept.de>
parents:
2375
diff
changeset
|
1555 |
|
b2a844aabc93
made my signals children of a common colorErrorSignal
Claus Gittinger <cg@exept.de>
parents:
2375
diff
changeset
|
1556 |
^ ColorErrorSignal |
b2a844aabc93
made my signals children of a common colorErrorSignal
Claus Gittinger <cg@exept.de>
parents:
2375
diff
changeset
|
1557 |
|
b2a844aabc93
made my signals children of a common colorErrorSignal
Claus Gittinger <cg@exept.de>
parents:
2375
diff
changeset
|
1558 |
"Created: / 30.9.1998 / 21:56:04 / cg" |
b2a844aabc93
made my signals children of a common colorErrorSignal
Claus Gittinger <cg@exept.de>
parents:
2375
diff
changeset
|
1559 |
! |
b2a844aabc93
made my signals children of a common colorErrorSignal
Claus Gittinger <cg@exept.de>
parents:
2375
diff
changeset
|
1560 |
|
1269
f0777b2cc08a
use a signal for invalid color names
Claus Gittinger <cg@exept.de>
parents:
1239
diff
changeset
|
1561 |
invalidColorNameSignal |
f0777b2cc08a
use a signal for invalid color names
Claus Gittinger <cg@exept.de>
parents:
1239
diff
changeset
|
1562 |
"return the signal raised when an invalid color name is encountered" |
f0777b2cc08a
use a signal for invalid color names
Claus Gittinger <cg@exept.de>
parents:
1239
diff
changeset
|
1563 |
|
f0777b2cc08a
use a signal for invalid color names
Claus Gittinger <cg@exept.de>
parents:
1239
diff
changeset
|
1564 |
^ InvalidColorNameSignal |
f0777b2cc08a
use a signal for invalid color names
Claus Gittinger <cg@exept.de>
parents:
1239
diff
changeset
|
1565 |
|
f0777b2cc08a
use a signal for invalid color names
Claus Gittinger <cg@exept.de>
parents:
1239
diff
changeset
|
1566 |
"Created: 24.1.1997 / 13:36:25 / cg" |
1023 | 1567 |
! ! |
1568 |
||
1144 | 1569 |
!Color class methodsFor:'accessing'! |
1023 | 1570 |
|
1571 |
allocatedColorsOn:aDevice |
|
3833 | 1572 |
"return a collection of colors which have already been allocated |
1573 |
on aDevice." |
|
1574 |
||
4176 | 1575 |
<resource: #obsolete> |
3833 | 1576 |
self obsoleteMethodWarning:'use #allocatedColorsOnDevice:'. |
1577 |
||
1578 |
^ self allocatedColorsOnDevice:aDevice |
|
1579 |
! |
|
1580 |
||
1581 |
allocatedColorsOnDevice:aDevice |
|
1582 |
"return a collection of colors which have already been allocated |
|
1583 |
on aDevice." |
|
1023 | 1584 |
|
1585 |
|colors| |
|
1586 |
||
1587 |
colors := OrderedCollection new. |
|
1365
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
1588 |
aDevice deviceColors do:[:clr | |
6353 | 1589 |
clr colorId notNil ifTrue:[ |
1590 |
colors add:clr |
|
1591 |
] ifFalse:[ |
|
1592 |
'Color [oops]: nil colorId in color' infoPrintCR. |
|
1593 |
] |
|
1023 | 1594 |
]. |
1595 |
^ colors asArray |
|
1596 |
||
1597 |
" |
|
3833 | 1598 |
Color allocatedColorsOnDevice:Display |
1023 | 1599 |
" |
1600 |
||
1365
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
1601 |
"Modified: 24.2.1997 / 18:16:14 / cg" |
1023 | 1602 |
! ! |
1603 |
||
1144 | 1604 |
!Color class methodsFor:'color space conversions'! |
1023 | 1605 |
|
1606 |
withHLSFromRed:r green:g blue:b do:aBlock |
|
3543 | 1607 |
"compute hls form rgb, evaluate aBlock with h,l and s as arguments. |
1608 |
r,g,b in 0..100 |
|
1609 |
h in 0..360; l in 0..100; s in 0..100" |
|
1023 | 1610 |
|
6110 | 1611 |
|max min r1 g1 b1 delta h l s divisor| |
1023 | 1612 |
|
1613 |
r1 := r / 100. "scale to 0..1" |
|
1614 |
g1 := g / 100. |
|
1615 |
b1 := b / 100. |
|
1616 |
||
1617 |
max := (r1 max:g1) max:b1. |
|
1618 |
min := (r1 min:g1) min:b1. |
|
1619 |
l := (max + min) / 2. |
|
1620 |
||
1621 |
max = min ifTrue:[ |
|
6353 | 1622 |
"achromatic, r=g=b" |
1623 |
||
1624 |
s := 0. |
|
1625 |
h := nil |
|
1023 | 1626 |
] ifFalse:[ |
6353 | 1627 |
l < 0.5 ifTrue:[ |
1628 |
divisor := (max + min) |
|
1629 |
] ifFalse:[ |
|
1630 |
divisor := (2 - max - min) |
|
1631 |
]. |
|
1632 |
divisor = 0 ifTrue:[ |
|
1633 |
s := 1.0 |
|
1634 |
] ifFalse:[ |
|
1635 |
s := (max - min) / divisor |
|
1636 |
]. |
|
1637 |
"calc hue" |
|
1638 |
||
1639 |
delta := max - min. |
|
1640 |
r1 = max ifTrue:[ |
|
1641 |
h := (g1 - b1) / delta |
|
1642 |
] ifFalse:[ |
|
1643 |
g1 = max ifTrue:[ |
|
1644 |
h := 2 + ((b1 - r1) / delta) |
|
1645 |
] ifFalse:[ |
|
1646 |
h := 4 + ((r1 - g1) / delta) |
|
1647 |
] |
|
1648 |
]. |
|
1649 |
h := h * 60. |
|
1650 |
h < 0 ifTrue:[ |
|
1651 |
h := h + 360 |
|
1652 |
]. |
|
1023 | 1653 |
]. |
1654 |
aBlock value:h value:(l * 100) value:(s * 100) |
|
6110 | 1655 |
|
1656 |
"Modified: / 27-07-2013 / 11:48:20 / cg" |
|
1023 | 1657 |
! |
1658 |
||
1659 |
withHLSFromScaledRed:r scaledGreen:g scaledBlue:b do:aBlock |
|
1660 |
"compute hls form rgb, evaluate aBlock with h,l and s as arguments" |
|
1661 |
||
1662 |
^ self withHLSFromRed:(r * 100.0 / MaxValue) |
|
6353 | 1663 |
green:(g * 100.0 / MaxValue) |
1664 |
blue:(b * 100.0 / MaxValue) |
|
1665 |
do:aBlock |
|
1023 | 1666 |
|
1667 |
"Created: 11.6.1996 / 17:23:47 / cg" |
|
1668 |
! |
|
1669 |
||
1670 |
withRGBFromHue:h light:l saturation:s do:aBlock |
|
3543 | 1671 |
"compute rgb form hls, evaluate aBlock with r,g and b as arguments |
1672 |
r,g,b in 0..100 |
|
1673 |
h in 0..360; l in 0..100; s in 0..100" |
|
1023 | 1674 |
|
1675 |
|valueFunc s1 l1 r g b m1 m2| |
|
1676 |
||
1677 |
valueFunc := [:n1 :n2 :hIn | |
|
6353 | 1678 |
|hue| |
1679 |
||
1680 |
hue := hIn. |
|
1681 |
hue > 360 ifTrue:[ |
|
1682 |
hue := hue - 360 |
|
1683 |
] ifFalse:[ |
|
1684 |
hue < 0 ifTrue:[ |
|
1685 |
hue := hue + 360 |
|
1686 |
]. |
|
1687 |
]. |
|
1688 |
hue < 60 ifTrue:[ |
|
1689 |
n1 + ((n2 - n1) * hue / 60) |
|
1690 |
] ifFalse:[ |
|
1691 |
hue < 180 ifTrue:[ |
|
1692 |
n2 |
|
1693 |
] ifFalse:[ |
|
1694 |
hue < 240 ifTrue:[ |
|
1695 |
n1 + ((n2 - n1) * (240 - hue) / 60) |
|
1696 |
] ifFalse:[ |
|
1697 |
n1 |
|
1698 |
] |
|
1699 |
] |
|
1700 |
] |
|
1023 | 1701 |
]. |
1702 |
||
1703 |
"compute hls; h in 0..360; l 0..100; s 0..100" |
|
1704 |
||
1705 |
s1 := s / 100.0. "scale to 0..1" |
|
1706 |
l1 := l / 100.0. |
|
1707 |
||
1708 |
l1 <= 0.5 ifTrue:[ |
|
6353 | 1709 |
m2 := l1 * (1 + s1) |
1023 | 1710 |
] ifFalse:[ |
6353 | 1711 |
m2 := l1 + s1 - (l1 * s1) |
1023 | 1712 |
]. |
1713 |
||
1714 |
m1 := 2 * l1 - m2. |
|
1715 |
||
1716 |
s1 = 0 ifTrue:[ |
|
6353 | 1717 |
"achromatic, ignore hue" |
1718 |
r := g := b := l1 |
|
1023 | 1719 |
] ifFalse:[ |
6353 | 1720 |
r := valueFunc value:m1 value:m2 value:h + 120. |
1721 |
g := valueFunc value:m1 value:m2 value:h. |
|
1722 |
b := valueFunc value:m1 value:m2 value:h - 120. |
|
1023 | 1723 |
]. |
1724 |
aBlock value:r*100 value:g*100 value:b*100 |
|
1725 |
! ! |
|
1726 |
||
1144 | 1727 |
!Color class methodsFor:'constant colors'! |
1023 | 1728 |
|
1729 |
black |
|
1730 |
"return the black color" |
|
1731 |
||
1732 |
Black isNil ifTrue:[ |
|
6353 | 1733 |
Black := self red:0 green:0 blue:0 |
1023 | 1734 |
]. |
1735 |
^ Black |
|
1736 |
||
1737 |
" |
|
1738 |
Color black inspect |
|
1739 |
" |
|
1740 |
||
1741 |
"Modified: 11.6.1996 / 15:55:31 / cg" |
|
1742 |
! |
|
1743 |
||
1744 |
blue |
|
1745 |
"return the blue color" |
|
1746 |
||
1747 |
Blue isNil ifTrue:[ |
|
6353 | 1748 |
Blue := self redPercent:0 greenPercent:0 bluePercent:100 |
1023 | 1749 |
]. |
1750 |
^ Blue |
|
1751 |
||
1752 |
" |
|
1753 |
Color blue inspect |
|
1754 |
" |
|
1755 |
||
1756 |
"Modified: 23.4.1996 / 13:15:51 / cg" |
|
1757 |
! |
|
1758 |
||
2962 | 1759 |
brown |
1760 |
^ self redPercent:60 greenPercent:20 bluePercent:0 |
|
1761 |
||
1762 |
" |
|
1763 |
Color brown |
|
1764 |
" |
|
1765 |
! |
|
1766 |
||
1023 | 1767 |
cyan |
1768 |
"return the cyan color - ST-80 compatibility" |
|
1769 |
||
2087 | 1770 |
^ self cyan:100 |
1023 | 1771 |
|
1772 |
" |
|
1773 |
Color cyan inspect |
|
1774 |
" |
|
1775 |
||
1776 |
"Modified: 23.4.1996 / 13:16:07 / cg" |
|
1777 |
! |
|
1778 |
||
2087 | 1779 |
cyan: cyan |
1780 |
"return a cyan color; |
|
1781 |
the argument cyan is interpreted as percent (0..100)" |
|
1782 |
||
1783 |
^ self cyan:100 magenta:100-cyan yellow:100-cyan |
|
6353 | 1784 |
|
2087 | 1785 |
! |
1786 |
||
1023 | 1787 |
darkGray |
1788 |
"return the dark grey color (English version ;-)" |
|
1789 |
||
1790 |
DarkGrey isNil ifTrue:[ |
|
6353 | 1791 |
DarkGrey := self grayPercent:33 |
1023 | 1792 |
]. |
1793 |
^ DarkGrey |
|
1794 |
||
1795 |
" |
|
1796 |
Color darkGray inspect |
|
1797 |
" |
|
1798 |
||
1368 | 1799 |
"Modified: 24.2.1997 / 21:33:11 / cg" |
1023 | 1800 |
! |
1801 |
||
1802 |
darkGrey |
|
1803 |
"return the darkGrey color (US version ;-)" |
|
1804 |
||
1805 |
^ self darkGray |
|
1806 |
||
1807 |
" |
|
1808 |
Color darkGrey inspect |
|
1809 |
" |
|
1810 |
||
1811 |
"Modified: 28.5.1996 / 20:47:14 / cg" |
|
1812 |
! |
|
1813 |
||
1814 |
gray |
|
1815 |
"return a medium grey color (US version ;-)" |
|
1816 |
||
1817 |
Grey isNil ifTrue:[ |
|
6353 | 1818 |
Grey := self grayPercent:50 |
1023 | 1819 |
]. |
1820 |
^ Grey |
|
1821 |
||
1822 |
" |
|
1823 |
Color gray inspect |
|
1824 |
" |
|
1825 |
||
1368 | 1826 |
"Modified: 24.2.1997 / 21:33:19 / cg" |
1023 | 1827 |
! |
1828 |
||
1829 |
gray:gray |
|
6353 | 1830 |
"return a gray color (US version). |
1023 | 1831 |
The argument, gray is interpreted as percent (0..100)." |
1832 |
||
1348 | 1833 |
^ self redPercent:gray greenPercent:gray bluePercent:gray |
1834 |
||
1835 |
" |
|
1836 |
Color gray:25 |
|
1837 |
" |
|
1838 |
||
1839 |
"Modified: 28.5.1996 / 20:49:51 / cg" |
|
1840 |
! |
|
1841 |
||
1842 |
grayPercent:gray |
|
6353 | 1843 |
"return a gray color (US version). |
1348 | 1844 |
The argument, gray is interpreted as percent (0..100)." |
1845 |
||
1846 |
^ self redPercent:gray greenPercent:gray bluePercent:gray |
|
1023 | 1847 |
|
1848 |
" |
|
1849 |
Color gray:25 |
|
1850 |
" |
|
1851 |
||
1852 |
"Modified: 28.5.1996 / 20:49:51 / cg" |
|
1853 |
! |
|
1854 |
||
1855 |
green |
|
1856 |
"return green" |
|
1857 |
||
1858 |
Green isNil ifTrue:[ |
|
6353 | 1859 |
Green := self redPercent:0 greenPercent:100 bluePercent:0 |
1023 | 1860 |
]. |
1861 |
^ Green |
|
1862 |
||
1863 |
" |
|
1864 |
Color green inspect |
|
1865 |
" |
|
1866 |
||
1867 |
"Modified: 23.4.1996 / 13:23:08 / cg" |
|
1868 |
! |
|
1869 |
||
1870 |
grey |
|
1871 |
"return the grey color (English version ;-)" |
|
1872 |
||
1873 |
^ self gray |
|
1874 |
||
1875 |
" |
|
1876 |
Color grey inspect |
|
1877 |
" |
|
1878 |
||
1879 |
"Modified: 28.5.1996 / 20:48:26 / cg" |
|
1880 |
! |
|
1881 |
||
1882 |
grey:grey |
|
6353 | 1883 |
"return a grey color (English version). |
1023 | 1884 |
The argument, grey is interpreted as percent (0..100)." |
1885 |
||
1368 | 1886 |
^ self grayPercent:grey |
1023 | 1887 |
|
1888 |
" |
|
1889 |
Color grey:25 |
|
1890 |
Color grey:12.5 |
|
1891 |
" |
|
1892 |
||
1368 | 1893 |
"Modified: 24.2.1997 / 21:33:28 / cg" |
1023 | 1894 |
! |
1895 |
||
5419 | 1896 |
greyByte:greyByte |
6353 | 1897 |
"return a grey color (English version). |
5419 | 1898 |
The argument, grey is interpreted as byte-value (0..255)." |
1899 |
||
1900 |
^ self redByte:greyByte greenByte:greyByte blueByte:greyByte |
|
1901 |
||
1902 |
" |
|
1903 |
Color greyByte:127 |
|
1904 |
" |
|
1905 |
! |
|
1906 |
||
2388
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1907 |
lightBlue |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1908 |
"return a light blue color" |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1909 |
|
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1910 |
^ self redPercent:50 greenPercent:50 bluePercent:100 |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1911 |
|
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1912 |
" |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1913 |
Color lightBlue inspect |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1914 |
" |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1915 |
|
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1916 |
"Modified: 23.4.1996 / 13:23:08 / cg" |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1917 |
! |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1918 |
|
2962 | 1919 |
lightBrown |
1920 |
^ self brown lighter |
|
1921 |
||
1922 |
" |
|
1923 |
Color lightBrown |
|
1924 |
" |
|
1925 |
! |
|
1926 |
||
1023 | 1927 |
lightGray |
1928 |
"return the lightGrey color (US version ;-)" |
|
1929 |
||
1930 |
LightGrey isNil ifTrue:[ |
|
6353 | 1931 |
LightGrey := self grayPercent:67 |
1023 | 1932 |
]. |
1933 |
^ LightGrey |
|
1934 |
||
1935 |
" |
|
1936 |
Color lightGray inspect |
|
1937 |
" |
|
1938 |
||
1368 | 1939 |
"Modified: 24.2.1997 / 21:33:41 / cg" |
1023 | 1940 |
! |
1941 |
||
2388
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1942 |
lightGreen |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1943 |
"return a light green color" |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1944 |
|
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1945 |
^ self redPercent:50 greenPercent:100 bluePercent:50 |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1946 |
|
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1947 |
" |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1948 |
Color lightGreen inspect |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1949 |
" |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1950 |
|
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1951 |
"Modified: 23.4.1996 / 13:23:08 / cg" |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1952 |
! |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1953 |
|
1023 | 1954 |
lightGrey |
1955 |
"return the lightGrey color (English version ;-)" |
|
1956 |
||
1957 |
^ self lightGray |
|
1958 |
||
1959 |
" |
|
1960 |
Color lightGrey inspect |
|
1961 |
" |
|
1962 |
||
1963 |
"Modified: 28.5.1996 / 20:51:11 / cg" |
|
1964 |
! |
|
1965 |
||
2388
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1966 |
lightRed |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1967 |
"return a light red color" |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1968 |
|
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1969 |
^ self redPercent:100 greenPercent:50 bluePercent:50 |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1970 |
|
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1971 |
" |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1972 |
Color lightRed inspect |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1973 |
" |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1974 |
|
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1975 |
"Modified: 23.4.1996 / 13:23:08 / cg" |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1976 |
! |
8a7f4bb3847c
added lightRed/lightGreen/lightBlue
Claus Gittinger <cg@exept.de>
parents:
2379
diff
changeset
|
1977 |
|
2949 | 1978 |
lightYellow |
1979 |
^ self yellow lighter |
|
1980 |
! |
|
1981 |
||
1023 | 1982 |
magenta |
1983 |
"return the magenta color - ST-80 compatibility" |
|
1984 |
||
2087 | 1985 |
^ self magenta:100 |
1023 | 1986 |
|
1987 |
" |
|
1988 |
Color magenta inspect |
|
1989 |
" |
|
1990 |
||
1991 |
"Modified: 23.4.1996 / 13:23:41 / cg" |
|
1992 |
! |
|
1993 |
||
2087 | 1994 |
magenta: magenta |
1995 |
"return a magenta color; |
|
1996 |
the argument magenta is interpreted as percent (0..100)" |
|
1997 |
||
1998 |
^ self cyan:100-magenta magenta:100 yellow:100-magenta |
|
6353 | 1999 |
|
2087 | 2000 |
! |
2001 |
||
1023 | 2002 |
mediumGray |
2003 |
"return medium-grey color (US version ;-)" |
|
2004 |
||
2005 |
^ self gray |
|
2006 |
||
2007 |
" |
|
2008 |
Color mediumGray inspect |
|
2009 |
" |
|
2010 |
||
2011 |
"Created: 23.4.1996 / 13:24:17 / cg" |
|
2012 |
"Modified: 28.5.1996 / 20:51:21 / cg" |
|
2013 |
! |
|
2014 |
||
2015 |
mediumGrey |
|
2016 |
"return medium-grey color (English version ;-)" |
|
2017 |
||
2018 |
^ self gray |
|
2019 |
||
2020 |
" |
|
2021 |
Color mediumGrey inspect |
|
2022 |
" |
|
2023 |
||
2024 |
"Modified: 28.5.1996 / 20:51:24 / cg" |
|
2025 |
! |
|
2026 |
||
2027 |
orange |
|
2028 |
"return the orange color - ST-80 compatibility" |
|
2029 |
||
7642 | 2030 |
Orange isNil ifTrue:[ |
2031 |
Orange := self redPercent:100 greenPercent:50 bluePercent:0. |
|
2032 |
]. |
|
2033 |
^ Orange |
|
2034 |
||
2035 |
" |
|
2036 |
Color orange inspect |
|
2037 |
" |
|
2077
442b9763111c
#orange should return an orange color and not a brown color
tz
parents:
2071
diff
changeset
|
2038 |
! |
442b9763111c
#orange should return an orange color and not a brown color
tz
parents:
2071
diff
changeset
|
2039 |
|
442b9763111c
#orange should return an orange color and not a brown color
tz
parents:
2071
diff
changeset
|
2040 |
orange: orange |
442b9763111c
#orange should return an orange color and not a brown color
tz
parents:
2071
diff
changeset
|
2041 |
"return a orange color; |
442b9763111c
#orange should return an orange color and not a brown color
tz
parents:
2071
diff
changeset
|
2042 |
the argument orange is interpreted as percent (0..100)" |
442b9763111c
#orange should return an orange color and not a brown color
tz
parents:
2071
diff
changeset
|
2043 |
|
442b9763111c
#orange should return an orange color and not a brown color
tz
parents:
2071
diff
changeset
|
2044 |
^ self redPercent:orange greenPercent:orange/2 bluePercent:0 |
6353 | 2045 |
|
2046 |
! |
|
2047 |
||
2048 |
pink |
|
1023 | 2049 |
"return the pink color - ST-80 compatibility" |
2050 |
||
1348 | 2051 |
^ self redPercent:100 greenPercent:0 bluePercent:100 |
1023 | 2052 |
|
2053 |
"Modified: 23.4.1996 / 13:29:38 / cg" |
|
2054 |
! |
|
2055 |
||
2056 |
red |
|
2057 |
"return the red color" |
|
2058 |
||
2059 |
Red isNil ifTrue:[ |
|
7642 | 2060 |
Red := self redPercent:100 greenPercent:0 bluePercent:0. |
1023 | 2061 |
]. |
2062 |
^ Red |
|
2063 |
||
7642 | 2064 |
" |
2065 |
Color red inspect |
|
2066 |
" |
|
2067 |
||
1023 | 2068 |
"Modified: 23.4.1996 / 13:29:44 / cg" |
2069 |
! |
|
2070 |
||
2942
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
2071 |
transparent |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
2072 |
"return the transparent-color" |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
2073 |
|
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
2074 |
Transparent isNil ifTrue:[ |
6353 | 2075 |
Transparent := TranslucentColor scaledRed:0 scaledGreen:0 scaledBlue:0. |
2076 |
Transparent setAlphaByte:0. |
|
2942
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
2077 |
]. |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
2078 |
^ Transparent |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
2079 |
|
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
2080 |
" |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
2081 |
self transparent |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
2082 |
" |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
2083 |
! |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
2084 |
|
1023 | 2085 |
veryDarkGray |
2086 |
"return a very dark-grey color (US version ;-)" |
|
2087 |
||
1368 | 2088 |
^ self grayPercent:13 |
1023 | 2089 |
|
2090 |
"Created: 23.4.1996 / 13:33:14 / cg" |
|
1368 | 2091 |
"Modified: 24.2.1997 / 21:33:52 / cg" |
1023 | 2092 |
! |
2093 |
||
2094 |
veryDarkGrey |
|
2095 |
"return a very dark-grey color (English version ;-)" |
|
2096 |
||
2097 |
^ self veryDarkGray |
|
2098 |
||
2099 |
"Modified: 28.5.1996 / 20:52:49 / cg" |
|
2100 |
! |
|
2101 |
||
2102 |
veryLightGray |
|
2103 |
"return a very light-grey color (US version ;-)" |
|
2104 |
||
1368 | 2105 |
^ self grayPercent:87 |
1023 | 2106 |
|
2107 |
"Created: 23.4.1996 / 13:33:46 / cg" |
|
1368 | 2108 |
"Modified: 24.2.1997 / 21:33:58 / cg" |
1023 | 2109 |
! |
2110 |
||
2111 |
veryLightGrey |
|
2112 |
"return a very light-grey color (English version ;-)" |
|
2113 |
||
2114 |
^ self veryLightGray |
|
2115 |
||
2116 |
"Modified: 28.5.1996 / 20:52:03 / cg" |
|
2117 |
! |
|
2118 |
||
3030 | 2119 |
veryVeryLightGray |
2120 |
"return a very very light-grey color (US version ;-)" |
|
2121 |
||
2122 |
^ self grayPercent:93 |
|
2123 |
||
2124 |
! |
|
2125 |
||
1023 | 2126 |
white |
2127 |
"return the white-color" |
|
2128 |
||
2129 |
White isNil ifTrue:[ |
|
7642 | 2130 |
White := self redPercent:100 greenPercent:100 bluePercent:100. |
1023 | 2131 |
]. |
2132 |
^ White |
|
7642 | 2133 |
|
2134 |
" |
|
2135 |
Color white inspect |
|
2136 |
" |
|
1023 | 2137 |
! |
2138 |
||
2139 |
yellow |
|
2140 |
"return the yellow color - ST-80 compatibility" |
|
2141 |
||
7642 | 2142 |
Yellow isNil ifTrue:[ |
2143 |
Yellow := self redPercent:100 greenPercent:100 bluePercent:0. |
|
2144 |
]. |
|
2145 |
^ Yellow |
|
2146 |
||
2147 |
" |
|
2148 |
Color yellow inspect |
|
2149 |
" |
|
1023 | 2150 |
|
2151 |
"Modified: 23.4.1996 / 13:33:56 / cg" |
|
2087 | 2152 |
! |
2153 |
||
2154 |
yellow: yellow |
|
2155 |
"return a yellow color; |
|
2156 |
the argument yellow is interpreted as percent (0..100)" |
|
2157 |
||
2158 |
^ self cyan:100-yellow magenta:100-yellow yellow:100 |
|
6353 | 2159 |
|
1023 | 2160 |
! ! |
2161 |
||
1233 | 2162 |
!Color class methodsFor:'obsolete'! |
2163 |
||
2164 |
nameOrDither:colorName |
|
2165 |
"return a named color - if the exact color is not available, |
|
6353 | 2166 |
return a dithered color. Report an error, if the colorname is |
1233 | 2167 |
illegal." |
2168 |
||
3427 | 2169 |
<resource:#obsolete> |
2170 |
||
1233 | 2171 |
self obsoleteMethodWarning:'use #name:'. |
2172 |
^ self name:colorName |
|
2173 |
||
2174 |
"Modified: 16.1.1997 / 23:01:03 / cg" |
|
2175 |
! |
|
2176 |
||
2177 |
nameOrDither:colorName ifIllegal:errorBlock |
|
2178 |
"return a named color - if the exact color is not available, |
|
2179 |
return a dithered color. If the colorname is illegal, return |
|
2180 |
the value of evaluating errorBlock." |
|
2181 |
||
3427 | 2182 |
<resource:#obsolete> |
2183 |
||
1233 | 2184 |
self obsoleteMethodWarning:'use #name:ifIllegal:'. |
2185 |
^ self name:colorName ifIllegal:errorBlock |
|
2186 |
||
2187 |
"Modified: 16.1.1997 / 23:01:32 / cg" |
|
2188 |
! |
|
2189 |
||
2190 |
nameOrNearest:colorName |
|
2191 |
"return a named color - or its nearest match" |
|
2192 |
||
3427 | 2193 |
<resource:#obsolete> |
2194 |
||
1233 | 2195 |
self obsoleteMethodWarning:'use #name:'. |
2196 |
^ self name:colorName |
|
2197 |
||
2198 |
"Modified: 16.1.1997 / 23:02:18 / cg" |
|
2199 |
! ! |
|
2200 |
||
1144 | 2201 |
!Color class methodsFor:'private'! |
1023 | 2202 |
|
2203 |
colorNearRed:r green:g blue:b on:aDevice |
|
2204 |
"return a device color on aDevice with rgb values |
|
2205 |
almost matching. If there is one, nil otherwise. |
|
2206 |
This is tried as a last chance before dithering. |
|
2207 |
The algorithm needs rework, the color components |
|
2208 |
should be weighted according some theory :-)" |
|
2209 |
||
2210 |
|bestColor minDelta diff rr rg rb dRed| |
|
2211 |
||
2212 |
"/ rr := (r * 3.0) rounded / 3.0. |
|
2213 |
"/ rg := (g * 3.0) rounded / 3.0. |
|
2214 |
"/ rb := (b * 3.0) rounded / 3.0. |
|
2215 |
||
2216 |
rr := r rounded. "round to 1%" |
|
2217 |
rg := (g * 2.0) rounded / 2.0. "round to 0.5%" |
|
2218 |
rb := (b / 2) rounded * 2. "round to 2%" |
|
2219 |
||
2220 |
minDelta := 100*100*100. |
|
1365
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
2221 |
aDevice deviceColors do:[:aColor | |
6353 | 2222 |
dRed := rr - aColor red. |
2223 |
dRed < 10 ifTrue:[ |
|
2224 |
diff := dRed asInteger squared |
|
2225 |
+ (rg - aColor green) asInteger squared |
|
2226 |
+ (rb - aColor blue) asInteger squared. |
|
2227 |
||
2228 |
diff < minDelta ifTrue:[ |
|
2229 |
diff = 0 ifTrue:[ |
|
2230 |
"got it" |
|
2231 |
^ aColor |
|
2232 |
]. |
|
2233 |
bestColor := aColor. |
|
2234 |
minDelta := diff |
|
2235 |
] |
|
2236 |
] |
|
1023 | 2237 |
]. |
2238 |
||
2239 |
"allow an error of 10% per component" |
|
2240 |
minDelta < (100+100+100) ifTrue:[ ^ bestColor ]. |
|
2241 |
^ nil |
|
2242 |
||
1365
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
2243 |
"Modified: 24.2.1997 / 18:17:24 / cg" |
1023 | 2244 |
! |
2245 |
||
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2246 |
existingColorRed:r green:g blue:b on:aDevice |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2247 |
"return a device color on aDevice with rgb values |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2248 |
if there is one, nil otherwise." |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2249 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2250 |
^ self existingColorScaledRed:(r * MaxValue // 100) |
6353 | 2251 |
scaledGreen:(g * MaxValue // 100) |
2252 |
scaledBlue:(b * MaxValue // 100) |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2253 |
! |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2254 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2255 |
existingColorScaledRed:r scaledGreen:g scaledBlue:b on:aDevice |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2256 |
"return a device color on aDevice with rgb values |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2257 |
if there is one, nil otherwise." |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2258 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2259 |
aDevice deviceColors do:[:aColor | |
6353 | 2260 |
(r == aColor scaledRed) ifTrue:[ |
2261 |
(g == aColor scaledGreen) ifTrue:[ |
|
2262 |
(b == aColor scaledBlue) ifTrue:[ |
|
2263 |
^ aColor |
|
2264 |
] |
|
2265 |
] |
|
2266 |
] |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2267 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2268 |
^ nil |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2269 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2270 |
"Modified: 24.2.1997 / 18:17:35 / cg" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2271 |
! ! |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2272 |
|
3878 | 2273 |
!Color class methodsFor:'private-dithering'! |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2274 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2275 |
complexDitherRed:red green:green blue:blue on:aDevice into:aBlock |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2276 |
"get a deep dither form for an rgb value. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2277 |
Use all available colors for error dithering into a form." |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2278 |
|
6353 | 2279 |
|errR errG errB f wantR wantG wantB clr |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2280 |
dir "{ Class: SmallInteger }" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2281 |
start "{ Class: SmallInteger }" |
6353 | 2282 |
end "{ Class: SmallInteger }" |
1929 | 2283 |
map |
2284 |
w "{ Class: SmallInteger }" |
|
2285 |
h "{ Class: SmallInteger }"| |
|
2286 |
||
2287 |
"/ w := h := 32. |
|
2288 |
"/ w := h := 4. |
|
2289 |
w := h := 2. |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2290 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2291 |
errR := 0. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2292 |
errG := 0. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2293 |
errB := 0. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2294 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2295 |
"get a form and clear it" |
4785
ffb3b0caceb8
Change senders of obsolete messages Form>>...on: to ...onDevice:
Stefan Vogel <sv@exept.de>
parents:
4772
diff
changeset
|
2296 |
f := Form width:w height:h depth:(aDevice depth) onDevice:aDevice. |
7360 | 2297 |
f isNil ifTrue:[^ nil]. |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2298 |
map := IdentityDictionary new. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2299 |
|
1929 | 2300 |
0 to:(w-1) do:[:x | |
7360 | 2301 |
x even ifTrue:[ |
2302 |
dir := 1. |
|
2303 |
start := 0. |
|
2304 |
end := (h-1). |
|
2305 |
] ifFalse:[ |
|
2306 |
dir := -1. |
|
2307 |
start := (h-1). |
|
2308 |
end := 0. |
|
2309 |
]. |
|
2310 |
start to:end by:dir do:[:y | |
|
2311 |
wantR := red + errR. |
|
2312 |
wantR > MaxValue ifTrue:[ |
|
2313 |
wantR := MaxValue |
|
2314 |
] ifFalse:[ wantR < 0 ifTrue:[ |
|
2315 |
wantR := 0 |
|
2316 |
]]. |
|
2317 |
||
2318 |
wantG := green + errG. |
|
2319 |
wantG > MaxValue ifTrue:[ |
|
2320 |
wantG := MaxValue |
|
2321 |
] ifFalse:[ wantG < 0 ifTrue:[ |
|
2322 |
wantG := 0 |
|
2323 |
]]. |
|
2324 |
||
2325 |
wantB := blue + errB. |
|
2326 |
wantB > MaxValue ifTrue:[ |
|
2327 |
wantB := MaxValue |
|
2328 |
] ifFalse:[ wantB < 0 ifTrue:[ |
|
2329 |
wantB := 0 |
|
2330 |
]]. |
|
2331 |
||
2332 |
"find the nearest color" |
|
2333 |
||
2334 |
clr := Color quickNearestColorScaledRed:wantR scaledGreen:wantG scaledBlue:wantB on:aDevice. |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2335 |
" |
7360 | 2336 |
clr := Color nearestColorScaledRed:wantR green:wantG blue:wantB on:aDevice. |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2337 |
" |
7360 | 2338 |
clr isNil ifTrue:[ |
2339 |
clr := Color scaledRed:wantR scaledGreen:wantG scaledBlue:wantB. |
|
2340 |
clr brightness > 0.5 ifTrue:[ |
|
2341 |
clr := Color white |
|
2342 |
] ifFalse:[ |
|
2343 |
clr := Color black |
|
2344 |
]. |
|
2345 |
clr := clr onDevice:aDevice |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2346 |
" |
7360 | 2347 |
^ aBlock value:nil value:nil |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2348 |
" |
7360 | 2349 |
]. |
2350 |
||
2351 |
f paint:clr. |
|
2352 |
f displayPointX:x y:y. |
|
2353 |
map at:clr colorId + 1 put:clr. |
|
2354 |
||
2355 |
"compute the new error" |
|
2356 |
errR := wantR - clr scaledRed. |
|
2357 |
errG := wantG - clr scaledGreen. |
|
2358 |
errB := wantB - clr scaledBlue. |
|
2359 |
]. |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2360 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2361 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2362 |
f colorMap:map. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2363 |
" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2364 |
'hard dither' printNewline. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2365 |
" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2366 |
^ aBlock value:nil value:f |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2367 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2368 |
"Created: 3.5.1997 / 11:02:47 / cg" |
1929 | 2369 |
"Modified: 19.10.1997 / 23:28:59 / cg" |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2370 |
! |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
2371 |
|
1023 | 2372 |
ditherBits |
2373 |
"return a dither pattern for x/64; x in 1..63" |
|
2374 |
||
2375 |
^ #( |
|
2376 |
||
6353 | 2377 |
"/ 1in64 |
2378 |
||
2379 |
#[2r10000000 |
|
2380 |
2r00000000 |
|
2381 |
2r00000000 |
|
2382 |
2r00000000 |
|
2383 |
2r00000000 |
|
2384 |
2r00000000 |
|
2385 |
2r00000000 |
|
2386 |
2r00000000] |
|
2387 |
||
2388 |
"/ 2in64 |
|
2389 |
||
2390 |
#[2r10000000 |
|
2391 |
2r00000000 |
|
2392 |
2r00000000 |
|
2393 |
2r00000000 |
|
2394 |
2r00001000 |
|
2395 |
2r00000000 |
|
2396 |
2r00000000 |
|
2397 |
2r00000000] |
|
2398 |
||
2399 |
"/ 3in64 |
|
2400 |
||
2401 |
#[2r10000000 |
|
2402 |
2r00000000 |
|
2403 |
2r00000000 |
|
2404 |
2r00000000 |
|
2405 |
2r10001000 |
|
2406 |
2r00000000 |
|
2407 |
2r00000000 |
|
2408 |
2r00000000] |
|
2409 |
||
2410 |
"/ 4in64 |
|
2411 |
||
2412 |
#[2r10001000 |
|
2413 |
2r00000000 |
|
2414 |
2r00000000 |
|
2415 |
2r00000000 |
|
2416 |
2r10001000 |
|
2417 |
2r00000000 |
|
2418 |
2r00000000 |
|
2419 |
2r00000000] |
|
2420 |
||
2421 |
"/ 5in64 |
|
2422 |
||
2423 |
#[2r10001000 |
|
2424 |
2r00000000 |
|
2425 |
2r00000000 |
|
2426 |
2r00000000 |
|
2427 |
2r10001000 |
|
2428 |
2r00000000 |
|
2429 |
2r00000010 |
|
2430 |
2r00000000] |
|
2431 |
||
2432 |
"/ 6in64 |
|
2433 |
||
2434 |
#[2r10001000 |
|
2435 |
2r00000000 |
|
2436 |
2r00100000 |
|
2437 |
2r00000000 |
|
2438 |
2r10001000 |
|
2439 |
2r00000000 |
|
2440 |
2r00000010 |
|
2441 |
2r00000000] |
|
2442 |
||
2443 |
"/ 7in64 |
|
2444 |
||
2445 |
#[2r10001000 |
|
2446 |
2r00000000 |
|
2447 |
2r00100010 |
|
2448 |
2r00000000 |
|
2449 |
2r10001000 |
|
2450 |
2r00000000 |
|
2451 |
2r00000010 |
|
2452 |
2r00000000] |
|
2453 |
||
2454 |
"/ 8in64 |
|
2455 |
||
2456 |
#[2r10001000 |
|
2457 |
2r00000000 |
|
2458 |
2r00100010 |
|
2459 |
2r00000000 |
|
2460 |
2r10001000 |
|
2461 |
2r00000000 |
|
2462 |
2r00100010 |
|
2463 |
2r00000000] |
|
2464 |
||
2465 |
"/ 9in64 |
|
2466 |
||
2467 |
#[2r10001000 |
|
2468 |
2r00000000 |
|
2469 |
2r00100010 |
|
2470 |
2r00000000 |
|
2471 |
2r10001000 |
|
2472 |
2r00000000 |
|
2473 |
2r10100010 |
|
2474 |
2r00000000] |
|
2475 |
||
2476 |
"/ 10in64 |
|
2477 |
||
2478 |
#[2r10001000 |
|
2479 |
2r00000000 |
|
2480 |
2r00101010 |
|
2481 |
2r00000000 |
|
2482 |
2r10001000 |
|
2483 |
2r00000000 |
|
2484 |
2r10100010 |
|
2485 |
2r00000000] |
|
2486 |
||
2487 |
"/ 11in64 |
|
2488 |
||
2489 |
#[2r10001000 |
|
2490 |
2r00000000 |
|
2491 |
2r00101010 |
|
2492 |
2r00000000 |
|
2493 |
2r10001000 |
|
2494 |
2r00000000 |
|
2495 |
2r10101010 |
|
2496 |
2r00000000] |
|
2497 |
||
2498 |
"/ 12in64 |
|
2499 |
||
2500 |
#[2r10001000 |
|
2501 |
2r00000000 |
|
2502 |
2r10101010 |
|
2503 |
2r00000000 |
|
2504 |
2r10001000 |
|
2505 |
2r00000000 |
|
2506 |
2r10101010 |
|
2507 |
2r00000000] |
|
2508 |
||
2509 |
"/ 13in64 |
|
2510 |
||
2511 |
#[2r10001000 |
|
2512 |
2r00000000 |
|
2513 |
2r10101010 |
|
2514 |
2r00000000 |
|
2515 |
2r10101000 |
|
2516 |
2r00000000 |
|
2517 |
2r10101010 |
|
2518 |
2r00000000] |
|
2519 |
||
2520 |
"/ 14in64 |
|
2521 |
||
2522 |
#[2r10001010 |
|
2523 |
2r00000000 |
|
2524 |
2r10101010 |
|
2525 |
2r00000000 |
|
2526 |
2r10101000 |
|
2527 |
2r00000000 |
|
2528 |
2r10101010 |
|
2529 |
2r00000000] |
|
2530 |
||
2531 |
"/ 15in64 |
|
2532 |
||
2533 |
#[2r10001010 |
|
2534 |
2r00000000 |
|
2535 |
2r10101010 |
|
2536 |
2r00000000 |
|
2537 |
2r10101010 |
|
2538 |
2r00000000 |
|
2539 |
2r10101010 |
|
2540 |
2r00000000] |
|
2541 |
||
2542 |
"/ 16in64 |
|
2543 |
||
2544 |
#[2r10101010 |
|
2545 |
2r00000000 |
|
2546 |
2r10101010 |
|
2547 |
2r00000000 |
|
2548 |
2r10101010 |
|
2549 |
2r00000000 |
|
2550 |
2r10101010 |
|
2551 |
2r00000000] |
|
2552 |
||
2553 |
"/ 17in64 |
|
2554 |
||
2555 |
#[2r10101010 |
|
2556 |
2r01000000 |
|
2557 |
2r10101010 |
|
2558 |
2r00000000 |
|
2559 |
2r10101010 |
|
2560 |
2r00000000 |
|
2561 |
2r10101010 |
|
2562 |
2r00000000] |
|
2563 |
||
2564 |
"/ 18in64 |
|
2565 |
||
2566 |
#[2r10101010 |
|
2567 |
2r01000000 |
|
2568 |
2r10101010 |
|
2569 |
2r00000000 |
|
2570 |
2r10101010 |
|
2571 |
2r00000100 |
|
2572 |
2r10101010 |
|
2573 |
2r00000000] |
|
2574 |
||
2575 |
"/ 19in64 |
|
2576 |
||
2577 |
#[2r10101010 |
|
2578 |
2r01000000 |
|
2579 |
2r10101010 |
|
2580 |
2r00000000 |
|
2581 |
2r10101010 |
|
2582 |
2r01000100 |
|
2583 |
2r10101010 |
|
2584 |
2r00000000] |
|
2585 |
||
2586 |
"/ 20in64 |
|
2587 |
||
2588 |
#[2r10101010 |
|
2589 |
2r01000100 |
|
2590 |
2r10101010 |
|
2591 |
2r00000000 |
|
2592 |
2r10101010 |
|
2593 |
2r01000100 |
|
2594 |
2r10101010 |
|
2595 |
2r00000000] |
|
2596 |
||
2597 |
"/ 21in64 |
|
2598 |
||
2599 |
#[2r10101010 |
|
2600 |
2r01000100 |
|
2601 |
2r10101010 |
|
2602 |
2r00000000 |
|
2603 |
2r10101010 |
|
2604 |
2r01000100 |
|
2605 |
2r10101010 |
|
2606 |
2r00000001] |
|
2607 |
||
2608 |
"/ 22in64 |
|
2609 |
||
2610 |
#[2r10101010 |
|
2611 |
2r01000100 |
|
2612 |
2r10101010 |
|
2613 |
2r00010000 |
|
2614 |
2r10101010 |
|
2615 |
2r01000100 |
|
2616 |
2r10101010 |
|
2617 |
2r00000001] |
|
2618 |
||
2619 |
"/ 23in64 |
|
2620 |
||
2621 |
#[2r10101010 |
|
2622 |
2r01000100 |
|
2623 |
2r10101010 |
|
2624 |
2r00010001 |
|
2625 |
2r10101010 |
|
2626 |
2r01000100 |
|
2627 |
2r10101010 |
|
2628 |
2r00000001] |
|
2629 |
||
2630 |
"/ 24in64 |
|
2631 |
||
2632 |
#[2r10101010 |
|
2633 |
2r01000100 |
|
2634 |
2r10101010 |
|
2635 |
2r00010001 |
|
2636 |
2r10101010 |
|
2637 |
2r01000100 |
|
2638 |
2r10101010 |
|
2639 |
2r00010001] |
|
2640 |
||
2641 |
"/ 25in64 |
|
2642 |
||
2643 |
#[2r10101010 |
|
2644 |
2r01000100 |
|
2645 |
2r10101010 |
|
2646 |
2r00010001 |
|
2647 |
2r10101010 |
|
2648 |
2r01000100 |
|
2649 |
2r10101010 |
|
2650 |
2r01010001] |
|
2651 |
||
2652 |
"/ 26in64 |
|
2653 |
||
2654 |
#[2r10101010 |
|
2655 |
2r01000100 |
|
2656 |
2r10101010 |
|
2657 |
2r00010101 |
|
2658 |
2r10101010 |
|
2659 |
2r01000100 |
|
2660 |
2r10101010 |
|
2661 |
2r01010001] |
|
2662 |
||
2663 |
"/ 27in64 |
|
2664 |
||
2665 |
#[2r10101010 |
|
2666 |
2r01000100 |
|
2667 |
2r10101010 |
|
2668 |
2r00010101 |
|
2669 |
2r10101010 |
|
2670 |
2r01000100 |
|
2671 |
2r10101010 |
|
2672 |
2r01010101] |
|
2673 |
||
2674 |
"/ 28in64 |
|
2675 |
||
2676 |
#[2r10101010 |
|
2677 |
2r01000100 |
|
2678 |
2r10101010 |
|
2679 |
2r01010101 |
|
2680 |
2r10101010 |
|
2681 |
2r01000100 |
|
2682 |
2r10101010 |
|
2683 |
2r01010101] |
|
2684 |
||
2685 |
"/ 29in64 |
|
2686 |
||
2687 |
#[2r10101010 |
|
2688 |
2r01000100 |
|
2689 |
2r10101010 |
|
2690 |
2r01010101 |
|
2691 |
2r10101010 |
|
2692 |
2r01010100 |
|
2693 |
2r10101010 |
|
2694 |
2r01010101] |
|
2695 |
||
2696 |
"/ 30in64 |
|
2697 |
||
2698 |
#[2r10101010 |
|
2699 |
2r01000101 |
|
2700 |
2r10101010 |
|
2701 |
2r01010101 |
|
2702 |
2r10101010 |
|
2703 |
2r01010100 |
|
2704 |
2r10101010 |
|
2705 |
2r01010101] |
|
2706 |
||
2707 |
"/ 31in64 |
|
2708 |
||
2709 |
#[2r10101010 |
|
2710 |
2r01000101 |
|
2711 |
2r10101010 |
|
2712 |
2r01010101 |
|
2713 |
2r10101010 |
|
2714 |
2r01010101 |
|
2715 |
2r10101010 |
|
2716 |
2r01010101] |
|
2717 |
||
2718 |
"/ 32in64 |
|
2719 |
||
2720 |
#[2r10101010 |
|
2721 |
2r01010101 |
|
2722 |
2r10101010 |
|
2723 |
2r01010101 |
|
2724 |
2r10101010 |
|
2725 |
2r01010101 |
|
2726 |
2r10101010 |
|
2727 |
2r01010101] |
|
2728 |
||
2729 |
"/ 33in64 |
|
2730 |
||
2731 |
#[2r11101010 |
|
2732 |
2r01010101 |
|
2733 |
2r10101010 |
|
2734 |
2r01010101 |
|
2735 |
2r10101010 |
|
2736 |
2r01010101 |
|
2737 |
2r10101010 |
|
2738 |
2r01010101] |
|
2739 |
||
2740 |
"/ 34in64 |
|
2741 |
||
2742 |
#[2r11101010 |
|
2743 |
2r01010101 |
|
2744 |
2r10101010 |
|
2745 |
2r01010101 |
|
2746 |
2r10101110 |
|
2747 |
2r01010101 |
|
2748 |
2r10101010 |
|
2749 |
2r01010101] |
|
2750 |
||
2751 |
"/ 35in64 |
|
2752 |
||
2753 |
#[2r11101010 |
|
2754 |
2r01010101 |
|
2755 |
2r10101010 |
|
2756 |
2r01010101 |
|
2757 |
2r11101110 |
|
2758 |
2r01010101 |
|
2759 |
2r10101010 |
|
2760 |
2r01010101] |
|
2761 |
||
2762 |
"/ 36in64 |
|
2763 |
||
2764 |
#[2r11101110 |
|
2765 |
2r01010101 |
|
2766 |
2r10101010 |
|
2767 |
2r01010101 |
|
2768 |
2r11101110 |
|
2769 |
2r01010101 |
|
2770 |
2r10101010 |
|
2771 |
2r01010101] |
|
2772 |
||
2773 |
"/ 37in64 |
|
2774 |
||
2775 |
#[2r11101110 |
|
2776 |
2r01010101 |
|
2777 |
2r10101010 |
|
2778 |
2r01010101 |
|
2779 |
2r11101110 |
|
2780 |
2r01010101 |
|
2781 |
2r10101011 |
|
2782 |
2r01010101] |
|
2783 |
||
2784 |
"/ 38in64 |
|
2785 |
||
2786 |
#[2r11101110 |
|
2787 |
2r01010101 |
|
2788 |
2r10111010 |
|
2789 |
2r01010101 |
|
2790 |
2r11101110 |
|
2791 |
2r01010101 |
|
2792 |
2r10101011 |
|
2793 |
2r01010101] |
|
2794 |
||
2795 |
"/ 39in64 |
|
2796 |
||
2797 |
#[2r11101110 |
|
2798 |
2r01010101 |
|
2799 |
2r10111011 |
|
2800 |
2r01010101 |
|
2801 |
2r11101110 |
|
2802 |
2r01010101 |
|
2803 |
2r10101011 |
|
2804 |
2r01010101] |
|
2805 |
||
2806 |
"/ 40in64 |
|
2807 |
||
2808 |
#[2r11101110 |
|
2809 |
2r01010101 |
|
2810 |
2r10111011 |
|
2811 |
2r01010101 |
|
2812 |
2r11101110 |
|
2813 |
2r01010101 |
|
2814 |
2r10111011 |
|
2815 |
2r01010101] |
|
2816 |
||
2817 |
"/ 41in64 |
|
2818 |
||
2819 |
#[2r11101110 |
|
2820 |
2r01010101 |
|
2821 |
2r10111011 |
|
2822 |
2r01010101 |
|
2823 |
2r11101110 |
|
2824 |
2r01010101 |
|
2825 |
2r11111011 |
|
2826 |
2r01010101] |
|
2827 |
||
2828 |
"/ 42in64 |
|
2829 |
||
2830 |
#[2r11101110 |
|
2831 |
2r01010101 |
|
2832 |
2r10111111 |
|
2833 |
2r01010101 |
|
2834 |
2r11101110 |
|
2835 |
2r01010101 |
|
2836 |
2r11111011 |
|
2837 |
2r01010101] |
|
2838 |
||
2839 |
"/ 43in64 |
|
2840 |
||
2841 |
#[2r11101110 |
|
2842 |
2r01010101 |
|
2843 |
2r10111111 |
|
2844 |
2r01010101 |
|
2845 |
2r11101110 |
|
2846 |
2r01010101 |
|
2847 |
2r11111111 |
|
2848 |
2r01010101] |
|
2849 |
||
2850 |
"/ 44in64 |
|
2851 |
||
2852 |
#[2r11101110 |
|
2853 |
2r01010101 |
|
2854 |
2r11111111 |
|
2855 |
2r01010101 |
|
2856 |
2r11101110 |
|
2857 |
2r01010101 |
|
2858 |
2r11111111 |
|
2859 |
2r01010101] |
|
2860 |
||
2861 |
"/ 45in64 |
|
2862 |
||
2863 |
#[2r11101110 |
|
2864 |
2r01010101 |
|
2865 |
2r11111111 |
|
2866 |
2r01010101 |
|
2867 |
2r11111110 |
|
2868 |
2r01010101 |
|
2869 |
2r11111111 |
|
2870 |
2r01010101] |
|
2871 |
||
2872 |
"/ 46in64 |
|
2873 |
||
2874 |
#[2r11101111 |
|
2875 |
2r01010101 |
|
2876 |
2r11111111 |
|
2877 |
2r01010101 |
|
2878 |
2r11111110 |
|
2879 |
2r01010101 |
|
2880 |
2r11111111 |
|
2881 |
2r01010101] |
|
2882 |
||
2883 |
"/ 47in64 |
|
2884 |
||
2885 |
#[2r11101111 |
|
2886 |
2r01010101 |
|
2887 |
2r11111111 |
|
2888 |
2r01010101 |
|
2889 |
2r11111111 |
|
2890 |
2r01010101 |
|
2891 |
2r11111111 |
|
2892 |
2r01010101] |
|
2893 |
||
2894 |
"/ 48in64 |
|
2895 |
||
2896 |
#[2r11111111 |
|
2897 |
2r01010101 |
|
2898 |
2r11111111 |
|
2899 |
2r01010101 |
|
2900 |
2r11111111 |
|
2901 |
2r01010101 |
|
2902 |
2r11111111 |
|
2903 |
2r01010101] |
|
2904 |
||
2905 |
"/ 49in64 |
|
2906 |
||
2907 |
#[2r11111111 |
|
2908 |
2r01110101 |
|
2909 |
2r11111111 |
|
2910 |
2r01010101 |
|
2911 |
2r11111111 |
|
2912 |
2r01010101 |
|
2913 |
2r11111111 |
|
2914 |
2r01010101] |
|
2915 |
||
2916 |
"/ 50in64 |
|
2917 |
||
2918 |
#[2r11111111 |
|
2919 |
2r01110101 |
|
2920 |
2r11111111 |
|
2921 |
2r01010101 |
|
2922 |
2r11111111 |
|
2923 |
2r01010111 |
|
2924 |
2r11111111 |
|
2925 |
2r01010101] |
|
2926 |
||
2927 |
"/ 51in64 |
|
2928 |
||
2929 |
#[2r11111111 |
|
2930 |
2r01110101 |
|
2931 |
2r11111111 |
|
2932 |
2r01010101 |
|
2933 |
2r11111111 |
|
2934 |
2r01110111 |
|
2935 |
2r11111111 |
|
2936 |
2r01010101] |
|
2937 |
||
2938 |
"/ 52in64 |
|
2939 |
||
2940 |
#[2r11111111 |
|
2941 |
2r01110111 |
|
2942 |
2r11111111 |
|
2943 |
2r01010101 |
|
2944 |
2r11111111 |
|
2945 |
2r01110111 |
|
2946 |
2r11111111 |
|
2947 |
2r01010101] |
|
2948 |
||
2949 |
"/ 53in64 |
|
2950 |
||
2951 |
#[2r11111111 |
|
2952 |
2r01110111 |
|
2953 |
2r11111111 |
|
2954 |
2r01010101 |
|
2955 |
2r11111111 |
|
2956 |
2r01110111 |
|
2957 |
2r11111111 |
|
2958 |
2r11010101] |
|
2959 |
||
2960 |
"/ 54in64 |
|
2961 |
||
2962 |
#[2r11111111 |
|
2963 |
2r01110111 |
|
2964 |
2r11111111 |
|
2965 |
2r01011101 |
|
2966 |
2r11111111 |
|
2967 |
2r01110111 |
|
2968 |
2r11111111 |
|
2969 |
2r11010101] |
|
2970 |
||
2971 |
"/ 55in64 |
|
2972 |
||
2973 |
#[2r11111111 |
|
2974 |
2r01110111 |
|
2975 |
2r11111111 |
|
2976 |
2r11011101 |
|
2977 |
2r11111111 |
|
2978 |
2r01110111 |
|
2979 |
2r11111111 |
|
2980 |
2r11010101] |
|
2981 |
||
2982 |
"/ 56in64 |
|
2983 |
||
2984 |
#[2r11111111 |
|
2985 |
2r01110111 |
|
2986 |
2r11111111 |
|
2987 |
2r11011101 |
|
2988 |
2r11111111 |
|
2989 |
2r01110111 |
|
2990 |
2r11111111 |
|
2991 |
2r11011101] |
|
2992 |
||
2993 |
"/ 57in64 |
|
2994 |
||
2995 |
#[2r11111111 |
|
2996 |
2r01110111 |
|
2997 |
2r11111111 |
|
2998 |
2r11011101 |
|
2999 |
2r11111111 |
|
3000 |
2r01110111 |
|
3001 |
2r11111111 |
|
3002 |
2r11111101] |
|
3003 |
||
3004 |
"/ 58in64 |
|
3005 |
||
3006 |
#[2r11111111 |
|
3007 |
2r01110111 |
|
3008 |
2r11111111 |
|
3009 |
2r11011111 |
|
3010 |
2r11111111 |
|
3011 |
2r01110111 |
|
3012 |
2r11111111 |
|
3013 |
2r11111101] |
|
3014 |
||
3015 |
"/ 59in64 |
|
3016 |
||
3017 |
#[2r11111111 |
|
3018 |
2r01110111 |
|
3019 |
2r11111111 |
|
3020 |
2r11011111 |
|
3021 |
2r11111111 |
|
3022 |
2r01110111 |
|
3023 |
2r11111111 |
|
3024 |
2r11111111] |
|
3025 |
||
3026 |
"/ 60in64 |
|
3027 |
||
3028 |
#[2r11111111 |
|
3029 |
2r01110111 |
|
3030 |
2r11111111 |
|
3031 |
2r11111111 |
|
3032 |
2r11111111 |
|
3033 |
2r01110111 |
|
3034 |
2r11111111 |
|
3035 |
2r11111111] |
|
3036 |
||
3037 |
"/ 61in64 |
|
3038 |
||
3039 |
#[2r11111111 |
|
3040 |
2r01110111 |
|
3041 |
2r11111111 |
|
3042 |
2r11111111 |
|
3043 |
2r11111111 |
|
3044 |
2r01111111 |
|
3045 |
2r11111111 |
|
3046 |
2r11111111] |
|
3047 |
||
3048 |
"/ 62in64 |
|
3049 |
||
3050 |
#[2r11111111 |
|
3051 |
2r11110111 |
|
3052 |
2r11111111 |
|
3053 |
2r11111111 |
|
3054 |
2r11111111 |
|
3055 |
2r01111111 |
|
3056 |
2r11111111 |
|
3057 |
2r11111111] |
|
3058 |
||
3059 |
"/ 63in64 |
|
3060 |
||
3061 |
#[2r11111111 |
|
3062 |
2r11110111 |
|
3063 |
2r11111111 |
|
3064 |
2r11111111 |
|
3065 |
2r11111111 |
|
3066 |
2r11111111 |
|
3067 |
2r11111111 |
|
3068 |
2r11111111] |
|
1023 | 3069 |
) |
3070 |
||
3071 |
"Modified: 23.4.1996 / 13:31:50 / cg" |
|
3072 |
"Created: 11.6.1996 / 15:34:29 / cg" |
|
3073 |
! |
|
3074 |
||
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3075 |
ditherGrayFor:fraction on:aDevice into:aBlock |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3076 |
"get a dither form or colorId for a brightness value. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3077 |
Fraction is 0..1. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3078 |
Returns 2 values (either color or ditherForm) through aBlock." |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3079 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3080 |
|d nGray grayBelow scaledGrey scaledGray1 scaledGray2 clr1 clr2 newFraction step| |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3081 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3082 |
d := aDevice depth. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3083 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3084 |
"/ special code for b&w displays |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3085 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3086 |
d == 1 ifTrue:[ |
6353 | 3087 |
aDevice blackpixel == 0 ifTrue:[ |
3088 |
clr1 := Black. |
|
3089 |
clr2 := White. |
|
3090 |
newFraction := fraction. |
|
3091 |
] ifFalse:[ |
|
3092 |
clr1 := White. |
|
3093 |
clr2 := Black. |
|
3094 |
newFraction := 1 - fraction |
|
3095 |
] |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3096 |
] ifFalse:[ |
6353 | 3097 |
"/ special code for 2-plane displays (NeXT) |
3098 |
||
3099 |
d == 2 ifTrue:[ |
|
3100 |
fraction <= 0.01 ifTrue:[ |
|
3101 |
clr1 := Black exactOn:aDevice |
|
3102 |
] ifFalse:[ |
|
3103 |
(fraction between:0.32 and:0.34) ifTrue:[ |
|
3104 |
clr1 := (Color gray:33) exactOn:aDevice |
|
3105 |
] ifFalse:[ |
|
3106 |
(fraction between:0.66 and:0.68) ifTrue:[ |
|
3107 |
clr1 := (Color gray:67) exactOn:aDevice |
|
3108 |
] ifFalse:[ |
|
3109 |
fraction >= 0.99 ifTrue:[ |
|
3110 |
clr1 := White exactOn:aDevice |
|
3111 |
] |
|
3112 |
] |
|
3113 |
] |
|
3114 |
]. |
|
3115 |
clr1 notNil ifTrue:[ |
|
3116 |
^ aBlock value:clr1 value:nil |
|
3117 |
]. |
|
3118 |
||
3119 |
(fraction between:0 and:0.33) ifTrue:[ |
|
3120 |
clr1 := Black. |
|
3121 |
clr2 := Color gray:33. |
|
3122 |
] ifFalse:[ |
|
3123 |
(fraction between:0.34 and:0.66) ifTrue:[ |
|
3124 |
clr1 := Color gray:33. |
|
3125 |
clr2 := Color gray:67. |
|
3126 |
] ifFalse:[ |
|
3127 |
clr1 := Color gray:67. |
|
3128 |
clr2 := White. |
|
3129 |
] |
|
3130 |
]. |
|
3131 |
scaledGray1 := clr1 scaledRed. |
|
3132 |
scaledGray2 := clr2 scaledRed. |
|
3133 |
||
3134 |
scaledGrey := (MaxValue * fraction) rounded. |
|
3135 |
] ifFalse:[ |
|
3136 |
nGray := (1 bitShift:d) - 1. |
|
3137 |
||
3138 |
"/ scale greyValue into grey levels |
|
3139 |
||
3140 |
grayBelow := (fraction * nGray) truncated. |
|
3141 |
||
3142 |
grayBelow < 0 ifTrue:[ |
|
3143 |
^ Color black exactOn:aDevice |
|
3144 |
]. |
|
3145 |
grayBelow >= nGray ifTrue:[ |
|
3146 |
^ Color white exactOn:aDevice |
|
3147 |
]. |
|
3148 |
||
3149 |
scaledGrey := (MaxValue * fraction) rounded. |
|
3150 |
||
3151 |
step := MaxValue // nGray. |
|
3152 |
scaledGray1 := grayBelow * step. |
|
3153 |
scaledGray2 := scaledGray1 + step. |
|
3154 |
||
3155 |
clr1 := Color scaledGray:scaledGray1. |
|
3156 |
clr2 := Color scaledGray:scaledGray2. |
|
3157 |
]. |
|
3158 |
||
3159 |
"/ scale remainder in between low..high |
|
3160 |
newFraction := (scaledGrey - scaledGray1) asFloat / (scaledGray2 - scaledGray1). |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3161 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3162 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3163 |
clr1 := clr1 exactOn:aDevice. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3164 |
clr2 := clr2 exactOn:aDevice. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3165 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3166 |
(clr1 isNil or:[clr2 isNil]) ifTrue:[ |
6353 | 3167 |
"/ fall back to b&w dither |
3168 |
aDevice blackpixel == 0 ifTrue:[ |
|
3169 |
clr1 := Black. |
|
3170 |
clr2 := White. |
|
3171 |
newFraction := fraction. |
|
3172 |
] ifFalse:[ |
|
3173 |
clr1 := White. |
|
3174 |
clr2 := Black. |
|
3175 |
newFraction := 1 - fraction |
|
3176 |
] |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3177 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3178 |
|
6353 | 3179 |
^ self |
3180 |
monoDitherFor:newFraction |
|
3181 |
between:clr1 and:clr2 |
|
3182 |
on:aDevice |
|
3183 |
into:aBlock |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3184 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3185 |
" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3186 |
Color basicNew |
6353 | 3187 |
ditherGrayFor:0.5 |
3188 |
on:Display |
|
3189 |
into:[:clr :form | clr notNil ifTrue:[clr inspect]. |
|
3190 |
form notNil ifTrue:[(form magnifiedBy:16) inspect].] |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3191 |
" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3192 |
" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3193 |
Color basicNew |
6353 | 3194 |
ditherGrayFor:0.25 |
3195 |
on:Display |
|
3196 |
into:[:clr :form | clr notNil ifTrue:[clr inspect]. |
|
3197 |
form notNil ifTrue:[(form magnifiedBy:16) inspect].] |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3198 |
" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3199 |
|
5779
def9764b9b8a
changed: #ditherGrayFor:on:into:
Claus Gittinger <cg@exept.de>
parents:
5689
diff
changeset
|
3200 |
"Created: / 03-05-1997 / 10:59:57 / cg" |
def9764b9b8a
changed: #ditherGrayFor:on:into:
Claus Gittinger <cg@exept.de>
parents:
5689
diff
changeset
|
3201 |
"Modified: / 24-07-2011 / 07:18:00 / cg" |
1023 | 3202 |
! |
3203 |
||
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3204 |
ditherRed:rV green:gV blue:bV on:aDevice into:aBlock |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3205 |
"get a dither form or colorId for an rgb value. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3206 |
Returns 2 values (either color or ditherForm) through |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3207 |
aBlock. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3208 |
This code is just a minimum of what is really needed, |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3209 |
and needs much more work. Currently only some special cases |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3210 |
are handled" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3211 |
|
6353 | 3212 |
|rh rl rs |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3213 |
lowL hiL lowValL hiValL lowS hiS lowValS hiValS lowH hiH lowValH hiValH d| |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3214 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3215 |
"get hls (since we dither anyway, round them a bit" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3216 |
|
7798 | 3217 |
Color withHLSFromScaledRed:rV scaledGreen:gV scaledBlue:bV do:[:hue :light :saturation | |
3218 |
hue notNil ifTrue:[ |
|
3219 |
rh := (hue * 3.0) rounded / 3.0. |
|
3220 |
]. |
|
3221 |
rl := (light * 3.0) rounded / 3.0. |
|
3222 |
rs := (saturation * 3.0) rounded / 3.0. |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3223 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3224 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3225 |
rh isNil ifTrue:[ |
7798 | 3226 |
"achromatic, dither between achromatic colors" |
3227 |
||
3228 |
lowL := nil. |
|
3229 |
hiL := nil. |
|
3230 |
||
3231 |
"find the 2 bounding colors" |
|
3232 |
aDevice deviceColors do:[:aColor | |
|
3233 |
aColor colorId notNil ifTrue:[ |
|
3234 |
||
3235 |
Color withHLSFromRed:aColor red green:aColor green blue:aColor blue do:[:hue :light :saturation | |
|
3236 |
| cl | |
|
3237 |
||
3238 |
hue isNil ifTrue:[ |
|
3239 |
cl := (light * 3.0) rounded / 3.0. |
|
3240 |
||
3241 |
cl > rl ifTrue:[ |
|
3242 |
hiL isNil ifTrue:[ |
|
3243 |
hiL := aColor. |
|
3244 |
hiValL := cl. |
|
3245 |
] ifFalse:[ |
|
3246 |
cl < hiValL ifTrue:[ |
|
3247 |
hiL := aColor. |
|
3248 |
hiValL := cl. |
|
3249 |
] |
|
3250 |
] |
|
3251 |
] ifFalse:[ |
|
3252 |
lowL isNil ifTrue:[ |
|
3253 |
lowL := aColor. |
|
3254 |
lowValL := cl |
|
3255 |
] ifFalse:[ |
|
3256 |
cl > lowValL ifTrue:[ |
|
3257 |
lowL := aColor. |
|
3258 |
lowValL := cl |
|
3259 |
] |
|
3260 |
] |
|
3261 |
] |
|
3262 |
] |
|
3263 |
] |
|
3264 |
] |
|
3265 |
]. |
|
3266 |
||
3267 |
(lowL notNil and:[hiL notNil]) ifTrue:[ |
|
3268 |
^ self |
|
3269 |
monoDitherFor:1.0 / (hiValL - lowValL) * (rl - lowValL) |
|
3270 |
between:lowL and:hiL |
|
3271 |
on:aDevice |
|
3272 |
into:aBlock |
|
3273 |
]. |
|
3274 |
"cannot happen, should always find at least black and white" |
|
3275 |
'Color [info]: oops - color to dither is not bound by b&w' infoPrintCR. |
|
3276 |
||
3277 |
^ aBlock value:nil value:nil |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3278 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3279 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3280 |
"chromatic case" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3281 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3282 |
aDevice hasColors ifFalse:[ |
7798 | 3283 |
"no chance, return nil values" |
3284 |
^ aBlock value:nil value:nil |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3285 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3286 |
(Red isNil or:[Green isNil or:[Blue isNil]]) ifTrue:[ |
7798 | 3287 |
"if we where not able to get primary colors: no chance" |
3288 |
^ aBlock value:nil value:nil |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3289 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3290 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3291 |
"try to find two bounding colors with same hue and saturation; |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3292 |
dither on light between those" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3293 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3294 |
lowL := nil. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3295 |
hiL := nil. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3296 |
lowS := nil. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3297 |
hiS := nil. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3298 |
lowH := nil. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3299 |
hiH := nil. |
1023 | 3300 |
|
1365
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
3301 |
aDevice deviceColors do:[:aColor | |
7798 | 3302 |
aColor colorId notNil ifTrue:[ |
3303 |
Color withHLSFromRed:aColor red green:aColor green blue:aColor blue do:[:hue :light :saturation | |
|
3304 |
| cl ch cs| |
|
3305 |
||
3306 |
hue notNil ifTrue:[ |
|
3307 |
ch := (hue * 3.0) rounded / 3.0. |
|
3308 |
] ifFalse:[ |
|
3309 |
ch := nil |
|
3310 |
]. |
|
3311 |
cl := (light * 3.0) rounded / 3.0. |
|
3312 |
cs := (saturation * 3.0) rounded / 3.0. |
|
3313 |
||
3314 |
((ch = rh) and:[cs = rs]) ifTrue:[ |
|
3315 |
"found a color with same saturation and same hue, keep for light" |
|
3316 |
||
3317 |
cl > rl ifTrue:[ |
|
3318 |
hiL isNil ifTrue:[ |
|
3319 |
hiL := aColor. |
|
3320 |
hiValL := cl |
|
3321 |
] ifFalse:[ |
|
3322 |
cl < hiValL ifTrue:[ |
|
3323 |
hiL := aColor. |
|
3324 |
hiValL := cl |
|
3325 |
] |
|
3326 |
]. |
|
3327 |
] ifFalse:[ |
|
3328 |
lowL isNil ifTrue:[ |
|
3329 |
lowL := aColor. |
|
3330 |
lowValL := cl |
|
3331 |
] ifFalse:[ |
|
3332 |
cl > lowValL ifTrue:[ |
|
3333 |
lowL := aColor. |
|
3334 |
lowValL := cl |
|
3335 |
] |
|
3336 |
] |
|
3337 |
] |
|
3338 |
]. |
|
3339 |
||
3340 |
(((ch = rh) or:[ch isNil]) and:[cl = rl]) ifTrue:[ |
|
3341 |
"found a color with same light and same hue, keep for saturation" |
|
3342 |
||
3343 |
cs > rs ifTrue:[ |
|
3344 |
hiS isNil ifTrue:[ |
|
3345 |
hiS := aColor. |
|
3346 |
hiValS := cs |
|
3347 |
] ifFalse:[ |
|
3348 |
cs < hiValS ifTrue:[ |
|
3349 |
hiS := aColor. |
|
3350 |
hiValS := cs |
|
3351 |
] |
|
3352 |
]. |
|
3353 |
] ifFalse:[ |
|
3354 |
lowS isNil ifTrue:[ |
|
3355 |
lowS := aColor. |
|
3356 |
lowValS := cs |
|
3357 |
] ifFalse:[ |
|
3358 |
cs > lowValS ifTrue:[ |
|
3359 |
lowS := aColor. |
|
3360 |
lowValS := cs |
|
3361 |
] |
|
3362 |
] |
|
3363 |
] |
|
3364 |
]. |
|
3365 |
||
3366 |
rh notNil ifTrue:[ |
|
3367 |
cl = rl ifTrue:[ |
|
3368 |
cs = rs ifTrue:[ |
|
3369 |
ch notNil ifTrue:[ |
|
3370 |
d := (ch - rh) abs. |
|
3371 |
d > 300 ifTrue:[ |
|
3372 |
rh > 180 ifTrue:[ |
|
3373 |
ch := ch + 360 |
|
3374 |
] ifFalse:[ |
|
3375 |
ch := ch - 360 |
|
3376 |
]. |
|
3377 |
]. |
|
3378 |
ch > rh ifTrue:[ |
|
3379 |
hiH isNil ifTrue:[ |
|
3380 |
hiH := aColor. |
|
3381 |
hiValH := ch |
|
3382 |
] ifFalse:[ |
|
3383 |
ch < hiValH ifTrue:[ |
|
3384 |
hiH := aColor. |
|
3385 |
hiValH := ch |
|
3386 |
] |
|
3387 |
] |
|
3388 |
] ifFalse:[ |
|
3389 |
lowH isNil ifTrue:[ |
|
3390 |
lowH := aColor. |
|
3391 |
lowValH := ch |
|
3392 |
] ifFalse:[ |
|
3393 |
ch > lowValH ifTrue:[ |
|
3394 |
lowH := aColor. |
|
3395 |
lowValH := ch |
|
3396 |
] |
|
3397 |
] |
|
3398 |
] |
|
3399 |
] |
|
3400 |
] |
|
3401 |
] |
|
3402 |
] |
|
3403 |
] |
|
3404 |
] |
|
1023 | 3405 |
]. |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3406 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3407 |
"found bounds for light ?" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3408 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3409 |
lowL notNil ifTrue:[ |
7798 | 3410 |
rl = lowValL ifTrue:[ |
3411 |
^ aBlock value:lowL value:nil |
|
3412 |
]. |
|
3413 |
hiL notNil ifTrue:[ |
|
3414 |
^ self |
|
3415 |
monoDitherFor:1.0 / (hiValL - lowValL) / (rl - lowValL) |
|
3416 |
between:lowL and:hiL |
|
3417 |
on:aDevice |
|
3418 |
into:aBlock |
|
3419 |
]. |
|
3420 |
"found bound for light - dither with white" |
|
3421 |
^ self |
|
3422 |
monoDitherFor:1.0 / (100 - lowValL) / (rl - lowValL) |
|
3423 |
between:lowL and:White |
|
3424 |
on:aDevice |
|
3425 |
into:aBlock |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3426 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3427 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3428 |
"found bound for light - dither with black" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3429 |
hiL notNil ifTrue:[ |
7798 | 3430 |
^ self |
3431 |
monoDitherFor:1.0 / (hiValL) / (rl) |
|
3432 |
between:Black and:hiL |
|
3433 |
on:aDevice |
|
3434 |
into:aBlock |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3435 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3436 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3437 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3438 |
"found bounds for saturation?" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3439 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3440 |
(lowS notNil and:[hiS notNil]) ifTrue:[ |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3441 |
" |
7798 | 3442 |
'saturation dither' printNewline. |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3443 |
" |
7798 | 3444 |
^ self |
3445 |
monoDitherFor:1.0 / (hiValS - lowValS) / (rs - lowValS) |
|
3446 |
between:lowS and:hiS |
|
3447 |
on:aDevice |
|
3448 |
into:aBlock |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3449 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3450 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3451 |
"found bounds for hue ?" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3452 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3453 |
(lowH notNil and:[hiH notNil]) ifTrue:[ |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3454 |
" |
7798 | 3455 |
'hue dither' printNewline. |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3456 |
" |
7798 | 3457 |
hiValH < lowValH ifTrue:[ |
3458 |
hiValH := hiValH + 360 |
|
3459 |
]. |
|
3460 |
||
3461 |
d := hiValH - lowValH. |
|
3462 |
||
3463 |
^ self |
|
3464 |
monoDitherFor:1.0 / (d / (rh - lowValH)) |
|
3465 |
between:lowH and:hiH |
|
3466 |
on:aDevice |
|
3467 |
into:aBlock |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3468 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3469 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3470 |
^ aBlock value:nil value:nil |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3471 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3472 |
"Modified: 3.5.1997 / 10:58:54 / cg" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3473 |
"Created: 3.5.1997 / 11:02:03 / cg" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3474 |
! |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3475 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3476 |
fixDitherRed:redVal green:greenVal blue:blueVal on:aDevice into:aBlock |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3477 |
"get a dither form for an rgb value. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3478 |
Returns 2 values (either color or ditherForm) through aBlock. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3479 |
This code uses the table of preallocated fix-colors to find |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3480 |
dither colors." |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3481 |
|
6353 | 3482 |
| |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3483 |
nR "{ Class: SmallInteger }" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3484 |
nG "{ Class: SmallInteger }" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3485 |
nB "{ Class: SmallInteger }" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3486 |
hR "{ Class: SmallInteger }" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3487 |
hG "{ Class: SmallInteger }" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3488 |
hB "{ Class: SmallInteger }" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3489 |
eR eG eB |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3490 |
rI "{ Class: SmallInteger }" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3491 |
gI "{ Class: SmallInteger }" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3492 |
bI "{ Class: SmallInteger }" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3493 |
idx "{ Class: SmallInteger }" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3494 |
f clr |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3495 |
r "{ Class: SmallInteger }" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3496 |
g "{ Class: SmallInteger }" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3497 |
b "{ Class: SmallInteger }" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3498 |
x1 "{ Class: SmallInteger }" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3499 |
x2 "{ Class: SmallInteger }" |
6353 | 3500 |
step "{ Class: SmallInteger }" |
3501 |
lastIdx mx |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3502 |
dS "{ Class: SmallInteger }" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3503 |
cube| |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3504 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3505 |
(cube := aDevice fixColors) notNil ifTrue:[ |
7360 | 3506 |
dS := 4. |
3507 |
||
3508 |
f := Form width:dS height:dS depth:(aDevice depth) onDevice:aDevice. |
|
3509 |
f isNil ifTrue:[^ nil]. |
|
3510 |
f initGC. |
|
3511 |
||
3512 |
mx := MaxValue asFloat. |
|
3513 |
||
3514 |
nR := aDevice numFixRed. |
|
3515 |
nG := aDevice numFixGreen. |
|
3516 |
nB := aDevice numFixBlue. |
|
3517 |
||
3518 |
hR := nR // 2. |
|
3519 |
hG := nG // 2. |
|
3520 |
hB := nB // 2. |
|
3521 |
||
3522 |
eR := eG := eB := 0. |
|
3523 |
r := redVal. |
|
3524 |
g := greenVal. |
|
3525 |
b := blueVal. |
|
3526 |
||
3527 |
step := -1. |
|
3528 |
||
3529 |
0 to:dS-1 do:[:y | |
|
3530 |
step == -1 ifTrue:[ |
|
3531 |
x1 := 0. x2 := dS-1. step := 1. |
|
3532 |
] ifFalse:[ |
|
3533 |
x1 := dS-1. x2 := 0. step := -1. |
|
3534 |
]. |
|
3535 |
||
3536 |
x1 to:x2 by:step do:[:x | |
|
3537 |
"/ the nearest along the grid |
|
3538 |
||
3539 |
r := redVal + eR. |
|
3540 |
r > MaxValue ifTrue:[r := MaxValue] |
|
3541 |
ifFalse:[r < 0 ifTrue:[r := 0]]. |
|
3542 |
g := greenVal + eG. |
|
3543 |
g > MaxValue ifTrue:[g := MaxValue] |
|
3544 |
ifFalse:[g < 0 ifTrue:[g := 0]]. |
|
3545 |
||
3546 |
b := blueVal + eB. |
|
3547 |
b > MaxValue ifTrue:[b := MaxValue] |
|
3548 |
ifFalse:[b < 0 ifTrue:[b := 0]]. |
|
3549 |
||
3550 |
rI := (r * (nR-1) + hR / mx) rounded. |
|
3551 |
gI := (g * (nG-1) + hG / mx) rounded . |
|
3552 |
bI := (b * (nB-1) + hB / mx) rounded . |
|
3553 |
||
3554 |
idx := (((rI * nG) + gI) * nB + bI) + 1. |
|
3555 |
clr := (cube at:idx) exactOn:aDevice. |
|
3556 |
lastIdx isNil ifTrue:[lastIdx := idx] |
|
3557 |
ifFalse:[lastIdx ~~ idx ifTrue:[lastIdx := -1]]. |
|
3558 |
||
3559 |
f foreground:clr. |
|
3560 |
f displayPointX:x y:y. |
|
3561 |
||
3562 |
eR := r - clr scaledRed. |
|
3563 |
eG := g - clr scaledGreen. |
|
3564 |
eB := b - clr scaledBlue. |
|
3565 |
]. |
|
3566 |
]. |
|
3567 |
f releaseGC. |
|
3568 |
||
3569 |
lastIdx ~~ -1 ifTrue:[ |
|
3570 |
^ aBlock value:clr value:nil |
|
3571 |
]. |
|
3572 |
^ aBlock value:nil value:f |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3573 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3574 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3575 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3576 |
^ aBlock value:nil value:nil |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3577 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3578 |
"Modified: 11.7.1996 / 18:30:28 / cg" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3579 |
"Created: 3.5.1997 / 11:03:18 / cg" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3580 |
! |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3581 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3582 |
monoDitherFor:fraction between:color1 and:color2 on:aDevice into:aBlock |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3583 |
"get a dither form or colorId for dithering between 2 colors. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3584 |
Fraction is 0..1. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3585 |
Returns 2 values (either color or ditherForm) through aBlock." |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3586 |
|
6353 | 3587 |
|form c1 c2 |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3588 |
index "{ Class:SmallInteger }"| |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3589 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3590 |
"/ |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3591 |
"/ having forms with: [1 .. 63] of 64 pixels (see Form), |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3592 |
"/ we get dithers for: 1/64, 2/64, ... 63/64 |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3593 |
"/ |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3594 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3595 |
index := (fraction * 64) rounded. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3596 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3597 |
c1 := color1 exactOn:aDevice. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3598 |
index < 1 ifTrue:[ |
6353 | 3599 |
^ aBlock value:c1 value:nil |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3600 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3601 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3602 |
c2 := color2 exactOn:aDevice. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3603 |
index >= 64 ifTrue:[ |
6353 | 3604 |
^ aBlock value:c2 value:nil |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3605 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3606 |
|
4772
be4524221fa7
Use Form class>>#width:height:fromArray:onDevice: instead of obsolete
Stefan Vogel <sv@exept.de>
parents:
4749
diff
changeset
|
3607 |
form := Form width:8 height:8 fromArray:(DitherBits at:index) onDevice:aDevice. |
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3608 |
form colorMap:(Array with:c1 with:c2). |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3609 |
^ aBlock value:nil value:form |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3610 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3611 |
" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3612 |
Color basicNew |
6353 | 3613 |
monoDitherFor:(MaxValue // 2) |
3614 |
between:Color black |
|
3615 |
and:Color white |
|
3616 |
on:Display |
|
3617 |
into:[:clr :dither | clr inspect. dither inspect] |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3618 |
" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3619 |
|
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3620 |
"Created: 3.5.1997 / 10:55:06 / cg" |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
3621 |
"Modified: 3.5.1997 / 11:05:20 / cg" |
1023 | 3622 |
! ! |
3623 |
||
1144 | 3624 |
!Color class methodsFor:'queries'! |
1023 | 3625 |
|
3626 |
constantNames |
|
3627 |
"return names known as instance creation messages" |
|
3628 |
||
6353 | 3629 |
^ #(white black |
6534 | 3630 |
grey mediumGray veryLightGray lightGray darkGray veryDarkGray |
3631 |
red green blue cyan yellow pink orange magenta) |
|
1023 | 3632 |
|
3633 |
"Modified: 2.5.1996 / 11:34:05 / cg" |
|
3634 |
! |
|
3635 |
||
3636 |
scalingValue |
|
3637 |
"ST-80 compatibility" |
|
3638 |
||
3639 |
^ MaxValue |
|
3640 |
||
3641 |
"Created: 2.5.1996 / 11:30:09 / cg" |
|
3642 |
"Modified: 11.7.1996 / 21:42:26 / cg" |
|
3643 |
! ! |
|
3644 |
||
1144 | 3645 |
!Color class methodsFor:'special instance creation'! |
1023 | 3646 |
|
3647 |
nearestColorRed:r green:g blue:b on:aDevice in:colors |
|
3648 |
"return the nearest color on aDevice with RGB values |
|
3649 |
same or near r/g/b in a collection of colors. |
|
3650 |
If there is one, return it; nil otherwise. |
|
3651 |
Near is defined as having an error less than the argument |
|
3652 |
error (in percent). The error is computed by the color |
|
3653 |
vector distance (which may not be the best possible solution)." |
|
3654 |
||
3655 |
^ self |
|
6353 | 3656 |
nearestColorScaledRed:(r * MaxValue // 100) |
3657 |
scaledGreen:(g * MaxValue // 100) |
|
3658 |
scaledBlue:(b * MaxValue // 100) |
|
3659 |
on:aDevice |
|
3660 |
in:colors |
|
1023 | 3661 |
|
3662 |
"Modified: 11.6.1996 / 18:04:55 / cg" |
|
3663 |
"Created: 14.6.1996 / 20:05:13 / cg" |
|
3664 |
! |
|
3665 |
||
3666 |
nearestColorScaledRed:r scaledGreen:g scaledBlue:b inCube:aColorCube numRed:nRed numGreen:nGreen numBlue:nBlue |
|
3667 |
"return a color with rgb values same or near r/g/b in a given |
|
3668 |
collection, containing colors from a colorCube. |
|
6353 | 3669 |
This is used with preallocated fixColors and is quite fast |
1023 | 3670 |
(no need to search)" |
3671 |
||
3672 |
|sR "{ Class: SmallInteger }" |
|
3673 |
sG "{ Class: SmallInteger }" |
|
3674 |
sB "{ Class: SmallInteger }" |
|
3675 |
idx "{ Class: SmallInteger }" |
|
3676 |
nR "{ Class: SmallInteger }" |
|
3677 |
nG "{ Class: SmallInteger }" |
|
3678 |
nB "{ Class: SmallInteger }" |
|
3679 |
rI "{ Class: SmallInteger }" |
|
3680 |
gI "{ Class: SmallInteger }" |
|
3681 |
bI "{ Class: SmallInteger }"| |
|
3682 |
||
3683 |
" |
|
3684 |
round to the step given by FixColors |
|
3685 |
" |
|
3686 |
nR := nRed. |
|
3687 |
nG := nGreen. |
|
3688 |
nB := nBlue. |
|
3689 |
||
3690 |
sR := MaxValue // (nR - 1). |
|
3691 |
sG := MaxValue // (nG - 1). |
|
3692 |
sB := MaxValue // (nB - 1). |
|
3693 |
||
3694 |
rI := (r + (sR // 2)) // sR. |
|
3695 |
gI := (g + (sG // 2)) // sG. |
|
3696 |
bI := (b + (sB // 2)) // sB. |
|
3697 |
idx := (((rI * nG) + gI) * nB + bI) + 1. |
|
3698 |
^ aColorCube at:idx |
|
3699 |
||
3700 |
"Modified: 11.7.1996 / 17:52:46 / cg" |
|
3701 |
"Created: 11.7.1996 / 18:20:13 / cg" |
|
3702 |
! |
|
3703 |
||
3704 |
nearestColorScaledRed:r scaledGreen:g scaledBlue:b on:aDevice |
|
3705 |
"return a device color on aDevice with RGB values |
|
3706 |
same or near r/g/b, if there is one, nil otherwise. |
|
3707 |
Near is defined as having an error less than the argument |
|
3708 |
error (in percent). The error is computed by the color |
|
3709 |
vector distance (which may not be the best possible solution)." |
|
3710 |
||
3711 |
|cube| |
|
3712 |
||
3713 |
" |
|
3714 |
if there are preallocated colors, things are much easier ... |
|
3715 |
" |
|
3716 |
(cube := aDevice fixColors) notNil ifTrue:[ |
|
6353 | 3717 |
^ self |
3718 |
nearestColorScaledRed:r |
|
3719 |
scaledGreen:g |
|
3720 |
scaledBlue:b |
|
3721 |
inCube:cube |
|
3722 |
numRed:(aDevice numFixRed) |
|
3723 |
numGreen:(aDevice numFixGreen) |
|
3724 |
numBlue:(aDevice numFixBlue) |
|
1023 | 3725 |
]. |
3726 |
||
3727 |
" |
|
3728 |
search in existing colors ... |
|
3729 |
" |
|
6353 | 3730 |
^ self |
3731 |
nearestColorScaledRed:r |
|
3732 |
scaledGreen:g |
|
3733 |
scaledBlue:b |
|
3734 |
on:aDevice |
|
3735 |
in:aDevice deviceColors |
|
1023 | 3736 |
|
3737 |
"Created: 14.6.1996 / 20:11:18 / cg" |
|
1365
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
3738 |
"Modified: 24.2.1997 / 18:17:51 / cg" |
1023 | 3739 |
! |
3740 |
||
3741 |
nearestColorScaledRed:r scaledGreen:g scaledBlue:b on:aDevice in:colors |
|
3742 |
"return the nearest color on aDevice with RGB values |
|
3743 |
same or near r/g/b in a collection of colors. |
|
3744 |
If there is one, return it; nil otherwise." |
|
3745 |
||
3746 |
|delta minDelta bestSoFar| |
|
3747 |
||
3748 |
minDelta := 9999999. |
|
3749 |
||
1619
4a7dbd25c588
handle the case where not even r/g/b primaries can be allocated
Claus Gittinger <cg@exept.de>
parents:
1534
diff
changeset
|
3750 |
colors isNil ifTrue:[^ nil]. |
4a7dbd25c588
handle the case where not even r/g/b primaries can be allocated
Claus Gittinger <cg@exept.de>
parents:
1534
diff
changeset
|
3751 |
|
1023 | 3752 |
colors do:[:aColor | |
6353 | 3753 |
|cr cg cb| |
3754 |
||
3755 |
(aDevice isNil |
|
3756 |
or:[(aColor graphicsDevice == aDevice) |
|
3757 |
and:[aColor colorId notNil]]) ifTrue:[ |
|
3758 |
delta := aColor deltaFromScaledRed:r scaledGreen:g scaledBlue:b. |
|
3759 |
delta < minDelta ifTrue:[ |
|
3760 |
" |
|
3761 |
an exact fit - no need to continue search |
|
3762 |
" |
|
3763 |
delta == 0 ifTrue:[^ aColor]. |
|
3764 |
||
3765 |
bestSoFar := aColor. |
|
3766 |
minDelta := delta |
|
3767 |
] |
|
3768 |
] |
|
1023 | 3769 |
]. |
3770 |
||
3771 |
^ bestSoFar |
|
3772 |
||
2198
122ff0da86d6
added support to find the nearest color in a colorMap.
Claus Gittinger <cg@exept.de>
parents:
2183
diff
changeset
|
3773 |
"Created: / 11.6.1996 / 18:02:12 / cg" |
122ff0da86d6
added support to find the nearest color in a colorMap.
Claus Gittinger <cg@exept.de>
parents:
2183
diff
changeset
|
3774 |
"Modified: / 28.7.1998 / 20:40:41 / cg" |
1023 | 3775 |
! |
3776 |
||
3777 |
quickNearestColorScaledRed:r scaledGreen:g scaledBlue:b on:aDevice |
|
3778 |
"return a device color on aDevice with rgb values |
|
3779 |
same or near r/g/b. |
|
3780 |
This looks for primary colors only and is thus faster |
|
3781 |
than the general nearestColor search (slightly uglier though)." |
|
3782 |
||
3783 |
|cube| |
|
3784 |
||
3785 |
" |
|
1954 | 3786 |
if there are preallocated colors, things are much easier ... |
1023 | 3787 |
" |
1954 | 3788 |
(cube := aDevice fixColors) notNil ifTrue:[ |
6353 | 3789 |
^ self |
3790 |
nearestColorScaledRed:r |
|
3791 |
scaledGreen:g |
|
3792 |
scaledBlue:b |
|
3793 |
inCube:cube |
|
3794 |
numRed:(aDevice numFixRed) |
|
3795 |
numGreen:(aDevice numFixGreen) |
|
3796 |
numBlue:(aDevice numFixBlue) |
|
1023 | 3797 |
]. |
3798 |
||
3799 |
" |
|
3800 |
search in existing colors ... |
|
3801 |
" |
|
6353 | 3802 |
^ self nearestColorScaledRed:r |
3803 |
scaledGreen:g |
|
3804 |
scaledBlue:b |
|
3805 |
on:aDevice |
|
3806 |
in:(aDevice availableDitherColors) |
|
1023 | 3807 |
|
3808 |
"Created: 14.6.1996 / 20:13:22 / cg" |
|
3809 |
"Modified: 11.7.1996 / 18:20:14 / cg" |
|
3810 |
! ! |
|
3811 |
||
3880 | 3812 |
!Color methodsFor:'Compatibility-ST80'! |
1347 | 3813 |
|
3814 |
asDevicePaintOn:aDevice |
|
3815 |
"ST-80 compatibility: an alias for on:. |
|
3816 |
create a new Color representing the same color as |
|
3817 |
myself on aDevice; if one already exists, return the one" |
|
3818 |
||
2828 | 3819 |
^ self onDevice:aDevice |
2943
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3820 |
! |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3821 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3822 |
asHiliteColor |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3823 |
"same as lightened - for ST-80 compatibility" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3824 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3825 |
^ self lightened |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3826 |
! |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3827 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3828 |
asShadowColor |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3829 |
"same as darkened - for ST-80 compatibility" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3830 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3831 |
^ self darkened |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3832 |
! ! |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3833 |
|
3880 | 3834 |
!Color methodsFor:'Compatibility-Squeak'! |
2943
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3835 |
|
6353 | 3836 |
alphaMixed: proportion with: aColor |
3837 |
"Answer this color mixed with the given color. The proportion, a number |
|
3838 |
between 0.0 and 1.0, determines what what fraction of the receiver to |
|
3839 |
use in the mix. For example, 0.9 would yield a color close to the |
|
3840 |
receiver. This method uses RGB interpolation; HSV interpolation can lead |
|
4789 | 3841 |
to surprises. Mixes the alphas (for transparency) also." |
3842 |
||
3843 |
| frac1 frac2 | |
|
3844 |
||
3845 |
frac1 := proportion asFloat min: 1.0 max: 0.0. |
|
3846 |
frac2 := 1.0 - frac1. |
|
7762 | 3847 |
^ self class |
3848 |
r: ((red * frac1) + (aColor scaledRed * frac2)) / MaxValue |
|
3849 |
g: ((green * frac1) + (aColor scaledGreen * frac2)) / MaxValue |
|
3850 |
b: ((blue * frac1) + (aColor scaledBlue * frac2)) / MaxValue |
|
3851 |
alpha: (self alpha * frac1) + (aColor alpha * frac2) |
|
6353 | 3852 |
|
3853 |
" |
|
3854 |
(Color r:1 g:0 b:0 alpha:1) alphaMixed:0.5 with:(Color r:1 g:0 b:0 alpha:1) |
|
3855 |
(Color r:1 g:0 b:0 alpha:0.5) alphaMixed:0.5 with:(Color r:0 g:1 b:0 alpha:0.5) |
|
4789 | 3856 |
" |
3857 |
||
3858 |
"Created: / 06-06-2007 / 10:53:25 / cg" |
|
3859 |
! |
|
3860 |
||
2945 | 3861 |
bitPatternForDepth: depth |
6353 | 3862 |
"Return a Bitmap, possibly containing a stipple pattern, |
3863 |
that best represents this color at the given depth. |
|
3864 |
BitBlt calls this method to convert colors into Bitmaps. |
|
3865 |
The resulting Bitmap may be multiple words to represent a stipple |
|
2945 | 3866 |
pattern of several lines. " |
3867 |
||
6353 | 3868 |
"See also: |
3869 |
pixelValueAtDepth: -- value for single pixel |
|
3870 |
pixelWordAtDepth: -- a 32-bit word filled with the pixel value" |
|
2945 | 3871 |
"Details: The pattern for the most recently requested depth is cached." |
3872 |
||
3873 |
^ self. |
|
3874 |
"/ depth == cachedDepth ifTrue: [^ cachedBitPattern]. |
|
3875 |
"/ cachedDepth _ depth. |
|
3876 |
"/ |
|
3877 |
"/ depth > 2 ifTrue: [^ cachedBitPattern _ Bitmap with: (self pixelWordForDepth: depth)]. |
|
3878 |
"/ depth = 1 ifTrue: [^ cachedBitPattern _ self halfTonePattern1]. |
|
3879 |
"/ depth = 2 ifTrue: [^ cachedBitPattern _ self halfTonePattern2]. |
|
3880 |
||
3881 |
! |
|
3882 |
||
3396 | 3883 |
colorForInsets |
3884 |
^ self |
|
3885 |
! |
|
3886 |
||
2943
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3887 |
darker |
3030 | 3888 |
"return a new color, which is darker than the receiver. |
2943
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3889 |
Almost the same as darkened for Squeak compatibility." |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3890 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3891 |
^ self mixed:0.8333 with:Black |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3892 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3893 |
" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3894 |
(Color red) darker |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3895 |
(Color red) muchDarker |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3896 |
" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3897 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3898 |
"Modified: 11.6.1996 / 18:10:37 / cg" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3899 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3900 |
! |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3901 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3902 |
lighter |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3903 |
"return a new color, which is slightly lighter than the receiver. |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3904 |
Almost the same as lightened for Squeak compatibility." |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3905 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3906 |
^ self mixed:0.8333 with:White |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3907 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3908 |
" |
6353 | 3909 |
(Color red) |
2943
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3910 |
(Color red) lighter |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3911 |
(Color red) muchLighter |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3912 |
(Color red) veryMuchLighter |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3913 |
" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3914 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3915 |
"Modified: 11.6.1996 / 18:10:49 / cg" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3916 |
! |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3917 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3918 |
muchDarker |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3919 |
"return a new color, which is much darker than the receiver. |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3920 |
Added for Squeak compatibility." |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3921 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3922 |
^ self mixed:0.233 with:Black |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3923 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3924 |
" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3925 |
(Color red) darker |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3926 |
(Color red) muchDarker |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3927 |
" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3928 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3929 |
"Modified: 11.6.1996 / 18:10:49 / cg" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3930 |
! |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3931 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3932 |
muchLighter |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3933 |
"return a new color, which is much lighter than the receiver. |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3934 |
Added for Squeak compatibility." |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3935 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3936 |
^ self mixed:0.233 with:White |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3937 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3938 |
" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3939 |
(Color red) lighter |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3940 |
(Color red) mixed:0.833 with:Color white |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3941 |
(Color red) muchLighter |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3942 |
(Color red) veryMuchLighter |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3943 |
" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3944 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3945 |
"Modified: 11.6.1996 / 18:10:49 / cg" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3946 |
! |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3947 |
|
3024 | 3948 |
newTileMorphRepresentative |
6353 | 3949 |
^ ColorTileMorph new colorSwatchColor: self |
3396 | 3950 |
! |
3024 | 3951 |
|
4203 | 3952 |
privateBlue |
3953 |
"Squeak compatibility: |
|
3954 |
return the blue components value mapped to 0..MaxValue" |
|
3955 |
||
3956 |
^ self scaledBlue |
|
3957 |
! |
|
3958 |
||
3959 |
privateGreen |
|
3960 |
"Squeak compatibility: |
|
3961 |
return the green components value mapped to 0..MaxValue" |
|
3962 |
||
3963 |
^ self scaledGreen |
|
3964 |
! |
|
3965 |
||
3966 |
privateRed |
|
3967 |
"Squeak compatibility: |
|
3968 |
return the red components value mapped to 0..MaxValue" |
|
3969 |
||
3970 |
^ self scaledRed |
|
3971 |
! |
|
3972 |
||
3309 | 3973 |
scaledPixelValue32 |
3974 |
^ (self redByte bitShift:16) |
|
3975 |
+ (self greenByte bitShift:8) |
|
3976 |
+ (self blueByte) |
|
3977 |
+ (self alphaByte bitShift:24) |
|
3978 |
! |
|
3979 |
||
2943
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3980 |
veryMuchLighter |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3981 |
"return a new color, which is very much lighter than the receiver. |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3982 |
Added for Squeak compatibility." |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3983 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3984 |
^ self mixed:0.1165 with:White |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3985 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3986 |
" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3987 |
(Color red) lighter |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3988 |
(Color red) muchLighter |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3989 |
(Color red) veryMuchLighter |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3990 |
" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3991 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
3992 |
"Modified: 11.6.1996 / 18:10:49 / cg" |
3396 | 3993 |
! |
3994 |
||
3995 |
wheel:thisMany |
|
3996 |
"An array of thisMany colors around the color wheel starting at self and ending all the way around the hue space just before self. Array is of length thisMany. Very useful for displaying color based on a variable in your program. " |
|
3997 |
||
3998 |
| sat bri hue step c | |
|
3999 |
||
4000 |
thisMany = 1 ifTrue: [^ Array with: self]. |
|
4001 |
sat := self saturation / 100. |
|
4002 |
bri := self brightness. |
|
4003 |
hue := self hue. |
|
4004 |
step := 360.0 / thisMany. |
|
4005 |
^ (1 to: thisMany) collect: [:num | |
|
7762 | 4006 |
c := self class h: hue s: sat v: bri. "hue is taken mod 360" |
4007 |
hue := hue + step. |
|
4008 |
c]. |
|
1347 | 4009 |
! ! |
4010 |
||
1023 | 4011 |
!Color methodsFor:'accessing'! |
4012 |
||
2942
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
4013 |
alpha |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
4014 |
"return the alpha value (0..1), |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
4015 |
where 0 is completely transparent and 1 is completely opaque" |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
4016 |
|
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
4017 |
^ 1. |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
4018 |
! |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
4019 |
|
3309 | 4020 |
alphaByte |
4021 |
"return the alpha byte-value (0..255), |
|
4022 |
where 0 is completely transparent and 255 is completely opaque" |
|
4023 |
||
4024 |
^ 255. |
|
4025 |
! |
|
4026 |
||
1023 | 4027 |
blue |
4028 |
"return the blue component in percent [0..100]" |
|
4029 |
||
4030 |
(blue isNil and:[colorId notNil]) ifTrue:[ |
|
6353 | 4031 |
device isNil ifTrue:[^ 0]. |
4032 |
device getRGBFrom:colorId into:[:r :g :b | ^ b]. |
|
1023 | 4033 |
]. |
4034 |
^ blue * 100.0 / MaxValue |
|
4035 |
! |
|
4036 |
||
4037 |
blueByte |
|
4038 |
"return the blue components value mapped to 0..255" |
|
4039 |
||
2183
3c2115660746
removed row[Red/Green/Blue]Byte;
Claus Gittinger <cg@exept.de>
parents:
2096
diff
changeset
|
4040 |
blue isNil ifTrue:[^ nil]. |
1023 | 4041 |
^ blue * 255 // MaxValue |
4042 |
||
4043 |
" |
|
6353 | 4044 |
Color red blueByte |
4045 |
Color blue blueByte |
|
4046 |
Color green blueByte |
|
4047 |
Color black blueByte |
|
4048 |
Color grey blueByte |
|
4049 |
Color white blueByte |
|
1023 | 4050 |
" |
4051 |
||
2183
3c2115660746
removed row[Red/Green/Blue]Byte;
Claus Gittinger <cg@exept.de>
parents:
2096
diff
changeset
|
4052 |
"Created: / 7.6.1996 / 18:30:25 / cg" |
3c2115660746
removed row[Red/Green/Blue]Byte;
Claus Gittinger <cg@exept.de>
parents:
2096
diff
changeset
|
4053 |
"Modified: / 26.7.1998 / 12:31:44 / cg" |
1023 | 4054 |
! |
4055 |
||
4056 |
colorId |
|
4057 |
"return the device-dependent color-id" |
|
4058 |
||
1238
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
4059 |
colorId notNil ifTrue:[^ colorId]. |
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
4060 |
replacementColor notNil ifTrue:[^ replacementColor colorId]. |
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
4061 |
^ nil |
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
4062 |
|
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
4063 |
"Modified: 17.1.1997 / 00:03:18 / cg" |
1023 | 4064 |
! |
4065 |
||
4066 |
cyan |
|
4067 |
"return the cyan component in percent [0..100] in cmy color space" |
|
4068 |
||
4069 |
^ 100 - self red |
|
4070 |
||
4071 |
"Modified: 11.6.1996 / 17:20:07 / cg" |
|
4072 |
"Created: 11.6.1996 / 18:30:00 / cg" |
|
4073 |
! |
|
4074 |
||
4075 |
device |
|
4076 |
"return the device I am associated to" |
|
4077 |
||
4078 |
^ device |
|
4079 |
||
4080 |
"Modified: 23.4.1996 / 13:36:42 / cg" |
|
4081 |
! |
|
4082 |
||
4083 |
deviceBlue |
|
4084 |
"return the actual value of the blue component in percent." |
|
4085 |
||
4086 |
|v| |
|
4087 |
||
4088 |
device getRGBFrom:colorId into:[:r :g :b | v := b]. |
|
4089 |
^ v |
|
4090 |
! |
|
4091 |
||
4092 |
deviceGreen |
|
4093 |
"return the actual value of the green component in percent. |
|
4094 |
(usually 16bit in X; but could be different on other systems)" |
|
4095 |
||
4096 |
|v| |
|
4097 |
||
4098 |
device getRGBFrom:colorId into:[:r :g :b | v := g]. |
|
4099 |
^ v |
|
4100 |
! |
|
4101 |
||
4102 |
deviceRed |
|
4103 |
"return the actual value of the red component in percent." |
|
4104 |
||
4105 |
|v| |
|
4106 |
||
4107 |
device getRGBFrom:colorId into:[:r :g :b | v := r]. |
|
4108 |
^ v |
|
4109 |
||
4110 |
" |
|
4111 |
(Color yellow on:Display) deviceRedValue |
|
4112 |
(Color yellow on:aPrinterPage) deviceRedValue |
|
4113 |
" |
|
4114 |
! |
|
4115 |
||
4116 |
ditherForm |
|
4117 |
"return the form to dither the color" |
|
4118 |
||
4119 |
^ ditherForm |
|
4120 |
! |
|
4121 |
||
4122 |
graphicsDevice |
|
4123 |
"same as #device, for ST-80 compatibility naming. |
|
4124 |
Return the device I am associated with." |
|
4125 |
||
4126 |
^ device |
|
4127 |
||
4128 |
"Created: 28.5.1996 / 18:39:27 / cg" |
|
4129 |
! |
|
4130 |
||
4131 |
green |
|
4132 |
"return the green component in percent [0..100]" |
|
4133 |
||
4134 |
(green isNil and:[colorId notNil]) ifTrue:[ |
|
6353 | 4135 |
device isNil ifTrue:[^ 0]. |
4136 |
device getRGBFrom:colorId into:[:r :g :b | ^ g]. |
|
1023 | 4137 |
]. |
4138 |
^ green * 100.0 / MaxValue |
|
4139 |
! |
|
4140 |
||
4141 |
greenByte |
|
4142 |
"return the green components value mapped to 0..255" |
|
4143 |
||
2183
3c2115660746
removed row[Red/Green/Blue]Byte;
Claus Gittinger <cg@exept.de>
parents:
2096
diff
changeset
|
4144 |
green isNil ifTrue:[^ nil]. |
1023 | 4145 |
^ green * 255 // MaxValue |
4146 |
||
4147 |
" |
|
6353 | 4148 |
Color red greenByte |
4149 |
Color blue greenByte |
|
4150 |
Color green greenByte |
|
4151 |
Color black greenByte |
|
4152 |
Color grey greenByte |
|
4153 |
Color white greenByte |
|
1023 | 4154 |
" |
4155 |
||
2183
3c2115660746
removed row[Red/Green/Blue]Byte;
Claus Gittinger <cg@exept.de>
parents:
2096
diff
changeset
|
4156 |
"Modified: / 26.7.1998 / 12:31:33 / cg" |
1023 | 4157 |
! |
4158 |
||
4159 |
hue |
|
6654 | 4160 |
"return the hue (in hue/light/saturation model) in degrees [0..360]. |
4161 |
The hue value is the position on the color wheel. |
|
4162 |
0 is red, 120 green, 240 blue" |
|
1023 | 4163 |
|
4164 |
|r g b h| |
|
4165 |
||
4166 |
(red isNil and:[colorId notNil]) ifTrue:[ |
|
6654 | 4167 |
device getRGBFrom:colorId into:[:xr :xg :xb | |
4168 |
r := xr. |
|
4169 |
g := xg. |
|
4170 |
b := xb. |
|
4171 |
] |
|
1023 | 4172 |
] ifFalse:[ |
6654 | 4173 |
r := self red. |
4174 |
g := self green. |
|
4175 |
b := self blue. |
|
1023 | 4176 |
]. |
4177 |
||
4178 |
self class withHLSFromRed:r green:g blue:b do:[:xh :xl :xs | |
|
6654 | 4179 |
h := xh |
1023 | 4180 |
]. |
4181 |
^ h |
|
4182 |
||
4183 |
" |
|
7411 | 4184 |
Color red hue |
1023 | 4185 |
Color yellow hue |
4186 |
" |
|
4187 |
||
6654 | 4188 |
" |
4189 |
color wheel: |
|
4190 |
||
4191 |
|v| |
|
4192 |
||
4193 |
v := View new extent:200@200. |
|
4194 |
v openAndWait. |
|
4195 |
0 to:360 do:[:hue | |
|
4196 |
100 downTo:0 do:[:sat | |
|
4197 |
|p| |
|
4198 |
v paint:(Color hue:hue light:50 saturation:sat). |
|
4199 |
p := Point r:sat degrees:hue. |
|
4200 |
v displayLineFrom:100@100 to:p+(100@100). |
|
4201 |
]. |
|
4202 |
]. |
|
4203 |
" |
|
4204 |
||
1023 | 4205 |
"Modified: 11.6.1996 / 17:14:51 / cg" |
4206 |
! |
|
4207 |
||
6353 | 4208 |
light |
1023 | 4209 |
"return the light (in hue/light/saturation model) in percent [0..100]. |
4210 |
This corresponds to the brightness of the color (if displayed on |
|
6170 | 4211 |
a b&w television screen). |
4212 |
Old; please use #brightness (which is 0..1) for compatibility with other smalltalks" |
|
1023 | 4213 |
|
4214 |
|r g b l| |
|
4215 |
||
4216 |
(red isNil and:[colorId notNil]) ifTrue:[ |
|
6353 | 4217 |
device getRGBFrom:colorId into:[:xr :xg :xb | |
4218 |
r := xr. |
|
4219 |
g := xg. |
|
4220 |
b := xb. |
|
4221 |
] |
|
1023 | 4222 |
] ifFalse:[ |
6353 | 4223 |
r := self red. |
4224 |
g := self green. |
|
4225 |
b := self blue. |
|
1023 | 4226 |
]. |
4227 |
||
4228 |
self class withHLSFromRed:r green:g blue:b do:[:xh :xl :xs | |
|
6353 | 4229 |
l := xl |
1023 | 4230 |
]. |
4231 |
^ l |
|
4232 |
||
4233 |
" |
|
6353 | 4234 |
Color yellow light |
4235 |
Color yellow darkened light |
|
1023 | 4236 |
" |
4237 |
||
4238 |
"Modified: 11.6.1996 / 17:15:24 / cg" |
|
4239 |
! |
|
4240 |
||
4241 |
magenta |
|
4242 |
"return the magenta component in percent [0..100] in cmy color space" |
|
4243 |
||
4244 |
^ 100 - self green |
|
4245 |
||
4246 |
"Modified: 11.6.1996 / 17:20:07 / cg" |
|
4247 |
"Created: 11.6.1996 / 18:30:11 / cg" |
|
4248 |
! |
|
4249 |
||
2945 | 4250 |
privateAlpha |
4251 |
"return the internal alpha value (0..255), |
|
4252 |
where 0 is completely transparent and 255 is completely opaque" |
|
4253 |
||
6353 | 4254 |
^ 255 |
2945 | 4255 |
|
4256 |
! |
|
4257 |
||
1023 | 4258 |
red |
4259 |
"return the red component in percent [0..100]" |
|
4260 |
||
4261 |
(red isNil and:[colorId notNil]) ifTrue:[ |
|
6353 | 4262 |
device isNil ifTrue:[^ 0]. |
4263 |
device getRGBFrom:colorId into:[:r :g :b | ^ r]. |
|
1023 | 4264 |
]. |
4265 |
red isNil ifTrue:[^ 0]. |
|
4266 |
^ red * 100.0 / MaxValue |
|
4267 |
||
4268 |
"Modified: 11.6.1996 / 17:20:07 / cg" |
|
4269 |
! |
|
4270 |
||
4271 |
red:r green:g blue:b |
|
4272 |
"set r/g/b components in percent. This method will change the color lookup |
|
4273 |
table in pseudocolor devices. |
|
6353 | 4274 |
This is only allowed for writable colors (i.e. those allocated with |
4275 |
Color>>variableColorOn: on pseudoColor displays). |
|
4276 |
Using this may make your code unportable, since it depends on a display |
|
1023 | 4277 |
using palettes (i.e. it will not work on greyScale or b&w displays)." |
4278 |
||
4279 |
^ self scaledRed:(r * MaxValue // 100) |
|
6353 | 4280 |
scaledGreen:(g * MaxValue // 100) |
4281 |
scaledBlue:(b * MaxValue // 100) |
|
1023 | 4282 |
|
4283 |
" |
|
4284 |
|c| |
|
4285 |
||
4286 |
c := Color variableColorOn:Display. |
|
4287 |
c inspect. |
|
4288 |
(Delay forSeconds:5) wait. |
|
4289 |
c red:100 green:0 blue:0. |
|
4290 |
(Delay forSeconds:5) wait. |
|
4291 |
c red:0 green:100 blue:0. |
|
4292 |
(Delay forSeconds:5) wait. |
|
4293 |
c red:0 green:0 blue:100. |
|
4294 |
" |
|
4295 |
! |
|
4296 |
||
4297 |
redByte |
|
2183
3c2115660746
removed row[Red/Green/Blue]Byte;
Claus Gittinger <cg@exept.de>
parents:
2096
diff
changeset
|
4298 |
"return the red components value mapped to 0..255; |
3c2115660746
removed row[Red/Green/Blue]Byte;
Claus Gittinger <cg@exept.de>
parents:
2096
diff
changeset
|
4299 |
nil if it has no red component." |
3c2115660746
removed row[Red/Green/Blue]Byte;
Claus Gittinger <cg@exept.de>
parents:
2096
diff
changeset
|
4300 |
|
3c2115660746
removed row[Red/Green/Blue]Byte;
Claus Gittinger <cg@exept.de>
parents:
2096
diff
changeset
|
4301 |
red isNil ifTrue:[^ nil]. |
1023 | 4302 |
^ red * 255 // MaxValue |
4303 |
||
4304 |
" |
|
6353 | 4305 |
Color red redByte |
4306 |
Color blue redByte |
|
4307 |
Color green redByte |
|
4308 |
Color black redByte |
|
4309 |
Color grey redByte |
|
4310 |
Color white redByte |
|
1023 | 4311 |
" |
4312 |
||
2183
3c2115660746
removed row[Red/Green/Blue]Byte;
Claus Gittinger <cg@exept.de>
parents:
2096
diff
changeset
|
4313 |
"Modified: / 26.7.1998 / 12:31:22 / cg" |
1023 | 4314 |
! |
4315 |
||
1929 | 4316 |
rgbValue |
4317 |
"return the rgb byteValues packed into a 24bit integer; |
|
4318 |
The returned value is composed of r<<16 + g<<8 + b." |
|
4319 |
||
4320 |
|t "{ Class: SmallInteger }" |
|
4321 |
v "{ Class: SmallInteger }"| |
|
4322 |
||
4323 |
v := red * 255 // MaxValue. |
|
4324 |
t := green * 255 // MaxValue. |
|
4325 |
v := (v bitShift:8) + t. |
|
4326 |
t := blue * 255 // MaxValue. |
|
4327 |
^ (v bitShift:8) + t. |
|
4328 |
||
4329 |
" |
|
6353 | 4330 |
Color red rgbValue hexPrintString |
4331 |
Color blue rgbValue hexPrintString |
|
4332 |
Color green rgbValue hexPrintString |
|
4333 |
Color black rgbValue hexPrintString |
|
4334 |
Color grey rgbValue hexPrintString |
|
4335 |
Color white rgbValue hexPrintString |
|
1929 | 4336 |
" |
4337 |
||
4338 |
"Modified: 17.10.1997 / 20:00:25 / cg" |
|
4339 |
! |
|
4340 |
||
6353 | 4341 |
saturation |
1023 | 4342 |
"return the saturation (in hue/light/saturation model) in percent [0..100]. |
4343 |
This corresponds to the saturation setting of a color TV" |
|
4344 |
||
4345 |
|r g b s| |
|
4346 |
||
4347 |
(red isNil and:[colorId notNil]) ifTrue:[ |
|
6353 | 4348 |
device getRGBFrom:colorId into:[:xr :xg :xb | |
4349 |
r := xr. |
|
4350 |
g := xg. |
|
4351 |
b := xb. |
|
4352 |
] |
|
1023 | 4353 |
] ifFalse:[ |
6353 | 4354 |
r := self red. |
4355 |
g := self green. |
|
4356 |
b := self blue. |
|
1023 | 4357 |
]. |
4358 |
||
4359 |
self class withHLSFromRed:r green:g blue:b do:[:xh :xl :xs | |
|
6353 | 4360 |
s := xs |
1023 | 4361 |
]. |
4362 |
^ s |
|
4363 |
||
4364 |
" |
|
4365 |
Color yellow saturation |
|
4366 |
" |
|
4367 |
||
4368 |
"Modified: 11.6.1996 / 17:15:47 / cg" |
|
4369 |
! |
|
4370 |
||
6353 | 4371 |
scaledAlpha |
4372 |
"ST-80 compatibility: |
|
4373 |
return the alpha components value mapped to 0..MaxValue" |
|
4374 |
||
4375 |
^ MaxValue |
|
4376 |
||
4377 |
" |
|
4378 |
Color blue scaledBlue |
|
4379 |
Color black scaledBlue |
|
4380 |
Color grey scaledBlue |
|
4381 |
" |
|
4382 |
||
4383 |
"Modified: 7.6.1996 / 18:32:30 / cg" |
|
4384 |
! |
|
4385 |
||
1023 | 4386 |
scaledBlue |
4387 |
"ST-80 compatibility: |
|
4388 |
return the blue components value mapped to 0..MaxValue" |
|
4389 |
||
4390 |
^ blue |
|
4391 |
||
4392 |
" |
|
6353 | 4393 |
Color blue scaledBlue |
4394 |
Color black scaledBlue |
|
4395 |
Color grey scaledBlue |
|
1023 | 4396 |
" |
4397 |
||
4398 |
"Modified: 7.6.1996 / 18:32:30 / cg" |
|
4399 |
! |
|
4400 |
||
4401 |
scaledGray |
|
4402 |
"return the grey intensity scaled to 0..MaxValue" |
|
4403 |
||
4404 |
^ ((red * 3) + (green * 6) + blue) // 10 |
|
4405 |
||
4406 |
" |
|
6353 | 4407 |
Color blue scaledGray |
4408 |
Color black scaledGray |
|
4409 |
Color white scaledGray |
|
4410 |
Color grey scaledGray |
|
1023 | 4411 |
" |
4412 |
||
4413 |
"Modified: 11.6.1996 / 14:43:51 / cg" |
|
4414 |
! |
|
4415 |
||
4416 |
scaledGreen |
|
4417 |
"ST-80 compatibility: |
|
4418 |
return the green components value mapped to 0..MaxValue" |
|
4419 |
||
4420 |
^ green |
|
4421 |
||
4422 |
" |
|
6353 | 4423 |
Color green scaledRed |
4424 |
Color black scaledRed |
|
4425 |
Color grey scaledRed |
|
1023 | 4426 |
" |
4427 |
||
4428 |
"Modified: 7.6.1996 / 18:32:38 / cg" |
|
4429 |
! |
|
4430 |
||
4431 |
scaledRed |
|
4432 |
"ST-80 compatibility: |
|
4433 |
return the red components value mapped to 0..MaxValue" |
|
4434 |
||
4435 |
^ red |
|
4436 |
||
4437 |
" |
|
6353 | 4438 |
Color red scaledRed |
4439 |
Color black scaledRed |
|
4440 |
Color grey scaledRed |
|
1023 | 4441 |
" |
4442 |
||
4443 |
"Modified: 7.6.1996 / 18:32:43 / cg" |
|
4444 |
! |
|
4445 |
||
4446 |
scaledRed:r scaledGreen:g scaledBlue:b |
|
4447 |
"set r/g/b components in 0..MaxValue. |
|
4448 |
This method will change the color lookup table in pseudocolor devices. |
|
6353 | 4449 |
This is only allowed for writable colors (i.e. those allocated with |
1023 | 4450 |
Color>>variableColorOn: on pseudoColor displays). |
6353 | 4451 |
Using this may make your code unportable, since it depends on a display |
1023 | 4452 |
using palettes (i.e. it will not work on greyScale or b&w displays)." |
4453 |
||
4454 |
(colorId isNil or:[red notNil]) ifTrue:[ |
|
6353 | 4455 |
^ self error:'operation is not allowed for shared colors' |
1023 | 4456 |
]. |
4457 |
device setColor:colorId scaledRed:r scaledGreen:g scaledBlue:b |
|
4458 |
! |
|
4459 |
||
4460 |
writable |
|
4461 |
"return true, if this is a writable colorcell" |
|
4462 |
||
4463 |
^ writable == true |
|
4464 |
! |
|
4465 |
||
4466 |
yellow |
|
4467 |
"return the yellow component in percent [0..100] in cmy color space" |
|
4468 |
||
4469 |
^ 100 - self blue |
|
4470 |
||
4471 |
"Modified: 11.6.1996 / 17:20:07 / cg" |
|
4472 |
"Created: 11.6.1996 / 18:30:20 / cg" |
|
4473 |
! ! |
|
4474 |
||
5131
95d91d6d649c
care for invalid hue/light/saturation
Claus Gittinger <cg@exept.de>
parents:
5127
diff
changeset
|
4475 |
|
1023 | 4476 |
!Color methodsFor:'comparing'! |
4477 |
||
4478 |
= aColor |
|
4479 |
"two colors are considered equal, if the color components are; |
|
4480 |
independent of the device, the color is on" |
|
4481 |
||
2083 | 4482 |
aColor == self ifTrue:[^ true]. |
1023 | 4483 |
aColor isColor ifTrue:[ |
6353 | 4484 |
(red == aColor scaledRed) ifTrue:[ |
4485 |
(green == aColor scaledGreen) ifTrue:[ |
|
4486 |
(blue == aColor scaledBlue) ifTrue:[ |
|
4487 |
^ true |
|
4488 |
] |
|
4489 |
] |
|
4490 |
] |
|
1023 | 4491 |
]. |
4492 |
^ false |
|
2083 | 4493 |
|
4494 |
"Modified: / 2.4.1998 / 10:04:39 / cg" |
|
1023 | 4495 |
! |
4496 |
||
1390 | 4497 |
almostSameAs:aColor |
4498 |
"return true, if aColor looks almost the same as the receiver |
|
4499 |
(i.e. the components differ by a small, invisible amount). |
|
4500 |
We assume, that the human eye can distinguish roughly 100 grey levels |
|
4501 |
(which is optimistic ;-); |
|
4502 |
therefore, allow a 1 percent difference in each component for the colors |
|
4503 |
to compare as looking the same." |
|
4504 |
||
4505 |
(self red - aColor red) abs > 1 ifTrue:[^ false]. |
|
4506 |
(self green - aColor green) abs > 1 ifTrue:[^ false]. |
|
4507 |
(self blue - aColor blue) abs > 1 ifTrue:[^ false]. |
|
4508 |
^ true |
|
4509 |
||
4510 |
" |
|
4511 |
(Color red:10 green:10 blue:10) almostSameAs:(Color red:11 green:11 blue:11) |
|
4512 |
" |
|
4513 |
||
4514 |
"Modified: 28.2.1997 / 12:00:01 / cg" |
|
4515 |
! |
|
4516 |
||
1023 | 4517 |
hash |
4518 |
"return an integer useful as hash key for the receiver. |
|
4519 |
Redefined since = is redefined" |
|
4520 |
||
2318
36d73b850969
fixed hash for colorId colors.
Claus Gittinger <cg@exept.de>
parents:
2313
diff
changeset
|
4521 |
red isNil ifTrue:[ |
6353 | 4522 |
^ colorId |
2318
36d73b850969
fixed hash for colorId colors.
Claus Gittinger <cg@exept.de>
parents:
2313
diff
changeset
|
4523 |
]. |
1023 | 4524 |
^ red + green + blue |
4525 |
! ! |
|
4526 |
||
4527 |
!Color methodsFor:'converting'! |
|
4528 |
||
6830 | 4529 |
asByteArray |
4530 |
^ByteArray |
|
4531 |
with: self redByte |
|
7411 | 4532 |
with: self greenByte |
4533 |
with: self blueByte |
|
6830 | 4534 |
! |
4535 |
||
1023 | 4536 |
fromLiteralArrayEncoding:encoding |
4537 |
"read my values from an encoding. |
|
6353 | 4538 |
The encoding is supposed to be either of the form: |
6552 | 4539 |
(#Color redPart greenPart bluePart) |
2778
3ef64f104266
allow 'Color colorName' in literalEncoding.
Claus Gittinger <cg@exept.de>
parents:
2455
diff
changeset
|
4540 |
or: |
6552 | 4541 |
(#Color constantColorSymbol) |
1023 | 4542 |
This is the reverse operation to #literalArrayEncoding." |
4543 |
||
6552 | 4544 |
|clr nameOrRGB| |
2778
3ef64f104266
allow 'Color colorName' in literalEncoding.
Claus Gittinger <cg@exept.de>
parents:
2455
diff
changeset
|
4545 |
|
3ef64f104266
allow 'Color colorName' in literalEncoding.
Claus Gittinger <cg@exept.de>
parents:
2455
diff
changeset
|
4546 |
encoding size == 2 ifTrue:[ |
6552 | 4547 |
nameOrRGB := encoding at:2. |
7411 | 4548 |
nameOrRGB isSymbol ifTrue:[ |
7762 | 4549 |
clr := self class perform:nameOrRGB |
7411 | 4550 |
] ifFalse:[ |
7762 | 4551 |
clr := self class rgbValue:nameOrRGB. |
6552 | 4552 |
]. |
4553 |
red := clr scaledRed. |
|
4554 |
green := clr scaledGreen. |
|
4555 |
blue := clr scaledBlue |
|
2778
3ef64f104266
allow 'Color colorName' in literalEncoding.
Claus Gittinger <cg@exept.de>
parents:
2455
diff
changeset
|
4556 |
] ifFalse:[ |
6554 | 4557 |
red := ((encoding at:2) / 100.0 * MaxValue) rounded asInteger. |
4558 |
green := ((encoding at:3) / 100.0 * MaxValue) rounded asInteger. |
|
4559 |
blue := ((encoding at:4) / 100.0 * MaxValue) rounded asInteger. |
|
2778
3ef64f104266
allow 'Color colorName' in literalEncoding.
Claus Gittinger <cg@exept.de>
parents:
2455
diff
changeset
|
4560 |
]. |
1023 | 4561 |
|
4562 |
" |
|
7411 | 4563 |
Color new fromLiteralArrayEncoding:#(#Color 50 25 25) |
4564 |
Color new fromLiteralArrayEncoding:#(#Color 16rFF00FF) |
|
4565 |
Color new fromLiteralArrayEncoding:#(#Color blue) |
|
1023 | 4566 |
" |
4567 |
! |
|
4568 |
||
4569 |
literalArrayEncoding |
|
4570 |
"encode myself as an array, from which a copy of the receiver |
|
4571 |
can be reconstructed with #decodeAsLiteralArray. |
|
6353 | 4572 |
The encoding is: |
6552 | 4573 |
(#Color redPart greenPart bluePart) |
1023 | 4574 |
" |
4575 |
||
4576 |
^ Array |
|
6552 | 4577 |
with:self class name |
7411 | 4578 |
with:((red * 100.0 / MaxValue) roundTo:0.25) |
4579 |
with:((green * 100.0 / MaxValue) roundTo:0.25) |
|
4580 |
with:((blue * 100.0 / MaxValue) roundTo:0.25) |
|
1023 | 4581 |
|
4582 |
" |
|
4583 |
Color new fromLiteralArrayEncoding:#(#Color 50 25 25) |
|
6353 | 4584 |
(Color red:25 green:30 blue:70) literalArrayEncoding |
1023 | 4585 |
" |
4586 |
||
4587 |
"Modified: 22.4.1996 / 13:00:11 / cg" |
|
4588 |
! ! |
|
4589 |
||
4590 |
!Color methodsFor:'copying'! |
|
4591 |
||
4592 |
postCopy |
|
4593 |
"redefined to clear out any device handles in the copy" |
|
4594 |
||
1238
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
4595 |
device := colorId := ditherForm := replacementColor := nil |
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
4596 |
|
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
4597 |
"Modified: 17.1.1997 / 00:03:42 / cg" |
2910
97a836c7e15c
deepCopy fix (do not copy device dependent stuff)
Claus Gittinger <cg@exept.de>
parents:
2889
diff
changeset
|
4598 |
! |
97a836c7e15c
deepCopy fix (do not copy device dependent stuff)
Claus Gittinger <cg@exept.de>
parents:
2889
diff
changeset
|
4599 |
|
97a836c7e15c
deepCopy fix (do not copy device dependent stuff)
Claus Gittinger <cg@exept.de>
parents:
2889
diff
changeset
|
4600 |
skipInstvarIndexInDeepCopy:index |
97a836c7e15c
deepCopy fix (do not copy device dependent stuff)
Claus Gittinger <cg@exept.de>
parents:
2889
diff
changeset
|
4601 |
index == 4 ifTrue:[ |
6353 | 4602 |
^ true "/ skip device |
2910
97a836c7e15c
deepCopy fix (do not copy device dependent stuff)
Claus Gittinger <cg@exept.de>
parents:
2889
diff
changeset
|
4603 |
]. |
97a836c7e15c
deepCopy fix (do not copy device dependent stuff)
Claus Gittinger <cg@exept.de>
parents:
2889
diff
changeset
|
4604 |
index == 5 ifTrue:[ |
6353 | 4605 |
^ true "/ skip colorId |
2910
97a836c7e15c
deepCopy fix (do not copy device dependent stuff)
Claus Gittinger <cg@exept.de>
parents:
2889
diff
changeset
|
4606 |
]. |
97a836c7e15c
deepCopy fix (do not copy device dependent stuff)
Claus Gittinger <cg@exept.de>
parents:
2889
diff
changeset
|
4607 |
index == 6 ifTrue:[ |
6353 | 4608 |
^ true "/ skip ditherForm |
2910
97a836c7e15c
deepCopy fix (do not copy device dependent stuff)
Claus Gittinger <cg@exept.de>
parents:
2889
diff
changeset
|
4609 |
]. |
97a836c7e15c
deepCopy fix (do not copy device dependent stuff)
Claus Gittinger <cg@exept.de>
parents:
2889
diff
changeset
|
4610 |
index == 7 ifTrue:[ |
6353 | 4611 |
^ true "/ skip replacementColor |
2910
97a836c7e15c
deepCopy fix (do not copy device dependent stuff)
Claus Gittinger <cg@exept.de>
parents:
2889
diff
changeset
|
4612 |
]. |
97a836c7e15c
deepCopy fix (do not copy device dependent stuff)
Claus Gittinger <cg@exept.de>
parents:
2889
diff
changeset
|
4613 |
^ false |
97a836c7e15c
deepCopy fix (do not copy device dependent stuff)
Claus Gittinger <cg@exept.de>
parents:
2889
diff
changeset
|
4614 |
|
97a836c7e15c
deepCopy fix (do not copy device dependent stuff)
Claus Gittinger <cg@exept.de>
parents:
2889
diff
changeset
|
4615 |
" |
97a836c7e15c
deepCopy fix (do not copy device dependent stuff)
Claus Gittinger <cg@exept.de>
parents:
2889
diff
changeset
|
4616 |
(Color black onDevice:Screen current) deepCopy |
97a836c7e15c
deepCopy fix (do not copy device dependent stuff)
Claus Gittinger <cg@exept.de>
parents:
2889
diff
changeset
|
4617 |
" |
1023 | 4618 |
! ! |
4619 |
||
4620 |
!Color methodsFor:'getting a device color'! |
|
4621 |
||
4622 |
exactOn:aDevice |
|
4623 |
"create a new Color representing the same color as |
|
4624 |
myself on aDevice; if one already exists, return the one. |
|
4625 |
Do not dither or otherwise approximate the color, but return |
|
6353 | 4626 |
nil, if the exact color is not available. |
7403 | 4627 |
Used to acquire primary colors for dithering, during startup." |
1023 | 4628 |
|
4629 |
|newColor id r g b| |
|
4630 |
||
4631 |
"if Iam already assigned to that device ..." |
|
4632 |
(device == aDevice and:[ditherForm isNil]) ifTrue:[^ self]. |
|
4633 |
||
4634 |
r := red. |
|
4635 |
g := green. |
|
4636 |
b := blue. |
|
4637 |
||
1239
f4bd3bc9f3f9
oops - dont round when searching for existing colors
Claus Gittinger <cg@exept.de>
parents:
1238
diff
changeset
|
4638 |
"first look if not already there" |
7762 | 4639 |
newColor := self class existingColorScaledRed:r scaledGreen:g scaledBlue:b on:aDevice. |
1239
f4bd3bc9f3f9
oops - dont round when searching for existing colors
Claus Gittinger <cg@exept.de>
parents:
1238
diff
changeset
|
4640 |
(newColor notNil and:[newColor ditherForm isNil]) ifTrue:[^ newColor]. |
f4bd3bc9f3f9
oops - dont round when searching for existing colors
Claus Gittinger <cg@exept.de>
parents:
1238
diff
changeset
|
4641 |
|
1023 | 4642 |
r := (r bitAnd:16rFF00) bitOr:(r bitShift:-8). |
4643 |
g := (g bitAnd:16rFF00) bitOr:(g bitShift:-8). |
|
4644 |
b := (b bitAnd:16rFF00) bitOr:(b bitShift:-8). |
|
4645 |
||
4646 |
"ask that device for the color" |
|
4647 |
id := aDevice colorScaledRed:r scaledGreen:g scaledBlue:b. |
|
4648 |
id isNil ifTrue:[ |
|
7403 | 4649 |
"/ this is a kludge: scavenge to free unused colors |
4650 |
"/ and try again ... |
|
4651 |
ObjectMemory scavenge; finalize. |
|
4652 |
id := aDevice colorScaledRed:r scaledGreen:g scaledBlue:b |
|
1023 | 4653 |
]. |
4654 |
id isNil ifTrue:[ |
|
7403 | 4655 |
"no such color - fail" |
1023 | 4656 |
|
4657 |
"/ 'COLOR: no color for ' infoPrint. self displayString infoPrintCR. |
|
7403 | 4658 |
^ nil |
1023 | 4659 |
]. |
4660 |
||
4661 |
"receiver was not associated - do it now" |
|
4662 |
device isNil ifTrue:[ |
|
7403 | 4663 |
device := aDevice. |
4664 |
colorId := id. |
|
4665 |
||
4666 |
aDevice visualType ~~ #TrueColor ifTrue:[ |
|
4667 |
"/ Lobby register:self. |
|
4668 |
aDevice registerColor:self. |
|
4669 |
]. |
|
4670 |
^ self |
|
1023 | 4671 |
]. |
4672 |
||
4673 |
"receiver was already associated to another device - need a new color" |
|
4674 |
newColor := (self class basicNew) setScaledRed:r scaledGreen:g scaledBlue:b device:aDevice. |
|
1238
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
4675 |
newColor setColorId:id. |
1023 | 4676 |
aDevice visualType ~~ #TrueColor ifTrue:[ |
7403 | 4677 |
"/ Lobby register:newColor. |
4678 |
aDevice registerColor:newColor. |
|
1023 | 4679 |
]. |
4680 |
^ newColor |
|
4681 |
||
1365
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
4682 |
"Modified: 24.2.1997 / 18:23:20 / cg" |
1023 | 4683 |
! |
4684 |
||
1856 | 4685 |
exactOrNearestOn:aDevice |
4686 |
"get a device color for the receiver, which is either exact |
|
4687 |
or the nearest, but never dithered. |
|
4688 |
This can be used for viewBackgrounds, where the exact greyLevel |
|
4689 |
does not matter, but a dithered color is not wanted." |
|
4690 |
||
4691 |
|deviceColor| |
|
4692 |
||
4693 |
deviceColor := self exactOn:aDevice. |
|
4694 |
deviceColor isNil ifTrue:[ |
|
6353 | 4695 |
deviceColor := self nearestOn:aDevice |
1856 | 4696 |
]. |
4697 |
^ deviceColor |
|
4698 |
||
4699 |
"Created: 13.8.1997 / 15:25:48 / cg" |
|
4700 |
! |
|
4701 |
||
6353 | 4702 |
nearestIn:aColorMap |
2198
122ff0da86d6
added support to find the nearest color in a colorMap.
Claus Gittinger <cg@exept.de>
parents:
2183
diff
changeset
|
4703 |
"return the nearest color in a colorMap" |
122ff0da86d6
added support to find the nearest color in a colorMap.
Claus Gittinger <cg@exept.de>
parents:
2183
diff
changeset
|
4704 |
|
122ff0da86d6
added support to find the nearest color in a colorMap.
Claus Gittinger <cg@exept.de>
parents:
2183
diff
changeset
|
4705 |
^ self class |
6353 | 4706 |
nearestColorScaledRed:(self scaledRed) |
4707 |
scaledGreen:(self scaledGreen) |
|
4708 |
scaledBlue:(self scaledBlue) |
|
4709 |
on:nil |
|
4710 |
in:aColorMap |
|
2198
122ff0da86d6
added support to find the nearest color in a colorMap.
Claus Gittinger <cg@exept.de>
parents:
2183
diff
changeset
|
4711 |
|
122ff0da86d6
added support to find the nearest color in a colorMap.
Claus Gittinger <cg@exept.de>
parents:
2183
diff
changeset
|
4712 |
"Created: / 28.7.1998 / 20:42:11 / cg" |
122ff0da86d6
added support to find the nearest color in a colorMap.
Claus Gittinger <cg@exept.de>
parents:
2183
diff
changeset
|
4713 |
! |
122ff0da86d6
added support to find the nearest color in a colorMap.
Claus Gittinger <cg@exept.de>
parents:
2183
diff
changeset
|
4714 |
|
6353 | 4715 |
nearestOn:aDevice |
4716 |
"create a new Color representing the same color as myself on aDevice; |
|
1023 | 4717 |
if one already exists, return the one. If no exact match is found, |
4718 |
search for the nearest match" |
|
4719 |
||
4720 |
|newColor id| |
|
4721 |
||
4722 |
"if I'am already assigned to that device ..." |
|
4723 |
(device == aDevice) ifTrue:[^ self]. |
|
4724 |
||
4725 |
"first look if not already there" |
|
7762 | 4726 |
newColor := self class nearestColorScaledRed:red scaledGreen:green scaledBlue:blue on:aDevice. |
1023 | 4727 |
newColor notNil ifTrue:[^ newColor]. |
4728 |
||
4729 |
"ask that device for the color" |
|
4730 |
id := aDevice colorScaledRed:red scaledGreen:green scaledBlue:blue. |
|
4731 |
id isNil ifTrue:[ |
|
7762 | 4732 |
"this is a kludge: |
4733 |
scavenge to possuby free unused colors and try again ... |
|
4734 |
this is a compromise: actually a full GC is required here, |
|
4735 |
but that is too expensive. |
|
4736 |
" |
|
4737 |
ObjectMemory scavenge; finalize. |
|
4738 |
id := aDevice colorScaledRed:red scaledGreen:green scaledBlue:blue |
|
1023 | 4739 |
]. |
4740 |
id isNil ifTrue:[ |
|
7762 | 4741 |
"no color - fail" |
4742 |
||
4743 |
^ nil |
|
1023 | 4744 |
]. |
4745 |
||
4746 |
"receiver was not associated - do it now" |
|
4747 |
device isNil ifTrue:[ |
|
7762 | 4748 |
device := aDevice. |
4749 |
colorId := id. |
|
4750 |
||
4751 |
aDevice visualType ~~ #TrueColor ifTrue:[ |
|
4752 |
"/ Lobby register:self. |
|
4753 |
aDevice registerColor:self. |
|
4754 |
]. |
|
4755 |
^ self |
|
1023 | 4756 |
]. |
4757 |
||
4758 |
"receiver was already associated to another device - need a new color" |
|
7762 | 4759 |
newColor := self class basicNew setScaledRed:red scaledGreen:green scaledBlue:blue device:aDevice. |
1238
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
4760 |
newColor setColorId:id. |
1023 | 4761 |
aDevice visualType ~~ #TrueColor ifTrue:[ |
7762 | 4762 |
"/ Lobby register:newColor. |
4763 |
aDevice registerColor:newColor. |
|
1023 | 4764 |
]. |
4765 |
^ newColor |
|
4766 |
||
1365
37a9e7ac4dbc
moved color registration from Color class to per-device lobby
Claus Gittinger <cg@exept.de>
parents:
1348
diff
changeset
|
4767 |
"Modified: 24.2.1997 / 18:23:26 / cg" |
1023 | 4768 |
! |
4769 |
||
4770 |
on:aDevice |
|
4771 |
"create a new Color representing the same color as |
|
4772 |
myself on aDevice; if one already exists, return the one" |
|
4773 |
||
3623 | 4774 |
"/ send out a warning: #on: is typically used to create views |
4775 |
"/ operating on a model. |
|
4776 |
"/ Please use #onDevice: to avoid confusion. |
|
4777 |
||
4778 |
<resource:#obsolete> |
|
4779 |
||
4780 |
self obsoleteMethodWarning:'use #onDevice:'. |
|
2836 | 4781 |
^ self onDevice:aDevice |
4782 |
||
4783 |
"Created: / 16.11.1995 / 20:16:42 / cg" |
|
4784 |
"Modified: / 8.9.1998 / 17:32:10 / cg" |
|
4785 |
! |
|
4786 |
||
4787 |
onDevice:aDevice |
|
4788 |
"create a new Color representing the same color as |
|
4789 |
myself on aDevice; if one already exists, return the one" |
|
4790 |
||
6353 | 4791 |
|newColor id form |
1023 | 4792 |
greyV "{ Class: SmallInteger }" |
4793 |
rV "{ Class: SmallInteger }" |
|
6353 | 4794 |
gV "{ Class: SmallInteger }" |
1023 | 4795 |
bV "{ Class: SmallInteger }" |
2375
265a5137e286
oops - possible color reuse between devices fixed
Claus Gittinger <cg@exept.de>
parents:
2318
diff
changeset
|
4796 |
deviceVisual deviceFixColors deviceDepth| |
1023 | 4797 |
|
6353 | 4798 |
"/ the most common cases (already allocated) first |
1233 | 4799 |
|
4800 |
colorId notNil ifTrue:[ |
|
7291 | 4801 |
"/ is someone validating me before drawing on aDevice ? |
4802 |
(aDevice notNil and:[aDevice == device]) ifTrue:[ |
|
4803 |
^ self |
|
4804 |
]. |
|
4805 |
||
4806 |
"/ a special case for pseudo-colors (0 and 1 in bitmaps) |
|
4807 |
"/ those have nil r/g/b values, but a nonNil colorId |
|
4808 |
||
4809 |
red isNil ifTrue:[^ self]. |
|
4810 |
||
4811 |
"/ want to release color ? |
|
4812 |
||
4813 |
(aDevice isNil and:[device notNil]) ifTrue:[ |
|
4814 |
"/ trueColor device-colors are not registered |
|
4815 |
device visualType ~~ #TrueColor ifTrue:[ |
|
4816 |
device unregisterColor:newColor. |
|
4817 |
device freeColor:colorId |
|
4818 |
]. |
|
4819 |
device := nil. |
|
4820 |
colorId := nil. |
|
4821 |
^ self |
|
4822 |
]. |
|
1205 | 4823 |
]. |
2313 | 4824 |
aDevice isNil ifTrue:[ |
7291 | 4825 |
^ self |
2313 | 4826 |
]. |
1205 | 4827 |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
4828 |
device == aDevice ifTrue:[ |
7291 | 4829 |
ditherForm notNil ifTrue:[ |
4830 |
^ self |
|
4831 |
] |
|
1707
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
4832 |
]. |
c4ba0f13330c
made all dither stuff class protocol
Claus Gittinger <cg@exept.de>
parents:
1621
diff
changeset
|
4833 |
|
7650 | 4834 |
"/ on high-resolution true-color systems, don't care for dithering and |
1023 | 4835 |
"/ especially freeing colors |
2842 | 4836 |
"/ (no need to register) |
1023 | 4837 |
|
2375
265a5137e286
oops - possible color reuse between devices fixed
Claus Gittinger <cg@exept.de>
parents:
2318
diff
changeset
|
4838 |
deviceDepth := aDevice depth. |
1023 | 4839 |
(deviceVisual := aDevice visualType) == #TrueColor ifTrue:[ |
7291 | 4840 |
deviceDepth >= 15 ifTrue:[ |
4841 |
id := aDevice colorScaledRed:red scaledGreen:green scaledBlue:blue. |
|
4842 |
id notNil ifTrue:[ |
|
4843 |
device isNil ifTrue:[ |
|
4844 |
"/ receiver was not associated - do it now & return mySelf |
|
4845 |
colorId := id. |
|
4846 |
ditherForm := nil. |
|
4847 |
device := aDevice. |
|
4848 |
^ self |
|
4849 |
]. |
|
7762 | 4850 |
newColor := self class basicNew |
7291 | 4851 |
setScaledRed:red |
4852 |
scaledGreen:green |
|
4853 |
scaledBlue:blue |
|
4854 |
device:aDevice. |
|
4855 |
newColor setColorId:id. |
|
4856 |
^ newColor |
|
4857 |
] |
|
4858 |
] |
|
1023 | 4859 |
]. |
4860 |
||
1239
f4bd3bc9f3f9
oops - dont round when searching for existing colors
Claus Gittinger <cg@exept.de>
parents:
1238
diff
changeset
|
4861 |
rV := red. |
f4bd3bc9f3f9
oops - dont round when searching for existing colors
Claus Gittinger <cg@exept.de>
parents:
1238
diff
changeset
|
4862 |
gV := green. |
f4bd3bc9f3f9
oops - dont round when searching for existing colors
Claus Gittinger <cg@exept.de>
parents:
1238
diff
changeset
|
4863 |
bV := blue. |
f4bd3bc9f3f9
oops - dont round when searching for existing colors
Claus Gittinger <cg@exept.de>
parents:
1238
diff
changeset
|
4864 |
|
7782 | 4865 |
"/ "/ round a bit within 1% in red & green, 2% in blue |
1239
f4bd3bc9f3f9
oops - dont round when searching for existing colors
Claus Gittinger <cg@exept.de>
parents:
1238
diff
changeset
|
4866 |
"/ rV := (red / 100.0) rounded * 100. |
f4bd3bc9f3f9
oops - dont round when searching for existing colors
Claus Gittinger <cg@exept.de>
parents:
1238
diff
changeset
|
4867 |
"/ gV := (green / 100.0) rounded * 100. |
f4bd3bc9f3f9
oops - dont round when searching for existing colors
Claus Gittinger <cg@exept.de>
parents:
1238
diff
changeset
|
4868 |
"/ bV := (blue / 50.0) rounded * 50. |
7782 | 4869 |
"/ |
4870 |
"/ "/ if I am already assigned to that device ... |
|
4871 |
"/ |
|
1368 | 4872 |
"/ ((device == aDevice) and:[ditherForm notNil]) ifTrue:[ |
4873 |
"/ |
|
4874 |
"/ "/ mhmh - if I was dithered the last time (not enough colors then) |
|
4875 |
"/ "/ try again - maybe some colors were reclaimed in the meanwhile |
|
4876 |
"/ |
|
4877 |
"/ deviceFixColors := aDevice fixColors. |
|
4878 |
"/ |
|
4879 |
"/ (deviceFixColors isNil |
|
4880 |
"/ and:[RetryAllocation]) ifTrue:[ |
|
4881 |
"/ " |
|
4882 |
"/ but there is no chance on b&w displays - so don't try |
|
4883 |
"/ " |
|
4884 |
"/ aDevice depth > 2 ifTrue:[ |
|
4885 |
"/ id := aDevice colorScaledRed:rV scaledGreen:gV scaledBlue:bV. |
|
4886 |
"/ id notNil ifTrue:[ |
|
4887 |
"/ colorId := id. |
|
4888 |
"/ ditherForm := nil. |
|
4889 |
"/ device registerColor:self. |
|
4890 |
"/ ] |
|
4891 |
"/ ] |
|
4892 |
"/ ]. |
|
4893 |
"/ ^ self |
|
4894 |
"/ ]. |
|
1023 | 4895 |
|
7762 | 4896 |
newColor := self class existingColorScaledRed:rV scaledGreen:gV scaledBlue:bV on:aDevice. |
2973 | 4897 |
newColor notNil ifTrue:[ |
7291 | 4898 |
(newColor scaledRed ~~ red |
4899 |
or:[newColor scaledGreen ~~ green |
|
4900 |
or:[newColor scaledBlue ~~ blue]]) ifTrue:[ |
|
4901 |
Transcript showCR:'Color>>#onDevice: got different color'. |
|
4902 |
]. |
|
4903 |
^ newColor |
|
2973 | 4904 |
]. |
4905 |
||
4906 |
"/ ask that device for the exact color |
|
4907 |
id := aDevice colorScaledRed:red scaledGreen:green scaledBlue:blue. |
|
4908 |
id notNil ifTrue:[ |
|
7291 | 4909 |
device isNil ifTrue:[ |
4910 |
"/ receiver was not associated - do it now & return mySelf |
|
4911 |
colorId := id. |
|
4912 |
ditherForm := nil. |
|
4913 |
device := aDevice. |
|
4914 |
newColor := self. |
|
4915 |
] ifFalse:[ |
|
7762 | 4916 |
newColor := self class basicNew |
7291 | 4917 |
setScaledRed:red |
4918 |
scaledGreen:green |
|
4919 |
scaledBlue:blue |
|
4920 |
device:aDevice. |
|
4921 |
newColor setColorId:id. |
|
4922 |
]. |
|
4923 |
id notNil ifTrue:[ |
|
4924 |
deviceVisual ~~ #TrueColor ifTrue:[ |
|
4925 |
aDevice registerColor:newColor. |
|
4926 |
] |
|
4927 |
]. |
|
4928 |
^ newColor |
|
6353 | 4929 |
]. |
1023 | 4930 |
|
4931 |
"/ |
|
2973 | 4932 |
"/ ok, we are either going to dither that color, or look for |
4933 |
"/ the nearest. |
|
1023 | 4934 |
"/ if its 'almost' grey, make it grey and round it a bit (1%) |
4935 |
"/ |
|
4936 |
greyV := (3 * red) + (6 * green) + (1 * blue). |
|
1621 | 4937 |
greyV := (greyV / 1000.0) rounded * 100. |
1023 | 4938 |
|
4939 |
"/ allow an error of 1% in red & green, 2% in blue |
|
4940 |
||
4941 |
((rV - greyV) abs <= 655 "/ MaxValue // 100 |
|
4942 |
and:[(gV - greyV) abs <= 655 "/ MaxValue // 100 |
|
4943 |
and:[(bV - greyV) abs <= 1310]]) ifTrue:[ "/ MaxValue // 100 * 2 |
|
7291 | 4944 |
rV := gV := bV := greyV. |
1023 | 4945 |
] ifFalse:[ |
7291 | 4946 |
rV := red. gV := green. bV := blue. |
1023 | 4947 |
]. |
4948 |
||
4949 |
aDevice hasColors ifTrue:[ |
|
7291 | 4950 |
deviceFixColors := aDevice fixColors. |
4951 |
deviceFixColors isNil ifTrue:[ |
|
4952 |
"/ ask that device for the exact color |
|
4953 |
id := aDevice colorScaledRed:rV scaledGreen:gV scaledBlue:bV. |
|
4954 |
id isNil ifTrue:[ |
|
4955 |
aDevice isOpen ifFalse:[ |
|
4956 |
^ nil |
|
4957 |
]. |
|
4958 |
||
4959 |
"/ this is a kludge: scavenge to free unused colors |
|
4960 |
"/ and try again ... |
|
4961 |
ObjectMemory scavenge; finalize. |
|
4962 |
id := aDevice colorScaledRed:rV scaledGreen:gV scaledBlue:bV |
|
4963 |
]. |
|
4964 |
||
4965 |
id isNil ifTrue:[ |
|
4966 |
"/ no such color - try color dithers |
|
4967 |
||
4968 |
self class |
|
4969 |
ditherRed:rV green:gV blue:bV |
|
4970 |
on:aDevice |
|
4971 |
into:[:c :f | newColor := c. form := f]. |
|
4972 |
newColor notNil ifTrue:[^ newColor]. |
|
4973 |
]. |
|
4974 |
]. |
|
4975 |
||
4976 |
"/ none found ? -> do a hard dither using fixColors |
|
4977 |
||
4978 |
(id isNil and:[form isNil]) ifTrue:[ |
|
4979 |
deviceFixColors notNil ifTrue:[ |
|
4980 |
self class |
|
4981 |
fixDitherRed:rV green:gV blue:bV |
|
4982 |
on:aDevice |
|
4983 |
into:[:c :f | newColor := c. form := f]. |
|
4984 |
newColor notNil ifTrue:[^ newColor]. |
|
4985 |
] |
|
4986 |
]. |
|
4987 |
||
4988 |
"/ still none found ? -> do a very hard dither using existing colors |
|
4989 |
||
4990 |
(id isNil and:[form isNil]) ifTrue:[ |
|
4991 |
self class |
|
4992 |
complexDitherRed:rV green:gV blue:bV |
|
4993 |
on:aDevice |
|
4994 |
into:[:c :f | newColor := c. form := f]. |
|
4995 |
newColor notNil ifTrue:[^ newColor]. |
|
4996 |
]. |
|
1023 | 4997 |
]. |
4998 |
||
4999 |
(id isNil and:[form isNil]) ifTrue:[ |
|
7291 | 5000 |
"still no result - try graying" |
5001 |
||
5002 |
greyV == 0 ifTrue:[ |
|
5003 |
id := aDevice blackpixel |
|
5004 |
] ifFalse:[ |
|
5005 |
greyV == MaxValue ifTrue:[ |
|
5006 |
id := aDevice whitepixel |
|
5007 |
] ifFalse:[ |
|
5008 |
aDevice hasGrayscales ifTrue:[ |
|
5009 |
self class |
|
5010 |
ditherGrayFor:(greyV / MaxValue) |
|
5011 |
on:aDevice |
|
5012 |
into:[:c :f | newColor := c. form := f]. |
|
5013 |
newColor notNil ifTrue:[^ newColor]. |
|
5014 |
]. |
|
5015 |
form isNil ifTrue:[ |
|
5016 |
"/ still none - dither b&w |
|
5017 |
self class |
|
5018 |
monoDitherFor:(greyV / MaxValue) |
|
5019 |
between:Black and:White |
|
5020 |
on:aDevice |
|
5021 |
into:[:c :f | newColor := c. form := f]. |
|
5022 |
newColor notNil ifTrue:[^ newColor]. |
|
5023 |
form isNil ifTrue:[ |
|
5024 |
"/ cannot happen |
|
5025 |
'Color [warning]: monoDither failed' errorPrintCR. |
|
5026 |
^ nil |
|
5027 |
] |
|
5028 |
] |
|
5029 |
] |
|
5030 |
]. |
|
1023 | 5031 |
]. |
5032 |
||
5033 |
device isNil ifTrue:[ |
|
7291 | 5034 |
"/ receiver was not associated - do it now & return mySelf |
5035 |
||
5036 |
device := aDevice. |
|
5037 |
id isNil ifTrue:[ |
|
5038 |
ditherForm := form |
|
5039 |
]. |
|
5040 |
colorId := id. |
|
5041 |
||
5042 |
"/ have to register - otherwise it keeps old info around |
|
5043 |
||
5044 |
id notNil ifTrue:[ |
|
5045 |
deviceVisual ~~ #TrueColor ifTrue:[ |
|
5046 |
aDevice registerColor:self. |
|
5047 |
] |
|
5048 |
]. |
|
5049 |
^ self |
|
1023 | 5050 |
]. |
5051 |
||
5052 |
"/ receiver was already associated to another device |
|
5053 |
"/ - need a new color and return it |
|
5054 |
||
7762 | 5055 |
newColor := self class basicNew |
7291 | 5056 |
setScaledRed:red |
5057 |
scaledGreen:green |
|
5058 |
scaledBlue:blue |
|
5059 |
device:aDevice. |
|
1023 | 5060 |
id isNil ifTrue:[ |
7291 | 5061 |
newColor setDitherForm:form |
1023 | 5062 |
] ifFalse:[ |
7291 | 5063 |
newColor setColorId:id. |
5064 |
||
5065 |
"/ trueColor device-colors are not registered |
|
5066 |
deviceVisual ~~ #TrueColor ifTrue:[ |
|
5067 |
aDevice registerColor:newColor. |
|
5068 |
] |
|
1023 | 5069 |
]. |
5070 |
^ newColor |
|
5071 |
||
2313 | 5072 |
"Created: / 16.11.1995 / 20:16:42 / cg" |
5073 |
"Modified: / 8.9.1998 / 17:32:10 / cg" |
|
1023 | 5074 |
! ! |
5075 |
||
5076 |
||
5077 |
!Color methodsFor:'instance creation'! |
|
5078 |
||
2948 | 5079 |
alpha:alphaValue |
4789 | 5080 |
"return a new color with the same color, but different alpha as the receiver. |
5081 |
The alpha arguments range is 0..1 (0=completely transparent; 1=completely opaque)" |
|
2948 | 5082 |
|
5083 |
alphaValue = 1 ifTrue:[ ^ self]. |
|
6353 | 5084 |
^ (TranslucentColor |
5085 |
scaledRed:red |
|
5086 |
scaledGreen:green |
|
5087 |
scaledBlue:blue) alpha:alphaValue |
|
2948 | 5088 |
|
5089 |
" |
|
4789 | 5090 |
(Color red alpha:0.5) alpha |
6353 | 5091 |
Color red alpha |
4789 | 5092 |
" |
5093 |
||
5094 |
"Modified: / 06-06-2007 / 11:17:55 / cg" |
|
2948 | 5095 |
! |
5096 |
||
1023 | 5097 |
blendWith:aColor |
5098 |
"create a new color from equally mixing the receiver |
|
5099 |
and the argument, aColor. |
|
6353 | 5100 |
Mixing is done by adding components |
2943
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5101 |
(which is different from mixing colors on paper .. which is subtractive)." |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5102 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5103 |
^ self mixed:1 with:aColor |
1023 | 5104 |
|
5105 |
" |
|
5106 |
(Color red) blendWith:(Color yellow) |
|
5107 |
(Color red) blendWith:(Color blue) |
|
1326
a519593747e8
#isGray - ST80 compatibility
Claus Gittinger <cg@exept.de>
parents:
1269
diff
changeset
|
5108 |
(Color red) blendWith:(Color black) |
a519593747e8
#isGray - ST80 compatibility
Claus Gittinger <cg@exept.de>
parents:
1269
diff
changeset
|
5109 |
(Color red) blendWith:(Color white) |
1023 | 5110 |
" |
5111 |
||
1326
a519593747e8
#isGray - ST80 compatibility
Claus Gittinger <cg@exept.de>
parents:
1269
diff
changeset
|
5112 |
"Modified: 10.2.1997 / 22:08:14 / cg" |
1023 | 5113 |
! |
5114 |
||
5965 | 5115 |
contrastingBlackOrWhite |
7639 | 5116 |
"answer either black or white, whichever gives a better contrast |
5117 |
for drawing text on a background with my color. |
|
5118 |
(i.e. if I am dark, return white; if I am bright, return black" |
|
5119 |
||
5120 |
^ self brightness < 0.55 |
|
5121 |
ifTrue:[self class white] |
|
5122 |
ifFalse:[self class black] |
|
5123 |
||
5124 |
" |
|
5125 |
(Color blue) contrastingBlackOrWhite |
|
5126 |
(Color red) contrastingBlackOrWhite |
|
5127 |
(Color green) contrastingBlackOrWhite |
|
5128 |
(Color yellow) contrastingBlackOrWhite |
|
5129 |
" |
|
5130 |
! |
|
5131 |
||
5132 |
contrastingColorFor:aBackgroundColor |
|
5133 |
"answer a slightly brightened or darkened variant of myself, |
|
5134 |
to ensure a good contrast when showing text on a background color. |
|
5135 |
i.e. when drawing read on grey, it might be better to darken or brighten |
|
5136 |
the red, if its brightness is too near to the grey's brightness. |
|
5137 |
Use this for alert strings shown on a color background." |
|
5138 |
||
5139 |
|colorUsed bgBrightness| |
|
5140 |
||
5141 |
colorUsed := self. |
|
5142 |
bgBrightness := aBackgroundColor brightness. |
|
5143 |
||
5144 |
(bgBrightness dist:colorUsed brightness) < 0.5 ifTrue:[ |
|
5145 |
bgBrightness > 0.5 ifTrue:[ |
|
5146 |
colorUsed := self slightlyDarkened. |
|
5147 |
(bgBrightness dist:colorUsed brightness) < 0.5 ifTrue:[ |
|
5148 |
colorUsed := self darkened. |
|
5149 |
]. |
|
5150 |
] ifFalse:[ |
|
5151 |
colorUsed := self slightlyLightened. |
|
5152 |
(bgBrightness dist:colorUsed brightness) < 0.5 ifTrue:[ |
|
5153 |
colorUsed := self lightened. |
|
5154 |
]. |
|
5155 |
]. |
|
5156 |
]. |
|
5157 |
^ colorUsed. |
|
5158 |
||
5159 |
" |
|
5160 |
(Color blue) contrastingColorFor:Color white. |
|
5161 |
(Color blue) contrastingColorFor:Color blue. |
|
5162 |
(Color red) contrastingColorFor:Color grey |
|
5163 |
(Color blue) contrastingColorFor:Color black |
|
5164 |
" |
|
5965 | 5165 |
! |
5166 |
||
1023 | 5167 |
darkened |
5168 |
"return a new color, which is slightly darker than the receiver" |
|
5169 |
||
5170 |
^ self blendWith:Black |
|
5171 |
||
5172 |
" |
|
5173 |
(Color red) darkened |
|
5174 |
(Color red) darkened darkened |
|
5175 |
" |
|
5176 |
||
5177 |
"Modified: 11.6.1996 / 18:10:37 / cg" |
|
5178 |
! |
|
5179 |
||
5180 |
lightened |
|
5181 |
"return a new color, which is slightly lighter than the receiver" |
|
5182 |
||
5183 |
^ self blendWith:White |
|
5184 |
||
5185 |
" |
|
5186 |
(Color red) lightened |
|
5187 |
(Color red) lightened lightened |
|
5188 |
" |
|
5189 |
||
5190 |
"Modified: 11.6.1996 / 18:10:49 / cg" |
|
2943
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5191 |
! |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5192 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5193 |
mixed:amount with:aColor |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5194 |
"create a new color from mixing amount of the receiver |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5195 |
with the argument, aColor. |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5196 |
Mixing is done by adding components (i.e. additive mixing) |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5197 |
(which is different from mixing colors on paper .. which is subtractive). |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5198 |
With an amount of 1, this is the same as blendWith." |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5199 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5200 |
red isNil ifTrue:[ |
6353 | 5201 |
^ aColor |
2943
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5202 |
]. |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5203 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5204 |
^ (self class) |
6353 | 5205 |
scaledRed:((red * amount) + aColor scaledRed) // (1 + amount) |
5206 |
scaledGreen:((green * amount) + aColor scaledGreen) // (1 + amount) |
|
5207 |
scaledBlue:((blue * amount) + aColor scaledBlue) // (1 + amount) |
|
2943
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5208 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5209 |
" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5210 |
(Color red) mixed:1 with:(Color yellow) |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5211 |
(Color red) mixed:0.9 with:(Color yellow) |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5212 |
(Color red) mixed:0.8 with:(Color yellow) |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5213 |
(Color red) mixed:0.5 with:(Color yellow) |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5214 |
(Color red) mixed:0.25 with:(Color yellow) |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5215 |
(Color red) mixed:0 with:(Color yellow) |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5216 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5217 |
(Color red) mixed:1 with:(Color white) |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5218 |
(Color red) mixed:0.8 with:(Color white) |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5219 |
(Color red) mixed:0.8 with:(Color black) |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5220 |
" |
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5221 |
|
6b4dca5fbee2
more lightening/darkening stuff
Claus Gittinger <cg@exept.de>
parents:
2942
diff
changeset
|
5222 |
"Modified: 10.2.1997 / 22:08:14 / cg" |
3724
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5223 |
! |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5224 |
|
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5225 |
slightlyDarkened |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5226 |
"return a new color, which is a bit darker than the receiver" |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5227 |
|
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5228 |
^ self blendWith:(self blendWith:Black) |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5229 |
|
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5230 |
" |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5231 |
(Color green) inspect |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5232 |
(Color green) darkened inspect |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5233 |
(Color green) slightlyDarkened inspect |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5234 |
" |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5235 |
! |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5236 |
|
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5237 |
slightlyLightened |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5238 |
"return a new color, which is a bit lighter than the receiver" |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5239 |
|
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5240 |
^ self blendWith:(self blendWith:White) |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5241 |
|
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5242 |
" |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5243 |
(Color red) inspect |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5244 |
(Color red) lightened inspect |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5245 |
(Color red) slightlyLightened inspect |
e35133b39f25
+ slightlyLightened/darkened
Claus Gittinger <cg@exept.de>
parents:
3665
diff
changeset
|
5246 |
" |
1023 | 5247 |
! ! |
5248 |
||
5249 |
!Color methodsFor:'instance release'! |
|
5250 |
||
2845 | 5251 |
executor |
1023 | 5252 |
"redefined, since for finalization only device and colorIndex |
5253 |
are needed - thus a faster copy is possible here" |
|
5254 |
||
2845 | 5255 |
^ DeviceColorHandle basicNew setDevice:device colorId:colorId |
5256 |
! |
|
5257 |
||
5258 |
releaseFromDevice |
|
5259 |
"I am no longer available on the device" |
|
5260 |
||
2975 | 5261 |
colorId := device := ditherForm := replacementColor := nil. |
2845 | 5262 |
|
1023 | 5263 |
! ! |
5264 |
||
3122 | 5265 |
!Color methodsFor:'misc'! |
5266 |
||
5267 |
magnifiedTo: extent |
|
5268 |
"do nothing here, for compatibility with Image/Form" |
|
5269 |
! ! |
|
5270 |
||
6967 | 5271 |
|
4851 | 5272 |
!Color methodsFor:'object persistency'! |
1023 | 5273 |
|
4207 | 5274 |
elementDescriptorFor:aspect |
4851 | 5275 |
"support for persistency: |
5276 |
answer the elements to be made persistent with an ObjectCoder" |
|
5277 |
||
3935 | 5278 |
red isNil ifTrue:[ |
6353 | 5279 |
^ Array with:(#colorId->colorId) |
3935 | 5280 |
]. |
5281 |
^ Array with:(#red->self red) with:(#green->self green) with:(#blue->self blue) |
|
4851 | 5282 |
! ! |
5283 |
||
5284 |
!Color methodsFor:'printing & storing'! |
|
3935 | 5285 |
|
4850
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5286 |
hex |
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5287 |
<resource: #obsolete> |
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5288 |
|
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5289 |
self obsoleteMethodWarning:'use #hexPrintString'. |
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5290 |
^ self hexPrintString |
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5291 |
! |
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5292 |
|
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5293 |
hexPrintString |
4908 | 5294 |
"return a hex-printString as rrggbb" |
5295 |
||
5296 |
|s| |
|
5297 |
||
5298 |
s := WriteStream on:(String new:6). |
|
5920 | 5299 |
red isNil ifTrue:[ |
6353 | 5300 |
colorId notNil ifTrue:[ |
5301 |
colorId printOn:s base:16 size:6 fill:$0. |
|
5302 |
] |
|
5920 | 5303 |
] ifFalse:[ |
6353 | 5304 |
self redByte printOn:s base:16 size:2 fill:$0. |
5305 |
self greenByte printOn:s base:16 size:2 fill:$0. |
|
5306 |
self blueByte printOn:s base:16 size:2 fill:$0. |
|
5920 | 5307 |
]. |
4908 | 5308 |
|
5309 |
^ s contents. |
|
5310 |
||
5311 |
" |
|
5312 |
Color red hexPrintString |
|
5313 |
Color green hexPrintString |
|
5314 |
Color blue hexPrintString |
|
6353 | 5315 |
Color yellow hexPrintString |
4850
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5316 |
" |
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5317 |
! |
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5318 |
|
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5319 |
htmlPrintString |
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5320 |
"return a hex-printString for html as #rrggbb;" |
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5321 |
|
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5322 |
^ '#',(self hexPrintString) |
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5323 |
|
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5324 |
" |
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5325 |
Color red htmlPrintString |
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5326 |
Color green htmlPrintString |
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5327 |
Color blue htmlPrintString |
6353 | 5328 |
Color yellow htmlPrintString |
4850
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5329 |
" |
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5330 |
! |
5e45abdda305
hexPrintString; htmlPrintString
Claus Gittinger <cg@exept.de>
parents:
4789
diff
changeset
|
5331 |
|
1023 | 5332 |
printOn:aStream |
5333 |
"append a string representing of the receiver |
|
5334 |
to the argument, aStream" |
|
5335 |
||
5336 |
self storeOn:aStream |
|
5337 |
! |
|
5338 |
||
5339 |
storeOn:aStream |
|
5340 |
"append a string representing an expression to reconstruct the receiver |
|
5341 |
to the argument, aStream" |
|
5342 |
||
2942
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5343 |
|clsName| |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5344 |
|
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5345 |
clsName := self class name. |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5346 |
|
1023 | 5347 |
red isNil ifTrue:[ |
6353 | 5348 |
colorId notNil ifTrue:[ |
5349 |
aStream nextPutAll:'(' , clsName , ' colorId:'. |
|
5350 |
colorId storeOn:aStream. |
|
5351 |
aStream nextPut:$). |
|
5352 |
^ self |
|
5353 |
] |
|
1023 | 5354 |
]. |
5355 |
(red == green and:[red == blue]) ifTrue:[ |
|
6353 | 5356 |
red == 0 ifTrue:[ |
5357 |
aStream nextPutAll:'(' , clsName , ' black)'. |
|
5358 |
] ifFalse:[ |
|
5359 |
red == MaxValue ifTrue:[ |
|
5360 |
aStream nextPutAll:'(' , clsName , ' white)'. |
|
5361 |
] ifFalse:[ |
|
5362 |
aStream nextPutAll:'(' , clsName , ' grey:'. |
|
5363 |
(self red) storeOn:aStream. |
|
5364 |
aStream nextPut:$). |
|
5365 |
] |
|
5366 |
]. |
|
5367 |
^ self |
|
1023 | 5368 |
]. |
2942
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5369 |
aStream nextPutAll:'(' , clsName , ' red:'. |
1023 | 5370 |
(self red) storeOn:aStream. |
5371 |
aStream nextPutAll:' green:'. |
|
5372 |
(self green) storeOn:aStream. |
|
5373 |
aStream nextPutAll:' blue:'. |
|
5374 |
(self blue) storeOn:aStream. |
|
5375 |
aStream nextPut:$). |
|
5376 |
! ! |
|
5377 |
||
5378 |
!Color methodsFor:'private'! |
|
5379 |
||
5380 |
restored |
|
5381 |
"private: color has been restored (either from snapin or binary store); |
|
5382 |
flush device stuff or reallocate a cell." |
|
5383 |
||
1238
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5384 |
ditherForm := replacementColor := nil. |
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5385 |
|
1023 | 5386 |
red notNil ifTrue:[ |
6353 | 5387 |
device := nil. |
5388 |
colorId := nil |
|
1023 | 5389 |
] ifFalse:[ |
6353 | 5390 |
"a variable color has been restored" |
5391 |
(colorId notNil and:[writable == true and:[device notNil]]) ifTrue:[ |
|
5392 |
colorId := device colorCell. |
|
5393 |
device setColor:colorId scaledRed:red scaledGreen:green scaledBlue:blue |
|
5394 |
] |
|
1023 | 5395 |
] |
1238
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5396 |
|
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5397 |
"Modified: 17.1.1997 / 00:04:14 / cg" |
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5398 |
! |
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5399 |
|
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5400 |
setColorId:anId |
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5401 |
"private: set the deviceId" |
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5402 |
|
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5403 |
colorId := anId |
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5404 |
|
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5405 |
"Created: 17.1.1997 / 00:05:41 / cg" |
1023 | 5406 |
! |
5407 |
||
5408 |
setDevice:aDevice colorId:aNumber |
|
5409 |
"private:set device and colorId" |
|
5410 |
||
5411 |
device := aDevice. |
|
1934 | 5412 |
colorId := aNumber. |
5413 |
writable := false. |
|
5414 |
! |
|
5415 |
||
5416 |
setDevice:aDevice colorId:aNumber writable:wBool |
|
5417 |
"private:set device, colorId and writable flag" |
|
5418 |
||
5419 |
device := aDevice. |
|
5420 |
colorId := aNumber. |
|
5421 |
writable := wBool. |
|
1023 | 5422 |
! |
5423 |
||
1238
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5424 |
setDitherForm:aForm |
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5425 |
"private: set the ditherForm" |
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5426 |
|
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5427 |
ditherForm := aForm |
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5428 |
|
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5429 |
"Created: 17.1.1997 / 00:04:57 / cg" |
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5430 |
! |
b363894182d0
prepare for replacement colors
Claus Gittinger <cg@exept.de>
parents:
1237
diff
changeset
|
5431 |
|
1023 | 5432 |
setScaledRed:r scaledGreen:g scaledBlue:b device:aDevice |
5433 |
"private: set the components" |
|
5434 |
||
5435 |
red notNil ifTrue:[ |
|
6353 | 5436 |
"oops cannot change (you want to make red be green - or what)" |
5437 |
||
5438 |
self error:'Colors cannot change their components'. |
|
5439 |
^ self |
|
1023 | 5440 |
]. |
5441 |
red := r. |
|
5442 |
green := g. |
|
5443 |
blue := b. |
|
5444 |
device := aDevice |
|
1233 | 5445 |
|
5446 |
"Modified: 16.1.1997 / 22:39:26 / cg" |
|
1023 | 5447 |
! ! |
5448 |
||
5449 |
!Color methodsFor:'queries'! |
|
5450 |
||
5451 |
averageColor |
|
6793 | 5452 |
"return the average color - that's myself. |
5453 |
This method has been added for compatibility with the image protocol." |
|
1023 | 5454 |
|
6353 | 5455 |
^ self |
1023 | 5456 |
! |
5457 |
||
5458 |
averageColorIn:aRectangle |
|
7580 | 5459 |
"return the average color - that's myself. |
6793 | 5460 |
This method has been added for compatibility with the image protocol." |
1023 | 5461 |
|
6353 | 5462 |
^ self |
1023 | 5463 |
! |
5464 |
||
5465 |
brightness |
|
5466 |
"ST80 compatibility: return the grey intensity in [0..1]" |
|
5467 |
||
6384 | 5468 |
red isNil ifTrue:[ |
5469 |
"/ a hack for colorId:0 and colorId:1 pseudo mask colors. |
|
5470 |
colorId == 0 ifTrue:[^ 0]. |
|
5471 |
^ 1 |
|
5472 |
]. |
|
1023 | 5473 |
^ ((3 * red) + (6 * green) + (blue)) / 10.0 / MaxValue |
5474 |
||
5475 |
"Modified: 7.6.1996 / 19:42:21 / cg" |
|
5476 |
! |
|
5477 |
||
5478 |
deltaFrom:aColor |
|
5479 |
"return the distance of the receiver from some color specified |
|
6785 | 5480 |
by r/g/b values. |
5481 |
A very questionable value; |
|
7411 | 5482 |
basing the distance on rgb values is very bad |
6785 | 5483 |
- better do a distance in a cie color cone" |
1023 | 5484 |
|
5485 |
^ aColor deltaFromRed:self red green:self green blue:self blue |
|
5486 |
||
3005 | 5487 |
" |
6353 | 5488 |
Color red deltaFrom:(Color blue) |
5489 |
Color red deltaFrom:(Color yellow) |
|
5490 |
Color red deltaFrom:(Color red:50) |
|
3005 | 5491 |
" |
5492 |
||
1023 | 5493 |
"Created: 14.6.1996 / 20:07:22 / cg" |
5494 |
"Modified: 14.6.1996 / 20:49:32 / cg" |
|
5495 |
! |
|
5496 |
||
5497 |
deltaFromRed:r green:g blue:b |
|
5498 |
"return the distance of the receiver from some color specified |
|
5499 |
by r/g/b values" |
|
5500 |
||
5501 |
" |
|
5502 |
Q: how should component errors be weighted ? |
|
5503 |
" |
|
3005 | 5504 |
^ ((self red - r) abs |
1023 | 5505 |
+ (self green - g) abs |
3005 | 5506 |
+ (self blue - b) abs) rounded. |
1023 | 5507 |
|
5508 |
"Created: 14.6.1996 / 20:03:58 / cg" |
|
5509 |
"Modified: 14.6.1996 / 20:20:24 / cg" |
|
5510 |
! |
|
5511 |
||
5512 |
deltaFromScaledRed:r scaledGreen:g scaledBlue:b |
|
5513 |
"return the distance of the receiver from some color specified |
|
5514 |
by r/g/b values" |
|
5515 |
||
5516 |
" |
|
5517 |
Q: how should component errors be weighted ? |
|
5518 |
" |
|
5519 |
^ (red - r) abs |
|
5520 |
+ (green - g) abs |
|
5521 |
+ (blue - b) abs. |
|
5522 |
||
5523 |
"Created: 11.6.1996 / 18:01:12 / cg" |
|
5524 |
"Modified: 14.6.1996 / 20:36:14 / cg" |
|
5525 |
! |
|
5526 |
||
5527 |
errorFrom:aColor |
|
5528 |
"return some value which can be used to compare colors. |
|
5529 |
The following simply returns the vector distance of the r/g/b vectors. |
|
5530 |
This may not be a very good idea; probably, we should honor the |
|
5531 |
fact that the hue difference should have more weight than saturation and/or light" |
|
5532 |
||
5533 |
^ (red - aColor scaledRed) squared |
|
5534 |
+ (green - aColor scaledGreen) squared |
|
5535 |
+ (blue - aColor scaledBlue) squared. |
|
5536 |
! |
|
5537 |
||
5538 |
grayIntensity |
|
5539 |
"return the grey intensity in percent [0..100] (US version ;-)" |
|
5540 |
||
6385 | 5541 |
red isNil ifTrue:[ |
5542 |
"/ a hack for colorId:0 and colorId:1 pseudo mask colors. |
|
5543 |
colorId == 0 ifTrue:[^ 0]. |
|
5544 |
^ 100 |
|
5545 |
]. |
|
1023 | 5546 |
^ ((3 * red) + (6 * green) + (1 * blue)) * 10.0 / MaxValue |
5547 |
||
7758 | 5548 |
" |
5549 |
Color red brightness |
|
5550 |
Color red grayIntensity |
|
5551 |
" |
|
5552 |
||
1023 | 5553 |
"Created: 2.5.1996 / 11:38:21 / cg" |
5554 |
! |
|
5555 |
||
5556 |
greyIntensity |
|
5557 |
"return the grey intensity in percent [0..100] (English version ;-)" |
|
5558 |
||
5559 |
^ self grayIntensity |
|
5560 |
||
5561 |
"Modified: 28.5.1996 / 20:45:41 / cg" |
|
5562 |
! |
|
5563 |
||
5564 |
isColor |
|
5565 |
"return true if the receiver is a Color." |
|
5566 |
||
5567 |
^ true |
|
5568 |
! |
|
5569 |
||
2828 | 5570 |
isColorObject |
5571 |
^ true |
|
5572 |
! |
|
5573 |
||
1023 | 5574 |
isDithered |
5575 |
"return true, if this is a dithered Color. |
|
5576 |
Only makes sense if the receiver is a device color." |
|
5577 |
||
5578 |
^ ditherForm notNil |
|
5579 |
! |
|
5580 |
||
1326
a519593747e8
#isGray - ST80 compatibility
Claus Gittinger <cg@exept.de>
parents:
1269
diff
changeset
|
5581 |
isGray |
a519593747e8
#isGray - ST80 compatibility
Claus Gittinger <cg@exept.de>
parents:
1269
diff
changeset
|
5582 |
"same as isGrayColor - for ST80 compatibility." |
a519593747e8
#isGray - ST80 compatibility
Claus Gittinger <cg@exept.de>
parents:
1269
diff
changeset
|
5583 |
|
a519593747e8
#isGray - ST80 compatibility
Claus Gittinger <cg@exept.de>
parents:
1269
diff
changeset
|
5584 |
^ self isGrayColor |
a519593747e8
#isGray - ST80 compatibility
Claus Gittinger <cg@exept.de>
parents:
1269
diff
changeset
|
5585 |
|
a519593747e8
#isGray - ST80 compatibility
Claus Gittinger <cg@exept.de>
parents:
1269
diff
changeset
|
5586 |
" |
a519593747e8
#isGray - ST80 compatibility
Claus Gittinger <cg@exept.de>
parents:
1269
diff
changeset
|
5587 |
(Color grey:50) isGray |
a519593747e8
#isGray - ST80 compatibility
Claus Gittinger <cg@exept.de>
parents:
1269
diff
changeset
|
5588 |
(Color red) isGray |
a519593747e8
#isGray - ST80 compatibility
Claus Gittinger <cg@exept.de>
parents:
1269
diff
changeset
|
5589 |
" |
a519593747e8
#isGray - ST80 compatibility
Claus Gittinger <cg@exept.de>
parents:
1269
diff
changeset
|
5590 |
|
a519593747e8
#isGray - ST80 compatibility
Claus Gittinger <cg@exept.de>
parents:
1269
diff
changeset
|
5591 |
"Created: 10.2.1997 / 22:10:25 / cg" |
a519593747e8
#isGray - ST80 compatibility
Claus Gittinger <cg@exept.de>
parents:
1269
diff
changeset
|
5592 |
! |
a519593747e8
#isGray - ST80 compatibility
Claus Gittinger <cg@exept.de>
parents:
1269
diff
changeset
|
5593 |
|
1023 | 5594 |
isGrayColor |
3005 | 5595 |
"return true, if this color is a gray one (US version ;-) - |
1023 | 5596 |
i.e. red = green = blue" |
5597 |
||
5598 |
red ~~ green ifTrue:[^ false]. |
|
5599 |
^ red == blue |
|
5600 |
||
5601 |
" |
|
5602 |
(Color grey:50) isGrayColor |
|
5603 |
(Color red) isGrayColor |
|
5604 |
" |
|
5605 |
||
5606 |
"Created: 2.5.1996 / 11:38:48 / cg" |
|
5607 |
! |
|
5608 |
||
5609 |
isGreyColor |
|
5610 |
"return true, if this color is a grey one (English version ;-) - |
|
5611 |
i.e. red = green = blue" |
|
5612 |
||
5613 |
^ self isGrayColor |
|
5614 |
||
5615 |
"(Color grey:50) isGreyColor" |
|
5616 |
"(Color red) isGreyColor" |
|
5617 |
||
5618 |
"Modified: 28.5.1996 / 20:44:36 / cg" |
|
2942
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5619 |
! |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5620 |
|
3598 | 5621 |
isOnDevice:aGraphicsDevice |
5622 |
"return true if i am allocated on aGraphicsDevice" |
|
5623 |
||
6353 | 5624 |
^ device == aGraphicsDevice |
3598 | 5625 |
and:[colorId notNil or:[replacementColor notNil and:[replacementColor colorId notNil]]] |
5626 |
! |
|
5627 |
||
2942
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5628 |
isOpaque |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5629 |
"return true, if I represent an opaque color" |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5630 |
|
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5631 |
^ true |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5632 |
|
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5633 |
! |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5634 |
|
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5635 |
isTranslucent |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5636 |
"return true, if I represent a translucent color; |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5637 |
that is: not completely opaque" |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5638 |
|
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5639 |
^ false |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5640 |
|
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5641 |
! |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5642 |
|
2945 | 5643 |
isTranslucentColor |
5644 |
"return true, if I represent a translucent color, but not transparent" |
|
5645 |
||
5646 |
^ false |
|
5647 |
||
5648 |
! |
|
5649 |
||
2942
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5650 |
isTransparent |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5651 |
"return true, if I represent a completely transparent color" |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5652 |
|
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5653 |
^ false |
513981eb5180
prepared support for translucent colors
Claus Gittinger <cg@exept.de>
parents:
2937
diff
changeset
|
5654 |
|
1023 | 5655 |
! ! |
5656 |
||
1907
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5657 |
!Color::DeviceColorHandle class methodsFor:'documentation'! |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5658 |
|
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5659 |
documentation |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5660 |
" |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5661 |
This is an abstract class for device handles which are responsible |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5662 |
for finalization i.e. to destroy underlying system resources, when the GC |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5663 |
frees an object which has created some system object. |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5664 |
These are used with colors. |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5665 |
|
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5666 |
[see also:] |
6353 | 5667 |
Color |
1907
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5668 |
|
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5669 |
[author:] |
6353 | 5670 |
Claus Gittinger |
1907
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5671 |
|
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5672 |
" |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5673 |
! ! |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5674 |
|
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5675 |
!Color::DeviceColorHandle methodsFor:'accessing'! |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5676 |
|
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5677 |
setDevice:aDevice colorId:anId |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5678 |
"set the handles contents" |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5679 |
|
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5680 |
device := aDevice. |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5681 |
colorId := anId. |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5682 |
|
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5683 |
"Modified: 23.4.1996 / 22:10:26 / cg" |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5684 |
"Created: 25.3.1997 / 14:29:10 / stefan" |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5685 |
! ! |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5686 |
|
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5687 |
!Color::DeviceColorHandle methodsFor:'finalization'! |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5688 |
|
3611
8b4384c9e660
Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents:
3598
diff
changeset
|
5689 |
finalize |
6353 | 5690 |
"the color for which I am a handle was collected |
1907
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5691 |
- release system resources" |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5692 |
|
2096 | 5693 |
|id| |
5694 |
||
5695 |
(id := colorId) notNil ifTrue:[ |
|
6353 | 5696 |
colorId := nil. |
5697 |
device freeColor:id. |
|
1907
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5698 |
]. |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5699 |
|
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5700 |
"Created: 25.3.1997 / 14:29:10 / stefan" |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5701 |
! ! |
61fdff318175
Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents:
1859
diff
changeset
|
5702 |
|
1144 | 5703 |
!Color class methodsFor:'documentation'! |
1023 | 5704 |
|
5705 |
version |
|
6967 | 5706 |
^ '$Header$' |
5419 | 5707 |
! |
5708 |
||
5709 |
version_CVS |
|
6967 | 5710 |
^ '$Header$' |
1023 | 5711 |
! ! |
3757 | 5712 |
|
6110 | 5713 |
|
1023 | 5714 |
Color initialize! |