← Back to branch summary

~ubuntu-branches/ubuntu/lucid/sawfish/lucid-updates

« back to all changes in this revision

Viewing changes to src/colors.c

  • Committer: Bazaar Package Importer
  • Author(s): Christian Marillat
  • Date: 2002-01-20 17:42:28 UTC
  • Revision ID: james.westby@ubuntu.com-20020120174228-4q1ydztbkvfq1ht2
Tags: upstream-1.0.1.20020116
Import upstream version 1.0.1.20020116

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/colors.c
 
1
/* colors.c -- Colour handling
 
2
   $Id: colors.c,v 1.22 2001/04/23 06:20:49 jsh Exp $
 
3
 
 
4
   Copyright (C) 1999 John Harper <john@dcs.warwick.ac.uk>
 
5
 
 
6
   This file is part of sawmill.
 
7
 
 
8
   sawmill is free software; you can redistribute it and/or modify it
 
9
   under the terms of the GNU General Public License as published by
 
10
   the Free Software Foundation; either version 2, or (at your option)
 
11
   any later version.
 
12
 
 
13
   sawmill is distributed in the hope that it will be useful, but
 
14
   WITHOUT ANY WARRANTY; without even the implied warranty of
 
15
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
16
   GNU General Public License for more details.
 
17
 
 
18
   You should have received a copy of the GNU General Public License
 
19
   along with sawmill; see the file COPYING.   If not, write to
 
20
   the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
 
21
 
 
22
#include "sawmill.h"
 
23
 
 
24
static Lisp_Color *color_list;
 
25
int color_type;
 
26
 
 
27
DEFSYM(default_foreground, "default-foreground");
 
28
 
 
29
DEFUN("get-color-rgb", Fget_color_rgb, Sget_color_rgb,
 
30
      (repv red, repv green, repv blue), rep_Subr3) /*
 
31
::doc:sawfish.wm.colors#get-color-rgb::
 
32
get-color-rgb RED GREEN BLUE
 
33
::end:: */
 
34
{
 
35
    Lisp_Color *f;
 
36
    rep_DECLARE1(red, rep_INTP);
 
37
    rep_DECLARE2(green, rep_INTP);
 
38
    rep_DECLARE3(blue, rep_INTP);
 
39
 
 
40
    if (dpy == 0)
 
41
        return Qnil;
 
42
 
 
43
    f = color_list;
 
44
    while (f != 0)
 
45
    {
 
46
        if (f->red == rep_INT(red)
 
47
            && f->green == rep_INT(green)
 
48
            && f->blue == rep_INT(blue))
 
49
        {
 
50
            break;
 
51
        }
 
52
        f = f->next;
 
53
    }
 
54
    if (f == 0)
 
55
    {
 
56
        int pixel = best_color_match (rep_INT(red) / 256,
 
57
                                      rep_INT(green) / 256,
 
58
                                      rep_INT(blue) / 256);
 
59
 
 
60
        f = rep_ALLOC_CELL(sizeof(Lisp_Color));
 
61
        rep_data_after_gc += sizeof (Lisp_Color);
 
62
        f->car = color_type;
 
63
        f->next = color_list;
 
64
        color_list = f;
 
65
 
 
66
        f->red = rep_INT(red);
 
67
        f->green = rep_INT(green);
 
68
        f->blue = rep_INT(blue);
 
69
        f->pixel = pixel;
 
70
    }
 
71
    return rep_VAL(f);
 
72
}
 
73
    
 
74
DEFUN("get-color", Fget_color, Sget_color, (repv name), rep_Subr1) /*
 
75
::doc:sawfish.wm.colors#get-color::
 
76
get-color NAME
 
77
 
 
78
Return the color object representing the color named NAME, a standard
 
79
X11 color specifier.
 
80
::end:: */
 
81
{
 
82
    XColor exact_col;
 
83
    rep_DECLARE1(name, rep_STRINGP);
 
84
 
 
85
    if (dpy == 0)
 
86
        return Qnil;
 
87
 
 
88
    if (XParseColor (dpy, image_cmap, rep_STR(name), &exact_col) != 0)
 
89
    {
 
90
        return Fget_color_rgb (rep_MAKE_INT(exact_col.red),
 
91
                               rep_MAKE_INT(exact_col.green),
 
92
                               rep_MAKE_INT(exact_col.blue));
 
93
    }
 
94
    else
 
95
    {
 
96
        return Fsignal (Qerror,
 
97
                        rep_list_2 (rep_string_dup("no such color"),
 
98
                                    name));
 
99
    }
 
100
}
 
101
 
 
102
DEFUN("color-name", Fcolor_name, Scolor_name, (repv color), rep_Subr1) /*
 
103
::doc:sawfish.wm.colors#color-name::
 
104
color-name COLOR
 
105
 
 
106
Return the name of the color represented by the color object COLOR.
 
107
::end:: */
 
