1 #include "snd.h"
2
3 typedef struct {
4 int size;
5 char *name;
6 rgb_t *r, *g, *b;
7 Xen lambda;
8 int gc_loc;
9 mus_float_t **(*make_rgb)(int size, Xen func);
10 void (*get_rgb)(double x, rgb_t *r, rgb_t *g, rgb_t *b);
11 } cmap;
12
13 static cmap **cmaps = NULL;
14 static int cmaps_size = 0;
15
16 #define no_such_colormap Xen_make_error_type("no-such-colormap")
17
18
is_colormap(int n)19 bool is_colormap(int n)
20 {
21 return((n >= 0) &&
22 (n < cmaps_size) &&
23 (cmaps[n]));
24 }
25
26
colormap_name(int n)27 char *colormap_name(int n)
28 {
29 if (is_colormap(n))
30 return(cmaps[n]->name);
31 return(NULL);
32 }
33
34
num_colormaps(void)35 int num_colormaps(void)
36 {
37 int i;
38 for (i = cmaps_size - 1; i >= 0; i--)
39 if (cmaps[i])
40 return(i + 1);
41 return(0);
42 }
43
44
delete_cmap(int index)45 static cmap *delete_cmap(int index)
46 {
47 if (is_colormap(index))
48 {
49 cmap *c;
50 c = cmaps[index];
51 if (c->r) free(c->r);
52 if (c->g) free(c->g);
53 if (c->b) free(c->b);
54 if (c->name) free(c->name);
55 if (Xen_is_procedure(c->lambda))
56 snd_unprotect_at(c->gc_loc);
57 free(c);
58 cmaps[index] = NULL;
59 }
60 return(NULL);
61 }
62
63
mus_float_ts_to_rgb_t(int size,mus_float_t * data)64 static rgb_t *mus_float_ts_to_rgb_t(int size, mus_float_t *data)
65 {
66 int i;
67 rgb_t *new_data;
68 new_data = (rgb_t *)calloc(size, sizeof(rgb_t));
69 for (i = 0; i < size; i++)
70 new_data[i] = float_to_rgb(data[i]);
71 return(new_data);
72 }
73
74
rebuild_colormap(cmap * c)75 static void rebuild_colormap(cmap *c)
76 {
77 mus_float_t **rgb;
78 int i;
79 /* release old colormap data */
80 if (c->r) free(c->r);
81 if (c->g) free(c->g);
82 if (c->b) free(c->b);
83 c->size = color_map_size(ss);
84 /* make new data */
85 rgb = (*(c->make_rgb))(c->size, c->lambda);
86 c->r = mus_float_ts_to_rgb_t(c->size, rgb[0]);
87 c->g = mus_float_ts_to_rgb_t(c->size, rgb[1]);
88 c->b = mus_float_ts_to_rgb_t(c->size, rgb[2]);
89 for (i = 0; i < 3; i++) free(rgb[i]);
90 free(rgb);
91 }
92
93
get_current_color(int index,int n,rgb_t * r,rgb_t * g,rgb_t * b)94 void get_current_color(int index, int n, rgb_t *r, rgb_t *g, rgb_t *b)
95 {
96 if (is_colormap(index))
97 {
98 cmap *c;
99 c = cmaps[index];
100 if (c->get_rgb)
101 (c->get_rgb)((double)n / (double)color_map_size(ss), r, g, b);
102 else
103 {
104 if (color_map_size(ss) != c->size)
105 rebuild_colormap(c);
106 if ((n >= 0) && (n < c->size))
107 {
108 (*r) = c->r[n];
109 (*g) = c->g[n];
110 (*b) = c->b[n];
111 }
112 }
113 }
114 }
115
116 #if HAVE_GL
color_map_reds(int index)117 rgb_t *color_map_reds(int index)
118 {
119 if (is_colormap(index))
120 {
121 cmap *c;
122 c = cmaps[index];
123 if (c->get_rgb) return(NULL);
124 if (color_map_size(ss) != c->size)
125 rebuild_colormap(c);
126 return(c->r);
127 }
128 return(NULL);
129 }
130
131
color_map_greens(int index)132 rgb_t *color_map_greens(int index)
133 {
134 if (is_colormap(index))
135 {
136 cmap *c;
137 c = cmaps[index];
138 if (c->get_rgb) return(NULL);
139 if (color_map_size(ss) != c->size)
140 rebuild_colormap(c);
141 return(c->g);
142 }
143 return(NULL);
144 }
145
146
color_map_blues(int index)147 rgb_t *color_map_blues(int index)
148 {
149 if (is_colormap(index))
150 {
151 cmap *c;
152 c = cmaps[index];
153 if (c->get_rgb) return(NULL);
154 if (color_map_size(ss) != c->size)
155 rebuild_colormap(c);
156 return(c->b);
157 }
158 return(NULL);
159 }
160 #endif
161
162
new_cmap(const char * name,int size,mus_float_t ** rgb)163 static cmap *new_cmap(const char *name, int size, mus_float_t **rgb)
164 {
165 cmap *c;
166 c = (cmap *)calloc(1, sizeof(cmap));
167 c->name = mus_strdup(name);
168 c->size = size;
169 if (rgb)
170 {
171 c->r = mus_float_ts_to_rgb_t(size, rgb[0]);
172 c->g = mus_float_ts_to_rgb_t(size, rgb[1]);
173 c->b = mus_float_ts_to_rgb_t(size, rgb[2]);
174 }
175 c->lambda = Xen_false;
176 c->gc_loc = NOT_A_GC_LOC;
177 return(c);
178 }
179
180
make_builtin_cmap(int size,const char * name,mus_float_t ** (* make_rgb)(int size,Xen ignored),void (* get_rgb)(double x,rgb_t * r,rgb_t * g,rgb_t * b))181 static cmap *make_builtin_cmap(int size, const char *name,
182 mus_float_t **(*make_rgb)(int size, Xen ignored),
183 void (*get_rgb)(double x, rgb_t *r, rgb_t *g, rgb_t *b))
184 {
185 mus_float_t **rgb = NULL;
186 cmap *c = NULL;
187 if ((make_rgb) && (!get_rgb))
188 rgb = make_rgb(size, Xen_false);
189 c = new_cmap(name, size, rgb);
190 c->get_rgb = get_rgb;
191 c->make_rgb = make_rgb;
192 if (rgb)
193 {
194 int i;
195 for (i = 0; i < 3; i++) free(rgb[i]);
196 free(rgb);
197 }
198 return(c);
199 }
200
201
make_base_rgb(int size)202 static mus_float_t **make_base_rgb(int size)
203 {
204 mus_float_t **rgb;
205 int i;
206 rgb = (mus_float_t **)calloc(3, sizeof(mus_float_t *));
207 for (i = 0; i < 3; i++) rgb[i] = (mus_float_t *)calloc(size, sizeof(mus_float_t));
208 return(rgb);
209 }
210
211
212 static char *add_colormap_func_error_msg = NULL;
213 static bool add_colormap_func_hit_error = false;
214
add_colormap_func_error(const char * msg,void * data)215 static void add_colormap_func_error(const char *msg, void *data)
216 {
217 add_colormap_func_hit_error = true;
218 add_colormap_func_error_msg = mus_strdup(msg); /* msg itself is freed by the error handler in snd-xen.c */
219 }
220
221
make_xen_colormap(int size,Xen lambda)222 static mus_float_t **make_xen_colormap(int size, Xen lambda)
223 {
224 Xen xrgb;
225 mus_float_t **rgb = NULL;
226 add_colormap_func_hit_error = false;
227 redirect_xen_error_to(add_colormap_func_error, NULL);
228 xrgb = Xen_call_with_1_arg(lambda,
229 C_int_to_Xen_integer(size),
230 S_add_colormap);
231 redirect_xen_error_to(NULL, NULL);
232 if (add_colormap_func_hit_error)
233 {
234 Xen str;
235 if (add_colormap_func_error_msg)
236 {
237 str = C_string_to_Xen_string(add_colormap_func_error_msg);
238 free(add_colormap_func_error_msg);
239 add_colormap_func_error_msg = NULL;
240 }
241 else str = Xen_false;
242
243 Xen_error(Xen_make_error_type("colormap-error"),
244 Xen_list_2(C_string_to_Xen_string(S_add_colormap ": function error ~A"),
245 str));
246 }
247
248 if (!(Xen_is_list(xrgb)))
249 Xen_error(Xen_make_error_type("colormap-error"),
250 Xen_list_3(C_string_to_Xen_string(S_add_colormap ": colormap function, ~A, returned ~A, but should return a list of 3 " S_vct "s"),
251 lambda,
252 xrgb));
253 else
254 {
255 vct *xr, *xg, *xb;
256 mus_float_t *xrdata, *xgdata, *xbdata;
257 int i, gc_loc;
258
259 /* user-defined colormap func returns a list of 3 vcts (r g b) */
260 gc_loc = snd_protect(xrgb);
261
262 if (!(mus_is_vct(Xen_list_ref(xrgb, 0))))
263 Xen_error(Xen_make_error_type("colormap-error"),
264 Xen_list_2(C_string_to_Xen_string(S_add_colormap ": function did not return a list of " S_vct "s! ~A"),
265 xrgb));
266
267 xr = Xen_to_vct(Xen_list_ref(xrgb, 0));
268 xrdata = mus_vct_data(xr);
269 if (mus_vct_length(xr) < size)
270 Xen_error(Xen_make_error_type("colormap-error"),
271 Xen_list_2(C_string_to_Xen_string(S_add_colormap ": function did not return a list of " S_vct "s of the correct size: ~A"),
272 xrgb));
273
274 xg = Xen_to_vct(Xen_list_ref(xrgb, 1));
275 xgdata = mus_vct_data(xg);
276 xb = Xen_to_vct(Xen_list_ref(xrgb, 2));
277 xbdata = mus_vct_data(xb);
278 rgb = make_base_rgb(size);
279 for (i = 0; i < size; i++)
280 {
281 rgb[0][i] = xrdata[i];
282 rgb[1][i] = xgdata[i];
283 rgb[2][i] = xbdata[i];
284 }
285
286 snd_unprotect_at(gc_loc);
287 }
288 return(rgb);
289 }
290
291
add_colormap(const char * name,Xen func)292 static int add_colormap(const char *name, Xen func)
293 {
294 cmap *c;
295 mus_float_t **rgb;
296 int index = -1, i, loc;
297 for (i = 0; i < cmaps_size; i++)
298 if (!(cmaps[i]))
299 {
300 index = i;
301 break;
302 }
303 if (index == -1) /* no free slot */
304 {
305 index = cmaps_size;
306 cmaps_size += 8;
307 cmaps = (cmap **)realloc(cmaps, cmaps_size * sizeof(cmap *));
308 for (i = index; i < cmaps_size; i++) cmaps[i] = NULL;
309 }
310 loc = snd_protect(func);
311 rgb = make_xen_colormap(color_map_size(ss), func);
312 c = new_cmap(name, color_map_size(ss), rgb);
313 c->make_rgb = make_xen_colormap;
314 c->lambda = func;
315 c->gc_loc = loc;
316 for (i = 0; i < 3; i++) free(rgb[i]);
317 free(rgb);
318 cmaps[index] = c;
319 return(index);
320 }
321
322
make_black_and_white_colormap(int size,Xen ignored)323 static mus_float_t **make_black_and_white_colormap(int size, Xen ignored)
324 {
325 /* (r 0) (g 0) (b 0) */
326 return(make_base_rgb(size));
327 }
328
329
330 #define black_and_white_rgb NULL
331
332 /* colormap functions taken mostly from (GPL) octave-forge code written by Kai Habel <kai.habel@gmx.de> */
333
make_gray_colormap(int size,Xen ignored)334 static mus_float_t **make_gray_colormap(int size, Xen ignored)
335 {
336 /* (r x) (g x) (b x) */
337 mus_float_t **rgb;
338 int i;
339 mus_float_t x, incr;
340 rgb = make_base_rgb(size);
341 incr = 1.0 / (mus_float_t)size;
342 for (i = 0, x = 0.0; i < size; i++, x += incr)
343 {
344 rgb[0][i] = x;
345 rgb[1][i] = x;
346 rgb[2][i] = x;
347 }
348 return(rgb);
349 }
350
351
352 #define gray_rgb NULL
353
make_autumn_colormap(int size,Xen ignored)354 static mus_float_t **make_autumn_colormap(int size, Xen ignored)
355 {
356 /* (r 1.0) (g x) (b 0.0) */
357 mus_float_t **rgb;
358 int i;
359 mus_float_t x, incr;
360 rgb = make_base_rgb(size);
361 incr = 1.0 / (mus_float_t)size;
362 for (i = 0, x = 0.0; i < size; i++, x += incr)
363 {
364 rgb[0][i] = 1.0;
365 rgb[1][i] = x;
366 rgb[2][i] = 0.0;
367 }
368 return(rgb);
369 }
370
371
372 #define autumn_rgb NULL
373
374
make_spring_colormap(int size,Xen ignored)375 static mus_float_t **make_spring_colormap(int size, Xen ignored)
376 {
377 /* (r 1.0) (g x) (b (- 1.0 x)) */
378 mus_float_t **rgb;
379 int i;
380 mus_float_t x, incr;
381 rgb = make_base_rgb(size);
382 incr = 1.0 / (mus_float_t)size;
383 for (i = 0, x = 0.0; i < size; i++, x += incr)
384 {
385 rgb[0][i] = 1.0;
386 rgb[1][i] = x;
387 rgb[2][i] = 1.0 - x;
388 }
389 return(rgb);
390 }
391
392
393 #define spring_rgb NULL
394
395
make_winter_colormap(int size,Xen ignored)396 static mus_float_t **make_winter_colormap(int size, Xen ignored)
397 {
398 /* (r 0.0) (g x) (b (- 1.0 (/ x 2))) */
399 mus_float_t **rgb;
400 int i;
401 mus_float_t x, incr;
402 rgb = make_base_rgb(size);
403 incr = 1.0 / (mus_float_t)size;
404 for (i = 0, x = 0.0; i < size; i++, x += incr)
405 {
406 rgb[0][i] = 0.0;
407 rgb[1][i] = x;
408 rgb[2][i] = 1.0 - (x * 0.5);
409 }
410 return(rgb);
411 }
412
413
414 #define winter_rgb NULL
415
416
make_summer_colormap(int size,Xen ignored)417 static mus_float_t **make_summer_colormap(int size, Xen ignored)
418 {
419 /* (r x) (g (+ 0.5 (/ x 2))) (b 0.4) */
420 mus_float_t **rgb;
421 int i;
422 mus_float_t x, incr;
423 rgb = make_base_rgb(size);
424 incr = 1.0 / (mus_float_t)size;
425 for (i = 0, x = 0.0; i < size; i++, x += incr)
426 {
427 rgb[0][i] = x;
428 rgb[1][i] = 0.5 + (0.5 * x);
429 rgb[2][i] = 0.4;
430 }
431 return(rgb);
432 }
433
434
435 #define summer_rgb NULL
436
437
make_cool_colormap(int size,Xen ignored)438 static mus_float_t **make_cool_colormap(int size, Xen ignored)
439 {
440 /* (r x) (g (- 1.0 x)) (b 1.0) */
441 mus_float_t **rgb;
442 int i;
443 mus_float_t x, incr;
444 rgb = make_base_rgb(size);
445 incr = 1.0 / (mus_float_t)size;
446 for (i = 0, x = 0.0; i < size; i++, x += incr)
447 {
448 rgb[0][i] = x;
449 rgb[1][i] = 1.0 - x;
450 rgb[2][i] = 1.0;
451 }
452 return(rgb);
453 }
454
455
456 #define cool_rgb NULL
457
458
make_copper_colormap(int size,Xen ignored)459 static mus_float_t **make_copper_colormap(int size, Xen ignored)
460 {
461 /* (r (if (< x 4/5) (* 5/4 x) 1.0)) (g (* 4/5 x)) (b (* 1/2 x)) */
462 mus_float_t **rgb;
463 int i;
464 mus_float_t x, incr;
465 rgb = make_base_rgb(size);
466 incr = 1.0 / (mus_float_t)size;
467 for (i = 0, x = 0.0; i < size; i++, x += incr)
468 {
469 rgb[0][i] = (x < 0.8) ? (1.25 * x) : 1.0;
470 rgb[1][i] = 0.8 * x;
471 rgb[2][i] = 0.5 * x;
472 }
473 return(rgb);
474 }
475
476
477 #define copper_rgb NULL
478
make_flag_colormap(int size,Xen ignored)479 static mus_float_t **make_flag_colormap(int size, Xen ignored)
480 {
481 /* (r (if (or (= k 0) (= k 1)) 1.0 0.0)) (g (if (= k 1) 1.0 0.0)) (b (if (or (= k 1) (= k 2)) 1.0 0.0)) */
482 mus_float_t **rgb;
483 int i, k = 0;
484 rgb = make_base_rgb(size);
485 for (i = 0; i < size; i++)
486 {
487 rgb[0][i] = (k < 2) ? 1.0 : 0.0;
488 rgb[1][i] = (k == 1) ? 1.0 : 0.0;
489 rgb[2][i] = ((k == 1) || (k == 2)) ? 1.0 : 0.0;
490 k++;
491 if (k == 4) k = 0;
492 }
493 return(rgb);
494 }
495
496
497 #define flag_rgb NULL
498
499
make_prism_colormap(int size,Xen ignored)500 static mus_float_t **make_prism_colormap(int size, Xen ignored)
501 {
502 /* (r (list-ref (list 1 1 1 0 0 2/3) k)) (g (list-ref (list 0 1/2 1 1 0 0) k)) (b (list-ref (list 0 0 0 0 1 1) k)) */
503 mus_float_t **rgb;
504 int i, k = 0;
505 mus_float_t rs[6] = {1.0, 1.0, 1.0, 0.0, 0.0, 0.6667};
506 mus_float_t gs[6] = {0.0, 0.5, 1.0, 1.0, 0.0, 0.0};
507 mus_float_t bs[6] = {0.0, 0.0, 0.0, 0.0, 1.0, 1.0};
508 rgb = make_base_rgb(size);
509 for (i = 0; i < size; i++)
510 {
511 rgb[0][i] = rs[k];
512 rgb[1][i] = gs[k];
513 rgb[2][i] = bs[k];
514 k++;
515 if (k == 6) k = 0;
516 }
517 return(rgb);
518 }
519
520
521 #define prism_rgb NULL
522
523
make_bone_colormap(int size,Xen ignored)524 static mus_float_t **make_bone_colormap(int size, Xen ignored)
525 {
526 /* (r (if (< x 3/4) (* 7/8 x) (- (* 11/8 x) 3/8)))
527 (g (if (< x 3/8) (* 7/8 x) (if (< x 3/4) (- (* 29/24 x) 1/8) (+ (* 7/8 x) 1/8))))
528 (b (if (< x 3/8) (* 29/24 x) (+ (* 7/8 x) 1/8)))
529 */
530 mus_float_t **rgb;
531 int i;
532 mus_float_t x, incr;
533 rgb = make_base_rgb(size);
534 incr = 1.0 / (mus_float_t)size;
535 for (i = 0, x = 0.0; i < size; i++, x += incr)
536 {
537 rgb[0][i] = (x < .75) ? (x * .875) : ((x * 11.0 / 8.0) - .375);
538 rgb[1][i] = (x < .375) ? (x * .875) : ((x < .75) ? ((x * 29.0 / 24.0) - .125) : ((x * .875) + .125));
539 rgb[2][i] = (x < .375) ? (x * 29.0 / 24.0) : ((x * .875) + .125);
540 }
541 return(rgb);
542 }
543
544
545 #define bone_rgb NULL
546
547
make_hot_colormap(int size,Xen ignored)548 static mus_float_t **make_hot_colormap(int size, Xen ignored)
549 {
550 /* (mimicking matlab here, not octave)
551 (r (if (< x 3/8) (* 8/3 x) 1.0))
552 (g (if (< x 3/8) 0.0 (if (< x 3/4) (- (* 8/3 x) 1.0) 1.0)))
553 (b (if (< x 3/4) 0.0 (- (* 4 x) 3)))
554 */
555 mus_float_t **rgb;
556 int i;
557 mus_float_t x, incr;
558 rgb = make_base_rgb(size);
559 incr = 1.0 / (mus_float_t)size;
560 for (i = 0, x = 0.0; i < size; i++, x += incr)
561 {
562 rgb[0][i] = (x < .375) ? (x * 8.0 / 3.0) : 1.0;
563 rgb[1][i] = (x < .375) ? 0.0 : ((x < .75) ? ((x * 8.0 / 3.0) - 1.0) : 1.0);
564 rgb[2][i] = (x < .75) ? 0.0 : ((x * 4.0) - 3.0);
565 }
566 return(rgb);
567 }
568
569
570 #define hot_rgb NULL
571
572
make_jet_colormap(int size,Xen ignored)573 static mus_float_t **make_jet_colormap(int size, Xen ignored)
574 {
575 /*
576 (r (if (< x 3/8) 0.0 (if (< x 5/8) (- (* 4 x) 3/2) (if (< x 7/8) 1.0 (+ (* -4 x) 9/2)))))
577 (g (if (< x 1/8) 0.0 (if (< x 3/8) (- (* 4 x) 1/2) (if (< x 5/8) 1.0 (if (< x 7/8) (+ (* -4 x) 7/2) 0.0)))))
578 (b (if (< x 1/8) (+ (* 4 x) 1/2) (if (< x 3/8) 1.0 (if (< x 5/8) (+ (* -4 x) 5/2) 0.0))))
579 */
580 mus_float_t **rgb;
581 int i;
582 mus_float_t x, incr;
583 rgb = make_base_rgb(size);
584 incr = 1.0 / (mus_float_t)size;
585 for (i = 0, x = 0.0; i < size; i++, x += incr)
586 {
587 rgb[0][i] = (x < .375) ? 0.0 : ((x < .625) ? ((x * 4.0) - 1.5) : ((x < .875) ? 1.0 : ((x * -4.0) + 4.5)));
588 rgb[1][i] = (x < .125) ? 0.0 : ((x < .375) ? ((x * 4.0) - 0.5) : ((x < .625) ? 1.0 : ((x < .875) ? ((x * -4.0) + 3.5) : 0.0)));
589 rgb[2][i] = (x < .125) ? ((x * 4.0) + 0.5) : ((x < .375) ? 1.0 : ((x < .625) ? ((x * -4.0) + 2.5) : 0.0));
590 }
591 return(rgb);
592 }
593
594
595 #define jet_rgb NULL
596
597
make_pink_colormap(int size,Xen ignored)598 static mus_float_t **make_pink_colormap(int size, Xen ignored)
599 {
600 /* matlab uses log here, or something like that -- this version is quite different
601 (r (if (< x 3/8) (* 14/9 x) (+ (* 2/3 x) 1/3)))
602 (g (if (< x 3/8) (* 2/3 x) (if (< x 3/4) (- (* 14/9 x) 1/3) (+ (* 2/3 x) 1/3))))
603 (b (if (< x 3/4) (* 2/3 x) (- (* 2 x) 1)))
604 */
605 mus_float_t **rgb;
606 int i;
607 mus_float_t x, incr;
608 rgb = make_base_rgb(size);
609 incr = 1.0 / (mus_float_t)size;
610 for (i = 0, x = 0.0; i < size; i++, x += incr)
611 {
612 rgb[0][i] = (x < .375) ? (x * 14.0 / 9.0) : ((x * 2.0 / 3.0) + 1.0 / 3.0);
613 rgb[1][i] = (x < .375) ? (x * 2.0 / 3.0) : ((x < .75) ? ((x * 14.0 / 9.0) - 1.0 / 3.0) : ((x * 2.0 / 3.0) + 1.0 / 3.0));
614 rgb[2][i] = (x < .75) ? (x * 2.0 / 3.0) : ((x * 2.0) - 1.0);
615 }
616 return(rgb);
617 }
618
619
620 #define pink_rgb NULL
621
622
make_rainbow_colormap(int size,Xen ignored)623 static mus_float_t **make_rainbow_colormap(int size, Xen ignored)
624 {
625 /*
626 (r (if (< x 2/5) 1.0 (if (< x 3/5) (+ (* -5 x) 3) (if (< x 4/5) 0.0 (- (* 10/3 x) 8/3)))))
627 (g (if (< x 2/5) (* 5/2 x) (if (< x 3/5) 1.0 (if (< x 4/5) (+ (* -5 x) 4) 0.0))))
628 (b (if (< x 3/5) 0.0 (if (< x 4/5) (- (* 5 x) 3) 1.0)))
629 */
630 mus_float_t **rgb;
631 int i;
632 mus_float_t x, incr;
633 rgb = make_base_rgb(size);
634 incr = 1.0 / (mus_float_t)size;
635 for (i = 0, x = 0.0; i < size; i++, x += incr)
636 {
637 rgb[0][i] = (x < .4) ? 1.0 : ((x < .6) ? ((x * -5.0) + 3.0) : ((x < .8) ? 0.0 : ((x * 10.0 / 3.0) - 8.0 / 3.0)));
638 rgb[1][i] = (x < .4) ? (x * 2.5) : ((x < .6) ? 1.0 : ((x < .8) ? ((x * -5.0) + 4.0) : 0.0));
639 rgb[2][i] = (x < .6) ? 0.0 : ((x < .8) ? ((x * 5.0) - 3.0) : 1.0);
640 }
641 return(rgb);
642 }
643
644
645 #define rainbow_rgb NULL
646
647
make_phases_colormap(int size,Xen ignored)648 static mus_float_t **make_phases_colormap(int size, Xen ignored)
649 {
650 /* 0 and pi: blue->green, pi/2 and 3pi/2: red->black */
651 mus_float_t **rgb;
652 int i;
653 mus_float_t x, incr;
654 rgb = make_base_rgb(size);
655 incr = (2.0 * M_PI) / (mus_float_t)size;
656 for (i = 0, x = 0.0; i < size; i++, x += incr)
657 {
658 if (x <= 0.5 * M_PI)
659 {
660 rgb[0][i] = x / (0.5 * M_PI);
661 rgb[1][i] = 0.0;
662 rgb[2][i] = 1.0 - rgb[0][i];
663 }
664 else
665 {
666 if (x <= M_PI)
667 {
668 rgb[0][i] = 1.0 - ((x - 0.5 * M_PI) / (0.5 * M_PI));
669 rgb[1][i] = 1.0 - rgb[0][i];
670 rgb[2][i] = 0.0;
671 }
672 else
673 {
674 if (x <= 1.5 * M_PI)
675 {
676 rgb[0][i] = 0.0;
677 rgb[1][i] = 1.0 - ((x - M_PI) / (0.5 * M_PI));
678 rgb[2][i] = 0.0;
679 }
680 else
681 {
682 rgb[0][i] = 0.0;
683 rgb[1][i] = 1.0 - ((x - (1.5 * M_PI)) / (0.5 * M_PI));
684 rgb[2][i] = 0.0;
685 }
686 }
687 }
688 }
689 return(rgb);
690 }
691
692
693 #define phases_rgb NULL
694
695
696 /* ---------------------------------------- colormap objects ---------------------------------------- */
697
698 typedef struct {
699 int n;
700 } xen_colormap;
701
702
703 #define Xen_to_xen_colormap(arg) ((xen_colormap *)Xen_object_ref(arg))
704
xen_colormap_to_int(Xen n)705 static int xen_colormap_to_int(Xen n)
706 {
707 xen_colormap *col;
708 col = Xen_to_xen_colormap(n);
709 return(col->n);
710 }
711
712 #define Xen_colormap_to_C_int(n) xen_colormap_to_int(n)
713
714
715 static Xen_object_type_t xen_colormap_tag;
716
xen_is_colormap(Xen obj)717 static bool xen_is_colormap(Xen obj)
718 {
719 return(Xen_c_object_is_type(obj, xen_colormap_tag));
720 }
721
722 #if (!HAVE_SCHEME)
xen_colormap_free(xen_colormap * v)723 static void xen_colormap_free(xen_colormap *v) {if (v) free(v);}
724
Xen_wrap_free(xen_colormap,free_xen_colormap,xen_colormap_free)725 Xen_wrap_free(xen_colormap, free_xen_colormap, xen_colormap_free)
726 #else
727 static s7_pointer s7_xen_colormap_free(s7_scheme *sc, s7_pointer obj)
728 {
729 xen_colormap *v;
730 v = (xen_colormap *)s7_c_object_value(obj);
731 if (v) free(v);
732 return(NULL);
733 }
734 #endif
735
736 static char *xen_colormap_to_string(xen_colormap *v)
737 {
738 #define COLORMAP_PRINT_BUFFER_SIZE 64
739 char *buf;
740 if (!v) return(NULL);
741 buf = (char *)calloc(COLORMAP_PRINT_BUFFER_SIZE, sizeof(char));
742 snprintf(buf, COLORMAP_PRINT_BUFFER_SIZE, "#<colormap %s>", colormap_name(v->n));
743 return(buf);
744 }
745
746
747 #if HAVE_FORTH || HAVE_RUBY
Xen_wrap_print(xen_colormap,print_xen_colormap,xen_colormap_to_string)748 Xen_wrap_print(xen_colormap, print_xen_colormap, xen_colormap_to_string)
749 #define S_xen_colormap_to_string "colormap->string"
750
751 static Xen g_xen_colormap_to_string(Xen obj)
752 {
753 char *vstr;
754 Xen result;
755 Xen_check_type(xen_is_colormap(obj), obj, 1, S_xen_colormap_to_string, "a colormap");
756 vstr = xen_colormap_to_string(Xen_to_xen_colormap(obj));
757 result = C_string_to_Xen_string(vstr);
758 free(vstr);
759 return(result);
760 }
761 #else
762 #if HAVE_SCHEME
g_xen_colormap_to_string(s7_scheme * sc,s7_pointer args)763 static s7_pointer g_xen_colormap_to_string(s7_scheme *sc, s7_pointer args)
764 {
765 char *vstr;
766 s7_pointer result;
767 vstr = xen_colormap_to_string(Xen_to_xen_colormap(s7_car(args)));
768 result = C_string_to_Xen_string(vstr);
769 free(vstr);
770 return(result);
771 }
772 #endif
773 #endif
774
775 #if (!HAVE_SCHEME)
xen_colormap_equalp(xen_colormap * v1,xen_colormap * v2)776 static bool xen_colormap_equalp(xen_colormap *v1, xen_colormap *v2)
777 {
778 return((v1 == v2) ||
779 (v1->n == v2->n));
780 }
781
equalp_xen_colormap(Xen obj1,Xen obj2)782 static Xen equalp_xen_colormap(Xen obj1, Xen obj2)
783 {
784 if ((!(xen_is_colormap(obj1))) || (!(xen_is_colormap(obj2)))) return(Xen_false);
785 return(C_bool_to_Xen_boolean(xen_colormap_equalp(Xen_to_xen_colormap(obj1), Xen_to_xen_colormap(obj2))));
786 }
787 #endif
788
789
xen_colormap_make(int n)790 static xen_colormap *xen_colormap_make(int n)
791 {
792 xen_colormap *new_v;
793 new_v = (xen_colormap *)malloc(sizeof(xen_colormap));
794 new_v->n = n;
795 return(new_v);
796 }
797
798
new_xen_colormap(int n)799 static Xen new_xen_colormap(int n)
800 {
801 xen_colormap *mx;
802 if (n < 0)
803 return(Xen_false);
804
805 mx = xen_colormap_make(n);
806 return(Xen_make_object(xen_colormap_tag, mx, 0, free_xen_colormap)); /* last 2 args ignored in s7 */
807 }
808
809 #define C_int_to_Xen_colormap(Val) new_xen_colormap(Val)
810
811
812 #if HAVE_SCHEME
s7_xen_colormap_is_equal(s7_scheme * sc,s7_pointer args)813 static s7_pointer s7_xen_colormap_is_equal(s7_scheme *sc, s7_pointer args)
814 {
815 s7_pointer p1, p2;
816 p1 = s7_car(args);
817 p2 = s7_cadr(args);
818 if (p1 == p2) return(s7_t(sc));
819 if (s7_c_object_type(p2) == xen_colormap_tag)
820 return(s7_make_boolean(sc, (((xen_colormap *)s7_c_object_value(p1))->n == ((xen_colormap *)s7_c_object_value(p2))->n)));
821 return(s7_f(sc));
822 }
823
s7_xen_colormap_length(s7_scheme * sc,Xen args)824 static Xen s7_xen_colormap_length(s7_scheme *sc, Xen args)
825 {
826 return(C_int_to_Xen_integer(color_map_size(ss)));
827 }
828
829
830 static Xen g_colormap_ref(Xen map, Xen pos);
s7_colormap_apply(s7_scheme * sc,Xen args1)831 static Xen s7_colormap_apply(s7_scheme *sc, Xen args1)
832 {
833 s7_pointer obj, args;
834 obj = s7_car(args1);
835 args = s7_cdr(args1);
836 if (!s7_is_pair(args))
837 s7_wrong_number_of_args_error(sc, "colormap ref", args);
838 return(g_colormap_ref(obj, Xen_car(args)));
839 }
840 #endif
841
842
init_xen_colormap(void)843 static void init_xen_colormap(void)
844 {
845 #if HAVE_SCHEME
846 xen_colormap_tag = s7_make_c_type(s7, "<colormap>");
847 s7_c_type_set_gc_free(s7, xen_colormap_tag, s7_xen_colormap_free);
848 s7_c_type_set_is_equal(s7, xen_colormap_tag, s7_xen_colormap_is_equal);
849 s7_c_type_set_length(s7, xen_colormap_tag, s7_xen_colormap_length);
850 s7_c_type_set_ref(s7, xen_colormap_tag, s7_colormap_apply);
851 s7_c_type_set_to_string(s7, xen_colormap_tag, g_xen_colormap_to_string);
852 #else
853 #if HAVE_RUBY
854 xen_colormap_tag = Xen_make_object_type("XenColormap", sizeof(xen_colormap));
855 #else
856 xen_colormap_tag = Xen_make_object_type("Colormap", sizeof(xen_colormap));
857 #endif
858 #endif
859
860 #if HAVE_FORTH
861 fth_set_object_inspect(xen_colormap_tag, print_xen_colormap);
862 fth_set_object_dump(xen_colormap_tag, g_xen_colormap_to_string);
863 fth_set_object_equal(xen_colormap_tag, equalp_xen_colormap);
864 fth_set_object_free(xen_colormap_tag, free_xen_colormap);
865 #endif
866
867 #if HAVE_RUBY
868 rb_define_method(xen_colormap_tag, "to_s", Xen_procedure_cast print_xen_colormap, 0);
869 rb_define_method(xen_colormap_tag, "eql?", Xen_procedure_cast equalp_xen_colormap, 1);
870 rb_define_method(xen_colormap_tag, "==", Xen_procedure_cast equalp_xen_colormap, 1);
871 rb_define_method(xen_colormap_tag, "to_str", Xen_procedure_cast g_xen_colormap_to_string, 0);
872 #endif
873 }
874
875
876 /* -------------------------------------------------------------------------------- */
877
g_integer_to_colormap(Xen n)878 static Xen g_integer_to_colormap(Xen n)
879 {
880 #define H_integer_to_colormap "(" S_integer_to_colormap " n) returns a colormap object corresponding to the given integer"
881 int id;
882 Xen_check_type(Xen_is_integer(n), n, 1, S_integer_to_colormap, "an integer");
883 id = Xen_integer_to_C_int(n);
884 if (is_colormap(id))
885 return(new_xen_colormap(id));
886 return(Xen_false);
887 }
888
889
g_colormap_to_integer(Xen n)890 static Xen g_colormap_to_integer(Xen n)
891 {
892 #define H_colormap_to_integer "(" S_colormap_to_integer " id) returns the integer corresponding to the given colormap"
893 Xen_check_type(xen_is_colormap(n), n, 1, S_colormap_to_integer, "a colormap");
894 return(C_int_to_Xen_integer(xen_colormap_to_int(n)));
895 }
896
897
898
g_colormap_ref(Xen map,Xen pos)899 static Xen g_colormap_ref(Xen map, Xen pos)
900 {
901 int index;
902 mus_float_t x;
903 rgb_t r = 0, g = 0, b = 0;
904
905 #define H_colormap_ref "(" S_colormap_ref " colormap pos): (list r g b). Pos is between 0.0 and 1.0."
906
907 Xen_check_type(xen_is_colormap(map), map, 1, S_colormap_ref, "a colormap object");
908 Xen_check_type(Xen_is_number(pos), pos, 2, S_colormap_ref, "a number between 0.0 and 1.0");
909
910 index = Xen_colormap_to_C_int(map);
911 if (!(is_colormap(index)))
912 Xen_error(no_such_colormap,
913 Xen_list_2(C_string_to_Xen_string(S_colormap_ref ": no such colormap: ~A"),
914 map));
915
916 x = Xen_real_to_C_double(pos);
917 if ((isnan(x)) || (x < 0.0) || (x > 1.0))
918 Xen_out_of_range_error(S_colormap_ref, 2, pos, "x must be between 0.0 and 1.0");
919
920 get_current_color(index, (int)(color_map_size(ss) * x + 0.5), &r, &g, &b);
921 return(Xen_list_3(C_double_to_Xen_real(rgb_to_float(r)),
922 C_double_to_Xen_real(rgb_to_float(g)),
923 C_double_to_Xen_real(rgb_to_float(b))));
924 }
925
926 /* can't use Colormap -- it's the X type name */
927
928
g_colormap(void)929 static Xen g_colormap(void)
930 {
931 #define H_colormap "(" S_colormap "): current colormap choice."
932 return(C_int_to_Xen_colormap(color_map(ss)));
933 }
934
g_set_colormap(Xen val)935 static Xen g_set_colormap(Xen val)
936 {
937 int index;
938
939 Xen_check_type(xen_is_colormap(val), val, 1, S_set S_colormap, "a colormap");
940
941 index = Xen_colormap_to_C_int(val);
942 if (!(is_colormap(index)))
943 Xen_error(no_such_colormap,
944 Xen_list_2(C_string_to_Xen_string(S_colormap ": no such colormap: ~A"),
945 val));
946
947 set_color_map(index); /* this normally redisplays */
948 return(val);
949 }
950
951
g_colormap_size(void)952 static Xen g_colormap_size(void) {return(C_int_to_Xen_integer(color_map_size(ss)));}
953
g_set_colormap_size(Xen val)954 static Xen g_set_colormap_size(Xen val)
955 {
956 int size;
957 #define H_colormap_size "(" S_colormap_size "): current colormap size; default is 512."
958
959 Xen_check_type(Xen_is_integer(val), val, 1, S_set S_colormap_size, "an integer");
960
961 size = Xen_integer_to_C_int(val);
962 if (size < 0)
963 Xen_out_of_range_error(S_set S_colormap_size, 1, val, "size < 0?");
964 if (size > (1 << 26))
965 Xen_out_of_range_error(S_set S_colormap_size, 1, val, "size too large");
966
967 set_color_map_size(size);
968 check_colormap_sizes(color_map_size(ss));
969
970 return(C_int_to_Xen_integer(color_map_size(ss)));
971 }
972
973
g_colormap_name(Xen col)974 static Xen g_colormap_name(Xen col)
975 {
976 int map;
977 #define H_colormap_name "(" S_colormap_name " colormap) returns the colormap's name (used in the Color/Orientation dialog)."
978
979 Xen_check_type(xen_is_colormap(col), col, 1, S_colormap_name, "a colormap");
980
981 map = Xen_colormap_to_C_int(col);
982 if (!(is_colormap(map)))
983 Xen_error(no_such_colormap,
984 Xen_list_2(C_string_to_Xen_string(S_colormap_name ": no such colormap: ~A"),
985 col));
986
987 return(C_string_to_Xen_string(cmaps[map]->name));
988 }
989
990
g_is_colormap(Xen obj)991 static Xen g_is_colormap(Xen obj)
992 {
993 #define H_is_colormap "(" S_is_colormap " obj) -> " PROC_TRUE " if 'obj' is a colormap."
994 return(C_bool_to_Xen_boolean(xen_is_colormap(obj) &&
995 is_colormap(Xen_colormap_to_C_int(obj))));
996 }
997
998
g_delete_colormap(Xen col)999 static Xen g_delete_colormap(Xen col)
1000 {
1001 int map;
1002 #define H_delete_colormap "(" S_delete_colormap " colormap) frees the specified colormap."
1003
1004 Xen_check_type(xen_is_colormap(col), col, 1, S_delete_colormap, "a colormap");
1005
1006 map = Xen_colormap_to_C_int(col);
1007 if (!(is_colormap(map)))
1008 Xen_error(no_such_colormap,
1009 Xen_list_2(C_string_to_Xen_string(S_delete_colormap ": no such colormap: ~A"),
1010 col));
1011
1012 delete_cmap(map);
1013 reflect_color_list(false);
1014 if (color_map(ss) == map) set_color_map(DEFAULT_COLOR_MAP);
1015
1016 return(col);
1017 }
1018
1019
1020 #include "clm2xen.h"
1021
g_add_colormap(Xen name,Xen func)1022 static Xen g_add_colormap(Xen name, Xen func)
1023 {
1024 int index;
1025 #define H_add_colormap "(" S_add_colormap " name func) adds the colormap created by func to the colormap table, \
1026 returning the new colormap. 'name' is the colormap's name in the View:Color/Orientation dialog."
1027
1028 Xen_check_type(Xen_is_string(name), name, 1, S_add_colormap, "a string");
1029 Xen_check_type(Xen_is_procedure(func) && (!mus_is_xen(func)), func, 2, S_add_colormap, "a function of 2 args");
1030
1031 if (!(procedure_arity_ok(func, 1)))
1032 return(snd_bad_arity_error(S_add_colormap,
1033 C_string_to_Xen_string("func should take 1 arg"),
1034 func));
1035
1036 index = add_colormap(Xen_string_to_C_string(name), func);
1037 reflect_color_list(false);
1038
1039 return(C_int_to_Xen_colormap(index));
1040 }
1041
1042
Xen_wrap_2_args(g_colormap_ref_w,g_colormap_ref)1043 Xen_wrap_2_args(g_colormap_ref_w, g_colormap_ref)
1044 Xen_wrap_no_args(g_colormap_w, g_colormap)
1045 Xen_wrap_1_arg(g_is_colormap_w, g_is_colormap)
1046 Xen_wrap_1_arg(g_set_colormap_w, g_set_colormap)
1047 Xen_wrap_no_args(g_colormap_size_w, g_colormap_size)
1048 Xen_wrap_1_arg(g_set_colormap_size_w, g_set_colormap_size)
1049 Xen_wrap_1_arg(g_colormap_name_w, g_colormap_name)
1050 Xen_wrap_1_arg(g_delete_colormap_w, g_delete_colormap)
1051 Xen_wrap_2_args(g_add_colormap_w, g_add_colormap)
1052 Xen_wrap_1_arg(g_integer_to_colormap_w, g_integer_to_colormap)
1053 Xen_wrap_1_arg(g_colormap_to_integer_w, g_colormap_to_integer)
1054
1055 #if HAVE_SCHEME
1056 static s7_pointer acc_colormap(s7_scheme *sc, s7_pointer args) {return(g_set_colormap(s7_cadr(args)));}
acc_colormap_size(s7_scheme * sc,s7_pointer args)1057 static s7_pointer acc_colormap_size(s7_scheme *sc, s7_pointer args) {return(g_set_colormap_size(s7_cadr(args)));}
1058 #endif
1059
1060 #if (!HAVE_SCHEME)
1061 static Xen colormap_temp[16]; /* static for Ruby's sake */
1062 #endif
1063
g_init_gxcolormaps(void)1064 void g_init_gxcolormaps(void)
1065 {
1066 #if HAVE_SCHEME
1067 s7_pointer i, p, t, b, r, s, col, fnc;
1068 b = s7_make_symbol(s7, "boolean?");
1069 i = s7_make_symbol(s7, "integer?");
1070 p = s7_make_symbol(s7, "pair?");
1071 r = s7_make_symbol(s7, "real?");
1072 s = s7_make_symbol(s7, "string?");
1073 col = s7_make_symbol(s7, "colormap?");
1074 fnc = s7_make_symbol(s7, "procedure?");
1075 t = s7_t(s7);
1076 #endif
1077
1078 cmaps_size = NUM_BUILTIN_COLORMAPS;
1079 cmaps = (cmap **)calloc(cmaps_size, sizeof(cmap *));
1080
1081 init_xen_colormap();
1082
1083 cmaps[BLACK_AND_WHITE_COLORMAP] = make_builtin_cmap(1, "black-and-white", make_black_and_white_colormap, black_and_white_rgb);
1084 cmaps[GRAY_COLORMAP] = make_builtin_cmap(1, "gray", make_gray_colormap, gray_rgb);
1085 cmaps[AUTUMN_COLORMAP] = make_builtin_cmap(1, "autumn", make_autumn_colormap, autumn_rgb);
1086 cmaps[SPRING_COLORMAP] = make_builtin_cmap(1, "spring", make_spring_colormap, spring_rgb);
1087 cmaps[WINTER_COLORMAP] = make_builtin_cmap(1, "winter", make_winter_colormap, winter_rgb);
1088 cmaps[SUMMER_COLORMAP] = make_builtin_cmap(1, "summer", make_summer_colormap, summer_rgb);
1089 cmaps[COOL_COLORMAP] = make_builtin_cmap(1, "cool", make_cool_colormap, cool_rgb);
1090 cmaps[COPPER_COLORMAP] = make_builtin_cmap(1, "copper", make_copper_colormap, copper_rgb);
1091 cmaps[FLAG_COLORMAP] = make_builtin_cmap(1, "flag", make_flag_colormap, flag_rgb);
1092 cmaps[PRISM_COLORMAP] = make_builtin_cmap(1, "prism", make_prism_colormap, prism_rgb);
1093 cmaps[BONE_COLORMAP] = make_builtin_cmap(1, "bone", make_bone_colormap, bone_rgb);
1094 cmaps[HOT_COLORMAP] = make_builtin_cmap(1, "hot", make_hot_colormap, hot_rgb);
1095 cmaps[JET_COLORMAP] = make_builtin_cmap(1, "jet", make_jet_colormap, jet_rgb);
1096 cmaps[PINK_COLORMAP] = make_builtin_cmap(1, "pink", make_pink_colormap, pink_rgb);
1097 cmaps[RAINBOW_COLORMAP] = make_builtin_cmap(1, "rainbow", make_rainbow_colormap, rainbow_rgb);
1098 cmaps[PHASES_COLORMAP] = make_builtin_cmap(1, "phases", make_phases_colormap, phases_rgb);
1099
1100 #if HAVE_SCHEME
1101 s7_define_constant(s7, "black-and-white-colormap", C_int_to_Xen_colormap(0));
1102 s7_define_constant(s7, "gray-colormap", C_int_to_Xen_colormap(1));
1103 s7_define_constant(s7, "hot-colormap", C_int_to_Xen_colormap(2));
1104 s7_define_constant(s7, "cool-colormap", C_int_to_Xen_colormap(3));
1105 s7_define_constant(s7, "bone-colormap", C_int_to_Xen_colormap(4));
1106 s7_define_constant(s7, "copper-colormap", C_int_to_Xen_colormap(5));
1107 s7_define_constant(s7, "pink-colormap", C_int_to_Xen_colormap(6));
1108 s7_define_constant(s7, "jet-colormap", C_int_to_Xen_colormap(7));
1109 s7_define_constant(s7, "prism-colormap", C_int_to_Xen_colormap(8));
1110 s7_define_constant(s7, "autumn-colormap", C_int_to_Xen_colormap(9));
1111 s7_define_constant(s7, "winter-colormap", C_int_to_Xen_colormap(10));
1112 s7_define_constant(s7, "spring-colormap", C_int_to_Xen_colormap(11));
1113 s7_define_constant(s7, "summer-colormap", C_int_to_Xen_colormap(12));
1114 s7_define_constant(s7, "rainbow-colormap", C_int_to_Xen_colormap(13));
1115 s7_define_constant(s7, "flag-colormap", C_int_to_Xen_colormap(14));
1116 s7_define_constant(s7, "phases-colormap", C_int_to_Xen_colormap(15));
1117 #else
1118 Xen_define_variable("black-and-white-colormap", colormap_temp[0], C_int_to_Xen_colormap(0));
1119 Xen_define_variable("gray-colormap", colormap_temp[1], C_int_to_Xen_colormap(1));
1120 Xen_define_variable("hot-colormap", colormap_temp[2], C_int_to_Xen_colormap(2));
1121 Xen_define_variable("cool-colormap", colormap_temp[3], C_int_to_Xen_colormap(3));
1122 Xen_define_variable("bone-colormap", colormap_temp[4], C_int_to_Xen_colormap(4));
1123 Xen_define_variable("copper-colormap", colormap_temp[5], C_int_to_Xen_colormap(5));
1124 Xen_define_variable("pink-colormap", colormap_temp[6], C_int_to_Xen_colormap(6));
1125 Xen_define_variable("jet-colormap", colormap_temp[7], C_int_to_Xen_colormap(7));
1126 Xen_define_variable("prism-colormap", colormap_temp[8], C_int_to_Xen_colormap(8));
1127 Xen_define_variable("autumn-colormap", colormap_temp[9], C_int_to_Xen_colormap(9));
1128 Xen_define_variable("winter-colormap", colormap_temp[10], C_int_to_Xen_colormap(10));
1129 Xen_define_variable("spring-colormap", colormap_temp[11], C_int_to_Xen_colormap(11));
1130 Xen_define_variable("summer-colormap", colormap_temp[12], C_int_to_Xen_colormap(12));
1131 Xen_define_variable("rainbow-colormap", colormap_temp[13], C_int_to_Xen_colormap(13));
1132 Xen_define_variable("flag-colormap", colormap_temp[14], C_int_to_Xen_colormap(14));
1133 Xen_define_variable("phases-colormap", colormap_temp[15], C_int_to_Xen_colormap(15));
1134 #endif
1135
1136 Xen_define_typed_procedure(S_is_colormap, g_is_colormap_w, 1, 0, 0, H_is_colormap, s7_make_signature(s7, 2, b, t));
1137 Xen_define_typed_procedure(S_colormap_ref, g_colormap_ref_w, 2, 0, 0, H_colormap_ref, s7_make_signature(s7, 3, p, col, r));
1138 Xen_define_typed_procedure(S_add_colormap, g_add_colormap_w, 2, 0, 0, H_add_colormap, s7_make_signature(s7, 3, col, s, fnc));
1139 Xen_define_typed_procedure(S_colormap_name, g_colormap_name_w, 1, 0, 0, H_colormap_name, s7_make_signature(s7, 2, s, col));
1140 Xen_define_typed_procedure(S_delete_colormap, g_delete_colormap_w, 1, 0, 0, H_delete_colormap, s7_make_signature(s7, 2, col, col));
1141 Xen_define_typed_procedure(S_integer_to_colormap, g_integer_to_colormap_w, 1, 0, 0, H_integer_to_colormap,
1142 s7_make_signature(s7, 2, s7_make_signature(s7, 2, col, b), i));
1143 Xen_define_typed_procedure(S_colormap_to_integer, g_colormap_to_integer_w, 1, 0, 0, H_colormap_to_integer, s7_make_signature(s7, 2, i, col));
1144
1145 Xen_define_typed_dilambda(S_colormap, g_colormap_w, H_colormap,
1146 S_set S_colormap, g_set_colormap_w, 0, 0, 1, 0,
1147 s7_make_signature(s7, 1, col), s7_make_signature(s7, 2, col, col));
1148
1149 Xen_define_typed_dilambda(S_colormap_size, g_colormap_size_w, H_colormap_size,
1150 S_set S_colormap_size, g_set_colormap_size_w, 0, 0, 1, 0,
1151 s7_make_signature(s7, 1, i), s7_make_signature(s7, 2, i, i));
1152
1153 #if HAVE_SCHEME
1154 s7_set_setter(s7, ss->color_map_size_symbol, s7_make_function(s7, "[acc-" S_colormap_size "]", acc_colormap_size, 2, 0, false, "accessor"));
1155 s7_set_setter(s7, ss->color_map_symbol, s7_make_function(s7, "[acc-" S_colormap "]", acc_colormap, 2, 0, false, "accessor"));
1156
1157 s7_set_documentation(s7, ss->color_map_size_symbol, "*colormap-size*: current colormap size; default is 512.");
1158 s7_set_documentation(s7, ss->color_map_symbol, "*colormap*: current colormap choice.");
1159 #endif
1160 }
1161