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