1 /* Part of XPCE --- The SWI-Prolog GUI toolkit
2
3 Author: Jan Wielemaker and Anjo Anjewierden
4 E-mail: jan@swi.psy.uva.nl
5 WWW: http://www.swi.psy.uva.nl/projects/xpce/
6 Copyright (c) 1985-2002, University of Amsterdam
7 All rights reserved.
8
9 Redistribution and use in source and binary forms, with or without
10 modification, are permitted provided that the following conditions
11 are met:
12
13 1. Redistributions of source code must retain the above copyright
14 notice, this list of conditions and the following disclaimer.
15
16 2. Redistributions in binary form must reproduce the above copyright
17 notice, this list of conditions and the following disclaimer in
18 the documentation and/or other materials provided with the
19 distribution.
20
21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32 POSSIBILITY OF SUCH DAMAGE.
33 */
34
35 #include <h/kernel.h>
36 #include <h/graphics.h>
37
38 static status XCloseColour(Colour c, DisplayObj d);
39
40 static status
toRBG(Int * r,Int * g,Int * b,Name model)41 toRBG(Int *r, Int *g, Int *b, Name model)
42 { if ( isDefault(*r) || isDefault(*g) || isDefault(*b) )
43 fail;
44
45 if ( model == NAME_hsv )
46 { int ih = valInt(*r) % 360;
47 int is = valInt(*g);
48 int iv = valInt(*b);
49 float R,G,B;
50
51 if ( is > 100 )
52 return errorPce(*g, NAME_unexpectedType, CtoType("0..100"));
53 if ( iv > 100 )
54 return errorPce(*g, NAME_unexpectedType, CtoType("0..100"));
55
56 if ( ih < 0 )
57 ih += 360;
58
59 HSVToRGB((float)ih/360.0, (float)is/100.0, (float)iv/100.0,
60 &R, &G, &B);
61 *r = toInt((int)(R*65535));
62 *g = toInt((int)(G*65535));
63 *b = toInt((int)(B*65535));
64 }
65
66 succeed;
67 }
68
69
70 static Name
defcolourname(Int r,Int g,Int b)71 defcolourname(Int r, Int g, Int b)
72 { if ( notDefault(r) && notDefault(g) && notDefault(b) )
73 { char buf[50];
74
75 sprintf(buf, "#%02x%02x%02x",
76 (unsigned int)valInt(r)>>8,
77 (unsigned int)valInt(g)>>8,
78 (unsigned int)valInt(b)>>8);
79
80 return CtoName(buf);
81 }
82
83 fail;
84 }
85
86
87 static status
initialiseColour(Colour c,Name name,Int r,Int g,Int b,Name model)88 initialiseColour(Colour c, Name name, Int r, Int g, Int b, Name model)
89 { if ( notDefault(name) )
90 assign(c, name, name);
91
92 if ( isDefault(r) && isDefault(g) && isDefault(b) )
93 { assign(c, kind, NAME_named);
94 } else if ( notDefault(r) && notDefault(g) && notDefault(b) )
95 { assign(c, kind, NAME_rgb);
96
97 if ( !toRBG(&r, &g, &b, model) )
98 fail;
99
100 if ( isDefault(name) )
101 { name = defcolourname(r, g, b);
102 assign(c, name, name);
103 }
104 } else
105 return errorPce(c, NAME_instantiationFault,
106 getMethodFromFunction(initialiseColour));
107
108 assign(c, red, r);
109 assign(c, green, g);
110 assign(c, blue, b);
111
112 appendHashTable(ColourTable, c->name, c);
113
114 succeed;
115 }
116
117
118 static status
unlinkColour(Colour c)119 unlinkColour(Colour c)
120 { deleteHashTable(ColourTable, c->name);
121 XCloseColour(c, DEFAULT);
122
123 succeed;
124 }
125
126
127 static Colour
getLookupColour(Class class,Name name,Int r,Int g,Int b,Name model)128 getLookupColour(Class class, Name name, Int r, Int g, Int b, Name model)
129 { if ( isDefault(name) && notDefault(r) && notDefault(g) && notDefault(b) )
130 { if ( !toRBG(&r, &g, &b, model) )
131 fail;
132
133 name = defcolourname(r, g, b);
134 }
135
136 if ( name )
137 answer(getMemberHashTable(ColourTable, name));
138
139 fail;
140 }
141
142
143 static Name
getStorageReferenceColour(Colour c)144 getStorageReferenceColour(Colour c)
145 { if ( c->kind == NAME_named )
146 answer(c->name);
147 else
148 answer(defcolourname(c->red, c->green, c->blue));
149 }
150
151
152 static status
equalColour(Colour c1,Colour c2)153 equalColour(Colour c1, Colour c2)
154 { if ( c1 == c2 )
155 succeed;
156 if ( instanceOfObject(c1, ClassColour) &&
157 instanceOfObject(c2, ClassColour) )
158 { if ( c1->name == c2->name )
159 succeed;
160
161 if ( isDefault(c1->red) ) /* `open' both colours */
162 getXrefObject(c1, CurrentDisplay(NIL));
163 if ( isDefault(c2->red) )
164 getXrefObject(c2, CurrentDisplay(NIL));
165
166 if ( c1->red == c2->red && /* tolerance? */
167 c1->green == c2->green &&
168 c1->blue == c2->blue )
169 succeed;
170 }
171
172 fail;
173 }
174
175
176 static status
storeColour(Colour c,FileObj file)177 storeColour(Colour c, FileObj file)
178 { return storeSlotsObject(c, file);
179 }
180
181
182 static status
loadColour(Colour c,IOSTREAM * fd,ClassDef def)183 loadColour(Colour c, IOSTREAM *fd, ClassDef def)
184 { TRY( loadSlotsObject(c, fd, def) );
185
186 if ( c->kind == NAME_named )
187 { assign(c, red, DEFAULT);
188 assign(c, green, DEFAULT);
189 assign(c, blue, DEFAULT);
190 }
191
192 succeed;
193 }
194
195
196 static int
take_hex(char * s,int digits)197 take_hex(char *s, int digits)
198 { unsigned int v = 0;
199
200 for(; digits-- > 0; s++)
201 { if ( *s >= '0' && *s <= '9' )
202 v = v * 16 + *s - '0';
203 else if ( *s >= 'a' && *s <= 'f' )
204 v = v * 16 + *s - 'a' + 10;
205 else if ( *s >= 'A' && *s <= 'F' )
206 v = v * 16 + *s - 'A' + 10;
207 else
208 return -1; /* error */
209 }
210
211 return v;
212 }
213
214
215 static Colour
getConvertColour(Class class,Name name)216 getConvertColour(Class class, Name name)
217 { Colour c;
218 char *s;
219
220 if ( (c = getMemberHashTable(ColourTable, name)) )
221 answer(c);
222
223 if ( (s=strName(name))[0] == '#' )
224 { int r, g, b;
225 int dgs = 0;
226 size_t l = strlen(s);
227
228 if ( l == 7 )
229 dgs = 2;
230 else if ( l == 13 )
231 dgs = 4;
232
233 if ( dgs )
234 { s++; /* skip # */
235 r = take_hex(s, dgs); s+= dgs;
236 g = take_hex(s, dgs); s+= dgs;
237 b = take_hex(s, dgs);
238
239 if ( r >= 0 && g >= 0 && b >= 0 )
240 { if ( dgs == 2 )
241 { r = r*256 + r;
242 g = g*256 + g;
243 b = b*256 + b;
244 }
245
246 answer(answerObject(ClassColour, name,
247 toInt(r), toInt(g), toInt(b), EAV));
248 }
249 }
250
251 fail;
252 }
253
254 answer(answerObject(ClassColour, name, EAV));
255 }
256
257
258 static status
XopenColour(Colour c,DisplayObj d)259 XopenColour(Colour c, DisplayObj d)
260 { if ( c->kind == NAME_named )
261 { DisplayObj d;
262
263 if ( (d = CurrentDisplay(NIL)) && !ws_colour_name(d, c->name) )
264 { errorPce(c, NAME_noNamedColour, c->name);
265 assign(c, name, NAME_black);
266 }
267 }
268
269 return ws_create_colour(c, d);
270 }
271
272
273 static status
XCloseColour(Colour c,DisplayObj d)274 XCloseColour(Colour c, DisplayObj d)
275 { ws_uncreate_colour(c, d);
276
277 succeed;
278 }
279
280
281 Int
getRedColour(Colour c)282 getRedColour(Colour c)
283 { if ( isDefault(c->red) )
284 getXrefObject(c, CurrentDisplay(NIL));
285
286 return c->red;
287 }
288
289
290 Int
getGreenColour(Colour c)291 getGreenColour(Colour c)
292 { if ( isDefault(c->green) )
293 getXrefObject(c, CurrentDisplay(NIL));
294
295 return c->green;
296 }
297
298
299 Int
getBlueColour(Colour c)300 getBlueColour(Colour c)
301 { if ( isDefault(c->blue) )
302 getXrefObject(c, CurrentDisplay(NIL));
303
304 return c->blue;
305 }
306
307
308 static status
get_hsv_colour(Colour c,float * h,float * s,float * v)309 get_hsv_colour(Colour c, float *h, float *s, float *v)
310 { if ( isDefault(c->red) )
311 { TRY(getXrefObject(c, CurrentDisplay(NIL)));
312 }
313
314 RGBToHSV((float)valInt(c->red)/65535.0,
315 (float)valInt(c->green)/65535.0,
316 (float)valInt(c->blue)/65535.0,
317 h, s, v);
318
319 succeed;
320 }
321
322
323 static Int
getHueColour(Colour c)324 getHueColour(Colour c)
325 { float h, s, v;
326
327 TRY(get_hsv_colour(c, &h, &s, &v));
328
329 return toInt((int)(h*360.0));
330 }
331
332
333 static Int
getSaturationColour(Colour c)334 getSaturationColour(Colour c)
335 { float h, s, v;
336
337 TRY(get_hsv_colour(c, &h, &s, &v));
338
339 return toInt((int)(s*100.0));
340 }
341
342
343 static Int
getValueColour(Colour c)344 getValueColour(Colour c)
345 { float h, s, v;
346
347 TRY(get_hsv_colour(c, &h, &s, &v));
348
349 return toInt((int)(v*100.0));
350 }
351
352
353 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
354 We store derived colours in a chain associated with the main colour, so
355 they remain in existence as long as the main colour.
356 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
357
358 static Colour
associateColour(Colour c,Int r,Int g,Int b)359 associateColour(Colour c, Int r, Int g, Int b)
360 { Name name;
361 Colour c2;
362 Chain ch;
363
364 name = defcolourname(r, g, b);
365 if ( !(c2=getMemberHashTable(ColourTable, name)) )
366 c2 = newObject(ClassColour, name, r, g, b, EAV);
367
368 if ( !(ch=getAttributeObject(c, NAME_associates)) )
369 attributeObject(c, NAME_associates, newObject(ClassChain, c2, EAV));
370 else
371 addChain(ch, c2);
372
373 answer(c2);
374 }
375
376
377
378 Colour
getHiliteColour(Colour c,Real h)379 getHiliteColour(Colour c, Real h)
380 { int r, g, b;
381 float hf;
382
383 if ( isDefault(h) )
384 h = getClassVariableValueObject(c, NAME_hiliteFactor);
385 hf = h ? valReal(h) : 0.9;
386
387 if ( isDefault(c->green) ) /* realise the colour */
388 getXrefObject(c, CurrentDisplay(NIL));
389
390 r = valInt(c->red);
391 g = valInt(c->green);
392 b = valInt(c->blue);
393
394 r = r + (int)((float)(65535 - r) * hf);
395 g = g + (int)((float)(65535 - g) * hf);
396 b = b + (int)((float)(65535 - b) * hf);
397
398 return associateColour(c, toInt(r), toInt(g), toInt(b));
399 }
400
401
402 Colour
getReduceColour(Colour c,Real re)403 getReduceColour(Colour c, Real re)
404 { int r, g, b;
405 float rf;
406
407 if ( isDefault(re) )
408 re = getClassVariableValueObject(c, NAME_reduceFactor);
409 rf = re ? valReal(re) : 0.6;
410
411 if ( isDefault(c->green) ) /* realise the colour */
412 getXrefObject(c, CurrentDisplay(NIL));
413
414 r = valInt(c->red);
415 g = valInt(c->green);
416 b = valInt(c->blue);
417
418 r = (int)((float)r * rf);
419 g = (int)((float)g * rf);
420 b = (int)((float)b * rf);
421
422 return associateColour(c, toInt(r), toInt(g), toInt(b));
423 }
424
425
426 static Int
getIntensityColour(Colour c)427 getIntensityColour(Colour c)
428 { int r, g, b;
429
430 if ( isDefault(c->green) )
431 getXrefObject(c, CurrentDisplay(NIL));
432
433 r = valInt(c->red);
434 g = valInt(c->green);
435 b = valInt(c->blue);
436
437 answer(toInt((r*20 + g*32 + b*18)/(20+32+18)));
438 }
439
440 /*******************************
441 * CLASS DECLARATION *
442 *******************************/
443
444 /* Type declarations */
445
446 static char *T_lookup[] =
447 { "[name|int]",
448 "red=[0..65535]", "green=[0..65535]", "blue=[0..65535]",
449 "model=[{rgb,hsv}]" };
450 static char *T_initialise[] =
451 { "name=[name]",
452 "red=[0..65535]", "green=[0..65535]", "blue=[0..65535]",
453 "model=[{rgb,hsv}]" };
454
455 /* Instance Variables */
456
457 static vardecl var_colour[] =
458 { IV(NAME_name, "name|int", IV_GET,
459 NAME_name, "Name of the colour"),
460 IV(NAME_kind, "{named,rgb}", IV_GET,
461 NAME_kind, "From colour-name database or user-defined"),
462 SV(NAME_red, "[0..65535]", IV_NONE|IV_FETCH, getRedColour,
463 NAME_colour, "Red value"),
464 SV(NAME_green, "[0..65535]", IV_NONE|IV_FETCH, getGreenColour,
465 NAME_colour, "Green value"),
466 SV(NAME_blue, "[0..65535]", IV_NONE|IV_FETCH, getBlueColour,
467 NAME_colour, "Blue value")
468 };
469
470 /* Send Methods */
471
472 static senddecl send_colour[] =
473 { SM(NAME_initialise, 5, T_initialise, initialiseColour,
474 DEFAULT, "Create from name and optional rgb"),
475 SM(NAME_unlink, 0, NULL, unlinkColour,
476 DEFAULT, "Deallocate the colour object"),
477 SM(NAME_Xclose, 1, "display", XCloseColour,
478 NAME_x, "Destroy window-system counterpart"),
479 SM(NAME_Xopen, 1, "display", XopenColour,
480 NAME_x, "Create window-system counterpart"),
481 SM(NAME_equal, 1, "colour", equalColour,
482 DEFAULT, "Test if colours have equal RGB")
483 };
484
485 /* Get Methods */
486
487 static getdecl get_colour[] =
488 { GM(NAME_hilite, 1, "colour", "factor=[0.0..1.0]", getHiliteColour,
489 NAME_3d, "Hilited version of the colour"),
490 GM(NAME_reduce, 1, "colour", "factor=[0.0..1.0]", getReduceColour,
491 NAME_3d, "Reduced version of the colour"),
492 GM(NAME_convert, 1, "colour", "name", getConvertColour,
493 NAME_conversion, "Convert X-colour name"),
494 GM(NAME_storageReference, 0, "name", NULL, getStorageReferenceColour,
495 NAME_file, "Description name for ->save_in_file"),
496 GM(NAME_intensity, 0, "0..65535", NULL, getIntensityColour,
497 NAME_grey, "Total light intensity of the colour"),
498 GM(NAME_lookup, 5, "colour", T_lookup, getLookupColour,
499 NAME_oms, "Lookup in @colours table"),
500 GM(NAME_hue, 0, "0..360", NULL, getHueColour,
501 NAME_colour, "Hue from the HSV-model"),
502 GM(NAME_saturnation, 0, "0..100", NULL, getSaturationColour,
503 NAME_colour, "Saturnation from the HSV-model"),
504 GM(NAME_value, 0, "0..100", NULL, getValueColour,
505 NAME_colour, "Value from the HSV-model")
506 };
507
508 /* Resources */
509
510 static classvardecl rc_colour[] =
511 { RC(NAME_hiliteFactor, "real", "0.9",
512 "Default factor for <-hilite'd colour"),
513 RC(NAME_reduceFactor, "real", "0.6",
514 "Default factor for <-reduce'd colour")
515 };
516
517 /* Class Declaration */
518
519 static Name colour_termnames[] = { NAME_name };
520
521 ClassDecl(colour_decls,
522 var_colour, send_colour, get_colour, rc_colour,
523 1, colour_termnames,
524 "$Rev$");
525
526
527 status
makeClassColour(Class class)528 makeClassColour(Class class)
529 { declareClass(class, &colour_decls);
530
531 setLoadStoreFunctionClass(class, loadColour, storeColour);
532 cloneStyleClass(class, NAME_none);
533
534 ColourTable = globalObject(NAME_colours, ClassHashTable, toInt(32), EAV);
535 assign(ColourTable, refer, NAME_none);
536
537 /* Don't know why this is done, it cannot be here as it is the reason why
538 the X11 display is opened during XPCE's initialisation. Possibly related
539 to the variable BLACK_COLOUR, set when opening the display
540
541 Well, it has to initialise the emulated colour resources on Windows.
542 There is no harm in this, so we'll just call it then. Maybe some day
543 we should make this more lazy.
544 */
545
546 #ifdef WIN32_GRAPHICS
547 ws_colour_name(CurrentDisplay(NIL), NAME_black);
548 #endif
549
550 succeed;
551 }
552
553