1 /* Copyright (C) 2000 The PARI group.
2
3 This file is part of the PARI/GP package.
4
5 PARI/GP is free software; you can redistribute it and/or modify it under the
6 terms of the GNU General Public License as published by the Free Software
7 Foundation; either version 2 of the License, or (at your option) any later
8 version. It is distributed in the hope that it will be useful, but WITHOUT
9 ANY WARRANTY WHATSOEVER.
10
11 Check the License for details. You should have received a copy of it, along
12 with the package; see the file 'COPYING'. If not, write to the Free Software
13 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
14
15 /*******************************************************************/
16 /* */
17 /* PLOT ROUTINES */
18 /* */
19 /*******************************************************************/
20 #include "pari.h"
21 #include "paripriv.h"
22 #include "rect.h"
23
24 static void (*pari_get_plot)(PARI_plot *);
25
26 /* no need for THREAD: OK to share this */
27 static hashtable *rgb_colors = NULL;
28
29 THREAD PariRect rectgraph[18]; /*NUMRECT*/
30 static THREAD long current_color[18]; /*NUMRECT*/
31
32 static long plotpoint_itype = 0, rectline_itype = 0;
33
34 const long NUMRECT = 18;
35 const long RECUR_MAXDEPTH = 10;
36 const double RECUR_PREC = 0.001;
37 const long DEFAULT_COLOR = 1, AXIS_COLOR = 2;
38
39 enum {
40 ROt_MV = 1, /* Move */
41 ROt_PT, /* Point */
42 ROt_LN, /* Line */
43 ROt_BX, /* Box */
44 ROt_FBX, /* Filled Box */
45 ROt_MP, /* Multiple point */
46 ROt_ML, /* Multiple lines */
47 ROt_ST, /* String */
48 ROt_PTT, /* Point type change */
49 ROt_LNT, /* Line type change */
50 ROt_PTS, /* Point size change */
51 ROt_NULL, /* To be the start of the chain */
52 };
53
54 /* string justification */
55 #define RoSTdirLEFT 0x00
56 #define RoSTdirRIGHT 0x02
57 #define RoSTdirHPOS_mask 0x03
58 #define RoSTdirBOTTOM 0x00
59 #define RoSTdirTOP 0x08
60 #define RoSTdirVPOS_mask 0x0c
61 #define RoSTdirHGAP 0x10
62 #define RoSTdirVGAP 0x20
63
64 /* ploth flags */
65 #define PLOT_PARAMETRIC 0x00001
66 #define PLOT_RECURSIVE 0x00002
67 #define PLOT_NO_RESCALE 0x00004
68 #define PLOT_NO_AXE_X 0x00008
69 #define PLOT_NO_AXE_Y 0x00010
70 #define PLOT_NO_FRAME 0x00020
71 #define PLOT_POINTS 0x00040
72 #define PLOT_POINTS_LINES 0x00080
73 #define PLOT_SPLINES 0x00100
74 #define PLOT_NO_TICK_X 0x00200
75 #define PLOT_NO_TICK_Y 0x00400
76 #define PLOT_NODOUBLETICK 0x00800
77 #define PLOT_COMPLEX 0x01000
78 #define PLOT_PARA 0x02000
79
80 INLINE long
DTOL(double t)81 DTOL(double t) { return (long)(t + 0.5); }
82
83 static const long PS_WIDTH = 1120 - 60; /* 1400 - 60 for hi-res */
84 static const long PS_HEIGH = 800 - 40; /* 1120 - 60 for hi-res */
85 static const long PS_SCALE = 1000; /* Allowing 64x zoom on 500ppi */
86
87 static void
_psdraw_scale(PARI_plot * T,GEN w,GEN x,GEN y)88 _psdraw_scale(PARI_plot *T, GEN w, GEN x, GEN y)
89 {
90 pari_sp av = avma;
91 FILE *F = fopen(current_psfile, "a");
92 if (!F) pari_err_FILE("postscript file",current_psfile);
93 fputs(rect2ps(w,x,y,T), F);
94 fclose(F); set_avma(av);
95 }
96 static void
_psdraw(PARI_plot * T,GEN w,GEN x,GEN y)97 _psdraw(PARI_plot *T, GEN w, GEN x, GEN y)
98 { (void)T; _psdraw_scale(NULL,w,x,y); }
99 static void
pari_get_psplot(PARI_plot * T)100 pari_get_psplot(PARI_plot *T)
101 {
102 T->width = PS_WIDTH;
103 T->height = PS_HEIGH;
104 T->fheight= 15;
105 T->fwidth = 6;
106 T->hunit = 5;
107 T->vunit = 5;
108 T->dwidth = 0;
109 T->dheight= 0;
110 T->draw = NULL;
111 }
112 static void
pari_get_svgplot(PARI_plot * T)113 pari_get_svgplot(PARI_plot *T)
114 {
115 T->width = 480;
116 T->height = 320;
117 T->fheight = 12;
118 T->fwidth = 6;
119 T->hunit = 3;
120 T->vunit = 3;
121 T->dwidth = 0;
122 T->dheight = 0;
123 T->draw = NULL;
124 }
125
126 /********************************************************************/
127 /** **/
128 /** RECTPLOT FUNCTIONS **/
129 /** **/
130 /********************************************************************/
131 void
pari_init_graphics(void)132 pari_init_graphics(void) { pari_get_plot = &pari_get_svgplot; }
133
134 void
pari_set_plot_engine(void (* plot)(PARI_plot *))135 pari_set_plot_engine(void (*plot)(PARI_plot *))
136 {
137 long n;
138 pari_get_plot = plot;
139 for (n = 0; n < NUMRECT; n++)
140 {
141 PariRect *e = &rectgraph[n];
142 RHead(e) = RTail(e) = NULL;
143 RXsize(e) = RYsize(e) = 0;
144 }
145 }
146
147 void
pari_kill_plot_engine(void)148 pari_kill_plot_engine(void)
149 {
150 int i;
151 for (i=0; i<NUMRECT; i++)
152 {
153 PariRect *e = &rectgraph[i];
154 if (RHead(e)) plotkill(i);
155 }
156 if (rgb_colors)
157 {
158 pari_free((void*)rgb_colors->table);
159 pari_free((void*)rgb_colors);
160 }
161 }
162
163 static PariRect *
check_rect(long ne)164 check_rect(long ne)
165 {
166 const char *f = "graphic function";
167 const long m = NUMRECT-1;
168 if (ne < 0) pari_err_DOMAIN(f, "rectwindow", "<", gen_0, stoi(ne));
169 if (ne > m) pari_err_DOMAIN(f, "rectwindow", ">", stoi(m), stoi(ne));
170 return &rectgraph[ne];
171 }
172
173 static PariRect *
check_rect_init(long ne)174 check_rect_init(long ne)
175 {
176 PariRect *e = check_rect(ne);
177 if (!RHead(e)) pari_err_TYPE("graphic function [use plotinit()]", stoi(ne));
178 return e;
179 }
180 static void
Rchain(PariRect * e,RectObj * z)181 Rchain(PariRect *e, RectObj *z)
182 {
183 if (!RHead(e)) RHead(e) = z; else RoNext(RTail(e)) = z;
184 RTail(e) = z;
185 RoNext(z) = NULL;
186 }
187
188 static long
rgb_to_long(long r,long g,long b)189 rgb_to_long(long r, long g, long b)
190 { return (r << 16) | (g << 8) | b; }
191 /* c from graphcolormap */
192 static long
colormap_to_color(long i)193 colormap_to_color(long i)
194 {
195 GEN c = GP_DATA->colormap;
196 long k = i+1, l = lg(c)-1;
197 int r, g, b;
198 if (k > l)
199 pari_err_COMPONENT("graphcolormap",">", stoi(l), stoi(k));
200 color_to_rgb(gel(c, k), &r,&g,&b);
201 return rgb_to_long(r, g, b);
202 }
203
204 static void
initrect_i(long ne,long x,long y)205 initrect_i(long ne, long x, long y)
206 {
207 PariRect *e;
208 RectObj *z;
209
210 if (x <= 1) pari_err_DOMAIN("plotinit", "x", "<=", gen_1, stoi(x));
211 if (y <= 1) pari_err_DOMAIN("plotinit", "y", "<=", gen_1, stoi(y));
212 e = check_rect(ne); if (RHead(e)) plotkill(ne);
213
214 current_color[ne] = colormap_to_color(DEFAULT_COLOR);
215 z = (RectObj*) pari_malloc(sizeof(RectObj));
216 RoType(z) = ROt_NULL;
217 Rchain(e, z);
218 RXsize(e) = x; RXcursor(e) = 0; RXscale(e) = 1; RXshift(e) = 0;
219 RYsize(e) = y; RYcursor(e) = 0; RYscale(e) = 1; RYshift(e) = 0;
220 }
221 static long
initrect_get_arg(GEN x,long dft)222 initrect_get_arg(GEN x, long dft)
223 {
224 if (!x) return dft;
225 if (typ(x) != t_INT) pari_err_TYPE("plotinit",x);
226 return itos(x);
227 }
228 void
plotinit(long ne,GEN x,GEN y,long flag)229 plotinit(long ne, GEN x, GEN y, long flag)
230 {
231 const long m = NUMRECT-3;
232 long xi, yi;
233 PARI_plot T;
234
235 if (flag)
236 {
237 pari_get_plot(&T);
238 xi = T.width -1; if (x) xi = DTOL(xi * gtodouble(x));
239 yi = T.height-1; if (y) yi = DTOL(yi * gtodouble(y));
240 }
241 else
242 {
243 if (!x || !y) pari_get_plot(&T);
244 xi = initrect_get_arg(x, T.width -1);
245 yi = initrect_get_arg(y, T.height-1);
246 }
247 if (ne > m) pari_err_DOMAIN("plotinit", "rectwindow", ">", stoi(m), stoi(ne));
248 initrect_i(ne, xi, yi);
249 }
250
251 GEN
plotcursor(long ne)252 plotcursor(long ne)
253 {
254 PariRect *e = check_rect_init(ne);
255 return mkvec2s((long)RXcursor(e), (long)RYcursor(e));
256 }
257
258 static void
plotscale0(long ne,double x1,double x2,double y1,double y2)259 plotscale0(long ne, double x1, double x2, double y1, double y2)
260 {
261 PariRect *e = check_rect_init(ne);
262 double x, y;
263
264 x = RXshift(e) + RXscale(e) * RXcursor(e);
265 y = RYshift(e) + RYscale(e) * RYcursor(e);
266 RXscale(e) = RXsize(e)/(x2-x1); RXshift(e) = -x1*RXscale(e);
267 RYscale(e) = RYsize(e)/(y1-y2); RYshift(e) = -y2*RYscale(e);
268 RXcursor(e) = (x - RXshift(e)) / RXscale(e);
269 RYcursor(e) = (y - RYshift(e)) / RYscale(e);
270 }
271 void
plotscale(long ne,GEN x1,GEN x2,GEN y1,GEN y2)272 plotscale(long ne, GEN x1, GEN x2, GEN y1, GEN y2)
273 { plotscale0(ne, gtodouble(x1), gtodouble(x2), gtodouble(y1), gtodouble(y2)); }
274
275 static void
plotmove0(long ne,double x,double y,long relative)276 plotmove0(long ne, double x, double y, long relative)
277 {
278 PariRect *e = check_rect_init(ne);
279 RectObj *z = (RectObj*) pari_malloc(sizeof(RectObj1P));
280
281 if (relative) { RXcursor(e) += x; RYcursor(e) += y; }
282 else { RXcursor(e) = x; RYcursor(e) = y; }
283 RoType(z) = ROt_MV;
284 RoMVx(z) = RXcursor(e) * RXscale(e) + RXshift(e);
285 RoMVy(z) = RYcursor(e) * RYscale(e) + RYshift(e);
286 Rchain(e, z);
287 }
288 static void
_move(long ne,double x,double y)289 _move(long ne, double x, double y)
290 { plotmove0(ne,x,y,0); }
291 void
plotmove(long ne,GEN x,GEN y)292 plotmove(long ne, GEN x, GEN y)
293 { plotmove0(ne,gtodouble(x),gtodouble(y),0); }
294 void
plotrmove(long ne,GEN x,GEN y)295 plotrmove(long ne, GEN x, GEN y)
296 { plotmove0(ne,gtodouble(x),gtodouble(y),1); }
297
298 /* ROt_MV/ROt_PT */
299 static void
plotpoint0(long ne,double x,double y,long relative)300 plotpoint0(long ne, double x, double y,long relative)
301 {
302 PariRect *e = check_rect_init(ne);
303 RectObj *z = (RectObj*) pari_malloc(sizeof(RectObj1P));
304
305 if (relative) { RXcursor(e) += x; RYcursor(e) += y; }
306 else { RXcursor(e) = x; RYcursor(e) = y; }
307 RoPTx(z) = RXcursor(e)*RXscale(e) + RXshift(e);
308 RoPTy(z) = RYcursor(e)*RYscale(e) + RYshift(e);
309 RoType(z) = ( DTOL(RoPTx(z)) < 0
310 || DTOL(RoPTy(z)) < 0 || DTOL(RoPTx(z)) > RXsize(e)
311 || DTOL(RoPTy(z)) > RYsize(e) ) ? ROt_MV : ROt_PT;
312 Rchain(e, z);
313 RoCol(z) = current_color[ne];
314 }
315 static void
plotpoint(long ne,GEN x,GEN y)316 plotpoint(long ne, GEN x, GEN y)
317 { plotpoint0(ne,gtodouble(x),gtodouble(y),0); }
318 void
plotrpoint(long ne,GEN x,GEN y)319 plotrpoint(long ne, GEN x, GEN y)
320 { plotpoint0(ne,gtodouble(x),gtodouble(y),1); }
321
322 GEN
plotcolor(long ne,GEN c)323 plotcolor(long ne, GEN c)
324 {
325 long t = typ(c), n = lg(GP_DATA->colormap)-2;
326 int r, g, b;
327 check_rect(ne);
328 if (t == t_INT)
329 {
330 long i = itos(c);
331 if (i < 0) pari_err_DOMAIN("plotcolor", "color", "<", gen_0, c);
332 if (i > n) pari_err_DOMAIN("plotcolor", "color", ">", stoi(n), c);
333 c = gel(GP_DATA->colormap,i+1);
334 }
335 else
336 {
337 if (t == t_VEC) { c = ZV_to_zv(c); t = typ(c); }
338 if (t != t_VECSMALL && t != t_STR) pari_err_TYPE("plotcolor",c);
339 }
340 color_to_rgb(c, &r,&g,&b);
341 current_color[ne] = rgb_to_long(r,g,b);
342 return mkvec3s(r, g, b);
343 }
344
345 /* ROt_MV/ROt_LN */
346 static void
rectline0(long ne,double gx2,double gy2,long relative)347 rectline0(long ne, double gx2, double gy2, long relative)
348 {
349 double dx, dy, dxy, xmin, xmax, ymin, ymax, x1, y1, x2, y2;
350 PariRect *e = check_rect_init(ne);
351 RectObj *z = (RectObj*) pari_malloc(sizeof(RectObj2P));
352 const double c = 1 + 1e-10;
353
354 x1 = RXcursor(e)*RXscale(e) + RXshift(e);
355 y1 = RYcursor(e)*RYscale(e) + RYshift(e);
356 if (relative)
357 { RXcursor(e)+=gx2; RYcursor(e)+=gy2; }
358 else
359 { RXcursor(e)=gx2; RYcursor(e)=gy2; }
360 x2 = RXcursor(e)*RXscale(e) + RXshift(e);
361 y2 = RYcursor(e)*RYscale(e) + RYshift(e);
362 xmin = maxdd(mindd(x1,x2),0); xmax = mindd(maxdd(x1,x2),RXsize(e));
363 ymin = maxdd(mindd(y1,y2),0); ymax = mindd(maxdd(y1,y2),RYsize(e));
364 dxy = x1*y2 - y1*x2; dx = x2-x1; dy = y2-y1;
365 if (dy)
366 {
367 double a = (dxy + RYsize(e)*dx) / dy, b = dxy / dy;
368 if (dx*dy < 0)
369 { xmin=maxdd(xmin,a); xmax=mindd(xmax,b); }
370 else
371 { xmin=maxdd(xmin,b); xmax=mindd(xmax,a); }
372 }
373 if (dx)
374 {
375 double a = (RXsize(e)*dy - dxy) / dx, b = -dxy / dx;
376 if (dx*dy < 0)
377 { ymin=maxdd(ymin,a); ymax=mindd(ymax,b); }
378 else
379 { ymin=maxdd(ymin,b); ymax=mindd(ymax,a); }
380 }
381 RoLNx1(z) = xmin;
382 RoLNx2(z) = xmax;
383 if (dx*dy < 0) { RoLNy1(z) = ymax; RoLNy2(z) = ymin; }
384 else { RoLNy1(z) = ymin; RoLNy2(z) = ymax; }
385 RoType(z) = (xmin>xmax*c || ymin>ymax*c) ? ROt_MV : ROt_LN;
386 Rchain(e, z);
387 RoCol(z) = current_color[ne];
388 }
389 static void
_line(long ne,double x,double y)390 _line(long ne, double x, double y)
391 { rectline0(ne, x, y, 0); }
392 void
plotline(long ne,GEN gx2,GEN gy2)393 plotline(long ne, GEN gx2, GEN gy2)
394 { rectline0(ne, gtodouble(gx2), gtodouble(gy2),0); }
395 void
plotrline(long ne,GEN gx2,GEN gy2)396 plotrline(long ne, GEN gx2, GEN gy2)
397 { rectline0(ne, gtodouble(gx2), gtodouble(gy2),1); }
398
399 enum {
400 TICKS_CLOCKW = 1, /* Draw in clockwise direction */
401 TICKS_ACLOCKW = 2, /* Draw in anticlockwise direction */
402 TICKS_ENDSTOO = 4, /* Draw at endspoints if needed */
403 TICKS_NODOUBLE = 8 /* Do not draw double-length ticks */
404 };
405
406 /* Given coordinates of ends of a line, and labels l1 l2 attached to the
407 * ends, plot ticks where the label coordinate takes "round" values */
408 static void
rectticks(PARI_plot * WW,long ne,double dx1,double dy1,double dx2,double dy2,double l1,double l2,long flags)409 rectticks(PARI_plot *WW, long ne, double dx1, double dy1, double dx2,
410 double dy2, double l1, double l2, long flags)
411 {
412 long dx, dy, dxy, dxy1, x1, y1, x2, y2, nticks, n, n1, dn;
413 double minstep, maxstep, step, l_min, l_max, minl, maxl, dl, dtx, dty, x, y;
414 double ddx, ddy;
415 const double mult[3] = { 2./1., 5./2., 10./5. };
416 PariRect *e = check_rect_init(ne);
417 int do_double = !(flags & TICKS_NODOUBLE);
418
419 x1 = DTOL(dx1*RXscale(e) + RXshift(e));
420 y1 = DTOL(dy1*RYscale(e) + RYshift(e));
421 x2 = DTOL(dx2*RXscale(e) + RXshift(e));
422 y2 = DTOL(dy2*RYscale(e) + RYshift(e));
423 dx = x2 - x1; if (dx < 0) dx = -dx;
424 dy = y2 - y1; if (dy < 0) dy = -dy;
425 dxy1 = maxss(dx, dy);
426 dx /= WW->hunit;
427 dy /= WW->vunit;
428 if (dx > 1000 || dy > 1000)
429 dxy = 1000; /* avoid overflow */
430 else
431 dxy = usqrt(dx*dx + dy*dy);
432 nticks = (long) ((dxy + 2.5)/4);
433 if (!nticks) return;
434
435 /* Find nticks (or less) "round" numbers between l1 and l2. For our purpose
436 * round numbers have "last significant" decimal digit either
437 * - any;
438 * - even;
439 * - divisible by 5.
440 * We need to choose which alternative is better. */
441 if (l1 < l2)
442 l_min = l1, l_max = l2;
443 else
444 l_min = l2, l_max = l1;
445 minstep = (l_max - l_min)/(nticks + 1);
446 maxstep = 2.5*(l_max - l_min);
447 step = exp(log(10.) * floor(log10(minstep)));
448 if (!(flags & TICKS_ENDSTOO)) {
449 double d = 2*(l_max - l_min)/dxy1; /* Two pixels off */
450 l_min += d;
451 l_max -= d;
452 }
453 for (n = 0; ; n++)
454 {
455 if (step >= maxstep) return;
456
457 if (step >= minstep) {
458 minl = ceil(l_min/step);
459 maxl = floor(l_max/step);
460 if (minl <= maxl && maxl - minl + 1 <= nticks) {
461 nticks = (long) (maxl - minl + 1);
462 l_min = minl * step;
463 l_max = maxl * step; break;
464 }
465 }
466 step *= mult[ n % 3 ];
467 }
468 /* Where to position doubleticks. Variants:
469 * small: each 5, double: each 10 ; n=2 mod 3
470 * small: each 2, double: each 10 ; n=1 mod 3
471 * small: each 1, double: each 5 */
472 dn = (n % 3 == 2)? 2: 5;
473 n1 = ((long)minl) % dn; /* unused if do_double = FALSE */
474
475 /* now l_min and l_max keep min/max values of l with ticks, and nticks is
476 the number of ticks to draw. */
477 if (nticks == 1) ddx = ddy = 0; /* -Wall */
478 else {
479 dl = (l_max - l_min)/(nticks - 1);
480 ddx = (dx2 - dx1) * dl / (l2 - l1);
481 ddy = (dy2 - dy1) * dl / (l2 - l1);
482 }
483 x = dx1 + (dx2 - dx1) * (l_min - l1) / (l2 - l1);
484 y = dy1 + (dy2 - dy1) * (l_min - l1) / (l2 - l1);
485 /* assume hunit and vunit form a square. For clockwise ticks: */
486 dtx = WW->hunit * dy/dxy * (y2 > y1 ? 1 : -1); /* y-coord runs down */
487 dty = WW->vunit * dx/dxy * (x2 > x1 ? 1 : -1);
488 for (n = 0; n < nticks; n++, x += ddx, y += ddy) {
489 RectObj *z = (RectObj*) pari_malloc(sizeof(RectObj2P));
490 double lunit = WW->hunit > 1 ? 1.5 : 2;
491 double l = (do_double && (n + n1) % dn == 0) ? lunit: 1;
492 double x1, x2, y1, y2;
493 x1 = x2 = x*RXscale(e) + RXshift(e);
494 y1 = y2 = y*RYscale(e) + RYshift(e);
495 if (flags & TICKS_CLOCKW) { x1 += dtx*l; y1 -= dty*l; }
496 if (flags & TICKS_ACLOCKW) { x2 -= dtx*l; y2 += dty*l; }
497 RoLNx1(z) = x1; RoLNy1(z) = y1;
498 RoLNx2(z) = x2; RoLNy2(z) = y2;
499 RoType(z) = ROt_LN;
500 Rchain(e, z);
501 RoCol(z) = current_color[ne];
502 }
503 }
504
505 static void
rectbox0(long ne,double gx2,double gy2,long relative,long filled)506 rectbox0(long ne, double gx2, double gy2, long relative, long filled)
507 {
508 double xx, yy, x1, y1, x2, y2, xmin, ymin, xmax, ymax;
509 PariRect *e = check_rect_init(ne);
510 RectObj *z = (RectObj*) pari_malloc(sizeof(RectObj2P));
511
512 x1 = RXcursor(e)*RXscale(e) + RXshift(e);
513 y1 = RYcursor(e)*RYscale(e) + RYshift(e);
514 if (relative)
515 { xx = RXcursor(e)+gx2; yy = RYcursor(e)+gy2; }
516 else
517 { xx = gx2; yy = gy2; }
518 x2 = xx*RXscale(e) + RXshift(e);
519 y2 = yy*RYscale(e) + RYshift(e);
520 xmin = maxdd(mindd(x1,x2),0); xmax = mindd(maxdd(x1,x2),RXsize(e));
521 ymin = maxdd(mindd(y1,y2),0); ymax = mindd(maxdd(y1,y2),RYsize(e));
522
523 RoType(z) = filled ? ROt_FBX: ROt_BX;
524 RoBXx1(z) = xmin; RoBXy1(z) = ymin;
525 RoBXx2(z) = xmax; RoBXy2(z) = ymax;
526 Rchain(e, z);
527 RoCol(z) = current_color[ne];
528 }
529 static void
_box(long ne,double x,double y)530 _box(long ne, double x, double y)
531 { rectbox0(ne, x, y, 0, 0); }
532 void
plotbox(long ne,GEN gx2,GEN gy2,long f)533 plotbox(long ne, GEN gx2, GEN gy2, long f)
534 { rectbox0(ne, gtodouble(gx2), gtodouble(gy2), 0, f); }
535 void
plotrbox(long ne,GEN gx2,GEN gy2,long f)536 plotrbox(long ne, GEN gx2, GEN gy2, long f)
537 { rectbox0(ne, gtodouble(gx2), gtodouble(gy2), 1, f); }
538
539 static void
freeobj(RectObj * z)540 freeobj(RectObj *z) {
541 switch(RoType(z)) {
542 case ROt_MP: case ROt_ML:
543 pari_free(RoMPxs(z));
544 pari_free(RoMPys(z)); break;
545 case ROt_ST:
546 pari_free(RoSTs(z)); break;
547 }
548 pari_free(z);
549 }
550
551 void
plotkill(long ne)552 plotkill(long ne)
553 {
554 RectObj *z, *t;
555 PariRect *e = check_rect_init(ne);
556
557 z = RHead(e);
558 RHead(e) = RTail(e) = NULL;
559 RXsize(e) = RYsize(e) = 0;
560 RXcursor(e) = RYcursor(e) = 0;
561 RXscale(e) = RYscale(e) = 1;
562 RXshift(e) = RYshift(e) = 0;
563 while (z) { t = RoNext(z); freeobj(z); z = t; }
564 }
565
566 /* ROt_MP */
567 static void
plotpoints0(long ne,double * X,double * Y,long lx)568 plotpoints0(long ne, double *X, double *Y, long lx)
569 {
570 double *px, *py;
571 long i, cp=0;
572 PariRect *e = check_rect_init(ne);
573 RectObj *z = (RectObj*) pari_malloc(sizeof(RectObjMP));
574
575 RoMPxs(z) = px = (double*) pari_malloc(lx*sizeof(double));
576 RoMPys(z) = py = (double*) pari_malloc(lx*sizeof(double));
577 for (i=0; i<lx; i++)
578 {
579 double x = RXscale(e)*X[i] + RXshift(e);
580 double y = RYscale(e)*Y[i] + RYshift(e);
581 if (x >= 0 && y >= 0 && x <= RXsize(e) && y <= RYsize(e))
582 {
583 px[cp] = x; py[cp] = y; cp++;
584 }
585 }
586 RoType(z) = ROt_MP;
587 RoMPcnt(z) = cp;
588 Rchain(e, z);
589 RoCol(z) = current_color[ne];
590 }
591 void
plotpoints(long ne,GEN X,GEN Y)592 plotpoints(long ne, GEN X, GEN Y)
593 {
594 pari_sp av = avma;
595 double *px, *py;
596 long i, lx;
597
598 if (!is_vec_t(typ(X)) || !is_vec_t(typ(Y))) { plotpoint(ne, X, Y); return; }
599 lx = lg(X); if (lg(Y) != lx) pari_err_DIM("plotpoints");
600 lx--; if (!lx) return;
601
602 px = (double*)stack_malloc_align(lx*sizeof(double), sizeof(double)); X++;
603 py = (double*)stack_malloc_align(lx*sizeof(double), sizeof(double)); Y++;
604 for (i=0; i<lx; i++)
605 {
606 px[i] = gtodouble(gel(X,i));
607 py[i] = gtodouble(gel(Y,i));
608 }
609 plotpoints0(ne,px,py,lx); set_avma(av);
610 }
611
612 /* ROt_ML */
613 static void
rectlines0(long ne,double * x,double * y,long lx,long flag)614 rectlines0(long ne, double *x, double *y, long lx, long flag)
615 {
616 long i,I;
617 double *ptx,*pty;
618 PariRect *e = check_rect_init(ne);
619 RectObj *z = (RectObj*) pari_malloc(sizeof(RectObj2P));
620
621 I = flag ? lx+1 : lx;
622 ptx = (double*) pari_malloc(I*sizeof(double));
623 pty = (double*) pari_malloc(I*sizeof(double));
624 for (i=0; i<lx; i++)
625 {
626 ptx[i] = RXscale(e)*x[i] + RXshift(e);
627 pty[i] = RYscale(e)*y[i] + RYshift(e);
628 }
629 if (flag)
630 {
631 ptx[i] = RXscale(e)*x[0] + RXshift(e);
632 pty[i] = RYscale(e)*y[0] + RYshift(e);
633 }
634 Rchain(e, z);
635 RoType(z) = ROt_ML;
636 RoMLcnt(z) = I;
637 RoMLxs(z) = ptx;
638 RoMLys(z) = pty;
639 RoCol(z) = current_color[ne];
640 }
641 void
plotlines(long ne,GEN X,GEN Y,long flag)642 plotlines(long ne, GEN X, GEN Y, long flag)
643 {
644 pari_sp av = avma;
645 double *x, *y;
646 long i, lx;
647
648 if (!is_vec_t(typ(X)) || !is_vec_t(typ(Y))) { plotline(ne, X, Y); return; }
649 lx = lg(X); if (lg(Y) != lx) pari_err_DIM("plotlines");
650 lx--; if (!lx) return;
651
652 x = (double*)stack_malloc_align(lx*sizeof(double), sizeof(double)); X++;
653 y = (double*)stack_malloc_align(lx*sizeof(double), sizeof(double)); Y++;
654 for (i=0; i<lx; i++)
655 {
656 x[i] = gtodouble(gel(X,i));
657 y[i] = gtodouble(gel(Y,i));
658 }
659 rectlines0(ne,x,y,lx,flag); set_avma(av);
660 }
661
662 /* ROt_ST */
663 void
plotstring(long ne,char * str,long dir)664 plotstring(long ne, char *str, long dir)
665 {
666 PariRect *e = check_rect_init(ne);
667 RectObj *z = (RectObj*) pari_malloc(sizeof(RectObjST));
668 long l = strlen(str);
669 char *s = (char *) pari_malloc(l+1);
670
671 memcpy(s,str,l+1);
672 RoType(z) = ROt_ST;
673 RoSTl(z) = l;
674 RoSTs(z) = s;
675 RoSTx(z) = RXscale(e)*RXcursor(e)+RXshift(e);
676 RoSTy(z) = RYscale(e)*RYcursor(e)+RYshift(e);
677 RoSTdir(z) = dir;
678 Rchain(e, z);
679 RoCol(z) = current_color[ne];
680 }
681
682 /* ROt_PTT */
683 void
plotpointtype(long ne,long type)684 plotpointtype(long ne, long type)
685 {
686 if (ne == -1) plotpoint_itype = type;
687 else {
688 PariRect *e = check_rect_init(ne);
689 RectObj *z = (RectObj*) pari_malloc(sizeof(RectObjPN));
690 RoType(z) = ROt_PTT;
691 RoPTTpen(z) = type;
692 Rchain(e, z);
693 }
694 }
695
696 /* ROt_PTS. FIXME: this function is a noop, since no graphic driver implement
697 * this code. ne == -1 (change globally). */
698 void
plotpointsize(long ne,GEN size)699 plotpointsize(long ne, GEN size)
700 {
701 if (ne == -1) { /*do nothing*/ }
702 else {
703 PariRect *e = check_rect_init(ne);
704 RectObj *z = (RectObj*) pari_malloc(sizeof(RectObjPS));
705 RoType(z) = ROt_PTS;
706 RoPTSsize(z) = gtodouble(size);
707 Rchain(e, z);
708 }
709 }
710
711 void
plotlinetype(long ne,long type)712 plotlinetype(long ne, long type)
713 {
714 if (ne == -1) rectline_itype = type;
715 else {
716 PariRect *e = check_rect_init(ne);
717 RectObj *z = (RectObj*) pari_malloc(sizeof(RectObjPN));
718 RoType(z) = ROt_LNT;
719 RoLNTpen(z) = type;
720 Rchain(e, z);
721 }
722 }
723
724 #define RECT_CP_RELATIVE 0x1
725 #define RECT_CP_NW 0x0
726 #define RECT_CP_SW 0x2
727 #define RECT_CP_SE 0x4
728 #define RECT_CP_NE 0x6
729
730 static double*
cpd(double * R,size_t t)731 cpd(double* R, size_t t)
732 { void *o = pari_malloc(t * sizeof(double)); memcpy(o,R,t); return (double*)o; }
733 static void*
cp(void * R,size_t t)734 cp(void* R, size_t t)
735 { void *o = pari_malloc(t); memcpy(o,R,t); return o; }
736 void
plotcopy(long source,long dest,GEN xoff,GEN yoff,long flag)737 plotcopy(long source, long dest, GEN xoff, GEN yoff, long flag)
738 {
739 PariRect *s = check_rect_init(source), *d = check_rect_init(dest);
740 RectObj *R, *tail = RTail(d);
741 long i, x, y;
742 if (flag & RECT_CP_RELATIVE) {
743 double xd = gtodouble(xoff), yd = gtodouble(yoff);
744 PARI_plot T;
745 if (xd > 1) pari_err_DOMAIN("plotcopy","dx",">",gen_1,xoff);
746 if (xd < 0) pari_err_DOMAIN("plotcopy","dx","<",gen_0,xoff);
747 if (yd > 1) pari_err_DOMAIN("plotcopy","dy",">",gen_1,yoff);
748 if (yd < 0) pari_err_DOMAIN("plotcopy","dy","<",gen_0,yoff);
749 pari_get_plot(&T);
750 x = DTOL(xd * (T.width-1));
751 y = DTOL(yd * (T.height-1));
752 } else {
753 if (typ(xoff) != t_INT) pari_err_TYPE("plotcopy",xoff);
754 if (typ(yoff) != t_INT) pari_err_TYPE("plotcopy",yoff);
755 x = itos(xoff);
756 y = itos(yoff);
757 }
758 switch (flag & ~RECT_CP_RELATIVE)
759 {
760 case RECT_CP_NW: break;
761 case RECT_CP_SW: y = RYsize(d) - RYsize(s) - y; break;
762 case RECT_CP_SE: y = RYsize(d) - RYsize(s) - y; /* fall through */
763 case RECT_CP_NE: x = RXsize(d) - RXsize(s) - x; break;
764 }
765 for (R = RHead(s); R; R = RoNext(R))
766 {
767 RectObj *o;
768 switch(RoType(R))
769 {
770 case ROt_PT:
771 o = (RectObj*)cp(R, sizeof(RectObj1P));
772 RoPTx(o) += x; RoPTy(o) += y;
773 break;
774 case ROt_LN: case ROt_BX: case ROt_FBX:
775 o = (RectObj*)cp(R, sizeof(RectObj2P));
776 RoLNx1(o) += x; RoLNy1(o) += y;
777 RoLNx2(o) += x; RoLNy2(o) += y;
778 break;
779 case ROt_MP: case ROt_ML:
780 o = (RectObj*)cp(R, sizeof(RectObjMP));
781 RoMPxs(o) = (double*)cp(RoMPxs(R), sizeof(double)*RoMPcnt(o));
782 RoMPys(o) = (double*)cp(RoMPys(R), sizeof(double)*RoMPcnt(o));
783 for (i=0; i<RoMPcnt(o); i++) { RoMPxs(o)[i] += x; RoMPys(o)[i] += y; }
784 break;
785 case ROt_ST:
786 o = (RectObj*)cp(R, sizeof(RectObjST));
787 RoSTs(o) = (char*)cp(RoSTs(R),RoSTl(R)+1);
788 RoSTx(o) += x; RoSTy(o) += y;
789 break;
790 default: /* ROt_PTT, ROt_LNT, ROt_PTS */
791 o = (RectObj*)cp(R, sizeof(RectObjPN));
792 break;
793 }
794 RoNext(tail) = o; tail = o;
795 }
796 RoNext(tail) = NULL; RTail(d) = tail;
797 }
798
799 enum {CLIPLINE_NONEMPTY = 1, CLIPLINE_CLIP_1 = 2, CLIPLINE_CLIP_2 = 4};
800 /* A simpler way is to clip by 4 half-planes */
801 static int
clipline(double xmin,double xmax,double ymin,double ymax,double * x1p,double * y1p,double * x2p,double * y2p)802 clipline(double xmin, double xmax, double ymin, double ymax,
803 double *x1p, double *y1p, double *x2p, double *y2p)
804 {
805 int xy_exch = 0, rc = CLIPLINE_NONEMPTY;
806 double t, sl;
807 double xi, xmn, xmx;
808 double yi, ymn, ymx;
809 int x1_is_ymn, x1_is_xmn;
810 double x1 = *x1p, x2 = *x2p, y1 = *y1p, y2 = *y2p;
811
812 if ((x1 < xmin && x2 < xmin) || (x1 > xmax && x2 > xmax))
813 return 0;
814 if (fabs(x1 - x2) < fabs(y1 - y2)) { /* Exchange x and y */
815 xy_exch = 1;
816 dswap(xmin, ymin); dswap(x1, y1);
817 dswap(xmax, ymax); dswap(x2, y2);
818 }
819
820 /* Build y as a function of x */
821 xi = x1;
822 yi = y1;
823 sl = x1==x2? 0: (y2 - yi)/(x2 - xi);
824
825 if (x1 > x2) {
826 x1_is_xmn = 0;
827 xmn = x2;
828 xmx = x1;
829 } else {
830 x1_is_xmn = 1;
831 xmn = x1;
832 xmx = x2;
833 }
834
835 if (xmn < xmin) {
836 xmn = xmin;
837 rc |= x1_is_xmn? CLIPLINE_CLIP_1: CLIPLINE_CLIP_2;
838 }
839 if (xmx > xmax) {
840 xmx = xmax;
841 rc |= x1_is_xmn? CLIPLINE_CLIP_2: CLIPLINE_CLIP_1;
842 }
843 if (xmn > xmx) return 0;
844
845 ymn = yi + (xmn - xi)*sl;
846 ymx = yi + (xmx - xi)*sl;
847
848 if (sl < 0) t = ymn, ymn = ymx, ymx = t;
849 if (ymn > ymax || ymx < ymin) return 0;
850
851 if (rc & CLIPLINE_CLIP_1) x1 = x1_is_xmn? xmn: xmx;
852 if (rc & CLIPLINE_CLIP_2) x2 = x1_is_xmn? xmx: xmn;
853
854 /* Now we know there is an intersection, need to move x1 and x2 */
855 x1_is_ymn = ((sl >= 0) == (x1 < x2));
856 if (ymn < ymin) {
857 double x = (ymin - yi)/sl + xi; /* slope != 0 ! */
858 if (x1_is_ymn) x1 = x, rc |= CLIPLINE_CLIP_1;
859 else x2 = x, rc |= CLIPLINE_CLIP_2;
860 }
861 if (ymx > ymax) {
862 double x = (ymax - yi)/sl + xi; /* slope != 0 ! */
863 if (x1_is_ymn) x2 = x, rc |= CLIPLINE_CLIP_2;
864 else x1 = x, rc |= CLIPLINE_CLIP_1;
865 }
866 if (rc & CLIPLINE_CLIP_1) y1 = yi + (x1 - xi)*sl;
867 if (rc & CLIPLINE_CLIP_2) y2 = yi + (x2 - xi)*sl;
868 if (xy_exch) /* Exchange x and y */
869 *x1p = y1, *x2p = y2, *y1p = x1, *y2p = x2;
870 else
871 *x1p = x1, *x2p = x2, *y1p = y1, *y2p = y2;
872 return rc;
873 }
874
875 void
plotclip(long rect)876 plotclip(long rect)
877 {
878 PariRect *s = check_rect_init(rect);
879 RectObj *next, *R = RHead(s), **prevp = &RHead(s);
880 double xmin = 0, xmax = RXsize(s);
881 double ymin = 0, ymax = RYsize(s);
882
883 for (; R; R = next) {
884 int did_clip = 0;
885 #define REMOVE() { *prevp = next; freeobj(R); break; }
886 #define NEXT() { prevp = &RoNext(R); break; }
887
888 next = RoNext(R);
889 switch(RoType(R)) {
890 case ROt_PT:
891 if ( DTOL(RoPTx(R)) < xmin || DTOL(RoPTx(R)) > xmax
892 || DTOL(RoPTy(R)) < ymin || DTOL(RoPTy(R)) > ymax) REMOVE();
893 NEXT();
894 case ROt_BX: case ROt_FBX:
895 if (RoLNx1(R) < xmin) RoLNx1(R) = xmin, did_clip = 1;
896 if (RoLNx2(R) < xmin) RoLNx2(R) = xmin, did_clip = 1;
897 if (RoLNy1(R) < ymin) RoLNy1(R) = ymin, did_clip = 1;
898 if (RoLNy2(R) < ymin) RoLNy2(R) = ymin, did_clip = 1;
899 if (RoLNx1(R) > xmax) RoLNx1(R) = xmax, did_clip = 1;
900 if (RoLNx2(R) > xmax) RoLNx2(R) = xmax, did_clip = 1;
901 if (RoLNy1(R) > ymax) RoLNy1(R) = ymax, did_clip = 1;
902 if (RoLNy2(R) > ymax) RoLNy2(R) = ymax, did_clip = 1;
903 /* Remove zero-size clipped boxes */
904 if (did_clip && RoLNx1(R) == RoLNx2(R)
905 && RoLNy1(R) == RoLNy2(R)) REMOVE();
906 NEXT();
907 case ROt_LN:
908 if (!clipline(xmin, xmax, ymin, ymax,
909 &RoLNx1(R), &RoLNy1(R),
910 &RoLNx2(R), &RoLNy2(R))) REMOVE();
911 NEXT();
912 case ROt_MP: {
913 int c = RoMPcnt(R), f = 0, t = 0;
914
915 while (f < c) {
916 if ( DTOL(RoMPxs(R)[f]) >= xmin && DTOL(RoMPxs(R)[f]) <= xmax
917 && DTOL(RoMPys(R)[f]) >= ymin && DTOL(RoMPys(R)[f]) <= ymax) {
918 if (t != f) {
919 RoMPxs(R)[t] = RoMPxs(R)[f];
920 RoMPys(R)[t] = RoMPys(R)[f];
921 }
922 t++;
923 }
924 f++;
925 }
926 if (t == 0) REMOVE();
927 RoMPcnt(R) = t;
928 NEXT();
929 }
930 case ROt_ML: {
931 /* Hard case. Break a multiline into several pieces
932 * if some part is clipped. */
933 int c = RoMPcnt(R) - 1;
934 int f = 0, t = 0, had_lines = 0, had_hole = 0, rc;
935 double ox = RoMLxs(R)[0], oy = RoMLys(R)[0], oxn, oyn;
936
937 while (f < c) {
938 /* Endpoint of this segment is startpoint of next one: need to
939 * preserve it if it is clipped. */
940 oxn = RoMLxs(R)[f+1];
941 oyn = RoMLys(R)[f+1];
942 rc = clipline(xmin, xmax, ymin, ymax,
943 &ox, &oy, /* &RoMLxs(R)[f], &RoMLys(R)[f], */
944 &RoMLxs(R)[f+1], &RoMLys(R)[f+1]);
945 RoMLxs(R)[f] = ox; ox = oxn;
946 RoMLys(R)[f] = oy; oy = oyn;
947 if (!rc) {
948 if (had_lines) had_hole = 1;
949 f++; continue;
950 }
951
952 if (!had_lines || (!(rc & CLIPLINE_CLIP_1) && !had_hole) ) {
953 /* Continuous */
954 had_lines = 1;
955 if (t != f) {
956 if (t == 0) {
957 RoMPxs(R)[t] = RoMPxs(R)[f];
958 RoMPys(R)[t] = RoMPys(R)[f];
959 }
960 RoMPxs(R)[t+1] = RoMPxs(R)[f+1];
961 RoMPys(R)[t+1] = RoMPys(R)[f+1];
962 }
963 t++;
964 f++;
965 if (rc & CLIPLINE_CLIP_2) had_hole = 1, RoMLcnt(R) = t+1;
966 continue;
967 }
968 /* Is not continuous, automatically R is not pari_free()ed. */
969 t++;
970 RoMLcnt(R) = t;
971 if (rc & CLIPLINE_CLIP_2) { /* Needs separate entry */
972 RectObj *n = (RectObj*) pari_malloc(sizeof(RectObj2P));
973 RoType(n) = ROt_LN;
974 RoCol(n) = RoCol(R);
975 RoLNx1(n) = RoMLxs(R)[f]; RoLNy1(n) = RoMLys(R)[f];
976 RoLNx2(n) = RoMLxs(R)[f+1]; RoLNy2(n) = RoMLys(R)[f+1];
977 RoNext(n) = next;
978 RoNext(R) = n;
979 /* Restore the unclipped value: */
980 RoMLxs(R)[f+1] = oxn; RoMLys(R)[f+1] = oyn;
981 f++;
982 prevp = &RoNext(n);
983 }
984 if (f + 1 < c) { /* Are other lines */
985 RectObj *n = (RectObj*) pari_malloc(sizeof(RectObjMP));
986 RoType(n) = ROt_ML;
987 RoCol(n) = RoCol(R);
988 RoMLcnt(n) = c - f;
989 RoMLxs(n) = cpd(RoMPxs(R) + f, c-f);
990 RoMLys(n) = cpd(RoMPys(R) + f, c-f);
991 RoMPxs(n)[0] = oxn;
992 RoMPys(n)[0] = oyn;
993 RoNext(n) = next;
994 RoNext(R) = n;
995 next = n;
996 }
997 break;
998 }
999 if (t == 0) REMOVE();
1000 NEXT();
1001 }
1002 }
1003 #undef REMOVE
1004 #undef NEXT
1005 }
1006 }
1007
1008 /********************************************************************/
1009 /** **/
1010 /** HI-RES PLOT **/
1011 /** **/
1012 /********************************************************************/
1013 static void
set_xrange(dblPointList * f,double x)1014 set_xrange(dblPointList *f, double x)
1015 { if (x < f->xsml) f->xsml = x;
1016 if (x > f->xbig) f->xbig = x; }
1017 static void
Appendx(dblPointList * f,dblPointList * l,double x)1018 Appendx(dblPointList *f, dblPointList *l, double x)
1019 { (l->d)[l->nb++] = x; set_xrange(f,x); }
1020 static void
set_yrange(dblPointList * f,double y)1021 set_yrange(dblPointList *f, double y)
1022 { if (y < f->ysml) f->ysml = y;
1023 if (y > f->ybig) f->ybig = y; }
1024 static void
Appendy(dblPointList * f,dblPointList * l,double y)1025 Appendy(dblPointList *f, dblPointList *l, double y)
1026 { (l->d)[l->nb++] = y; set_yrange(f,y); }
1027
1028 static void
get_xy(long cplx,GEN t,double * x,double * y)1029 get_xy(long cplx, GEN t, double *x, double *y)
1030 {
1031 GEN a, b;
1032 if (cplx)
1033 {
1034 if (typ(t) == t_VEC)
1035 {
1036 if (lg(t) != 2) pari_err_DIM("get_xy");
1037 t = gel(t,1);
1038 }
1039 a = real_i(t); b = imag_i(t);
1040 }
1041 else
1042 {
1043 if (typ(t) != t_VEC || lg(t) != 3) pari_err_DIM("get_xy");
1044 a = gel(t,1); b = gel(t,2);
1045 }
1046 *x = gtodouble(a);
1047 *y = gtodouble(b);
1048 }
1049 /* t a t_VEC (possibly a scalar if cplx), get next (x,y) coordinate starting
1050 * at index *i [update i] */
1051 static void
get_xy_from_vec(long cplx,GEN t,long * i,double * x,double * y)1052 get_xy_from_vec(long cplx, GEN t, long *i, double *x, double *y)
1053 {
1054 GEN a, b;
1055 if (cplx)
1056 {
1057 if (typ(t) == t_VEC) t = gel(t,*i);
1058 a = real_i(t); b = imag_i(t); (*i)++;
1059 }
1060 else
1061 {
1062 a = gel(t, (*i)++);
1063 b = gel(t, (*i)++);
1064 }
1065 *x = gtodouble(a);
1066 *y = gtodouble(b);
1067 }
1068
1069 static void
dblV_from_RgV(dblPointList * L,GEN x)1070 dblV_from_RgV(dblPointList *L, GEN x)
1071 {
1072 long j, l = lg(x);
1073 double *X = (double*)pari_malloc(l*sizeof(double));
1074 for (j = 1; j < l; j++) X[j-1] = gtodouble(gel(x,j));
1075 L->d = X; L->nb = l-1;
1076 }
1077
1078 /* Convert data from GEN to double before we call plotrecthrawin. */
1079 static dblPointList*
gtodblList(GEN data,long flags)1080 gtodblList(GEN data, long flags)
1081 {
1082 dblPointList *l, *L;
1083 double *X, *Y;
1084 long nl = lg(data)-1, i, j;
1085 const long param = (flags & (PLOT_PARAMETRIC|PLOT_COMPLEX));
1086 const long cplx = (flags & PLOT_COMPLEX);
1087
1088 if (! is_vec_t(typ(data))) pari_err_TYPE("gtodblList",data);
1089 if (!nl) return NULL;
1090
1091 if (nl == 1 && !cplx) pari_err_DIM("gtodblList");
1092 for (i = 1; i <= nl; i++)
1093 { /* Check input first */
1094 GEN x = gel(data,i);
1095 if (!is_vec_t(typ(x))) pari_err_TYPE("gtodblList",x);
1096 }
1097 if (flags & PLOT_PARAMETRIC)
1098 {
1099 if (odd(nl))
1100 pari_err_TYPE("gtodbllist [odd #components in parametric plot]", data);
1101 for (i = 1; i < nl; i += 2)
1102 {
1103 GEN x = gel(data,i), y = gel(data,i+1);
1104 if (lg(y) != lg(x)) pari_err_DIM("gtodblList");
1105 }
1106 }
1107 else if (!cplx)
1108 {
1109 long l1 = lg(gel(data,1)); if (l1 == 1) return NULL;
1110 for (i = 2; i <= nl; i++)
1111 if (lg(gel(data,i)) != l1) pari_err_DIM("gtodblList");
1112 }
1113
1114 /* Now allocate memory and convert coord. to double */
1115 if (cplx)
1116 {
1117 l = (dblPointList*)pari_malloc((2*nl)*sizeof(dblPointList));
1118 for (i = 0; i < nl; i++)
1119 {
1120 pari_sp av = avma;
1121 GEN x = gel(data,i+1);
1122 dblV_from_RgV(&l[2*i], real_i(x));
1123 dblV_from_RgV(&l[2*i+1], imag_i(x)); set_avma(av);
1124 }
1125 }
1126 else if (param)
1127 {
1128 l = (dblPointList*)pari_malloc(nl*sizeof(dblPointList));
1129 for (i = 1; i < nl; i += 2)
1130 {
1131 dblV_from_RgV(&l[i-1], gel(data,i));
1132 dblV_from_RgV(&l[i], gel(data,i+1));
1133 }
1134 }
1135 else
1136 {
1137 l = (dblPointList*)pari_malloc(nl*sizeof(dblPointList));
1138 dblV_from_RgV(&l[0], gel(data,1));
1139 for (i = 2; i <= nl; i++) dblV_from_RgV(&l[i-1], gel(data, i));
1140 }
1141 /* Compute extremas */
1142 L = &l[0];
1143 if (param)
1144 {
1145 L->nb = cplx? nl: nl/2;
1146 for (i=0; i < L->nb; i+=2)
1147 if (l[i+1].nb) break;
1148 if (i >= L->nb) { pari_free(l); return NULL; }
1149 L->xsml = L->xbig = l[i ].d[0];
1150 L->ysml = L->ybig = l[i+1].d[0];
1151 for (; i < L->nb; i+=2)
1152 {
1153 long nbi = l[i+1].nb; X = l[i].d; Y = l[i+1].d;
1154 for (j = 0; j < nbi; j++) { set_xrange(L, X[j]); set_yrange(L, Y[j]); }
1155 }
1156 }
1157 else
1158 {
1159 L->nb = nl-1;
1160 X = L->d; L->xsml = L->xbig = X[0];
1161 Y = l[1].d; L->ysml = L->ybig = Y[0];
1162 for (j=0; j < l[1].nb; j++) set_xrange(L, X[j]);
1163 for (i=1; i <= L->nb; i++)
1164 {
1165 long nbi = l[i].nb; Y = l[i].d;
1166 for (j = 0; j < nbi; j++) set_yrange(L, Y[j]);
1167 }
1168 }
1169 return l;
1170 }
1171
1172 /* x,y t_REAL; return (x+y)/2, */
1173 static GEN
rmiddle(GEN x,GEN y)1174 rmiddle(GEN x, GEN y) { GEN z = addrr(x,y); shiftr_inplace(z,-1); return z; }
1175
1176 static void
single_recursion(void * E,GEN (* eval)(void *,GEN),dblPointList * pl,GEN xl,double yl,GEN xr,double yr,long depth)1177 single_recursion(void *E, GEN(*eval)(void*,GEN), dblPointList *pl,
1178 GEN xl,double yl, GEN xr,double yr,long depth)
1179 {
1180 GEN xx;
1181 pari_sp av = avma;
1182 double yy, dy=pl[0].ybig - pl[0].ysml;
1183
1184 if (depth==RECUR_MAXDEPTH) return;
1185
1186 xx = rmiddle(xl,xr);
1187 yy = gtodouble(eval(E,xx));
1188
1189 if (dy && fabs(yl+yr-2*yy) < dy*RECUR_PREC) return;
1190 single_recursion(E,eval, pl,xl,yl, xx,yy, depth+1);
1191 Appendx(&pl[0],&pl[0],rtodbl(xx));
1192 Appendy(&pl[0],&pl[1],yy);
1193 single_recursion(E,eval, pl,xx,yy, xr,yr, depth+1);
1194 set_avma(av);
1195 }
1196
1197 static void
param_recursion(void * E,GEN (* eval)(void *,GEN),long cplx,dblPointList * pl,GEN tl,double xl,double yl,GEN tr,double xr,double yr,long depth)1198 param_recursion(void *E,GEN(*eval)(void*,GEN), long cplx, dblPointList *pl,
1199 GEN tl,double xl, double yl, GEN tr,double xr,double yr, long depth)
1200 {
1201 GEN t;
1202 pari_sp av = avma;
1203 double xx, dy=pl[0].ybig - pl[0].ysml;
1204 double yy, dx=pl[0].xbig - pl[0].xsml;
1205
1206 if (depth==RECUR_MAXDEPTH) return;
1207
1208 t = rmiddle(tl,tr);
1209 get_xy(cplx, eval(E,t), &xx,&yy);
1210
1211 if (dx && dy && fabs(xl+xr-2*xx) < dx*RECUR_PREC
1212 && fabs(yl+yr-2*yy) < dy*RECUR_PREC) return;
1213 param_recursion(E,eval, cplx, pl, tl,xl,yl, t,xx,yy, depth+1);
1214 Appendx(&pl[0],&pl[0],xx);
1215 Appendy(&pl[0],&pl[1],yy);
1216 param_recursion(E,eval,cplx, pl, t,xx,yy, tr,xr,yr, depth+1);
1217 set_avma(av);
1218 }
1219
1220 /* Graph 'code' for parameter values in [a,b], using 'N' sample points
1221 * (0 = use a default value); code is either a t_CLOSURE or a t_POL or a
1222 * t_VEC of two t_POLs from rectsplines. Returns a dblPointList of
1223 * (absolute) coordinates. */
1224 static dblPointList *
plotrecthin(void * E,GEN (* eval)(void *,GEN),GEN a,GEN b,ulong flags,long N,long prec)1225 plotrecthin(void *E, GEN(*eval)(void*, GEN), GEN a, GEN b, ulong flags,
1226 long N, long prec)
1227 {
1228 const double INF = 1.0/0.0;
1229 const long param = flags & (PLOT_PARAMETRIC|PLOT_COMPLEX);
1230 const long recur = flags & PLOT_RECURSIVE;
1231 const long cplx = flags & PLOT_COMPLEX;
1232 GEN t, dx, x;
1233 dblPointList *pl;
1234 long tx, i, j, sig, nc, nl, ncoords, nbpoints, non_vec = 0;
1235
1236 sig = gcmp(b,a); if (!sig) return NULL;
1237 if (sig < 0) swap(a, b);
1238 if (N == 1) pari_err_DOMAIN("ploth", "#points", "<", gen_2, stoi(N));
1239 if (!N) N = recur? 8: (param? 1500: 1000);
1240 /* compute F(a) to determine nc = #curves; nl = #coord. lists */
1241 x = gtofp(a, prec);
1242 t = eval(E, x); tx = typ(t);
1243 if (cplx) nc = nl = (tx == t_VEC)? lg(t)-1: 1;
1244 else if (param)
1245 {
1246 if (tx != t_VEC) pari_err_TYPE("ploth [not a t_VEC in parametric plot]", t);
1247 nl = lg(t)-1; nc = nl >> 1;
1248 if (odd(nl)) pari_err_TYPE("ploth [odd #components in parametric plot]",t);
1249 }
1250 else if (!is_matvec_t(tx)) { nl = 2; non_vec = 1; nc = 1; }
1251 else
1252 {
1253 if (tx != t_VEC) pari_err_TYPE("ploth [not a t_VEC]",t);
1254 nl = lg(t);
1255 nc = nl-1;
1256 }
1257 if (!nc) return NULL;
1258 if (recur && nc > 1) pari_err_TYPE("ploth [multi-curves + recursive]",t);
1259
1260 ncoords = cplx? 2*nl: nl;
1261 nbpoints = recur? N << RECUR_MAXDEPTH: N;
1262 pl=(dblPointList*) pari_malloc(ncoords*sizeof(dblPointList));
1263 /* set [xy]sml,[xy]big to default values */
1264 if (param)
1265 {
1266 pl[0].xsml = INF;
1267 pl[0].xbig =-INF;
1268 } else {
1269 pl[0].xsml = gtodouble(a);
1270 pl[0].xbig = gtodouble(b);
1271 }
1272 pl[0].ysml = INF;
1273 pl[0].ybig =-INF;
1274 for (i = 0; i < ncoords; i++)
1275 {
1276 pl[i].d = (double*)pari_malloc((nbpoints+1)*sizeof(double));
1277 pl[i].nb=0;
1278 }
1279 dx = divru(gtofp(gsub(b,a),prec), N-1);
1280 if (recur)
1281 { /* recursive plot */
1282 double yl, yr = 0;
1283 if (param)
1284 {
1285 GEN tl = cgetr(prec), tr = cgetr(prec);
1286 double xl, xr = 0;
1287 pari_sp av2 = avma;
1288 affgr(a, tl);
1289 t = eval(E, tl);
1290 get_xy(cplx,t, &xl,&yl);
1291 for (i=0; i<N-1; i++, set_avma(av2))
1292 {
1293 if (i) { affrr(tr,tl); xl = xr; yl = yr; }
1294 addrrz(tl,dx,tr);
1295 t = eval(E, tr);
1296 get_xy(cplx,t, &xr,&yr);
1297 Appendx(&pl[0],&pl[0],xl);
1298 Appendy(&pl[0],&pl[1],yl);
1299 param_recursion(E,eval, cplx, pl, tl,xl,yl, tr,xr,yr, 0);
1300 }
1301 Appendx(&pl[0],&pl[0],xr);
1302 Appendy(&pl[0],&pl[1],yr);
1303 }
1304 else /* single curve */
1305 {
1306 GEN xl = cgetr(prec), xr = cgetr(prec);
1307 pari_sp av2 = avma;
1308 affgr(a,xl);
1309 yl = gtodouble(eval(E,xl));
1310 for (i=0; i<N-1; i++, set_avma(av2))
1311 {
1312 addrrz(xl,dx,xr);
1313 yr = gtodouble(eval(E,xr));
1314 Appendx(&pl[0],&pl[0],rtodbl(xl));
1315 Appendy(&pl[0],&pl[1],yl);
1316 single_recursion(E,eval, pl,xl,yl,xr,yr,0);
1317 affrr(xr,xl); yl = yr;
1318 }
1319 Appendx(&pl[0],&pl[0],rtodbl(xr));
1320 Appendy(&pl[0],&pl[1],yr);
1321 }
1322 }
1323 else /* nonrecursive plot */
1324 {
1325 GEN V, X = cgetg(N+1, t_VEC);
1326 for (i = 1; i <= N; i++) { gel(X,i) = x; x = addrr(x,dx); }
1327 if (flags & PLOT_PARA && eval == gp_call)
1328 {
1329 GEN worker = snm_closure(is_entry("_parapply_slice_worker"),
1330 mkvec((GEN)E));
1331 V = gen_parapply_slice(worker, X, mt_nbthreads());
1332 }
1333 else
1334 {
1335 V = cgetg(N+1, t_VEC);
1336 for (i = 1; i <= N; i++) gel(V,i) = eval(E,gel(X,i));
1337 }
1338 if (param)
1339 {
1340 for (i = 1; i <= N; i++)
1341 {
1342 long nt, k, j;
1343 t = gel(V,i);
1344 if (typ(t) != t_VEC)
1345 {
1346 if (cplx) nt = 1;
1347 else nt = 0; /* trigger error */
1348 }
1349 else
1350 nt = lg(t)-1;
1351 if (nt != nl) pari_err_DIM("plotrecth");
1352 k = 0; j = 1;
1353 while (j <= nl)
1354 {
1355 double xx, yy;
1356 get_xy_from_vec(cplx, t, &j, &xx, &yy);
1357 Appendx(&pl[0], &pl[k++], xx);
1358 Appendy(&pl[0], &pl[k++], yy);
1359 }
1360 }
1361 }
1362 else if (non_vec)
1363 for (i = 1; i <= N; i++)
1364 {
1365 Appendy(&pl[0], &pl[1], gtodouble(gel(V,i)));
1366 pl[0].d[i-1] = gtodouble(gel(X,i));
1367 }
1368 else /* vector of nonparametric curves */
1369 for (i = 1; i <= N; i++)
1370 {
1371 t = gel(V,i);
1372 if (typ(t) != t_VEC || lg(t) != nl) pari_err_DIM("plotrecth");
1373 for (j = 1; j < nl; j++) Appendy(&pl[0], &pl[j], gtodouble(gel(t,j)));
1374 pl[0].d[i-1] = gtodouble(gel(X,i));
1375 }
1376 }
1377 pl[0].nb = nc; return pl;
1378 }
1379
1380 static GEN
spline_eval(void * E,GEN x)1381 spline_eval(void* E, GEN x) { return gsubst((GEN)E,0,x); }
1382
1383 /* Uses highlevel plotting functions to implement splines as
1384 a low-level plotting function. */
1385 static void
rectsplines(long ne,double * x,double * y,long lx,long flag)1386 rectsplines(long ne, double *x, double *y, long lx, long flag)
1387 {
1388 long i, j;
1389 pari_sp av0 = avma;
1390 GEN X = pol_x(0), xa = cgetg(lx+1, t_VEC), ya = cgetg(lx+1, t_VEC);
1391 GEN tas, pol3;
1392 long param = flag & PLOT_PARAMETRIC;
1393 const long fl = param | PLOT_RECURSIVE | PLOT_NO_RESCALE | PLOT_NO_FRAME
1394 | PLOT_NO_AXE_Y | PLOT_NO_AXE_X;
1395
1396 if (lx < 4) pari_err(e_MISC, "Too few points (%ld) for spline plot", lx);
1397 for (i = 1; i <= lx; i++) {
1398 gel(xa,i) = dbltor(x[i-1]);
1399 gel(ya,i) = dbltor(y[i-1]);
1400 }
1401 if (param) {
1402 tas = new_chunk(4);
1403 for (j = 1; j <= 4; j++) gel(tas,j-1) = utoipos(j);
1404 pol3 = cgetg(3, t_VEC);
1405 }
1406 else
1407 tas = pol3 = NULL; /* gcc -Wall */
1408 for (i = 0; i <= lx - 4; i++) {
1409 pari_sp av = avma;
1410
1411 xa++; ya++;
1412 if (param) {
1413 gel(pol3,1) = polintspec(tas, xa, X, 4, NULL);
1414 gel(pol3,2) = polintspec(tas, ya, X, 4, NULL);
1415 } else {
1416 pol3 = polintspec(xa, ya, X, 4, NULL);
1417 tas = xa;
1418 }
1419 /* Start with 3 points */
1420 plotrecth((void*)pol3, &spline_eval, ne,
1421 i== 0 ? gel(tas,0) : gel(tas,1),
1422 i==lx-4 ? gel(tas,3) : gel(tas,2),
1423 fl, 2, DEFAULTPREC);
1424 set_avma(av);
1425 }
1426 set_avma(av0);
1427 }
1428
1429 static void
pari_get_fmtplot(GEN fmt,PARI_plot * T)1430 pari_get_fmtplot(GEN fmt, PARI_plot *T)
1431 {
1432 char *f = GSTR(fmt);
1433 if (!strcmp(f, "svg")) pari_get_svgplot(T);
1434 else if (!strcmp(f, "ps")) pari_get_psplot(T);
1435 else pari_err_TYPE("plotexport [unknown format]", fmt);
1436 }
1437 static GEN
fmt_convert(GEN fmt,GEN w,GEN x,GEN y,PARI_plot * T)1438 fmt_convert(GEN fmt, GEN w, GEN x, GEN y, PARI_plot *T)
1439 {
1440 char *f, *s = NULL;
1441 if (typ(fmt) != t_STR) pari_err_TYPE("plotexport",fmt);
1442 f = GSTR(fmt);
1443 if (!strcmp(f, "svg"))
1444 s = rect2svg(w,x,y,T);
1445 else if (!strcmp(f, "ps"))
1446 s = rect2ps(w,x,y,T);
1447 else
1448 pari_err_TYPE("plotexport [unknown format]", fmt);
1449 return strtoGENstr(s);
1450 }
1451
1452 static void
Draw(PARI_plot * T,GEN w,GEN x,GEN y)1453 Draw(PARI_plot *T, GEN w, GEN x, GEN y)
1454 {
1455 if (!T->draw) pari_err(e_MISC,"high resolution graphics disabled");
1456 T->draw(T, w,x,y);
1457 }
1458 static void
set_range(double m,double M,double * sml,double * big)1459 set_range(double m, double M, double *sml, double *big)
1460 {
1461 if (M - m < 1.e-9)
1462 {
1463 double d = fabs(m)/10; if (!d) d = 0.1;
1464 M += d; m -= d;
1465 }
1466 *sml = m; *big = M;
1467 }
1468 /* Plot a dblPointList. Complete with axes, bounding box, etc.
1469 *
1470 * data is an array of structs. Its meaning depends on flags :
1471 *
1472 * + data[0] contains global extremas, the number of curves to plot
1473 * (data[0].nb) and a list of doubles (first set of x-coordinates).
1474 *
1475 * + data[i].nb (i>0) contains the number of points in the list
1476 * data[i].d (hopefully, data[2i].nb=data[2i+1].nb when i>0...)
1477 *
1478 * + If flags contain PLOT_PARAMETRIC, the array length should be
1479 * even, and successive pairs (data[2i].d, data[2i+1].d) represent
1480 * curves to plot.
1481 *
1482 * + If there is no such flag, the first element is an array with
1483 * x-coordinates and the following ones contain y-coordinates.
1484 * If W != NULL, output wrt this PARI_plot using two drawing rectangles:
1485 * one for labels, another for graphs. Else draw to rectwindow ne without
1486 * labels.
1487 * If fmt != NULL (requires W != NULL), output is a t_STR containing the
1488 * converted picture, else a bounding box */
1489 static GEN
plotrecthrawin(GEN fmt,PARI_plot * W,long ne,dblPointList * data,long flags)1490 plotrecthrawin(GEN fmt, PARI_plot *W, long ne, dblPointList *data, long flags)
1491 {
1492 const long param = flags & (PLOT_PARAMETRIC|PLOT_COMPLEX);
1493 const long max_graphcolors = lg(GP_DATA->graphcolors)-1;
1494 const pari_sp av = avma;
1495 dblPointList x, y;
1496 double xsml, xbig, ysml, ybig;
1497 long ltype, i, nc, w[3], wx[3], wy[3];
1498
1499 if (!data) return cgetg(1,t_VEC);
1500 x = data[0]; nc = x.nb;
1501 set_range(x.xsml, x.xbig, &xsml, &xbig);
1502 set_range(x.ysml, x.ybig, &ysml, &ybig);
1503 if (W)
1504 { /* actual output; else output to rectwindow: no labels */
1505 const long se = NUMRECT-2;
1506 long lm, rm, tm, bm;
1507 char YBIG[16], YSML[16], XSML[16], XBIG[16];
1508 /* left/right/top/bottom margin */
1509 sprintf(YSML,"%.5g", ysml); sprintf(YBIG,"%.5g", ybig);
1510 sprintf(XSML,"%.5g", xsml); sprintf(XBIG,"%.5g", xbig);
1511 /* left margin has y labels with hgap on both sides of text */
1512 lm = maxss(strlen(YSML),strlen(YBIG))*W->fwidth + 2*W->hunit-1;
1513 rm = W->hunit-1;
1514 tm = W->vunit-1;
1515 bm = W->vunit+W->fheight-1;
1516 w[0] = wx[0] = wy[0] = evaltyp(t_VECSMALL) | evallg(3);
1517 w[1] = se; wx[1] = 0; wy[1] = 0;
1518 w[2] = ne; wx[2] = lm; wy[2] = tm;
1519 /* Window (width x height) is given in pixels, correct pixels are 0..n-1,
1520 * whereas rect functions work with windows whose pixel range is [0,n] */
1521 initrect_i(se, W->width - 1, W->height - 1);
1522 initrect_i(ne, W->width - (lm+rm) - 1, W->height - (tm+bm) - 1);
1523 /* draw labels on se */
1524 _move(se,lm,0); plotstring(se, YBIG, RoSTdirRIGHT|RoSTdirHGAP|RoSTdirTOP);
1525 _move(se,lm,W->height-bm); plotstring(se,YSML, RoSTdirRIGHT|RoSTdirHGAP|RoSTdirVGAP);
1526 _move(se,lm,W->height-bm); plotstring(se, XSML, RoSTdirLEFT|RoSTdirTOP);
1527 _move(se,W->width-rm-1, W->height-bm); plotstring(se, XBIG, RoSTdirRIGHT|RoSTdirTOP);
1528 }
1529 if (!(flags & PLOT_NO_RESCALE)) plotscale0(ne, xsml, xbig, ysml, ybig);
1530 if (!(flags & PLOT_NO_FRAME))
1531 {
1532 long fl = (flags & PLOT_NODOUBLETICK)? TICKS_CLOCKW|TICKS_NODOUBLE
1533 : TICKS_CLOCKW;
1534 PARI_plot T, *pl;
1535 if (W) pl = W; else { pl = &T; pari_get_plot(pl); }
1536 plotlinetype(ne, -2); /* frame */
1537 current_color[ne] = colormap_to_color(DEFAULT_COLOR);
1538 _move(ne,xsml,ysml);
1539 _box(ne,xbig,ybig);
1540 if (!(flags & PLOT_NO_TICK_X)) {
1541 rectticks(pl, ne, xsml, ysml, xbig, ysml, xsml, xbig, fl);
1542 rectticks(pl, ne, xbig, ybig, xsml, ybig, xbig, xsml, fl);
1543 }
1544 if (!(flags & PLOT_NO_TICK_Y)) {
1545 rectticks(pl, ne, xbig, ysml, xbig, ybig, ysml, ybig, fl);
1546 rectticks(pl, ne, xsml, ybig, xsml, ysml, ybig, ysml, fl);
1547 }
1548 }
1549 if (!(flags & PLOT_NO_AXE_Y) && (xsml<=0 && xbig >=0))
1550 {
1551 plotlinetype(ne, -1); /* axes */
1552 current_color[ne] = colormap_to_color(AXIS_COLOR);
1553 _move(ne,0.0,ysml);
1554 _line(ne,0.0,ybig);
1555 }
1556 if (!(flags & PLOT_NO_AXE_X) && (ysml<=0 && ybig >=0))
1557 {
1558 plotlinetype(ne, -1); /* axes */
1559 current_color[ne] = colormap_to_color(AXIS_COLOR);
1560 _move(ne,xsml,0.0);
1561 _line(ne,xbig,0.0);
1562 }
1563
1564 if (param) {
1565 i = 0;
1566 flags |= PLOT_PARAMETRIC;
1567 flags &= (~PLOT_COMPLEX); /* turn COMPLEX to PARAMETRIC*/
1568 } else i = 1;
1569 for (ltype = 0; ltype < nc; ltype++)
1570 {
1571 long c = GP_DATA->graphcolors[1+(ltype%max_graphcolors)];
1572 current_color[ne] = colormap_to_color(c);
1573 if (param) x = data[i++];
1574
1575 y = data[i++];
1576 if (flags & (PLOT_POINTS_LINES|PLOT_POINTS)) {
1577 plotlinetype(ne, plotpoint_itype + ltype); /* Graphs */
1578 plotpointtype(ne,plotpoint_itype + ltype); /* Graphs */
1579 plotpoints0(ne, x.d, y.d, y.nb);
1580 if (!(flags & PLOT_POINTS_LINES)) continue;
1581 }
1582
1583 if (flags & PLOT_SPLINES) {
1584 /* rectsplines will call us back with ltype == 0 */
1585 int old = rectline_itype;
1586 rectline_itype = rectline_itype + ltype;
1587 rectsplines(ne, x.d, y.d, y.nb, flags);
1588 rectline_itype = old;
1589 } else {
1590 plotlinetype(ne, rectline_itype + ltype); /* Graphs */
1591 rectlines0(ne, x.d, y.d, y.nb, 0);
1592 }
1593 }
1594 for (i--; i>=0; i--) pari_free(data[i].d);
1595 pari_free(data);
1596
1597 if (W)
1598 {
1599 GEN s = NULL;
1600 if (fmt) s = fmt_convert(fmt, w, wx, wy, W); else Draw(W, w,wx,wy);
1601 plotkill(w[1]);
1602 plotkill(w[2]);
1603 if (fmt) return s;
1604 }
1605 set_avma(av);
1606 retmkvec4(dbltor(xsml), dbltor(xbig), dbltor(ysml), dbltor(ybig));
1607 }
1608
1609 /*************************************************************************/
1610 /* */
1611 /* HI-RES FUNCTIONS */
1612 /* */
1613 /*************************************************************************/
1614 /* If T != NULL, draw using the attached graphic (using rectwindow ne as a temp)
1615 * Else write to rectwindow 'ne'.
1616 * Graph y=f(x), x=a..b, use n points */
1617 static GEN
plotrecth_i(GEN fmt,void * E,GEN (* f)(void *,GEN),PARI_plot * T,long ne,GEN a,GEN b,ulong flags,long n,long prec)1618 plotrecth_i(GEN fmt, void *E, GEN(*f)(void*,GEN), PARI_plot *T, long ne,
1619 GEN a,GEN b, ulong flags,long n, long prec)
1620 {
1621 pari_sp av = avma;
1622 dblPointList *pl = plotrecthin(E,f, a,b, flags, n, prec);
1623 set_avma(av); return plotrecthrawin(fmt, T, ne, pl, flags);
1624 }
1625 GEN
plotrecth(void * E,GEN (* f)(void *,GEN),long ne,GEN a,GEN b,ulong flags,long n,long prec)1626 plotrecth(void *E, GEN(*f)(void*,GEN), long ne, GEN a,GEN b,
1627 ulong flags, long n, long prec)
1628 { return plotrecth_i(NULL, E,f, NULL, ne, a,b, flags&~PLOT_PARA, n, prec); }
1629 GEN
plotrecth0(long ne,GEN a,GEN b,GEN code,ulong flags,long n,long prec)1630 plotrecth0(long ne, GEN a,GEN b,GEN code,ulong flags,long n, long prec)
1631 { EXPR_WRAP(code, plotrecth(EXPR_ARG, ne, a,b, flags, n, prec)); }
1632 static GEN
_ploth(void * E,GEN (* f)(void *,GEN),GEN a,GEN b,long flags,long n,long prec)1633 _ploth(void *E, GEN(*f)(void*,GEN), GEN a, GEN b,long flags, long n, long prec)
1634 {
1635 PARI_plot T; pari_get_plot(&T);
1636 return plotrecth_i(NULL, E,f, &T, NUMRECT-1, a,b, flags,n, prec);
1637 }
1638 GEN
ploth(void * E,GEN (* f)(void *,GEN),GEN a,GEN b,long flags,long n,long prec)1639 ploth(void *E, GEN(*f)(void*,GEN), GEN a, GEN b,long flags, long n, long prec)
1640 { return _ploth(E, f, a, b, flags&~PLOT_PARA, n, prec); }
1641 GEN
parploth(GEN a,GEN b,GEN code,long flags,long n,long prec)1642 parploth(GEN a, GEN b, GEN code, long flags, long n, long prec)
1643 { return _ploth(code, gp_call, a, b, flags|PLOT_PARA, n, prec); }
1644 GEN
ploth0(GEN a,GEN b,GEN code,long flags,long n,long prec)1645 ploth0(GEN a, GEN b, GEN code, long flags,long n, long prec)
1646 { EXPR_WRAP(code, ploth(EXPR_ARG, a,b,flags,n, prec)); }
1647
1648 GEN
psploth(void * E,GEN (* f)(void *,GEN),GEN a,GEN b,long flags,long n,long prec)1649 psploth(void *E, GEN(*f)(void*,GEN), GEN a,GEN b, long flags, long n, long prec)
1650 {
1651 PARI_plot T; pari_get_psplot(&T); T.draw = &_psdraw;
1652 return plotrecth_i(NULL, E,f, &T, NUMRECT-1, a,b, flags&~PLOT_PARA,n, prec);
1653 }
1654 GEN
psploth0(GEN a,GEN b,GEN code,long flags,long n,long prec)1655 psploth0(GEN a, GEN b, GEN code, long flags, long n, long prec)
1656 { EXPR_WRAP(code, psploth(EXPR_ARG, a, b, flags, n, prec)); }
1657
1658 static GEN
_plothexport(GEN fmt,void * E,GEN (* f)(void *,GEN),GEN a,GEN b,long flags,long n,long prec)1659 _plothexport(GEN fmt, void *E, GEN(*f)(void*,GEN), GEN a,GEN b, long flags,
1660 long n, long prec)
1661 {
1662 pari_sp av = avma;
1663 GEN s;
1664 PARI_plot T; pari_get_fmtplot(fmt, &T);
1665 s = plotrecth_i(fmt, E,f, &T, NUMRECT-1, a,b, flags,n, prec);
1666 return gerepileuptoleaf(av, s);
1667 }
1668 GEN
plothexport(GEN fmt,void * E,GEN (* f)(void *,GEN),GEN a,GEN b,long flags,long n,long prec)1669 plothexport(GEN fmt, void *E, GEN(*f)(void*,GEN), GEN a,GEN b, long flags,
1670 long n, long prec)
1671 { return _plothexport(fmt, E, f, a, b, flags&~PLOT_PARA, n, prec); }
1672 GEN
plothexport0(GEN fmt,GEN a,GEN b,GEN code,long flags,long n,long prec)1673 plothexport0(GEN fmt, GEN a, GEN b, GEN code, long flags, long n, long prec)
1674 { EXPR_WRAP(code, plothexport(fmt, EXPR_ARG, a, b, flags, n, prec)); }
1675 GEN
parplothexport(GEN fmt,GEN a,GEN b,GEN code,long flags,long n,long prec)1676 parplothexport(GEN fmt, GEN a, GEN b, GEN code, long flags, long n, long prec)
1677 { return _plothexport(fmt, code, gp_call, a, b, flags|PLOT_PARA, n, prec); }
1678
1679 /* Draw list of points */
1680 static GEN
plotrecthraw_i(GEN fmt,PARI_plot * T,long ne,GEN data,long flags)1681 plotrecthraw_i(GEN fmt, PARI_plot *T, long ne, GEN data, long flags)
1682 {
1683 dblPointList *pl = gtodblList(data,flags);
1684 return plotrecthrawin(fmt, T, ne, pl, flags);
1685 }
1686 static GEN
plothraw_i(GEN fmt,PARI_plot * T,GEN X,GEN Y,long flag)1687 plothraw_i(GEN fmt, PARI_plot *T, GEN X, GEN Y, long flag)
1688 {
1689 pari_sp av = avma;
1690 switch (flag) {
1691 case 0: flag = PLOT_PARAMETRIC|PLOT_POINTS; break;
1692 case 1: flag = PLOT_PARAMETRIC; break;
1693 default: flag |= PLOT_PARAMETRIC; break;
1694 }
1695 return gerepileupto(av, plotrecthraw_i(fmt, T, NUMRECT-1, mkvec2(X,Y), flag));
1696 }
1697 GEN
plothraw(GEN X,GEN Y,long flags)1698 plothraw(GEN X, GEN Y, long flags)
1699 { PARI_plot T; pari_get_plot(&T); return plothraw_i(NULL,&T,X,Y,flags); }
1700 GEN
psplothraw(GEN X,GEN Y,long flags)1701 psplothraw(GEN X, GEN Y, long flags)
1702 { PARI_plot T; pari_get_psplot(&T); T.draw = &_psdraw;
1703 return plothraw_i(NULL,&T,X,Y,flags); }
1704 GEN
plotrecthraw(long ne,GEN data,long flags)1705 plotrecthraw(long ne, GEN data, long flags)
1706 { return plotrecthraw_i(NULL, NULL, ne, data, flags); }
1707 GEN
plothrawexport(GEN fmt,GEN X,GEN Y,long flags)1708 plothrawexport(GEN fmt, GEN X, GEN Y, long flags)
1709 { PARI_plot T; pari_get_fmtplot(fmt,&T); return plothraw_i(fmt,&T,X,Y,flags); }
1710
1711 GEN
plothsizes(long flag)1712 plothsizes(long flag)
1713 {
1714 GEN vect = cgetg(1+8,t_VEC);
1715 PARI_plot T;
1716
1717 pari_get_plot(&T);
1718 gel(vect,1) = stoi(T.width);
1719 gel(vect,2) = stoi(T.height);
1720 if (flag) {
1721 gel(vect,3) = dbltor(T.hunit*1.0/T.width);
1722 gel(vect,4) = dbltor(T.vunit*1.0/T.height);
1723 gel(vect,5) = dbltor(T.fwidth*1.0/T.width);
1724 gel(vect,6) = dbltor(T.fheight*1.0/T.height);
1725 } else {
1726 gel(vect,3) = stoi(T.hunit);
1727 gel(vect,4) = stoi(T.vunit);
1728 gel(vect,5) = stoi(T.fwidth);
1729 gel(vect,6) = stoi(T.fheight);
1730 }
1731 gel(vect,7) = stoi(T.dwidth);
1732 gel(vect,8) = stoi(T.dheight);
1733 return vect;
1734 }
1735
1736 /*************************************************************************/
1737 /* */
1738 /* POSTSCRIPT OUTPUT */
1739 /* */
1740 /*************************************************************************/
1741 static long
wxy_n(GEN wxy)1742 wxy_n(GEN wxy)
1743 {
1744 long n;
1745 switch(typ(wxy))
1746 {
1747 case t_INT: return 1;
1748 case t_VEC:
1749 n = lg(wxy)-1;
1750 if (n%3) pari_err_DIM("plotdraw");
1751 return n/3;
1752 }
1753 pari_err_TYPE("plotdraw",wxy);
1754 return 0;/*LCOV_EXCL_LINE*/
1755 }
1756 static void
wxy_init(GEN wxy,GEN * pW,GEN * pX,GEN * pY,PARI_plot * T)1757 wxy_init(GEN wxy, GEN *pW, GEN *pX, GEN *pY, PARI_plot *T)
1758 {
1759 long i, n = wxy_n(wxy);
1760 GEN W, X, Y;
1761 *pW = W = cgetg(n+1, t_VECSMALL); /* win number */
1762 *pX = X = cgetg(n+1, t_VECSMALL);
1763 *pY = Y = cgetg(n+1, t_VECSMALL); /* (x,y)-offset */
1764 if (typ(wxy) == t_INT)
1765 {
1766 W[1] = itos(wxy); check_rect_init(W[1]);
1767 X[1] = 0;
1768 Y[1] = 0; return;
1769 }
1770 for (i = 1; i <= n; i++)
1771 {
1772 GEN w = gel(wxy,3*i-2), x = gel(wxy,3*i-1), y = gel(wxy,3*i);
1773 if (typ(w) != t_INT) pari_err_TYPE("plotdraw",w);
1774 W[i] = itos(w); check_rect_init(W[i]);
1775 if (T) {
1776 X[i] = DTOL(gtodouble(x)*(T->width - 1));
1777 Y[i] = DTOL(gtodouble(y)*(T->height - 1));
1778 } else {
1779 X[i] = gtos(x);
1780 Y[i] = gtos(y);
1781 }
1782 }
1783 }
1784 /* if flag is set, rescale wrt T */
1785 static void
gendraw(PARI_plot * T,GEN wxy,long flag)1786 gendraw(PARI_plot *T, GEN wxy, long flag)
1787 {
1788 GEN w, x, y, W, X, Y;
1789 long i, l;
1790 wxy_init(wxy, &w,&x,&y, flag? T: NULL);
1791 l = lg(w);
1792 /* malloc mandatory in case draw() forks then pari_close(). Done after
1793 * wxy_init to avoid leak on error */
1794 W = cgetalloc(t_VECSMALL, l);
1795 X = cgetalloc(t_VECSMALL, l);
1796 Y = cgetalloc(t_VECSMALL, l);
1797 for (i = 1; i < l; i++) { W[i] = w[i]; X[i] = x[i]; Y[i] = y[i]; }
1798 Draw(T,W,X,Y);
1799 pari_free(W); pari_free(X); pari_free(Y);
1800 }
1801 void
psdraw(GEN wxy,long flag)1802 psdraw(GEN wxy, long flag)
1803 { PARI_plot T; pari_get_psplot(&T); T.draw = flag? &_psdraw: &_psdraw_scale;
1804 gendraw(&T, wxy, flag); }
1805 void
plotdraw(GEN wxy,long flag)1806 plotdraw(GEN wxy, long flag)
1807 { PARI_plot T; pari_get_plot(&T); gendraw(&T, wxy, flag); }
1808 GEN
plotexport(GEN fmt,GEN wxy,long flag)1809 plotexport(GEN fmt, GEN wxy, long flag)
1810 {
1811 pari_sp av = avma;
1812 GEN w, x, y;
1813 PARI_plot _T, *T = flag? &_T: NULL;
1814 if (T) pari_get_plot(T);
1815 wxy_init(wxy, &w, &x, &y, T);
1816 return gerepileuptoleaf(av, fmt_convert(fmt, w, x, y, T));
1817 }
1818
1819 /* may be called after pari_close(): don't use the PARI stack */
1820 void
gen_draw(struct plot_eng * eng,GEN w,GEN x,GEN y,double xs,double ys)1821 gen_draw(struct plot_eng *eng, GEN w, GEN x, GEN y, double xs, double ys)
1822 {
1823 void *data = eng->data;
1824 long i, j, lw = lg(w);
1825 long hgapsize = eng->pl->hunit, fheight = eng->pl->fheight;
1826 long vgapsize = eng->pl->vunit, fwidth = eng->pl->fwidth;
1827 for(i = 1; i < lw; i++)
1828 {
1829 PariRect *e = &rectgraph[w[i]];
1830 RectObj *R;
1831 long x0 = x[i], y0 = y[i];
1832 for (R = RHead(e); R; R = RoNext(R))
1833 {
1834 long col = RoCol(R);
1835 switch(RoType(R))
1836 {
1837 case ROt_PT:
1838 eng->sc(data,col);
1839 eng->pt(data, DTOL((RoPTx(R)+x0)*xs), DTOL((RoPTy(R)+y0)*ys));
1840 break;
1841 case ROt_LN:
1842 eng->sc(data,col);
1843 eng->ln(data, DTOL((RoLNx1(R)+x0)*xs), DTOL((RoLNy1(R)+y0)*ys),
1844 DTOL((RoLNx2(R)+x0)*xs), DTOL((RoLNy2(R)+y0)*ys));
1845 break;
1846 case ROt_BX:
1847 eng->sc(data,col);
1848 eng->bx(data,
1849 DTOL((RoBXx1(R)+x0)*xs),
1850 DTOL((RoBXy1(R)+y0)*ys),
1851 DTOL((RoBXx2(R)-RoBXx1(R))*xs),
1852 DTOL((RoBXy2(R)-RoBXy1(R))*ys));
1853 break;
1854 case ROt_FBX:
1855 eng->sc(data,col);
1856 eng->fb(data,
1857 DTOL((RoBXx1(R)+x0)*xs),
1858 DTOL((RoBXy1(R)+y0)*ys),
1859 DTOL((RoBXx2(R)-RoBXx1(R))*xs),
1860 DTOL((RoBXy2(R)-RoBXy1(R))*ys));
1861 break;
1862 case ROt_MP:
1863 {
1864 double *ptx = RoMPxs(R);
1865 double *pty = RoMPys(R);
1866 long nb = RoMPcnt(R);
1867 struct plot_points *points =
1868 (struct plot_points *) pari_malloc(sizeof(*points)*nb);
1869 for(j=0;j<nb;j++)
1870 {
1871 points[j].x = DTOL((ptx[j]+x0)*xs);
1872 points[j].y = DTOL((pty[j]+y0)*ys);
1873 }
1874 eng->sc(data,col);
1875 eng->mp(data, nb, points);
1876 pari_free(points);
1877 break;
1878 }
1879 case ROt_ML:
1880 {
1881 double *ptx = RoMLxs(R);
1882 double *pty = RoMLys(R);
1883 long nb = RoMLcnt(R);
1884 struct plot_points *points =
1885 (struct plot_points *) pari_malloc(sizeof(*points)*nb);
1886 for(j=0;j<nb;j++)
1887 {
1888 points[j].x = DTOL((ptx[j]+x0)*xs);
1889 points[j].y = DTOL((pty[j]+y0)*ys);
1890 }
1891 eng->sc(data,col);
1892 eng->ml(data, nb, points);
1893 pari_free(points);
1894 break;
1895 }
1896 case ROt_ST:
1897 {
1898 long dir = RoSTdir(R);
1899 long h = dir & RoSTdirHPOS_mask, hgap = 0;
1900 long v = dir & RoSTdirVPOS_mask, vgap = 0;
1901 long x, y, l = RoSTl(R);
1902 long shift = (h == RoSTdirLEFT ? 0 : (h == RoSTdirRIGHT? 2: 1));
1903 long vshift= (v == RoSTdirBOTTOM? 0: (v == RoSTdirTOP? 2: 1));
1904 if (dir & RoSTdirHGAP)
1905 hgap = (h == RoSTdirLEFT) ? hgapsize : -hgapsize;
1906 if (dir & RoSTdirVGAP)
1907 vgap = (v == RoSTdirBOTTOM) ? 2*vgapsize : -2*vgapsize;
1908 x = DTOL(xs * (RoSTx(R) + x0 + hgap - (l * fwidth * shift)/2));
1909 y = DTOL(ys * (RoSTy(R) + y0 - (vgap - vshift*(fheight-1))/2));
1910 eng->sc(data,col);
1911 eng->st(data, x, y, RoSTs(R), l);
1912 break;
1913 }
1914 default:
1915 break;
1916 }
1917 }
1918 }
1919 }
1920 /*************************************************************************/
1921 /* SVG */
1922 /*************************************************************************/
1923
1924 struct svg_data {
1925 pari_str str;
1926 char hexcolor[8]; /* "#rrggbb\0" */
1927 };
1928 #define data_str(d) (&((struct svg_data*)(d))->str)
1929 #define data_hexcolor(d) (((struct svg_data*)(d))->hexcolor)
1930
1931 /* Work with precision 1/scale */
1932 static const float SVG_SCALE = 1024.0;
1933
1934 static float
svg_rescale(float x)1935 svg_rescale(float x) { return x / SVG_SCALE; }
1936
1937 static void
svg_point(void * data,long x,long y)1938 svg_point(void *data, long x, long y)
1939 {
1940 pari_str *S = data_str(data);
1941
1942 str_printf(S, "<circle cx='%.2f' cy='%.2f' r='0.5' ",
1943 svg_rescale(x), svg_rescale(y));
1944 str_printf(S, "style='fill:%s;stroke:none;'/>", data_hexcolor(data));
1945 }
1946
1947 static void
svg_line(void * data,long x1,long y1,long x2,long y2)1948 svg_line(void *data, long x1, long y1, long x2, long y2)
1949 {
1950 pari_str *S = data_str(data);
1951
1952 str_printf(S, "<line x1='%.2f' y1='%.2f' x2='%.2f' y2='%.2f' ",
1953 svg_rescale(x1), svg_rescale(y1), svg_rescale(x2), svg_rescale(y2));
1954 str_printf(S, "style='fill:none;stroke:%s;'/>", data_hexcolor(data));
1955 }
1956
1957 static void
svg_rect(void * data,long x,long y,long w,long h)1958 svg_rect(void *data, long x, long y, long w, long h)
1959 {
1960 pari_str *S = data_str(data);
1961
1962 str_printf(S, "<rect x='%.2f' y='%.2f' width='%.2f' height='%.2f' ",
1963 svg_rescale(x), svg_rescale(y), svg_rescale(w), svg_rescale(h));
1964 str_printf(S, "style='fill:none;stroke:%s;'/>", data_hexcolor(data));
1965 }
1966
1967 static void
svg_fillrect(void * data,long x,long y,long w,long h)1968 svg_fillrect(void *data, long x, long y, long w, long h)
1969 {
1970 pari_str *S = data_str(data);
1971 const char * color = data_hexcolor(data);
1972 str_printf(S, "<rect x='%.2f' y='%.2f' width='%.2f' height='%.2f' ",
1973 svg_rescale(x), svg_rescale(y), svg_rescale(w), svg_rescale(h));
1974 str_printf(S, "style='fill:%s;stroke:%s;'/>", color, color);
1975 }
1976
1977 static void
svg_points(void * data,long nb,struct plot_points * p)1978 svg_points(void *data, long nb, struct plot_points *p)
1979 {
1980 long i;
1981 for (i = 0; i < nb; i++)
1982 svg_point(data, p[i].x, p[i].y);
1983 }
1984
1985 static void
svg_color(void * data,long col)1986 svg_color(void *data, long col)
1987 {
1988 static const char hex[] = "0123456789abcdef";
1989 char *c = data_hexcolor(data);
1990 int r, g, b;
1991 long_to_rgb(col, &r, &g, &b);
1992 c[0] = '#';
1993 c[1] = hex[r / 16];
1994 c[2] = hex[r & 15];
1995 c[3] = hex[g / 16];
1996 c[4] = hex[g & 15];
1997 c[5] = hex[b / 16];
1998 c[6] = hex[b & 15];
1999 c[7] = '\0';
2000 }
2001
2002 static void
svg_lines(void * data,long nb,struct plot_points * p)2003 svg_lines(void *data, long nb, struct plot_points *p)
2004 {
2005 long i;
2006 pari_str *S = data_str(data);
2007
2008 str_printf(S, "<polyline points='");
2009 for (i = 0; i < nb; i++)
2010 {
2011 if (i > 0) str_printf(S, " ");
2012 str_printf(S, "%.2f,%.2f", svg_rescale(p[i].x), svg_rescale(p[i].y));
2013 }
2014 str_printf(S, "' style='fill:none;stroke:%s;'/>", data_hexcolor(data));
2015 }
2016
2017 static void
svg_text(void * data,long x,long y,char * text,long numtext)2018 svg_text(void *data, long x, long y, char *text, long numtext)
2019 {
2020 pari_str *S = data_str(data);
2021 (void)numtext;
2022 str_printf(S, "<text x='%.5f' y='%.5f' font-size='%ld' style='fill:%s;'>%s</text>",
2023 svg_rescale(x),svg_rescale(y), 12, data_hexcolor(data), text);
2024 }
2025
2026 static void
svg_head(PARI_plot * T,pari_str * S)2027 svg_head(PARI_plot *T, pari_str *S)
2028 {
2029 str_printf(S, "<svg width='%ld' height='%ld' version='1.1' xmlns='http://www.w3.org/2000/svg'>", T->width, T->height);
2030 }
2031
2032 static void
svg_tail(pari_str * S)2033 svg_tail(pari_str *S)
2034 {
2035 str_printf(S, "</svg>");
2036 }
2037
2038 char *
rect2svg(GEN w,GEN x,GEN y,PARI_plot * T)2039 rect2svg(GEN w, GEN x, GEN y, PARI_plot *T)
2040 {
2041 struct plot_eng pl;
2042 struct svg_data data;
2043 PARI_plot U;
2044
2045 str_init(&data.str, 1);
2046 svg_color(&data, 0);
2047 if (!T)
2048 {
2049 long i, l = lg(w), xmax = 0, ymax = 0;
2050 T = &U; pari_get_svgplot(T);
2051 for (i = 1; i < l; i++)
2052 {
2053 PariRect *e = check_rect_init(w[i]);
2054 xmax = maxss(xmax, RXsize(e) + x[i]);
2055 ymax = maxss(ymax, RYsize(e) + y[i]);
2056 }
2057 T->width = xmax;
2058 T->height = ymax;
2059 }
2060 pl.data = &data;
2061 pl.sc = &svg_color;
2062 pl.pt = &svg_point;
2063 pl.ln = &svg_line;
2064 pl.bx = &svg_rect;
2065 pl.fb = &svg_fillrect;
2066 pl.mp = &svg_points;
2067 pl.ml = &svg_lines;
2068 pl.st = &svg_text;
2069 pl.pl = T;
2070
2071 svg_head(T, &data.str);
2072 gen_draw(&pl, w, x, y, SVG_SCALE, SVG_SCALE);
2073 svg_tail(&data.str);
2074
2075 return data.str.string;
2076 }
2077
2078 /*************************************************************************/
2079 /* POSTSCRIPT */
2080 /*************************************************************************/
2081 static void
ps_sc(void * data,long col)2082 ps_sc(void *data, long col)
2083 {
2084 pari_str *S = (pari_str*)data;
2085 int r, g, b; long_to_rgb(col, &r, &g, &b);
2086 if (!r && !g && !b)
2087 str_puts(S,"c0\n");
2088 else
2089 str_printf(S,"%.6f %.6f %.6f c\n", r/255., g/255., b/255.);
2090 }
2091
2092 static void
ps_point(void * data,long x,long y)2093 ps_point(void *data, long x, long y)
2094 {
2095 pari_str *S = (pari_str*)data;
2096 str_printf(S,"%ld %ld p\n",y,x);
2097 }
2098
2099 static void
ps_line(void * data,long x1,long y1,long x2,long y2)2100 ps_line(void *data, long x1, long y1, long x2, long y2)
2101 {
2102 pari_str *S = (pari_str*)data;
2103 str_printf(S,"%ld %ld m %ld %ld l\n",y1,x1,y2,x2);
2104 str_printf(S,"stroke\n");
2105 }
2106
2107 static void
ps_rect(void * data,long x,long y,long w,long h)2108 ps_rect(void *data, long x, long y, long w, long h)
2109 {
2110 pari_str *S = (pari_str*)data;
2111 str_printf(S,"%ld %ld m %ld %ld l %ld %ld l %ld %ld l closepath currentlinejoin 0 setlinejoin stroke setlinejoin\n",
2112 y,x, y,x+w, y+h,x+w, y+h,x);
2113 }
2114
2115 static void
ps_fillrect(void * data,long x,long y,long w,long h)2116 ps_fillrect(void *data, long x, long y, long w, long h)
2117 {
2118 pari_str *S = (pari_str*)data;
2119 str_printf(S,"%ld %ld m %ld %ld l %ld %ld l %ld %ld l closepath currentlinejoin 0 setlinejoin fill setlinejoin\n",
2120 y,x, y,x+w, y+h,x+w, y+h,x);
2121 }
2122
2123 static void
ps_points(void * data,long nb,struct plot_points * p)2124 ps_points(void *data, long nb, struct plot_points *p)
2125 {
2126 long i;
2127 for (i=0; i<nb; i++) ps_point(data, p[i].x, p[i].y);
2128 }
2129
2130 static void
ps_lines(void * data,long nb,struct plot_points * p)2131 ps_lines(void *data, long nb, struct plot_points *p)
2132 {
2133 pari_str *S = (pari_str*)data;
2134 long i;
2135 str_printf(S,"%ld %ld m\n",p[0].y,p[0].x);
2136 for (i=1; i<nb; i++) str_printf(S, "%ld %ld l\n", p[i].y, p[i].x);
2137 str_printf(S,"stroke\n");
2138 }
2139
2140 static void
ps_string(void * data,long x,long y,char * s,long length)2141 ps_string(void *data, long x, long y, char *s, long length)
2142 {
2143 pari_str *S = (pari_str*)data;
2144 (void)length;
2145 if (strpbrk(s, "(\\)")) {
2146 str_printf(S,"(");
2147 while (*s) {
2148 if ( *s=='(' || *s==')' || *s=='\\' ) str_putc(S,'\\');
2149 str_putc(S, *s);
2150 s++;
2151 }
2152 } else
2153 str_printf(S,"(%s", s);
2154 str_printf(S,") %ld %ld m 90 rotate show -90 rotate\n", y, x);
2155 }
2156
2157 char *
rect2ps_i(GEN w,GEN x,GEN y,PARI_plot * T,int plotps)2158 rect2ps_i(GEN w, GEN x, GEN y, PARI_plot *T, int plotps)
2159 {
2160 struct plot_eng pl;
2161 PARI_plot U;
2162 pari_str S;
2163 double xs = 0.65*PS_SCALE, ys = 0.65*PS_SCALE;
2164 if (T) /* res wrt T dimens */
2165 {
2166 if (plotps)
2167 xs = ys = PS_SCALE;
2168 else
2169 {
2170 xs *= ((double)PS_WIDTH) / T->width;
2171 ys *= ((double)PS_HEIGH) / T->height;
2172 }
2173 }
2174 else
2175 {
2176 T = &U; pari_get_psplot(T);
2177 }
2178 str_init(&S, 1);
2179 /* Definitions taken from post terminal of Gnuplot. */
2180 str_printf(&S, "%%!\n\
2181 50 50 translate\n\
2182 1 %d div 1 %d div scale\n\
2183 1 setlinejoin\n\
2184 /p {moveto 0 2 rlineto 2 0 rlineto 0 -2 rlineto closepath fill} def\n\
2185 /c0 {0 0 0 setrgbcolor} def\n\
2186 /c {setrgbcolor} def\n\
2187 /l {lineto} def\n\
2188 /m {moveto} def\n"
2189 "/Times-Roman findfont %ld scalefont setfont\n",
2190 PS_SCALE, PS_SCALE, DTOL(T->fheight * xs));
2191
2192 pl.sc = &ps_sc;
2193 pl.pt = &ps_point;
2194 pl.ln = &ps_line;
2195 pl.bx = &ps_rect;
2196 pl.fb = &ps_fillrect;
2197 pl.mp = &ps_points;
2198 pl.ml = &ps_lines;
2199 pl.st = &ps_string;
2200 pl.pl = T;
2201 pl.data = (void*)&S;
2202
2203 if (plotps) str_printf(&S,"0 %ld translate -90 rotate\n", (T->height - 50)*PS_SCALE);
2204 gen_draw(&pl, w, x, y, xs, ys);
2205 str_puts(&S,"stroke showpage\n");
2206 *S.cur = 0; return S.string;
2207 }
2208 char *
rect2ps(GEN w,GEN x,GEN y,PARI_plot * T)2209 rect2ps(GEN w, GEN x, GEN y, PARI_plot *T)
2210 { return rect2ps_i(w,x,y,T,0); }
2211
2212 void
pari_plot_by_file(const char * env,const char * suf,const char * img)2213 pari_plot_by_file(const char *env, const char *suf, const char *img)
2214 {
2215 const char *cmd, *s = pari_unique_filename_suffix("plotfile", suf);
2216 FILE *f = fopen(s, "w");
2217 if (!f) pari_err_FILE("image file", s);
2218 fputs(img, f); (void)fclose(f);
2219 cmd = os_getenv(env);
2220 #ifdef GP_MIME_OPEN
2221 if (!cmd) cmd = GP_MIME_OPEN;
2222 #else
2223 if (!cmd) cmd = "open -W";
2224 #endif
2225 cmd = pari_sprintf("%s \"%s\" 2>/dev/null", cmd, s);
2226 gpsystem(cmd);
2227 pari_unlink(s);
2228 pari_free((char*)s);
2229 }
2230
2231 /*************************************************************************/
2232 /* */
2233 /* RGB COLORS */
2234 /* */
2235 /*************************************************************************/
2236 /* generated from /etc/X11/rgb.txt by the following perl script
2237 #!/usr/bin/perl
2238 while(<>)
2239 {
2240 ($hex, $name) = split(/\t\t/, $_);
2241 $hex =~ s/^ +//; chomp($name); $name =~ s, *,,g;
2242 $hex = sprintf("0x%02x%02x%02x", split(/\s+/, $hex));
2243 $name = lc($name); next if ($done{$name});
2244 $done{$name} = 1;
2245 print "COL(\"$name\", $hex),\n";
2246 }
2247 */
2248
2249 #define COL(x,y) {(void*)x,(void*)y,0,NULL}
2250 static hashentry col_list[] = {
2251 COL("", 0x000000),
2252 COL("snow", 0xfffafa),
2253 COL("ghostwhite", 0xf8f8ff),
2254 COL("whitesmoke", 0xf5f5f5),
2255 COL("gainsboro", 0xdcdcdc),
2256 COL("floralwhite", 0xfffaf0),
2257 COL("oldlace", 0xfdf5e6),
2258 COL("linen", 0xfaf0e6),
2259 COL("antiquewhite", 0xfaebd7),
2260 COL("papayawhip", 0xffefd5),
2261 COL("blanchedalmond", 0xffebcd),
2262 COL("bisque", 0xffe4c4),
2263 COL("peachpuff", 0xffdab9),
2264 COL("navajowhite", 0xffdead),
2265 COL("moccasin", 0xffe4b5),
2266 COL("cornsilk", 0xfff8dc),
2267 COL("ivory", 0xfffff0),
2268 COL("lemonchiffon", 0xfffacd),
2269 COL("seashell", 0xfff5ee),
2270 COL("honeydew", 0xf0fff0),
2271 COL("mintcream", 0xf5fffa),
2272 COL("azure", 0xf0ffff),
2273 COL("aliceblue", 0xf0f8ff),
2274 COL("lavender", 0xe6e6fa),
2275 COL("lavenderblush", 0xfff0f5),
2276 COL("mistyrose", 0xffe4e1),
2277 COL("white", 0xffffff),
2278 COL("black", 0x000000),
2279 COL("darkslategray", 0x2f4f4f),
2280 COL("darkslategrey", 0x2f4f4f),
2281 COL("dimgray", 0x696969),
2282 COL("dimgrey", 0x696969),
2283 COL("slategray", 0x708090),
2284 COL("slategrey", 0x708090),
2285 COL("lightslategray", 0x778899),
2286 COL("lightslategrey", 0x778899),
2287 COL("gray", 0xbebebe),
2288 COL("grey", 0xbebebe),
2289 COL("lightgrey", 0xd3d3d3),
2290 COL("lightgray", 0xd3d3d3),
2291 COL("midnightblue", 0x191970),
2292 COL("navy", 0x000080),
2293 COL("navyblue", 0x000080),
2294 COL("cornflowerblue", 0x6495ed),
2295 COL("darkslateblue", 0x483d8b),
2296 COL("slateblue", 0x6a5acd),
2297 COL("mediumslateblue", 0x7b68ee),
2298 COL("lightslateblue", 0x8470ff),
2299 COL("mediumblue", 0x0000cd),
2300 COL("royalblue", 0x4169e1),
2301 COL("blue", 0x0000ff),
2302 COL("dodgerblue", 0x1e90ff),
2303 COL("deepskyblue", 0x00bfff),
2304 COL("skyblue", 0x87ceeb),
2305 COL("lightskyblue", 0x87cefa),
2306 COL("steelblue", 0x4682b4),
2307 COL("lightsteelblue", 0xb0c4de),
2308 COL("lightblue", 0xadd8e6),
2309 COL("powderblue", 0xb0e0e6),
2310 COL("paleturquoise", 0xafeeee),
2311 COL("darkturquoise", 0x00ced1),
2312 COL("mediumturquoise", 0x48d1cc),
2313 COL("turquoise", 0x40e0d0),
2314 COL("cyan", 0x00ffff),
2315 COL("lightcyan", 0xe0ffff),
2316 COL("cadetblue", 0x5f9ea0),
2317 COL("mediumaquamarine", 0x66cdaa),
2318 COL("aquamarine", 0x7fffd4),
2319 COL("darkgreen", 0x006400),
2320 COL("darkolivegreen", 0x556b2f),
2321 COL("darkseagreen", 0x8fbc8f),
2322 COL("seagreen", 0x2e8b57),
2323 COL("mediumseagreen", 0x3cb371),
2324 COL("lightseagreen", 0x20b2aa),
2325 COL("palegreen", 0x98fb98),
2326 COL("springgreen", 0x00ff7f),
2327 COL("lawngreen", 0x7cfc00),
2328 COL("green", 0x00ff00),
2329 COL("chartreuse", 0x7fff00),
2330 COL("mediumspringgreen", 0x00fa9a),
2331 COL("greenyellow", 0xadff2f),
2332 COL("limegreen", 0x32cd32),
2333 COL("yellowgreen", 0x9acd32),
2334 COL("forestgreen", 0x228b22),
2335 COL("olivedrab", 0x6b8e23),
2336 COL("darkkhaki", 0xbdb76b),
2337 COL("khaki", 0xf0e68c),
2338 COL("palegoldenrod", 0xeee8aa),
2339 COL("lightgoldenrodyellow", 0xfafad2),
2340 COL("lightyellow", 0xffffe0),
2341 COL("yellow", 0xffff00),
2342 COL("gold", 0xffd700),
2343 COL("lightgoldenrod", 0xeedd82),
2344 COL("goldenrod", 0xdaa520),
2345 COL("darkgoldenrod", 0xb8860b),
2346 COL("rosybrown", 0xbc8f8f),
2347 COL("indianred", 0xcd5c5c),
2348 COL("saddlebrown", 0x8b4513),
2349 COL("sienna", 0xa0522d),
2350 COL("peru", 0xcd853f),
2351 COL("burlywood", 0xdeb887),
2352 COL("beige", 0xf5f5dc),
2353 COL("wheat", 0xf5deb3),
2354 COL("sandybrown", 0xf4a460),
2355 COL("tan", 0xd2b48c),
2356 COL("chocolate", 0xd2691e),
2357 COL("firebrick", 0xb22222),
2358 COL("brown", 0xa52a2a),
2359 COL("darksalmon", 0xe9967a),
2360 COL("salmon", 0xfa8072),
2361 COL("lightsalmon", 0xffa07a),
2362 COL("orange", 0xffa500),
2363 COL("darkorange", 0xff8c00),
2364 COL("coral", 0xff7f50),
2365 COL("lightcoral", 0xf08080),
2366 COL("tomato", 0xff6347),
2367 COL("orangered", 0xff4500),
2368 COL("red", 0xff0000),
2369 COL("hotpink", 0xff69b4),
2370 COL("deeppink", 0xff1493),
2371 COL("pink", 0xffc0cb),
2372 COL("lightpink", 0xffb6c1),
2373 COL("palevioletred", 0xdb7093),
2374 COL("maroon", 0xb03060),
2375 COL("mediumvioletred", 0xc71585),
2376 COL("violetred", 0xd02090),
2377 COL("magenta", 0xff00ff),
2378 COL("violet", 0xee82ee),
2379 COL("plum", 0xdda0dd),
2380 COL("orchid", 0xda70d6),
2381 COL("mediumorchid", 0xba55d3),
2382 COL("darkorchid", 0x9932cc),
2383 COL("darkviolet", 0x9400d3),
2384 COL("blueviolet", 0x8a2be2),
2385 COL("purple", 0xa020f0),
2386 COL("mediumpurple", 0x9370db),
2387 COL("thistle", 0xd8bfd8),
2388 COL("snow1", 0xfffafa),
2389 COL("snow2", 0xeee9e9),
2390 COL("snow3", 0xcdc9c9),
2391 COL("snow4", 0x8b8989),
2392 COL("seashell1", 0xfff5ee),
2393 COL("seashell2", 0xeee5de),
2394 COL("seashell3", 0xcdc5bf),
2395 COL("seashell4", 0x8b8682),
2396 COL("antiquewhite1", 0xffefdb),
2397 COL("antiquewhite2", 0xeedfcc),
2398 COL("antiquewhite3", 0xcdc0b0),
2399 COL("antiquewhite4", 0x8b8378),
2400 COL("bisque1", 0xffe4c4),
2401 COL("bisque2", 0xeed5b7),
2402 COL("bisque3", 0xcdb79e),
2403 COL("bisque4", 0x8b7d6b),
2404 COL("peachpuff1", 0xffdab9),
2405 COL("peachpuff2", 0xeecbad),
2406 COL("peachpuff3", 0xcdaf95),
2407 COL("peachpuff4", 0x8b7765),
2408 COL("navajowhite1", 0xffdead),
2409 COL("navajowhite2", 0xeecfa1),
2410 COL("navajowhite3", 0xcdb38b),
2411 COL("navajowhite4", 0x8b795e),
2412 COL("lemonchiffon1", 0xfffacd),
2413 COL("lemonchiffon2", 0xeee9bf),
2414 COL("lemonchiffon3", 0xcdc9a5),
2415 COL("lemonchiffon4", 0x8b8970),
2416 COL("cornsilk1", 0xfff8dc),
2417 COL("cornsilk2", 0xeee8cd),
2418 COL("cornsilk3", 0xcdc8b1),
2419 COL("cornsilk4", 0x8b8878),
2420 COL("ivory1", 0xfffff0),
2421 COL("ivory2", 0xeeeee0),
2422 COL("ivory3", 0xcdcdc1),
2423 COL("ivory4", 0x8b8b83),
2424 COL("honeydew1", 0xf0fff0),
2425 COL("honeydew2", 0xe0eee0),
2426 COL("honeydew3", 0xc1cdc1),
2427 COL("honeydew4", 0x838b83),
2428 COL("lavenderblush1", 0xfff0f5),
2429 COL("lavenderblush2", 0xeee0e5),
2430 COL("lavenderblush3", 0xcdc1c5),
2431 COL("lavenderblush4", 0x8b8386),
2432 COL("mistyrose1", 0xffe4e1),
2433 COL("mistyrose2", 0xeed5d2),
2434 COL("mistyrose3", 0xcdb7b5),
2435 COL("mistyrose4", 0x8b7d7b),
2436 COL("azure1", 0xf0ffff),
2437 COL("azure2", 0xe0eeee),
2438 COL("azure3", 0xc1cdcd),
2439 COL("azure4", 0x838b8b),
2440 COL("slateblue1", 0x836fff),
2441 COL("slateblue2", 0x7a67ee),
2442 COL("slateblue3", 0x6959cd),
2443 COL("slateblue4", 0x473c8b),
2444 COL("royalblue1", 0x4876ff),
2445 COL("royalblue2", 0x436eee),
2446 COL("royalblue3", 0x3a5fcd),
2447 COL("royalblue4", 0x27408b),
2448 COL("blue1", 0x0000ff),
2449 COL("blue2", 0x0000ee),
2450 COL("blue3", 0x0000cd),
2451 COL("blue4", 0x00008b),
2452 COL("dodgerblue1", 0x1e90ff),
2453 COL("dodgerblue2", 0x1c86ee),
2454 COL("dodgerblue3", 0x1874cd),
2455 COL("dodgerblue4", 0x104e8b),
2456 COL("steelblue1", 0x63b8ff),
2457 COL("steelblue2", 0x5cacee),
2458 COL("steelblue3", 0x4f94cd),
2459 COL("steelblue4", 0x36648b),
2460 COL("deepskyblue1", 0x00bfff),
2461 COL("deepskyblue2", 0x00b2ee),
2462 COL("deepskyblue3", 0x009acd),
2463 COL("deepskyblue4", 0x00688b),
2464 COL("skyblue1", 0x87ceff),
2465 COL("skyblue2", 0x7ec0ee),
2466 COL("skyblue3", 0x6ca6cd),
2467 COL("skyblue4", 0x4a708b),
2468 COL("lightskyblue1", 0xb0e2ff),
2469 COL("lightskyblue2", 0xa4d3ee),
2470 COL("lightskyblue3", 0x8db6cd),
2471 COL("lightskyblue4", 0x607b8b),
2472 COL("slategray1", 0xc6e2ff),
2473 COL("slategray2", 0xb9d3ee),
2474 COL("slategray3", 0x9fb6cd),
2475 COL("slategray4", 0x6c7b8b),
2476 COL("lightsteelblue1", 0xcae1ff),
2477 COL("lightsteelblue2", 0xbcd2ee),
2478 COL("lightsteelblue3", 0xa2b5cd),
2479 COL("lightsteelblue4", 0x6e7b8b),
2480 COL("lightblue1", 0xbfefff),
2481 COL("lightblue2", 0xb2dfee),
2482 COL("lightblue3", 0x9ac0cd),
2483 COL("lightblue4", 0x68838b),
2484 COL("lightcyan1", 0xe0ffff),
2485 COL("lightcyan2", 0xd1eeee),
2486 COL("lightcyan3", 0xb4cdcd),
2487 COL("lightcyan4", 0x7a8b8b),
2488 COL("paleturquoise1", 0xbbffff),
2489 COL("paleturquoise2", 0xaeeeee),
2490 COL("paleturquoise3", 0x96cdcd),
2491 COL("paleturquoise4", 0x668b8b),
2492 COL("cadetblue1", 0x98f5ff),
2493 COL("cadetblue2", 0x8ee5ee),
2494 COL("cadetblue3", 0x7ac5cd),
2495 COL("cadetblue4", 0x53868b),
2496 COL("turquoise1", 0x00f5ff),
2497 COL("turquoise2", 0x00e5ee),
2498 COL("turquoise3", 0x00c5cd),
2499 COL("turquoise4", 0x00868b),
2500 COL("cyan1", 0x00ffff),
2501 COL("cyan2", 0x00eeee),
2502 COL("cyan3", 0x00cdcd),
2503 COL("cyan4", 0x008b8b),
2504 COL("darkslategray1", 0x97ffff),
2505 COL("darkslategray2", 0x8deeee),
2506 COL("darkslategray3", 0x79cdcd),
2507 COL("darkslategray4", 0x528b8b),
2508 COL("aquamarine1", 0x7fffd4),
2509 COL("aquamarine2", 0x76eec6),
2510 COL("aquamarine3", 0x66cdaa),
2511 COL("aquamarine4", 0x458b74),
2512 COL("darkseagreen1", 0xc1ffc1),
2513 COL("darkseagreen2", 0xb4eeb4),
2514 COL("darkseagreen3", 0x9bcd9b),
2515 COL("darkseagreen4", 0x698b69),
2516 COL("seagreen1", 0x54ff9f),
2517 COL("seagreen2", 0x4eee94),
2518 COL("seagreen3", 0x43cd80),
2519 COL("seagreen4", 0x2e8b57),
2520 COL("palegreen1", 0x9aff9a),
2521 COL("palegreen2", 0x90ee90),
2522 COL("palegreen3", 0x7ccd7c),
2523 COL("palegreen4", 0x548b54),
2524 COL("springgreen1", 0x00ff7f),
2525 COL("springgreen2", 0x00ee76),
2526 COL("springgreen3", 0x00cd66),
2527 COL("springgreen4", 0x008b45),
2528 COL("green1", 0x00ff00),
2529 COL("green2", 0x00ee00),
2530 COL("green3", 0x00cd00),
2531 COL("green4", 0x008b00),
2532 COL("chartreuse1", 0x7fff00),
2533 COL("chartreuse2", 0x76ee00),
2534 COL("chartreuse3", 0x66cd00),
2535 COL("chartreuse4", 0x458b00),
2536 COL("olivedrab1", 0xc0ff3e),
2537 COL("olivedrab2", 0xb3ee3a),
2538 COL("olivedrab3", 0x9acd32),
2539 COL("olivedrab4", 0x698b22),
2540 COL("darkolivegreen1", 0xcaff70),
2541 COL("darkolivegreen2", 0xbcee68),
2542 COL("darkolivegreen3", 0xa2cd5a),
2543 COL("darkolivegreen4", 0x6e8b3d),
2544 COL("khaki1", 0xfff68f),
2545 COL("khaki2", 0xeee685),
2546 COL("khaki3", 0xcdc673),
2547 COL("khaki4", 0x8b864e),
2548 COL("lightgoldenrod1", 0xffec8b),
2549 COL("lightgoldenrod2", 0xeedc82),
2550 COL("lightgoldenrod3", 0xcdbe70),
2551 COL("lightgoldenrod4", 0x8b814c),
2552 COL("lightyellow1", 0xffffe0),
2553 COL("lightyellow2", 0xeeeed1),
2554 COL("lightyellow3", 0xcdcdb4),
2555 COL("lightyellow4", 0x8b8b7a),
2556 COL("yellow1", 0xffff00),
2557 COL("yellow2", 0xeeee00),
2558 COL("yellow3", 0xcdcd00),
2559 COL("yellow4", 0x8b8b00),
2560 COL("gold1", 0xffd700),
2561 COL("gold2", 0xeec900),
2562 COL("gold3", 0xcdad00),
2563 COL("gold4", 0x8b7500),
2564 COL("goldenrod1", 0xffc125),
2565 COL("goldenrod2", 0xeeb422),
2566 COL("goldenrod3", 0xcd9b1d),
2567 COL("goldenrod4", 0x8b6914),
2568 COL("darkgoldenrod1", 0xffb90f),
2569 COL("darkgoldenrod2", 0xeead0e),
2570 COL("darkgoldenrod3", 0xcd950c),
2571 COL("darkgoldenrod4", 0x8b6508),
2572 COL("rosybrown1", 0xffc1c1),
2573 COL("rosybrown2", 0xeeb4b4),
2574 COL("rosybrown3", 0xcd9b9b),
2575 COL("rosybrown4", 0x8b6969),
2576 COL("indianred1", 0xff6a6a),
2577 COL("indianred2", 0xee6363),
2578 COL("indianred3", 0xcd5555),
2579 COL("indianred4", 0x8b3a3a),
2580 COL("sienna1", 0xff8247),
2581 COL("sienna2", 0xee7942),
2582 COL("sienna3", 0xcd6839),
2583 COL("sienna4", 0x8b4726),
2584 COL("burlywood1", 0xffd39b),
2585 COL("burlywood2", 0xeec591),
2586 COL("burlywood3", 0xcdaa7d),
2587 COL("burlywood4", 0x8b7355),
2588 COL("wheat1", 0xffe7ba),
2589 COL("wheat2", 0xeed8ae),
2590 COL("wheat3", 0xcdba96),
2591 COL("wheat4", 0x8b7e66),
2592 COL("tan1", 0xffa54f),
2593 COL("tan2", 0xee9a49),
2594 COL("tan3", 0xcd853f),
2595 COL("tan4", 0x8b5a2b),
2596 COL("chocolate1", 0xff7f24),
2597 COL("chocolate2", 0xee7621),
2598 COL("chocolate3", 0xcd661d),
2599 COL("chocolate4", 0x8b4513),
2600 COL("firebrick1", 0xff3030),
2601 COL("firebrick2", 0xee2c2c),
2602 COL("firebrick3", 0xcd2626),
2603 COL("firebrick4", 0x8b1a1a),
2604 COL("brown1", 0xff4040),
2605 COL("brown2", 0xee3b3b),
2606 COL("brown3", 0xcd3333),
2607 COL("brown4", 0x8b2323),
2608 COL("salmon1", 0xff8c69),
2609 COL("salmon2", 0xee8262),
2610 COL("salmon3", 0xcd7054),
2611 COL("salmon4", 0x8b4c39),
2612 COL("lightsalmon1", 0xffa07a),
2613 COL("lightsalmon2", 0xee9572),
2614 COL("lightsalmon3", 0xcd8162),
2615 COL("lightsalmon4", 0x8b5742),
2616 COL("orange1", 0xffa500),
2617 COL("orange2", 0xee9a00),
2618 COL("orange3", 0xcd8500),
2619 COL("orange4", 0x8b5a00),
2620 COL("darkorange1", 0xff7f00),
2621 COL("darkorange2", 0xee7600),
2622 COL("darkorange3", 0xcd6600),
2623 COL("darkorange4", 0x8b4500),
2624 COL("coral1", 0xff7256),
2625 COL("coral2", 0xee6a50),
2626 COL("coral3", 0xcd5b45),
2627 COL("coral4", 0x8b3e2f),
2628 COL("tomato1", 0xff6347),
2629 COL("tomato2", 0xee5c42),
2630 COL("tomato3", 0xcd4f39),
2631 COL("tomato4", 0x8b3626),
2632 COL("orangered1", 0xff4500),
2633 COL("orangered2", 0xee4000),
2634 COL("orangered3", 0xcd3700),
2635 COL("orangered4", 0x8b2500),
2636 COL("red1", 0xff0000),
2637 COL("red2", 0xee0000),
2638 COL("red3", 0xcd0000),
2639 COL("red4", 0x8b0000),
2640 COL("debianred", 0xd70751),
2641 COL("deeppink1", 0xff1493),
2642 COL("deeppink2", 0xee1289),
2643 COL("deeppink3", 0xcd1076),
2644 COL("deeppink4", 0x8b0a50),
2645 COL("hotpink1", 0xff6eb4),
2646 COL("hotpink2", 0xee6aa7),
2647 COL("hotpink3", 0xcd6090),
2648 COL("hotpink4", 0x8b3a62),
2649 COL("pink1", 0xffb5c5),
2650 COL("pink2", 0xeea9b8),
2651 COL("pink3", 0xcd919e),
2652 COL("pink4", 0x8b636c),
2653 COL("lightpink1", 0xffaeb9),
2654 COL("lightpink2", 0xeea2ad),
2655 COL("lightpink3", 0xcd8c95),
2656 COL("lightpink4", 0x8b5f65),
2657 COL("palevioletred1", 0xff82ab),
2658 COL("palevioletred2", 0xee799f),
2659 COL("palevioletred3", 0xcd6889),
2660 COL("palevioletred4", 0x8b475d),
2661 COL("maroon1", 0xff34b3),
2662 COL("maroon2", 0xee30a7),
2663 COL("maroon3", 0xcd2990),
2664 COL("maroon4", 0x8b1c62),
2665 COL("violetred1", 0xff3e96),
2666 COL("violetred2", 0xee3a8c),
2667 COL("violetred3", 0xcd3278),
2668 COL("violetred4", 0x8b2252),
2669 COL("magenta1", 0xff00ff),
2670 COL("magenta2", 0xee00ee),
2671 COL("magenta3", 0xcd00cd),
2672 COL("magenta4", 0x8b008b),
2673 COL("orchid1", 0xff83fa),
2674 COL("orchid2", 0xee7ae9),
2675 COL("orchid3", 0xcd69c9),
2676 COL("orchid4", 0x8b4789),
2677 COL("plum1", 0xffbbff),
2678 COL("plum2", 0xeeaeee),
2679 COL("plum3", 0xcd96cd),
2680 COL("plum4", 0x8b668b),
2681 COL("mediumorchid1", 0xe066ff),
2682 COL("mediumorchid2", 0xd15fee),
2683 COL("mediumorchid3", 0xb452cd),
2684 COL("mediumorchid4", 0x7a378b),
2685 COL("darkorchid1", 0xbf3eff),
2686 COL("darkorchid2", 0xb23aee),
2687 COL("darkorchid3", 0x9a32cd),
2688 COL("darkorchid4", 0x68228b),
2689 COL("purple1", 0x9b30ff),
2690 COL("purple2", 0x912cee),
2691 COL("purple3", 0x7d26cd),
2692 COL("purple4", 0x551a8b),
2693 COL("mediumpurple1", 0xab82ff),
2694 COL("mediumpurple2", 0x9f79ee),
2695 COL("mediumpurple3", 0x8968cd),
2696 COL("mediumpurple4", 0x5d478b),
2697 COL("thistle1", 0xffe1ff),
2698 COL("thistle2", 0xeed2ee),
2699 COL("thistle3", 0xcdb5cd),
2700 COL("thistle4", 0x8b7b8b),
2701 COL("gray0", 0x000000),
2702 COL("grey0", 0x000000),
2703 COL("gray1", 0x030303),
2704 COL("grey1", 0x030303),
2705 COL("gray2", 0x050505),
2706 COL("grey2", 0x050505),
2707 COL("gray3", 0x080808),
2708 COL("grey3", 0x080808),
2709 COL("gray4", 0x0a0a0a),
2710 COL("grey4", 0x0a0a0a),
2711 COL("gray5", 0x0d0d0d),
2712 COL("grey5", 0x0d0d0d),
2713 COL("gray6", 0x0f0f0f),
2714 COL("grey6", 0x0f0f0f),
2715 COL("gray7", 0x121212),
2716 COL("grey7", 0x121212),
2717 COL("gray8", 0x141414),
2718 COL("grey8", 0x141414),
2719 COL("gray9", 0x171717),
2720 COL("grey9", 0x171717),
2721 COL("gray10", 0x1a1a1a),
2722 COL("grey10", 0x1a1a1a),
2723 COL("gray11", 0x1c1c1c),
2724 COL("grey11", 0x1c1c1c),
2725 COL("gray12", 0x1f1f1f),
2726 COL("grey12", 0x1f1f1f),
2727 COL("gray13", 0x212121),
2728 COL("grey13", 0x212121),
2729 COL("gray14", 0x242424),
2730 COL("grey14", 0x242424),
2731 COL("gray15", 0x262626),
2732 COL("grey15", 0x262626),
2733 COL("gray16", 0x292929),
2734 COL("grey16", 0x292929),
2735 COL("gray17", 0x2b2b2b),
2736 COL("grey17", 0x2b2b2b),
2737 COL("gray18", 0x2e2e2e),
2738 COL("grey18", 0x2e2e2e),
2739 COL("gray19", 0x303030),
2740 COL("grey19", 0x303030),
2741 COL("gray20", 0x333333),
2742 COL("grey20", 0x333333),
2743 COL("gray21", 0x363636),
2744 COL("grey21", 0x363636),
2745 COL("gray22", 0x383838),
2746 COL("grey22", 0x383838),
2747 COL("gray23", 0x3b3b3b),
2748 COL("grey23", 0x3b3b3b),
2749 COL("gray24", 0x3d3d3d),
2750 COL("grey24", 0x3d3d3d),
2751 COL("gray25", 0x404040),
2752 COL("grey25", 0x404040),
2753 COL("gray26", 0x424242),
2754 COL("grey26", 0x424242),
2755 COL("gray27", 0x454545),
2756 COL("grey27", 0x454545),
2757 COL("gray28", 0x474747),
2758 COL("grey28", 0x474747),
2759 COL("gray29", 0x4a4a4a),
2760 COL("grey29", 0x4a4a4a),
2761 COL("gray30", 0x4d4d4d),
2762 COL("grey30", 0x4d4d4d),
2763 COL("gray31", 0x4f4f4f),
2764 COL("grey31", 0x4f4f4f),
2765 COL("gray32", 0x525252),
2766 COL("grey32", 0x525252),
2767 COL("gray33", 0x545454),
2768 COL("grey33", 0x545454),
2769 COL("gray34", 0x575757),
2770 COL("grey34", 0x575757),
2771 COL("gray35", 0x595959),
2772 COL("grey35", 0x595959),
2773 COL("gray36", 0x5c5c5c),
2774 COL("grey36", 0x5c5c5c),
2775 COL("gray37", 0x5e5e5e),
2776 COL("grey37", 0x5e5e5e),
2777 COL("gray38", 0x616161),
2778 COL("grey38", 0x616161),
2779 COL("gray39", 0x636363),
2780 COL("grey39", 0x636363),
2781 COL("gray40", 0x666666),
2782 COL("grey40", 0x666666),
2783 COL("gray41", 0x696969),
2784 COL("grey41", 0x696969),
2785 COL("gray42", 0x6b6b6b),
2786 COL("grey42", 0x6b6b6b),
2787 COL("gray43", 0x6e6e6e),
2788 COL("grey43", 0x6e6e6e),
2789 COL("gray44", 0x707070),
2790 COL("grey44", 0x707070),
2791 COL("gray45", 0x737373),
2792 COL("grey45", 0x737373),
2793 COL("gray46", 0x757575),
2794 COL("grey46", 0x757575),
2795 COL("gray47", 0x787878),
2796 COL("grey47", 0x787878),
2797 COL("gray48", 0x7a7a7a),
2798 COL("grey48", 0x7a7a7a),
2799 COL("gray49", 0x7d7d7d),
2800 COL("grey49", 0x7d7d7d),
2801 COL("gray50", 0x7f7f7f),
2802 COL("grey50", 0x7f7f7f),
2803 COL("gray51", 0x828282),
2804 COL("grey51", 0x828282),
2805 COL("gray52", 0x858585),
2806 COL("grey52", 0x858585),
2807 COL("gray53", 0x878787),
2808 COL("grey53", 0x878787),
2809 COL("gray54", 0x8a8a8a),
2810 COL("grey54", 0x8a8a8a),
2811 COL("gray55", 0x8c8c8c),
2812 COL("grey55", 0x8c8c8c),
2813 COL("gray56", 0x8f8f8f),
2814 COL("grey56", 0x8f8f8f),
2815 COL("gray57", 0x919191),
2816 COL("grey57", 0x919191),
2817 COL("gray58", 0x949494),
2818 COL("grey58", 0x949494),
2819 COL("gray59", 0x969696),
2820 COL("grey59", 0x969696),
2821 COL("gray60", 0x999999),
2822 COL("grey60", 0x999999),
2823 COL("gray61", 0x9c9c9c),
2824 COL("grey61", 0x9c9c9c),
2825 COL("gray62", 0x9e9e9e),
2826 COL("grey62", 0x9e9e9e),
2827 COL("gray63", 0xa1a1a1),
2828 COL("grey63", 0xa1a1a1),
2829 COL("gray64", 0xa3a3a3),
2830 COL("grey64", 0xa3a3a3),
2831 COL("gray65", 0xa6a6a6),
2832 COL("grey65", 0xa6a6a6),
2833 COL("gray66", 0xa8a8a8),
2834 COL("grey66", 0xa8a8a8),
2835 COL("gray67", 0xababab),
2836 COL("grey67", 0xababab),
2837 COL("gray68", 0xadadad),
2838 COL("grey68", 0xadadad),
2839 COL("gray69", 0xb0b0b0),
2840 COL("grey69", 0xb0b0b0),
2841 COL("gray70", 0xb3b3b3),
2842 COL("grey70", 0xb3b3b3),
2843 COL("gray71", 0xb5b5b5),
2844 COL("grey71", 0xb5b5b5),
2845 COL("gray72", 0xb8b8b8),
2846 COL("grey72", 0xb8b8b8),
2847 COL("gray73", 0xbababa),
2848 COL("grey73", 0xbababa),
2849 COL("gray74", 0xbdbdbd),
2850 COL("grey74", 0xbdbdbd),
2851 COL("gray75", 0xbfbfbf),
2852 COL("grey75", 0xbfbfbf),
2853 COL("gray76", 0xc2c2c2),
2854 COL("grey76", 0xc2c2c2),
2855 COL("gray77", 0xc4c4c4),
2856 COL("grey77", 0xc4c4c4),
2857 COL("gray78", 0xc7c7c7),
2858 COL("grey78", 0xc7c7c7),
2859 COL("gray79", 0xc9c9c9),
2860 COL("grey79", 0xc9c9c9),
2861 COL("gray80", 0xcccccc),
2862 COL("grey80", 0xcccccc),
2863 COL("gray81", 0xcfcfcf),
2864 COL("grey81", 0xcfcfcf),
2865 COL("gray82", 0xd1d1d1),
2866 COL("grey82", 0xd1d1d1),
2867 COL("gray83", 0xd4d4d4),
2868 COL("grey83", 0xd4d4d4),
2869 COL("gray84", 0xd6d6d6),
2870 COL("grey84", 0xd6d6d6),
2871 COL("gray85", 0xd9d9d9),
2872 COL("grey85", 0xd9d9d9),
2873 COL("gray86", 0xdbdbdb),
2874 COL("grey86", 0xdbdbdb),
2875 COL("gray87", 0xdedede),
2876 COL("grey87", 0xdedede),
2877 COL("gray88", 0xe0e0e0),
2878 COL("grey88", 0xe0e0e0),
2879 COL("gray89", 0xe3e3e3),
2880 COL("grey89", 0xe3e3e3),
2881 COL("gray90", 0xe5e5e5),
2882 COL("grey90", 0xe5e5e5),
2883 COL("gray91", 0xe8e8e8),
2884 COL("grey91", 0xe8e8e8),
2885 COL("gray92", 0xebebeb),
2886 COL("grey92", 0xebebeb),
2887 COL("gray93", 0xededed),
2888 COL("grey93", 0xededed),
2889 COL("gray94", 0xf0f0f0),
2890 COL("grey94", 0xf0f0f0),
2891 COL("gray95", 0xf2f2f2),
2892 COL("grey95", 0xf2f2f2),
2893 COL("gray96", 0xf5f5f5),
2894 COL("grey96", 0xf5f5f5),
2895 COL("gray97", 0xf7f7f7),
2896 COL("grey97", 0xf7f7f7),
2897 COL("gray98", 0xfafafa),
2898 COL("grey98", 0xfafafa),
2899 COL("gray99", 0xfcfcfc),
2900 COL("grey99", 0xfcfcfc),
2901 COL("gray100", 0xffffff),
2902 COL("grey100", 0xffffff),
2903 COL("darkgrey", 0xa9a9a9),
2904 COL("darkgray", 0xa9a9a9),
2905 COL("darkblue", 0x00008b),
2906 COL("darkcyan", 0x008b8b),
2907 COL("darkmagenta", 0x8b008b),
2908 COL("darkred", 0x8b0000),
2909 COL("lightgreen", 0x90ee90),
2910 COL(NULL,0) /* sentinel */
2911 };
2912 #undef COL
2913
2914 void
long_to_rgb(long c,int * r,int * g,int * b)2915 long_to_rgb(long c, int *r, int *g, int *b)
2916 {
2917 *b = c & 0xff; c >>= 8;
2918 *g = c & 0xff; c >>= 8;
2919 *r = c;
2920 }
2921 static int
hex2(const char * s)2922 hex2(const char *s)
2923 {
2924 int m = 0, c = 0, i;
2925 for (i = 0; i < 2; i++, s++)
2926 {
2927 if (*s >= '0' && *s <= '9')
2928 c = *s - '0';
2929 else if (*s >= 'A' && *s <= 'F')
2930 c = *s - 'A' + 10;
2931 else if (*s >= 'a' && *s <= 'f')
2932 c = *s - 'a' + 10;
2933 else pari_err(e_MISC,"incorrect hexadecimal number: %s", s);
2934 m = 16*m + c;
2935 }
2936 return m;
2937 }
2938 void
colorname_to_rgb(const char * s,int * r,int * g,int * b)2939 colorname_to_rgb(const char *s, int *r, int *g, int *b)
2940 {
2941 if (!rgb_colors) rgb_colors = hashstr_import_static(col_list, 1000);
2942 if (*s == '#' && strlen(s) == 7)
2943 {
2944 *r = hex2(s+1);
2945 *g = hex2(s+3);
2946 *b = hex2(s+5);
2947 }
2948 else
2949 {
2950 hashentry *ep = hash_search(rgb_colors, (void*)s);
2951 if (!ep) pari_err(e_MISC, "unknown color %s", s);
2952 long_to_rgb((long)ep->val, r,g,b);
2953 }
2954 }
2955
2956 static void
chk_8bit(int v,GEN c)2957 chk_8bit(int v, GEN c)
2958 { if (v & ~0xff) pari_err(e_MISC, "invalid RGB code: %Ps", c); }
2959 void
color_to_rgb(GEN c,int * r,int * g,int * b)2960 color_to_rgb(GEN c, int *r, int *g, int *b)
2961 {
2962 switch(typ(c))
2963 {
2964 case t_STR:
2965 colorname_to_rgb(GSTR(c), r,g,b);
2966 break;
2967 default: /* t_VECSMALL: */
2968 *r = c[1]; chk_8bit(*r, c);
2969 *g = c[2]; chk_8bit(*g, c);
2970 *b = c[3]; chk_8bit(*b, c);
2971 break;
2972 }
2973 }
2974