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