108
{
 
109
    char buf[32];
 
110
    rep_DECLARE1(color, COLORP);
 
111
    sprintf (buf, "#%04x%04x%04x",
 
112
             VCOLOR(color)->red, VCOLOR(color)->green, VCOLOR(color)->blue);
 
113
    return rep_string_dup (buf);
 
114
}
 
115
 
 
116
DEFUN("color-rgb", Fcolor_rgb, Scolor_rgb, (repv color), rep_Subr1) /*
 
117
::doc:sawfish.wm.colors#color-rgb::
 
118
color-rgb COLOR
 
119
 
 
120
Returns a list of integers (RED GREEN BLUE) representing the actual
 
121
color values of the color represented by object COLOR. The individual
 
122
values range from zero to 65535.
 
123
::end:: */
 
124
{
 
125
    rep_DECLARE1(color, COLORP);
 
126
    return rep_list_3 (rep_MAKE_INT(VCOLOR(color)->red),
 
127
                       rep_MAKE_INT(VCOLOR(color)->green),
 
128
                       rep_MAKE_INT(VCOLOR(color)->blue));
 
129
}
 
130
 
 
131
DEFUN("color-rgb-8", Fcolor_rgb_8, Scolor_rgb_8, (repv color), rep_Subr1) /*
 
132
::doc:sawfish.wm.colors#color-rgb::
 
133
color-rgb-8 COLOR
 
134
 
 
135
Returns a list of integers (RED GREEN BLUE) representing the actual
 
136
color values of the color represented by object COLOR. The individual
 
137
values range from zero to 255.
 
138
::end:: */
 
139
{
 
140
    rep_DECLARE1(color, COLORP);
 
141
    return rep_list_3 (rep_MAKE_INT(VCOLOR(color)->red / 256),
 
142
                       rep_MAKE_INT(VCOLOR(color)->green / 256),
 
143
                       rep_MAKE_INT(VCOLOR(color)->blue / 256));
 
144
}
 
145
 
 
146
DEFUN("colorp", Fcolorp, Scolorp, (repv win), rep_Subr1) /*
 
147
::doc:sawfish.wm.colors#colorp::
 
148
colorp ARG
 
149
 
 
150
Returns t if ARG is a color object.
 
151
::end:: */
 
152
{
 
153
    return COLORP(win) ? Qt : Qnil;
 
154
}
 
155
 
 
156
 
 
157
/* type hooks */
 
158
 
 
159
static int
 
160
color_cmp (repv w1, repv w2)
 
161
{
 
162
    return w1 != w2;
 
163
}
 
164
 
 
165
static void
 
166
color_prin (repv stream, repv obj)
 
167
{
 
168
    char buf[256];
 
169
    sprintf (buf, "#<color #%04x%04x%04x>",
 
170
             VCOLOR(obj)->red, VCOLOR(obj)->green, VCOLOR(obj)->blue);
 
171
    rep_stream_puts (stream, buf, -1, FALSE);
 
172
}
 
173
 
 
174
static void
 
175
color_sweep (void)
 
176
{
 
177
    Lisp_Color *w = color_list;
 
178
    color_list = 0;
 
179
    while (w != 0)
 
180
    {
 
181
        Lisp_Color *next = w->next;
 
182
        if (!rep_GC_CELL_MARKEDP(rep_VAL(w)))
 
183
            rep_FREE_CELL(w);
 
184
        else
 
185
        {
 
186
            rep_GC_CLR_CELL(rep_VAL(w));
 
187
            w->next = color_list;
 
188
            color_list = w;
 
189
        }
 
190
        w = next;
 
191
    }
 
192
}
 
193
 
 
194
 
 
195
/* initialisation */
 
196
 
 
197
void
 
198
colors_init (void)
 
199
{
 
200
    repv tem = rep_push_structure ("sawfish.wm.colors");
 
201
    color_type = rep_register_new_type ("color", color_cmp, color_prin,
 
202
                                        color_prin, color_sweep, 0,
 
203
                                        0, 0, 0, 0, 0, 0, 0);
 
204
    rep_ADD_SUBR(Sget_color_rgb);
 
205
    rep_ADD_SUBR(Sget_color);
 
206
    rep_ADD_SUBR(Scolor_name);
 
207
    rep_ADD_SUBR(Scolor_rgb);
 
208
    rep_ADD_SUBR(Scolor_rgb_8);
 
209
    rep_ADD_SUBR(Scolorp);
 
210
    rep_INTERN_SPECIAL(default_foreground);
 
211
    if (!batch_mode_p ())
 
212
    {
 
213
        repv black = Fget_color (rep_string_dup("#000000"));
 
214
        if (black == rep_NULL)
 
215
            black = Qnil;
 
216
        Fset (Qdefault_foreground, black);
 
217
    }
 
218
    rep_pop_structure (tem);
 
219
}
 
220
 
 
221
void
 
222
colors_kill (void)
 
223
{
 
224
}