CoCalc -- plotport.c

Testing latest pari + WASM + node.js... and it works?! Wow.
pari / 2021-07-01 / pari-2.14.0.alpha / src / graph / plotport.c
²⁸⁴⁸⁵ views
License: GPL3
ubuntu2004
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
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
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
97
_psdraw(PARI_plot *T, GEN w, GEN x, GEN y)
98
{ (void)T; _psdraw_scale(NULL,w,x,y); }
99
static void
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
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
132
pari_init_graphics(void) { pari_get_plot = &pari_get_svgplot; }
133

134
void
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
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 *
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 *
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
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
189
rgb_to_long(long r, long g, long b)
190
{ return (r << 16) | (g << 8) | b; }
191
/* c from graphcolormap */
192
static long
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
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
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
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
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
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
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
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
289
_move(long ne, double x, double y)
290
{ plotmove0(ne,x,y,0); }
291
void
292
plotmove(long ne, GEN x, GEN y)
293
{ plotmove0(ne,gtodouble(x),gtodouble(y),0); }
294
void
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
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
316
plotpoint(long ne, GEN x, GEN y)
317
{ plotpoint0(ne,gtodouble(x),gtodouble(y),0); }
318
void
319
plotrpoint(long ne, GEN x, GEN y)
320
{ plotpoint0(ne,gtodouble(x),gtodouble(y),1); }
321

322
GEN
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
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
390
_line(long ne, double x, double y)
391
{ rectline0(ne, x, y, 0); }
392
void
393
plotline(long ne, GEN gx2, GEN gy2)
394
{ rectline0(ne, gtodouble(gx2), gtodouble(gy2),0); }
395
void
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
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
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
530
_box(long ne, double x, double y)
531
{ rectbox0(ne, x, y, 0, 0); }
532
void
533
plotbox(long ne, GEN gx2, GEN gy2, long f)
534
{ rectbox0(ne, gtodouble(gx2), gtodouble(gy2), 0, f); }
535
void
536
plotrbox(long ne, GEN gx2, GEN gy2, long f)
537
{ rectbox0(ne, gtodouble(gx2), gtodouble(gy2), 1, f); }
538

539
static void
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
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
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
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
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
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
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
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
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
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*
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*
734
cp(void* R, size_t t)
735
{ void *o = pari_malloc(t); memcpy(o,R,t); return o; }
736
void
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
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
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
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
1018
Appendx(dblPointList *f, dblPointList *l, double x)
1019
{ (l->d)[l->nb++] = x; set_xrange(f,x); }
1020
static void
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
1025
Appendy(dblPointList *f, dblPointList *l, double y)
1026
{ (l->d)[l->nb++] = y; set_yrange(f,y); }
1027

1028
static void
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
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
/* X,Y t_VEC; next (x,y) coordinate starting at index i; Y ignored if (cplx) */
1069
static void
1070
get_xy_from_vec2(long cplx, GEN X, GEN Y, long i, double *x, double *y)
1071
{
1072
  GEN a, b;
1073
  if (cplx)
1074
  {
1075
    GEN z = gel(X,i);
1076
    a = real_i(z); b = imag_i(z);
1077
  }
1078
  else
1079
  {
1080
    a = gel(X,i); b = gel(Y,i);
1081
  }
1082
  *x = gtodouble(a);
1083
  *y = gtodouble(b);
1084
}
1085

1086
/* Convert data from GEN to double before we call plotrecthrawin. */
1087
static dblPointList*
1088
gtodblList(GEN data, long flags)
1089
{
1090
  dblPointList *l, *L;
1091
  double *X, *Y;
1092
  long nl=lg(data)-1, lx1, i, j;
1093
  const long param = (flags & (PLOT_PARAMETRIC|PLOT_COMPLEX));
1094
  const long cplx = (flags & PLOT_COMPLEX);
1095

1096
  if (! is_vec_t(typ(data))) pari_err_TYPE("gtodblList",data);
1097
  if (!nl) return NULL;
1098
  lx1 = lg(gel(data,1));
1099
  if (!param && lx1 == 1) return NULL;
1100

1101
  /* Check input first */
1102
  if (nl == 1 && !cplx) pari_err_DIM("gtodblList");
1103
  for (i = 0; i < nl; i += cplx? 1: 2)
1104
  {
1105
    GEN x = gel(data,i+1), y = cplx? NULL: gel(data,i+2);
1106
    long lx = lg(x);
1107
    if (!is_vec_t(typ(x))) pari_err_TYPE("gtodblList",x);
1108
    if (y)
1109
    {
1110
      if (!is_vec_t(typ(y))) pari_err_TYPE("gtodblList",y);
1111
      if (lg(y) != lx || (!param && lx != lx1)) pari_err_DIM("gtodblList");
1112
    }
1113
  }
1114
  /* Now allocate memory, then convert coord. to double */
1115
  l = (dblPointList*)pari_malloc((cplx? 2*nl: nl)*sizeof(dblPointList));
1116
  L = &l[0];
1117
  for (i = 0; i < nl; i += cplx? 1: 2)
1118
  {
1119
    GEN x = gel(data,i+1), y = cplx? NULL: gel(data,i+2);
1120
    long lx = lg(x)-1;
1121
    l[i].d   = X = (double*)pari_malloc(lx*sizeof(double));
1122
    l[i+1].d = Y = (double*)pari_malloc(lx*sizeof(double));
1123
    for (j=1; j<=lx; j++) get_xy_from_vec2(cplx, x, y, j, X+(j-1), Y+(j-1));
1124
    l[i].nb = l[i+1].nb = lx;
1125
  }
1126
  /* Compute extremas */
1127
  if (param)
1128
  {
1129
    L->nb = cplx? nl: nl/2;
1130
    for (i=0; i < L->nb; i+=2)
1131
      if (l[i+1].nb) break;
1132
    if (i >= L->nb) { pari_free(l); return NULL; }
1133
    L->xsml = L->xbig = l[i  ].d[0];
1134
    L->ysml = L->ybig = l[i+1].d[0];
1135
    for (; i < L->nb; i+=2)
1136
    {
1137
      long nbi = l[i+1].nb; X = l[i].d; Y = l[i+1].d;
1138
      for (j = 0; j < nbi; j++) { set_xrange(L, X[j]); set_yrange(L, Y[j]); }
1139
    }
1140
  }
1141
  else
1142
  {
1143
    L->nb = nl-1;
1144
    X = L->d;   L->xsml = L->xbig = X[0];
1145
    Y = l[1].d; L->ysml = L->ybig = Y[0];
1146
    for (j=0; j < l[1].nb; j++) set_xrange(L, X[j]);
1147
    for (i=1; i <= L->nb; i++)
1148
    {
1149
      long nbi = l[i].nb; Y = l[i].d;
1150
      for (j = 0; j < nbi; j++) set_yrange(L, Y[j]);
1151
    }
1152
  }
1153
  return l;
1154
}
1155

1156
/* x,y t_REAL; return (x+y)/2,  */
1157
static GEN
1158
rmiddle(GEN x, GEN y) { GEN z = addrr(x,y); shiftr_inplace(z,-1); return z; }
1159

1160
static void
1161
single_recursion(void *E, GEN(*eval)(void*,GEN), dblPointList *pl,
1162
                 GEN xl,double yl, GEN xr,double yr,long depth)
1163
{
1164
  GEN xx;
1165
  pari_sp av = avma;
1166
  double yy, dy=pl[0].ybig - pl[0].ysml;
1167

1168
  if (depth==RECUR_MAXDEPTH) return;
1169

1170
  xx = rmiddle(xl,xr);
1171
  yy = gtodouble(eval(E,xx));
1172

1173
  if (dy && fabs(yl+yr-2*yy) < dy*RECUR_PREC) return;
1174
  single_recursion(E,eval, pl,xl,yl, xx,yy, depth+1);
1175
  Appendx(&pl[0],&pl[0],rtodbl(xx));
1176
  Appendy(&pl[0],&pl[1],yy);
1177
  single_recursion(E,eval, pl,xx,yy, xr,yr, depth+1);
1178
  set_avma(av);
1179
}
1180

1181
static void
1182
param_recursion(void *E,GEN(*eval)(void*,GEN), long cplx, dblPointList *pl,
1183
  GEN tl,double xl, double yl, GEN tr,double xr,double yr, long depth)
1184
{
1185
  GEN t;
1186
  pari_sp av = avma;
1187
  double xx, dy=pl[0].ybig - pl[0].ysml;
1188
  double yy, dx=pl[0].xbig - pl[0].xsml;
1189

1190
  if (depth==RECUR_MAXDEPTH) return;
1191

1192
  t = rmiddle(tl,tr);
1193
  get_xy(cplx, eval(E,t), &xx,&yy);
1194

1195
  if (dx && dy && fabs(xl+xr-2*xx) < dx*RECUR_PREC
1196
               && fabs(yl+yr-2*yy) < dy*RECUR_PREC) return;
1197
  param_recursion(E,eval, cplx, pl, tl,xl,yl, t,xx,yy, depth+1);
1198
  Appendx(&pl[0],&pl[0],xx);
1199
  Appendy(&pl[0],&pl[1],yy);
1200
  param_recursion(E,eval,cplx, pl, t,xx,yy, tr,xr,yr, depth+1);
1201
  set_avma(av);
1202
}
1203

1204
/* Graph 'code' for parameter values in [a,b], using 'N' sample points
1205
 * (0 = use a default value); code is either a t_CLOSURE or a t_POL or a
1206
 * t_VEC of two t_POLs from rectsplines. Returns a dblPointList of
1207
 * (absolute) coordinates. */
1208
static dblPointList *
1209
plotrecthin(void *E, GEN(*eval)(void*, GEN), GEN a, GEN b, ulong flags,
1210
            long N, long prec)
1211
{
1212
  const double INF = 1.0/0.0;
1213
  const long param = flags & (PLOT_PARAMETRIC|PLOT_COMPLEX);
1214
  const long recur = flags & PLOT_RECURSIVE;
1215
  const long cplx = flags & PLOT_COMPLEX;
1216
  GEN t, dx, x;
1217
  dblPointList *pl;
1218
  long tx, i, j, sig, nc, nl, ncoords, nbpoints, non_vec = 0;
1219

1220
  sig = gcmp(b,a); if (!sig) return NULL;
1221
  if (sig < 0) swap(a, b);
1222
  if (N == 1) pari_err_DOMAIN("ploth", "#points", "<", gen_2, stoi(N));
1223
  if (!N) N = recur? 8: (param? 1500: 1000);
1224
  /* compute F(a) to determine nc = #curves; nl = #coord. lists */
1225
  x = gtofp(a, prec);
1226
  t = eval(E, x); tx = typ(t);
1227
  if (cplx) nc = nl = (tx == t_VEC)? lg(t)-1: 1;
1228
  else if (param)
1229
  {
1230
    if (tx != t_VEC) pari_err_TYPE("ploth [not a t_VEC in parametric plot]", t);
1231
    nl = lg(t)-1; nc = nl >> 1;
1232
    if (odd(nl)) pari_err_TYPE("ploth [odd #components in parametric plot]",t);
1233
  }
1234
  else if (!is_matvec_t(tx)) { nl = 2; non_vec = 1; nc = 1; }
1235
  else
1236
  {
1237
    if (tx != t_VEC) pari_err_TYPE("ploth [not a t_VEC]",t);
1238
    nl = lg(t);
1239
    nc = nl-1;
1240
  }
1241
  if (!nc) return NULL;
1242
  if (recur && nc > 1) pari_err_TYPE("ploth [multi-curves + recursive]",t);
1243

1244
  ncoords = cplx? 2*nl: nl;
1245
  nbpoints = recur? N << RECUR_MAXDEPTH: N;
1246
  pl=(dblPointList*) pari_malloc(ncoords*sizeof(dblPointList));
1247
  /* set [xy]sml,[xy]big to default values */
1248
  if (param)
1249
  {
1250
    pl[0].xsml = INF;
1251
    pl[0].xbig =-INF;
1252
  } else {
1253
    pl[0].xsml = gtodouble(a);
1254
    pl[0].xbig = gtodouble(b);
1255
  }
1256
  pl[0].ysml = INF;
1257
  pl[0].ybig =-INF;
1258
  for (i = 0; i < ncoords; i++)
1259
  {
1260
    pl[i].d = (double*)pari_malloc((nbpoints+1)*sizeof(double));
1261
    pl[i].nb=0;
1262
  }
1263
  dx = divru(gtofp(gsub(b,a),prec), N-1);
1264
  if (recur)
1265
  { /* recursive plot */
1266
    double yl, yr = 0;
1267
    if (param)
1268
    {
1269
      GEN tl = cgetr(prec), tr = cgetr(prec);
1270
      double xl, xr = 0;
1271
      pari_sp av2 = avma;
1272
      affgr(a, tl);
1273
      t = eval(E, tl);
1274
      get_xy(cplx,t, &xl,&yl);
1275
      for (i=0; i<N-1; i++, set_avma(av2))
1276
      {
1277
        if (i) { affrr(tr,tl); xl = xr; yl = yr; }
1278
        addrrz(tl,dx,tr);
1279
        t = eval(E, tr);
1280
        get_xy(cplx,t, &xr,&yr);
1281
        Appendx(&pl[0],&pl[0],xl);
1282
        Appendy(&pl[0],&pl[1],yl);
1283
        param_recursion(E,eval, cplx, pl, tl,xl,yl, tr,xr,yr, 0);
1284
      }
1285
      Appendx(&pl[0],&pl[0],xr);
1286
      Appendy(&pl[0],&pl[1],yr);
1287
    }
1288
    else /* single curve */
1289
    {
1290
      GEN xl = cgetr(prec), xr = cgetr(prec);
1291
      pari_sp av2 = avma;
1292
      affgr(a,xl);
1293
      yl = gtodouble(eval(E,xl));
1294
      for (i=0; i<N-1; i++, set_avma(av2))
1295
      {
1296
        addrrz(xl,dx,xr);
1297
        yr = gtodouble(eval(E,xr));
1298
        Appendx(&pl[0],&pl[0],rtodbl(xl));
1299
        Appendy(&pl[0],&pl[1],yl);
1300
        single_recursion(E,eval, pl,xl,yl,xr,yr,0);
1301
        affrr(xr,xl); yl = yr;
1302
      }
1303
      Appendx(&pl[0],&pl[0],rtodbl(xr));
1304
      Appendy(&pl[0],&pl[1],yr);
1305
    }
1306
  }
1307
  else /* nonrecursive plot */
1308
  {
1309
    GEN V, X = cgetg(N+1, t_VEC);
1310
    for (i = 1; i <= N; i++) { gel(X,i) = x; x = addrr(x,dx); }
1311
    if (flags & PLOT_PARA && eval == gp_call)
1312
    {
1313
      GEN worker = snm_closure(is_entry("_parapply_slice_worker"),
1314
                               mkvec((GEN)E));
1315
      V = gen_parapply_slice(worker, X, mt_nbthreads());
1316
    }
1317
    else
1318
    {
1319
      V = cgetg(N+1, t_VEC);
1320
      for (i = 1; i <= N; i++) gel(V,i) = eval(E,gel(X,i));
1321
    }
1322
    if (param)
1323
    {
1324
      for (i = 1; i <= N; i++)
1325
      {
1326
        long nt, k, j;
1327
        t = gel(V,i);
1328
        if (typ(t) != t_VEC)
1329
        {
1330
          if (cplx) nt = 1;
1331
          else nt = 0; /* trigger error */
1332
        }
1333
        else
1334
          nt = lg(t)-1;
1335
        if (nt != nl) pari_err_DIM("plotrecth");
1336
        k = 0; j = 1;
1337
        while (j <= nl)
1338
        {
1339
          double xx, yy;
1340
          get_xy_from_vec(cplx, t, &j, &xx, &yy);
1341
          Appendx(&pl[0], &pl[k++], xx);
1342
          Appendy(&pl[0], &pl[k++], yy);
1343
        }
1344
      }
1345
    }
1346
    else if (non_vec)
1347
      for (i = 1; i <= N; i++)
1348
      {
1349
        Appendy(&pl[0], &pl[1], gtodouble(gel(V,i)));
1350
        pl[0].d[i-1] = gtodouble(gel(X,i));
1351
      }
1352
    else /* vector of nonparametric curves */
1353
      for (i = 1; i <= N; i++)
1354
      {
1355
        t = gel(V,i);
1356
        if (typ(t) != t_VEC || lg(t) != nl) pari_err_DIM("plotrecth");
1357
        for (j = 1; j < nl; j++) Appendy(&pl[0], &pl[j], gtodouble(gel(t,j)));
1358
        pl[0].d[i-1] = gtodouble(gel(X,i));
1359
      }
1360
  }
1361
  pl[0].nb = nc; return pl;
1362
}
1363

1364
static GEN
1365
spline_eval(void* E, GEN x) { return gsubst((GEN)E,0,x); }
1366

1367
/* Uses highlevel plotting functions to implement splines as
1368
   a low-level plotting function. */
1369
static void
1370
rectsplines(long ne, double *x, double *y, long lx, long flag)
1371
{
1372
  long i, j;
1373
  pari_sp av0 = avma;
1374
  GEN X = pol_x(0), xa = cgetg(lx+1, t_VEC), ya = cgetg(lx+1, t_VEC);
1375
  GEN tas, pol3;
1376
  long param = flag & PLOT_PARAMETRIC;
1377
  const long fl = param | PLOT_RECURSIVE | PLOT_NO_RESCALE | PLOT_NO_FRAME
1378
                        | PLOT_NO_AXE_Y | PLOT_NO_AXE_X;
1379

1380
  if (lx < 4) pari_err(e_MISC, "Too few points (%ld) for spline plot", lx);
1381
  for (i = 1; i <= lx; i++) {
1382
    gel(xa,i) = dbltor(x[i-1]);
1383
    gel(ya,i) = dbltor(y[i-1]);
1384
  }
1385
  if (param) {
1386
    tas = new_chunk(4);
1387
    for (j = 1; j <= 4; j++) gel(tas,j-1) = utoipos(j);
1388
    pol3 = cgetg(3, t_VEC);
1389
  }
1390
  else
1391
    tas = pol3 = NULL; /* gcc -Wall */
1392
  for (i = 0; i <= lx - 4; i++) {
1393
    pari_sp av = avma;
1394

1395
    xa++; ya++;
1396
    if (param) {
1397
      gel(pol3,1) = polintspec(tas, xa, X, 4, NULL);
1398
      gel(pol3,2) = polintspec(tas, ya, X, 4, NULL);
1399
    } else {
1400
      pol3 = polintspec(xa, ya, X, 4, NULL);
1401
      tas = xa;
1402
    }
1403
    /* Start with 3 points */
1404
    plotrecth((void*)pol3, &spline_eval, ne,
1405
               i== 0 ? gel(tas,0) : gel(tas,1),
1406
               i==lx-4 ? gel(tas,3) : gel(tas,2),
1407
               fl, 2, DEFAULTPREC);
1408
    set_avma(av);
1409
  }
1410
  set_avma(av0);
1411
}
1412

1413
static void
1414
pari_get_fmtplot(GEN fmt, PARI_plot *T)
1415
{
1416
  char *f = GSTR(fmt);
1417
  if (!strcmp(f, "svg")) pari_get_svgplot(T);
1418
  else if (!strcmp(f, "ps")) pari_get_psplot(T);
1419
  else pari_err_TYPE("plotexport [unknown format]", fmt);
1420
}
1421
static GEN
1422
fmt_convert(GEN fmt, GEN w, GEN x, GEN y, PARI_plot *T)
1423
{
1424
  char *f, *s = NULL;
1425
  if (typ(fmt) != t_STR) pari_err_TYPE("plotexport",fmt);
1426
  f = GSTR(fmt);
1427
  if (!strcmp(f, "svg"))
1428
    s = rect2svg(w,x,y,T);
1429
  else if (!strcmp(f, "ps"))
1430
    s = rect2ps(w,x,y,T);
1431
  else
1432
    pari_err_TYPE("plotexport [unknown format]", fmt);
1433
  return strtoGENstr(s);
1434
}
1435

1436
static void
1437
Draw(PARI_plot *T, GEN w, GEN x, GEN y)
1438
{
1439
  if (!T->draw) pari_err(e_MISC,"high resolution graphics disabled");
1440
  T->draw(T, w,x,y);
1441
}
1442
static void
1443
set_range(double m, double M, double *sml, double *big)
1444
{
1445
  if (M - m < 1.e-9)
1446
  {
1447
    double d = fabs(m)/10; if (!d) d = 0.1;
1448
    M += d; m -= d;
1449
  }
1450
  *sml = m; *big = M;
1451
}
1452
/* Plot a dblPointList. Complete with axes, bounding box, etc.
1453
 *
1454
 * data is an array of structs. Its meaning depends on flags :
1455
 *
1456
 * + data[0] contains global extremas, the number of curves to plot
1457
 *   (data[0].nb) and a list of doubles (first set of x-coordinates).
1458
 *
1459
 * + data[i].nb (i>0) contains the number of points in the list
1460
 *   data[i].d (hopefully, data[2i].nb=data[2i+1].nb when i>0...)
1461
 *
1462
 * + If flags contain PLOT_PARAMETRIC, the array length should be
1463
 *   even, and successive pairs (data[2i].d, data[2i+1].d) represent
1464
 *   curves to plot.
1465
 *
1466
 * + If there is no such flag, the first element is an array with
1467
 *   x-coordinates and the following ones contain y-coordinates.
1468
 * If W != NULL, output wrt this PARI_plot using two drawing rectangles:
1469
 * one for labels, another for graphs. Else draw to rectwindow ne without
1470
 * labels.
1471
 * If fmt != NULL (requires W != NULL), output is a t_STR containing the
1472
 * converted picture, else a bounding box */
1473
static GEN
1474
plotrecthrawin(GEN fmt, PARI_plot *W, long ne, dblPointList *data, long flags)
1475
{
1476
  const long param = flags & (PLOT_PARAMETRIC|PLOT_COMPLEX);
1477
  const long max_graphcolors = lg(GP_DATA->graphcolors)-1;
1478
  const pari_sp av = avma;
1479
  dblPointList x, y;
1480
  double xsml, xbig, ysml, ybig;
1481
  long ltype, i, nc, w[3], wx[3], wy[3];
1482

1483
  if (!data) return cgetg(1,t_VEC);
1484
  x = data[0]; nc = x.nb;
1485
  set_range(x.xsml, x.xbig, &xsml, &xbig);
1486
  set_range(x.ysml, x.ybig, &ysml, &ybig);
1487
  if (W)
1488
  { /* actual output; else output to rectwindow: no labels */
1489
    const long se = NUMRECT-2;
1490
    long lm, rm, tm, bm;
1491
    char YBIG[16], YSML[16], XSML[16], XBIG[16];
1492
    /* left/right/top/bottom margin */
1493
    sprintf(YSML,"%.5g", ysml); sprintf(YBIG,"%.5g", ybig);
1494
    sprintf(XSML,"%.5g", xsml); sprintf(XBIG,"%.5g", xbig);
1495
    /* left margin has y labels with hgap on both sides of text */
1496
    lm = maxss(strlen(YSML),strlen(YBIG))*W->fwidth + 2*W->hunit-1;
1497
    rm = W->hunit-1;
1498
    tm = W->vunit-1;
1499
    bm = W->vunit+W->fheight-1;
1500
    w[0] = wx[0] = wy[0] = evaltyp(t_VECSMALL) | evallg(3);
1501
    w[1] = se; wx[1] = 0;  wy[1] = 0;
1502
    w[2] = ne; wx[2] = lm; wy[2] = tm;
1503
   /* Window (width x height) is given in pixels, correct pixels are 0..n-1,
1504
    * whereas rect functions work with windows whose pixel range is [0,n] */
1505
    initrect_i(se, W->width - 1, W->height - 1);
1506
    initrect_i(ne, W->width - (lm+rm) - 1, W->height - (tm+bm) - 1);
1507
    /* draw labels on se */
1508
    _move(se,lm,0); plotstring(se, YBIG, RoSTdirRIGHT|RoSTdirHGAP|RoSTdirTOP);
1509
    _move(se,lm,W->height-bm); plotstring(se,YSML, RoSTdirRIGHT|RoSTdirHGAP|RoSTdirVGAP);
1510
    _move(se,lm,W->height-bm); plotstring(se, XSML, RoSTdirLEFT|RoSTdirTOP);
1511
    _move(se,W->width-rm-1, W->height-bm); plotstring(se, XBIG, RoSTdirRIGHT|RoSTdirTOP);
1512
  }
1513
  if (!(flags & PLOT_NO_RESCALE)) plotscale0(ne, xsml, xbig, ysml, ybig);
1514
  if (!(flags & PLOT_NO_FRAME))
1515
  {
1516
    long fl = (flags & PLOT_NODOUBLETICK)? TICKS_CLOCKW|TICKS_NODOUBLE
1517
                                         : TICKS_CLOCKW;
1518
    PARI_plot T, *pl;
1519
    if (W) pl = W; else { pl = &T; pari_get_plot(pl); }
1520
    plotlinetype(ne, -2); /* frame */
1521
    current_color[ne] = colormap_to_color(DEFAULT_COLOR);
1522
    _move(ne,xsml,ysml);
1523
    _box(ne,xbig,ybig);
1524
    if (!(flags & PLOT_NO_TICK_X)) {
1525
      rectticks(pl, ne, xsml, ysml, xbig, ysml, xsml, xbig, fl);
1526
      rectticks(pl, ne, xbig, ybig, xsml, ybig, xbig, xsml, fl);
1527
    }
1528
    if (!(flags & PLOT_NO_TICK_Y)) {
1529
      rectticks(pl, ne, xbig, ysml, xbig, ybig, ysml, ybig, fl);
1530
      rectticks(pl, ne, xsml, ybig, xsml, ysml, ybig, ysml, fl);
1531
    }
1532
  }
1533
  if (!(flags & PLOT_NO_AXE_Y) && (xsml<=0 && xbig >=0))
1534
  {
1535
    plotlinetype(ne, -1); /* axes */
1536
    current_color[ne] = colormap_to_color(AXIS_COLOR);
1537
    _move(ne,0.0,ysml);
1538
    _line(ne,0.0,ybig);
1539
  }
1540
  if (!(flags & PLOT_NO_AXE_X) && (ysml<=0 && ybig >=0))
1541
  {
1542
    plotlinetype(ne, -1); /* axes */
1543
    current_color[ne] = colormap_to_color(AXIS_COLOR);
1544
    _move(ne,xsml,0.0);
1545
    _line(ne,xbig,0.0);
1546
  }
1547

1548
  if (param) {
1549
    i = 0;
1550
    flags |= PLOT_PARAMETRIC;
1551
    flags &= (~PLOT_COMPLEX); /* turn COMPLEX to PARAMETRIC*/
1552
  } else i = 1;
1553
  for (ltype = 0; ltype < nc; ltype++)
1554
  {
1555
    long c = GP_DATA->graphcolors[1+(ltype%max_graphcolors)];
1556
    current_color[ne] = colormap_to_color(c);
1557
    if (param) x = data[i++];
1558

1559
    y = data[i++];
1560
    if (flags & (PLOT_POINTS_LINES|PLOT_POINTS)) {
1561
      plotlinetype(ne, plotpoint_itype + ltype); /* Graphs */
1562
      plotpointtype(ne,plotpoint_itype + ltype); /* Graphs */
1563
      plotpoints0(ne, x.d, y.d, y.nb);
1564
      if (!(flags & PLOT_POINTS_LINES)) continue;
1565
    }
1566

1567
    if (flags & PLOT_SPLINES) {
1568
      /* rectsplines will call us back with ltype == 0 */
1569
      int old = rectline_itype;
1570
      rectline_itype = rectline_itype + ltype;
1571
      rectsplines(ne, x.d, y.d, y.nb, flags);
1572
      rectline_itype = old;
1573
    } else {
1574
      plotlinetype(ne, rectline_itype + ltype); /* Graphs */
1575
      rectlines0(ne, x.d, y.d, y.nb, 0);
1576
    }
1577
  }
1578
  for (i--; i>=0; i--) pari_free(data[i].d);
1579
  pari_free(data);
1580

1581
  if (W)
1582
  {
1583
    GEN s = NULL;
1584
    if (fmt) s = fmt_convert(fmt, w, wx, wy, W); else Draw(W, w,wx,wy);
1585
    plotkill(w[1]);
1586
    plotkill(w[2]);
1587
    if (fmt) return s;
1588
  }
1589
  set_avma(av);
1590
  retmkvec4(dbltor(xsml), dbltor(xbig), dbltor(ysml), dbltor(ybig));
1591
}
1592

1593
/*************************************************************************/
1594
/*                                                                       */
1595
/*                          HI-RES FUNCTIONS                             */
1596
/*                                                                       */
1597
/*************************************************************************/
1598
/* If T != NULL, draw using the attached graphic (using rectwindow ne as a temp)
1599
 * Else write to rectwindow 'ne'.
1600
 * Graph y=f(x), x=a..b, use n points */
1601
static GEN
1602
plotrecth_i(GEN fmt, void *E, GEN(*f)(void*,GEN), PARI_plot *T, long ne,
1603
            GEN a,GEN b, ulong flags,long n, long prec)
1604
{
1605
  pari_sp av = avma;
1606
  dblPointList *pl = plotrecthin(E,f, a,b, flags, n, prec);
1607
  set_avma(av); return plotrecthrawin(fmt, T, ne, pl, flags);
1608
}
1609
GEN
1610
plotrecth(void *E, GEN(*f)(void*,GEN), long ne, GEN a,GEN b,
1611
          ulong flags, long n, long prec)
1612
{ return plotrecth_i(NULL, E,f, NULL, ne, a,b, flags&~PLOT_PARA, n, prec); }
1613
GEN
1614
plotrecth0(long ne, GEN a,GEN b,GEN code,ulong flags,long n, long prec)
1615
{ EXPR_WRAP(code, plotrecth(EXPR_ARG, ne, a,b, flags, n, prec)); }
1616
static GEN
1617
_ploth(void *E, GEN(*f)(void*,GEN), GEN a, GEN b,long flags, long n, long prec)
1618
{
1619
  PARI_plot T; pari_get_plot(&T);
1620
  return plotrecth_i(NULL, E,f, &T, NUMRECT-1, a,b, flags,n, prec);
1621
}
1622
GEN
1623
ploth(void *E, GEN(*f)(void*,GEN), GEN a, GEN b,long flags, long n, long prec)
1624
{ return _ploth(E, f, a, b, flags&~PLOT_PARA, n, prec); }
1625
GEN
1626
parploth(GEN a, GEN b, GEN code, long flags, long n, long prec)
1627
{ return _ploth(code, gp_call, a, b, flags|PLOT_PARA, n, prec); }
1628
GEN
1629
ploth0(GEN a, GEN b, GEN code, long flags,long n, long prec)
1630
{ EXPR_WRAP(code, ploth(EXPR_ARG, a,b,flags,n, prec)); }
1631

1632
GEN
1633
psploth(void *E, GEN(*f)(void*,GEN), GEN a,GEN b, long flags, long n, long prec)
1634
{
1635
  PARI_plot T; pari_get_psplot(&T); T.draw = &_psdraw;
1636
  return plotrecth_i(NULL, E,f, &T, NUMRECT-1, a,b, flags&~PLOT_PARA,n, prec);
1637
}
1638
GEN
1639
psploth0(GEN a, GEN b, GEN code, long flags, long n, long prec)
1640
{ EXPR_WRAP(code, psploth(EXPR_ARG, a, b, flags, n, prec)); }
1641

1642
static GEN
1643
_plothexport(GEN fmt, void *E, GEN(*f)(void*,GEN), GEN a,GEN b, long flags,
1644
            long n, long prec)
1645
{
1646
  pari_sp av = avma;
1647
  GEN s;
1648
  PARI_plot T; pari_get_fmtplot(fmt, &T);
1649
  s = plotrecth_i(fmt, E,f, &T, NUMRECT-1, a,b, flags,n, prec);
1650
  return gerepileuptoleaf(av, s);
1651
}
1652
GEN
1653
plothexport(GEN fmt, void *E, GEN(*f)(void*,GEN), GEN a,GEN b, long flags,
1654
            long n, long prec)
1655
{ return _plothexport(fmt, E, f, a, b, flags&~PLOT_PARA, n, prec); }
1656
GEN
1657
plothexport0(GEN fmt, GEN a, GEN b, GEN code, long flags, long n, long prec)
1658
{ EXPR_WRAP(code, plothexport(fmt, EXPR_ARG, a, b, flags, n, prec)); }
1659
GEN
1660
parplothexport(GEN fmt, GEN a, GEN b, GEN code, long flags, long n, long prec)
1661
{ return _plothexport(fmt, code, gp_call, a, b, flags|PLOT_PARA, n, prec); }
1662

1663
/* Draw list of points */
1664
static GEN
1665
plotrecthraw_i(GEN fmt, PARI_plot *T, long ne, GEN data, long flags)
1666
{
1667
  dblPointList *pl = gtodblList(data,flags);
1668
  return plotrecthrawin(fmt, T, ne, pl, flags);
1669
}
1670
static GEN
1671
plothraw_i(GEN fmt, PARI_plot *T, GEN X, GEN Y, long flag)
1672
{
1673
  pari_sp av = avma;
1674
  switch (flag) {
1675
    case 0: flag = PLOT_PARAMETRIC|PLOT_POINTS; break;
1676
    case 1: flag = PLOT_PARAMETRIC; break;
1677
    default: flag |= PLOT_PARAMETRIC; break;
1678
  }
1679
  return gerepileupto(av, plotrecthraw_i(fmt, T, NUMRECT-1, mkvec2(X,Y), flag));
1680
}
1681
GEN
1682
plothraw(GEN X, GEN Y, long flags)
1683
{ PARI_plot T; pari_get_plot(&T); return plothraw_i(NULL,&T,X,Y,flags); }
1684
GEN
1685
psplothraw(GEN X, GEN Y, long flags)
1686
{ PARI_plot T; pari_get_psplot(&T); T.draw = &_psdraw;
1687
  return plothraw_i(NULL,&T,X,Y,flags); }
1688
GEN
1689
plotrecthraw(long ne, GEN data, long flags)
1690
{ return plotrecthraw_i(NULL, NULL, ne, data, flags); }
1691
GEN
1692
plothrawexport(GEN fmt, GEN X, GEN Y, long flags)
1693
{ PARI_plot T; pari_get_fmtplot(fmt,&T); return plothraw_i(fmt,&T,X,Y,flags); }
1694

1695
GEN
1696
plothsizes(long flag)
1697
{
1698
  GEN vect = cgetg(1+8,t_VEC);
1699
  PARI_plot T;
1700

1701
  pari_get_plot(&T);
1702
  gel(vect,1) = stoi(T.width);
1703
  gel(vect,2) = stoi(T.height);
1704
  if (flag) {
1705
    gel(vect,3) = dbltor(T.hunit*1.0/T.width);
1706
    gel(vect,4) = dbltor(T.vunit*1.0/T.height);
1707
    gel(vect,5) = dbltor(T.fwidth*1.0/T.width);
1708
    gel(vect,6) = dbltor(T.fheight*1.0/T.height);
1709
  } else {
1710
    gel(vect,3) = stoi(T.hunit);
1711
    gel(vect,4) = stoi(T.vunit);
1712
    gel(vect,5) = stoi(T.fwidth);
1713
    gel(vect,6) = stoi(T.fheight);
1714
  }
1715
  gel(vect,7) = stoi(T.dwidth);
1716
  gel(vect,8) = stoi(T.dheight);
1717
  return vect;
1718
}
1719

1720
/*************************************************************************/
1721
/*                                                                       */
1722
/*                         POSTSCRIPT OUTPUT                             */
1723
/*                                                                       */
1724
/*************************************************************************/
1725
static long
1726
wxy_n(GEN wxy)
1727
{
1728
  long n;
1729
  switch(typ(wxy))
1730
  {
1731
    case t_INT: return 1;
1732
    case t_VEC:
1733
      n = lg(wxy)-1;
1734
      if (n%3) pari_err_DIM("plotdraw");
1735
      return n/3;
1736
  }
1737
  pari_err_TYPE("plotdraw",wxy);
1738
  return 0;/*LCOV_EXCL_LINE*/
1739
}
1740
static void
1741
wxy_init(GEN wxy, GEN *pW, GEN *pX, GEN *pY, PARI_plot *T)
1742
{
1743
  long i, n = wxy_n(wxy);
1744
  GEN W, X, Y;
1745
  *pW = W = cgetg(n+1, t_VECSMALL); /* win number */
1746
  *pX = X = cgetg(n+1, t_VECSMALL);
1747
  *pY = Y = cgetg(n+1, t_VECSMALL); /* (x,y)-offset */
1748
  if (typ(wxy) == t_INT)
1749
  {
1750
    W[1] = itos(wxy); check_rect_init(W[1]);
1751
    X[1] = 0;
1752
    Y[1] = 0; return;
1753
  }
1754
  for (i = 1; i <= n; i++)
1755
  {
1756
    GEN w = gel(wxy,3*i-2), x = gel(wxy,3*i-1), y = gel(wxy,3*i);
1757
    if (typ(w) != t_INT) pari_err_TYPE("plotdraw",w);
1758
    W[i] = itos(w); check_rect_init(W[i]);
1759
    if (T) {
1760
      X[i] = DTOL(gtodouble(x)*(T->width - 1));
1761
      Y[i] = DTOL(gtodouble(y)*(T->height - 1));
1762
    } else {
1763
      X[i] = gtos(x);
1764
      Y[i] = gtos(y);
1765
    }
1766
  }
1767
}
1768
/* if flag is set, rescale wrt T */
1769
static void
1770
gendraw(PARI_plot *T, GEN wxy, long flag)
1771
{
1772
  GEN w, x, y, W, X, Y;
1773
  long i, l;
1774
  wxy_init(wxy, &w,&x,&y, flag? T: NULL);
1775
  l = lg(w);
1776
  /* malloc mandatory in case draw() forks then pari_close(). Done after
1777
   * wxy_init to avoid leak on error */
1778
  W = cgetalloc(t_VECSMALL, l);
1779
  X = cgetalloc(t_VECSMALL, l);
1780
  Y = cgetalloc(t_VECSMALL, l);
1781
  for (i = 1; i < l; i++) { W[i] = w[i]; X[i] = x[i]; Y[i] = y[i]; }
1782
  Draw(T,W,X,Y);
1783
  pari_free(W); pari_free(X); pari_free(Y);
1784
}
1785
void
1786
psdraw(GEN wxy, long flag)
1787
{ PARI_plot T; pari_get_psplot(&T); T.draw = flag? &_psdraw: &_psdraw_scale;
1788
  gendraw(&T, wxy, flag); }
1789
void
1790
plotdraw(GEN wxy, long flag)
1791
{ PARI_plot T; pari_get_plot(&T); gendraw(&T, wxy, flag); }
1792
GEN
1793
plotexport(GEN fmt, GEN wxy, long flag)
1794
{
1795
  pari_sp av = avma;
1796
  GEN w, x, y;
1797
  PARI_plot _T, *T = flag? &_T: NULL;
1798
  if (T) pari_get_plot(T);
1799
  wxy_init(wxy, &w, &x, &y, T);
1800
  return gerepileuptoleaf(av, fmt_convert(fmt, w, x, y, T));
1801
}
1802

1803
/* may be called after pari_close(): don't use the PARI stack */
1804
void
1805
gen_draw(struct plot_eng *eng, GEN w, GEN x, GEN y, double xs, double ys)
1806
{
1807
  void *data = eng->data;
1808
  long i, j, lw = lg(w);
1809
  long hgapsize = eng->pl->hunit, fheight = eng->pl->fheight;
1810
  long vgapsize = eng->pl->vunit,  fwidth = eng->pl->fwidth;
1811
  for(i = 1; i < lw; i++)
1812
  {
1813
    PariRect *e = &rectgraph[w[i]];
1814
    RectObj *R;
1815
    long x0 = x[i], y0 = y[i];
1816
    for (R = RHead(e); R; R = RoNext(R))
1817
    {
1818
      long col = RoCol(R);
1819
      switch(RoType(R))
1820
      {
1821
      case ROt_PT:
1822
        eng->sc(data,col);
1823
        eng->pt(data, DTOL((RoPTx(R)+x0)*xs), DTOL((RoPTy(R)+y0)*ys));
1824
        break;
1825
      case ROt_LN:
1826
        eng->sc(data,col);
1827
        eng->ln(data, DTOL((RoLNx1(R)+x0)*xs), DTOL((RoLNy1(R)+y0)*ys),
1828
                      DTOL((RoLNx2(R)+x0)*xs), DTOL((RoLNy2(R)+y0)*ys));
1829
        break;
1830
      case ROt_BX:
1831
        eng->sc(data,col);
1832
        eng->bx(data,
1833
                DTOL((RoBXx1(R)+x0)*xs),
1834
                DTOL((RoBXy1(R)+y0)*ys),
1835
                DTOL((RoBXx2(R)-RoBXx1(R))*xs),
1836
                DTOL((RoBXy2(R)-RoBXy1(R))*ys));
1837
        break;
1838
      case ROt_FBX:
1839
        eng->sc(data,col);
1840
        eng->fb(data,
1841
                DTOL((RoBXx1(R)+x0)*xs),
1842
                DTOL((RoBXy1(R)+y0)*ys),
1843
                DTOL((RoBXx2(R)-RoBXx1(R))*xs),
1844
                DTOL((RoBXy2(R)-RoBXy1(R))*ys));
1845
        break;
1846
      case ROt_MP:
1847
        {
1848
          double *ptx = RoMPxs(R);
1849
          double *pty = RoMPys(R);
1850
          long     nb = RoMPcnt(R);
1851
          struct plot_points *points =
1852
            (struct plot_points *) pari_malloc(sizeof(*points)*nb);
1853
          for(j=0;j<nb;j++)
1854
          {
1855
            points[j].x = DTOL((ptx[j]+x0)*xs);
1856
            points[j].y = DTOL((pty[j]+y0)*ys);
1857
          }
1858
          eng->sc(data,col);
1859
          eng->mp(data, nb, points);
1860
          pari_free(points);
1861
          break;
1862
        }
1863
      case ROt_ML:
1864
        {
1865
          double *ptx = RoMLxs(R);
1866
          double *pty = RoMLys(R);
1867
          long     nb = RoMLcnt(R);
1868
          struct plot_points *points =
1869
            (struct plot_points *) pari_malloc(sizeof(*points)*nb);
1870
          for(j=0;j<nb;j++)
1871
          {
1872
            points[j].x = DTOL((ptx[j]+x0)*xs);
1873
            points[j].y = DTOL((pty[j]+y0)*ys);
1874
          }
1875
          eng->sc(data,col);
1876
          eng->ml(data, nb, points);
1877
          pari_free(points);
1878
          break;
1879
        }
1880
      case ROt_ST:
1881
        {
1882
          long dir = RoSTdir(R);
1883
          long h = dir & RoSTdirHPOS_mask, hgap  = 0;
1884
          long v = dir & RoSTdirVPOS_mask, vgap  = 0;
1885
          long x, y, l = RoSTl(R);
1886
          long shift = (h == RoSTdirLEFT ? 0 : (h == RoSTdirRIGHT? 2: 1));
1887
          long vshift= (v == RoSTdirBOTTOM? 0: (v == RoSTdirTOP? 2: 1));
1888
          if (dir & RoSTdirHGAP)
1889
            hgap = (h == RoSTdirLEFT) ? hgapsize : -hgapsize;
1890
          if (dir & RoSTdirVGAP)
1891
            vgap = (v == RoSTdirBOTTOM) ? 2*vgapsize : -2*vgapsize;
1892
          x = DTOL(xs * (RoSTx(R) + x0 + hgap - (l * fwidth * shift)/2));
1893
          y = DTOL(ys * (RoSTy(R) + y0 - (vgap - vshift*(fheight-1))/2));
1894
          eng->sc(data,col);
1895
          eng->st(data, x, y, RoSTs(R), l);
1896
          break;
1897
        }
1898
      default:
1899
        break;
1900
      }
1901
    }
1902
  }
1903
}
1904
/*************************************************************************/
1905
/*                               SVG                                     */
1906
/*************************************************************************/
1907

1908
struct svg_data {
1909
  pari_str str;
1910
  char hexcolor[8];  /* "#rrggbb\0" */
1911
};
1912
#define data_str(d) (&((struct svg_data*)(d))->str)
1913
#define data_hexcolor(d) (((struct svg_data*)(d))->hexcolor)
1914

1915
/* Work with precision 1/scale */
1916
static const float SVG_SCALE = 1024.0;
1917

1918
static float
1919
svg_rescale(float x) { return x / SVG_SCALE; }
1920

1921
static void
1922
svg_point(void *data, long x, long y)
1923
{
1924
  pari_str *S = data_str(data);
1925

1926
  str_printf(S, "<circle cx='%.2f' cy='%.2f' r='0.5' ",
1927
    svg_rescale(x), svg_rescale(y));
1928
  str_printf(S, "style='fill:%s;stroke:none;'/>", data_hexcolor(data));
1929
}
1930

1931
static void
1932
svg_line(void *data, long x1, long y1, long x2, long y2)
1933
{
1934
  pari_str *S = data_str(data);
1935

1936
  str_printf(S, "<line x1='%.2f' y1='%.2f' x2='%.2f' y2='%.2f' ",
1937
    svg_rescale(x1), svg_rescale(y1), svg_rescale(x2), svg_rescale(y2));
1938
  str_printf(S, "style='fill:none;stroke:%s;'/>", data_hexcolor(data));
1939
}
1940

1941
static void
1942
svg_rect(void *data, long x, long y, long w, long h)
1943
{
1944
  pari_str *S = data_str(data);
1945

1946
  str_printf(S, "<rect x='%.2f' y='%.2f' width='%.2f' height='%.2f' ",
1947
    svg_rescale(x), svg_rescale(y), svg_rescale(w), svg_rescale(h));
1948
  str_printf(S, "style='fill:none;stroke:%s;'/>", data_hexcolor(data));
1949
}
1950

1951
static void
1952
svg_fillrect(void *data, long x, long y, long w, long h)
1953
{
1954
  pari_str *S = data_str(data);
1955
  const char * color = data_hexcolor(data);
1956
  str_printf(S, "<rect x='%.2f' y='%.2f' width='%.2f' height='%.2f' ",
1957
    svg_rescale(x), svg_rescale(y), svg_rescale(w), svg_rescale(h));
1958
  str_printf(S, "style='fill:%s;stroke:%s;'/>", color, color);
1959
}
1960

1961
static void
1962
svg_points(void *data, long nb, struct plot_points *p)
1963
{
1964
  long i;
1965
  for (i = 0; i < nb; i++)
1966
    svg_point(data, p[i].x, p[i].y);
1967
}
1968

1969
static void
1970
svg_color(void *data, long col)
1971
{
1972
  static const char hex[] = "0123456789abcdef";
1973
  char *c = data_hexcolor(data);
1974
  int r, g, b;
1975
  long_to_rgb(col, &r, &g, &b);
1976
  c[0] = '#';
1977
  c[1] = hex[r / 16];
1978
  c[2] = hex[r & 15];
1979
  c[3] = hex[g / 16];
1980
  c[4] = hex[g & 15];
1981
  c[5] = hex[b / 16];
1982
  c[6] = hex[b & 15];
1983
  c[7] = '\0';
1984
}
1985

1986
static void
1987
svg_lines(void *data, long nb, struct plot_points *p)
1988
{
1989
  long i;
1990
  pari_str *S = data_str(data);
1991

1992
  str_printf(S, "<polyline points='");
1993
  for (i = 0; i < nb; i++)
1994
  {
1995
    if (i > 0) str_printf(S, " ");
1996
    str_printf(S, "%.2f,%.2f", svg_rescale(p[i].x), svg_rescale(p[i].y));
1997
  }
1998
  str_printf(S, "' style='fill:none;stroke:%s;'/>", data_hexcolor(data));
1999
}
2000

2001
static void
2002
svg_text(void *data, long x, long y, char *text, long numtext)
2003
{
2004
  pari_str *S = data_str(data);
2005
  (void)numtext;
2006
  str_printf(S, "<text x='%.5f' y='%.5f' font-size='%ld' style='fill:%s;'>%s</text>",
2007
    svg_rescale(x),svg_rescale(y), 12, data_hexcolor(data), text);
2008
}
2009

2010
static void
2011
svg_head(PARI_plot *T, pari_str *S)
2012
{
2013
  str_printf(S, "<svg width='%ld' height='%ld' version='1.1' xmlns='http://www.w3.org/2000/svg'>", T->width, T->height);
2014
}
2015

2016
static void
2017
svg_tail(pari_str *S)
2018
{
2019
  str_printf(S, "</svg>");
2020
}
2021

2022
char *
2023
rect2svg(GEN w, GEN x, GEN y, PARI_plot *T)
2024
{
2025
  struct plot_eng pl;
2026
  struct svg_data data;
2027
  PARI_plot U;
2028

2029
  str_init(&data.str, 1);
2030
  svg_color(&data, 0);
2031
  if (!T)
2032
  {
2033
    long i, l = lg(w), xmax = 0, ymax = 0;
2034
    T = &U; pari_get_svgplot(T);
2035
    for (i = 1; i < l; i++)
2036
    {
2037
      PariRect *e = check_rect_init(w[i]);
2038
      xmax = maxss(xmax, RXsize(e) + x[i]);
2039
      ymax = maxss(ymax, RYsize(e) + y[i]);
2040
    }
2041
    T->width = xmax;
2042
    T->height = ymax;
2043
  }
2044
  pl.data = &data;
2045
  pl.sc = &svg_color;
2046
  pl.pt = &svg_point;
2047
  pl.ln = &svg_line;
2048
  pl.bx = &svg_rect;
2049
  pl.fb = &svg_fillrect;
2050
  pl.mp = &svg_points;
2051
  pl.ml = &svg_lines;
2052
  pl.st = &svg_text;
2053
  pl.pl = T;
2054

2055
  svg_head(T, &data.str);
2056
  gen_draw(&pl, w, x, y, SVG_SCALE, SVG_SCALE);
2057
  svg_tail(&data.str);
2058

2059
  return data.str.string;
2060
}
2061

2062
/*************************************************************************/
2063
/*                            POSTSCRIPT                                 */
2064
/*************************************************************************/
2065
static void
2066
ps_sc(void *data, long col)
2067
{
2068
  pari_str *S = (pari_str*)data;
2069
  int r, g, b; long_to_rgb(col, &r, &g, &b);
2070
  if (!r && !g && !b)
2071
    str_puts(S,"c0\n");
2072
  else
2073
    str_printf(S,"%.6f %.6f %.6f c\n", r/255., g/255., b/255.);
2074
}
2075

2076
static void
2077
ps_point(void *data, long x, long y)
2078
{
2079
  pari_str *S = (pari_str*)data;
2080
  str_printf(S,"%ld %ld p\n",y,x);
2081
}
2082

2083
static void
2084
ps_line(void *data, long x1, long y1, long x2, long y2)
2085
{
2086
  pari_str *S = (pari_str*)data;
2087
  str_printf(S,"%ld %ld m %ld %ld l\n",y1,x1,y2,x2);
2088
  str_printf(S,"stroke\n");
2089
}
2090

2091
static void
2092
ps_rect(void *data, long x, long y, long w, long h)
2093
{
2094
  pari_str *S = (pari_str*)data;
2095
  str_printf(S,"%ld %ld m %ld %ld l %ld %ld l %ld %ld l closepath currentlinejoin 0 setlinejoin stroke setlinejoin\n",
2096
             y,x, y,x+w, y+h,x+w, y+h,x);
2097
}
2098

2099
static void
2100
ps_fillrect(void *data, long x, long y, long w, long h)
2101
{
2102
  pari_str *S = (pari_str*)data;
2103
  str_printf(S,"%ld %ld m %ld %ld l %ld %ld l %ld %ld l closepath currentlinejoin 0 setlinejoin fill setlinejoin\n",
2104
             y,x, y,x+w, y+h,x+w, y+h,x);
2105
}
2106

2107
static void
2108
ps_points(void *data, long nb, struct plot_points *p)
2109
{
2110
  long i;
2111
  for (i=0; i<nb; i++) ps_point(data, p[i].x, p[i].y);
2112
}
2113

2114
static void
2115
ps_lines(void *data, long nb, struct plot_points *p)
2116
{
2117
  pari_str *S = (pari_str*)data;
2118
  long i;
2119
  str_printf(S,"%ld %ld m\n",p[0].y,p[0].x);
2120
  for (i=1; i<nb; i++) str_printf(S, "%ld %ld l\n", p[i].y, p[i].x);
2121
  str_printf(S,"stroke\n");
2122
}
2123

2124
static void
2125
ps_string(void *data, long x, long y, char *s, long length)
2126
{
2127
  pari_str *S = (pari_str*)data;
2128
  (void)length;
2129
  if (strpbrk(s, "(\\)")) {
2130
    str_printf(S,"(");
2131
    while (*s) {
2132
      if ( *s=='(' || *s==')' || *s=='\\' ) str_putc(S,'\\');
2133
      str_putc(S, *s);
2134
      s++;
2135
    }
2136
  } else
2137
    str_printf(S,"(%s", s);
2138
  str_printf(S,") %ld %ld m 90 rotate show -90 rotate\n", y, x);
2139
}
2140

2141
char *
2142
rect2ps_i(GEN w, GEN x, GEN y, PARI_plot *T, int plotps)
2143
{
2144
  struct plot_eng pl;
2145
  PARI_plot U;
2146
  pari_str S;
2147
  double xs = 0.65*PS_SCALE, ys = 0.65*PS_SCALE;
2148
  if (T) /* res wrt T dimens */
2149
  {
2150
    if (plotps)
2151
      xs = ys = PS_SCALE;
2152
    else
2153
    {
2154
      xs *= ((double)PS_WIDTH) / T->width;
2155
      ys *= ((double)PS_HEIGH) / T->height;
2156
    }
2157
  }
2158
  else
2159
  {
2160
    T = &U; pari_get_psplot(T);
2161
  }
2162
  str_init(&S, 1);
2163
  /* Definitions taken from post terminal of Gnuplot. */
2164
  str_printf(&S, "%%!\n\
2165
50 50 translate\n\
2166
1 %d div 1 %d div scale\n\
2167
1 setlinejoin\n\
2168
/p {moveto 0 2 rlineto 2 0 rlineto 0 -2 rlineto closepath fill} def\n\
2169
/c0 {0 0 0 setrgbcolor} def\n\
2170
/c {setrgbcolor} def\n\
2171
/l {lineto} def\n\
2172
/m {moveto} def\n"
2173
"/Times-Roman findfont %ld scalefont setfont\n",
2174
PS_SCALE, PS_SCALE, DTOL(T->fheight * xs));
2175

2176
  pl.sc = &ps_sc;
2177
  pl.pt = &ps_point;
2178
  pl.ln = &ps_line;
2179
  pl.bx = &ps_rect;
2180
  pl.fb = &ps_fillrect;
2181
  pl.mp = &ps_points;
2182
  pl.ml = &ps_lines;
2183
  pl.st = &ps_string;
2184
  pl.pl = T;
2185
  pl.data = (void*)&S;
2186

2187
  if (plotps) str_printf(&S,"0 %ld translate -90 rotate\n", (T->height - 50)*PS_SCALE);
2188
  gen_draw(&pl, w, x, y, xs, ys);
2189
  str_puts(&S,"stroke showpage\n");
2190
  *S.cur = 0; return S.string;
2191
}
2192
char *
2193
rect2ps(GEN w, GEN x, GEN y, PARI_plot *T)
2194
{ return rect2ps_i(w,x,y,T,0); }
2195

2196
void
2197
pari_plot_by_file(const char *env, const char *suf, const char *img)
2198
{
2199
  const char *cmd, *s = pari_unique_filename_suffix("plotfile", suf);
2200
  FILE *f = fopen(s, "w");
2201
  if (!f) pari_err_FILE("image file", s);
2202
  fputs(img, f); (void)fclose(f);
2203
  cmd = os_getenv(env);
2204
#ifdef GP_MIME_OPEN
2205
  if (!cmd) cmd = GP_MIME_OPEN;
2206
#else
2207
  if (!cmd) cmd = "open -W";
2208
#endif
2209
  cmd = pari_sprintf("%s \"%s\" 2>/dev/null", cmd, s);
2210
  gpsystem(cmd);
2211
  pari_unlink(s);
2212
  pari_free((char*)s);
2213
}
2214

2215
/*************************************************************************/
2216
/*                                                                       */
2217
/*                           RGB COLORS                                  */
2218
/*                                                                       */
2219
/*************************************************************************/
2220
/* generated from /etc/X11/rgb.txt by the following perl script
2221
#!/usr/bin/perl
2222
while(<>)
2223
{
2224
  ($hex, $name) = split(/\t\t/, $_);
2225
  $hex =~ s/^ +//; chomp($name); $name =~ s, *,,g;
2226
  $hex = sprintf("0x%02x%02x%02x", split(/\s+/, $hex));
2227
  $name = lc($name); next if ($done{$name});
2228
  $done{$name} = 1;
2229
  print "COL(\"$name\", $hex),\n";
2230
}
2231
*/
2232

2233
#define COL(x,y) {(void*)x,(void*)y,0,NULL}
2234
static hashentry col_list[] = {
2235
COL("", 0x000000),
2236
COL("snow", 0xfffafa),
2237
COL("ghostwhite", 0xf8f8ff),
2238
COL("whitesmoke", 0xf5f5f5),
2239
COL("gainsboro", 0xdcdcdc),
2240
COL("floralwhite", 0xfffaf0),
2241
COL("oldlace", 0xfdf5e6),
2242
COL("linen", 0xfaf0e6),
2243
COL("antiquewhite", 0xfaebd7),
2244
COL("papayawhip", 0xffefd5),
2245
COL("blanchedalmond", 0xffebcd),
2246
COL("bisque", 0xffe4c4),
2247
COL("peachpuff", 0xffdab9),
2248
COL("navajowhite", 0xffdead),
2249
COL("moccasin", 0xffe4b5),
2250
COL("cornsilk", 0xfff8dc),
2251
COL("ivory", 0xfffff0),
2252
COL("lemonchiffon", 0xfffacd),
2253
COL("seashell", 0xfff5ee),
2254
COL("honeydew", 0xf0fff0),
2255
COL("mintcream", 0xf5fffa),
2256
COL("azure", 0xf0ffff),
2257
COL("aliceblue", 0xf0f8ff),
2258
COL("lavender", 0xe6e6fa),
2259
COL("lavenderblush", 0xfff0f5),
2260
COL("mistyrose", 0xffe4e1),
2261
COL("white", 0xffffff),
2262
COL("black", 0x000000),
2263
COL("darkslategray", 0x2f4f4f),
2264
COL("darkslategrey", 0x2f4f4f),
2265
COL("dimgray", 0x696969),
2266
COL("dimgrey", 0x696969),
2267
COL("slategray", 0x708090),
2268
COL("slategrey", 0x708090),
2269
COL("lightslategray", 0x778899),
2270
COL("lightslategrey", 0x778899),
2271
COL("gray", 0xbebebe),
2272
COL("grey", 0xbebebe),
2273
COL("lightgrey", 0xd3d3d3),
2274
COL("lightgray", 0xd3d3d3),
2275
COL("midnightblue", 0x191970),
2276
COL("navy", 0x000080),
2277
COL("navyblue", 0x000080),
2278
COL("cornflowerblue", 0x6495ed),
2279
COL("darkslateblue", 0x483d8b),
2280
COL("slateblue", 0x6a5acd),
2281
COL("mediumslateblue", 0x7b68ee),
2282
COL("lightslateblue", 0x8470ff),
2283
COL("mediumblue", 0x0000cd),
2284
COL("royalblue", 0x4169e1),
2285
COL("blue", 0x0000ff),
2286
COL("dodgerblue", 0x1e90ff),
2287
COL("deepskyblue", 0x00bfff),
2288
COL("skyblue", 0x87ceeb),
2289
COL("lightskyblue", 0x87cefa),
2290
COL("steelblue", 0x4682b4),
2291
COL("lightsteelblue", 0xb0c4de),
2292
COL("lightblue", 0xadd8e6),
2293
COL("powderblue", 0xb0e0e6),
2294
COL("paleturquoise", 0xafeeee),
2295
COL("darkturquoise", 0x00ced1),
2296
COL("mediumturquoise", 0x48d1cc),
2297
COL("turquoise", 0x40e0d0),
2298
COL("cyan", 0x00ffff),
2299
COL("lightcyan", 0xe0ffff),
2300
COL("cadetblue", 0x5f9ea0),
2301
COL("mediumaquamarine", 0x66cdaa),
2302
COL("aquamarine", 0x7fffd4),
2303
COL("darkgreen", 0x006400),
2304
COL("darkolivegreen", 0x556b2f),
2305
COL("darkseagreen", 0x8fbc8f),
2306
COL("seagreen", 0x2e8b57),
2307
COL("mediumseagreen", 0x3cb371),
2308
COL("lightseagreen", 0x20b2aa),
2309
COL("palegreen", 0x98fb98),
2310
COL("springgreen", 0x00ff7f),
2311
COL("lawngreen", 0x7cfc00),
2312
COL("green", 0x00ff00),
2313
COL("chartreuse", 0x7fff00),
2314
COL("mediumspringgreen", 0x00fa9a),
2315
COL("greenyellow", 0xadff2f),
2316
COL("limegreen", 0x32cd32),
2317
COL("yellowgreen", 0x9acd32),
2318
COL("forestgreen", 0x228b22),
2319
COL("olivedrab", 0x6b8e23),
2320
COL("darkkhaki", 0xbdb76b),
2321
COL("khaki", 0xf0e68c),
2322
COL("palegoldenrod", 0xeee8aa),
2323
COL("lightgoldenrodyellow", 0xfafad2),
2324
COL("lightyellow", 0xffffe0),
2325
COL("yellow", 0xffff00),
2326
COL("gold", 0xffd700),
2327
COL("lightgoldenrod", 0xeedd82),
2328
COL("goldenrod", 0xdaa520),
2329
COL("darkgoldenrod", 0xb8860b),
2330
COL("rosybrown", 0xbc8f8f),
2331
COL("indianred", 0xcd5c5c),
2332
COL("saddlebrown", 0x8b4513),
2333
COL("sienna", 0xa0522d),
2334
COL("peru", 0xcd853f),
2335
COL("burlywood", 0xdeb887),
2336
COL("beige", 0xf5f5dc),
2337
COL("wheat", 0xf5deb3),
2338
COL("sandybrown", 0xf4a460),
2339
COL("tan", 0xd2b48c),
2340
COL("chocolate", 0xd2691e),
2341
COL("firebrick", 0xb22222),
2342
COL("brown", 0xa52a2a),
2343
COL("darksalmon", 0xe9967a),
2344
COL("salmon", 0xfa8072),
2345
COL("lightsalmon", 0xffa07a),
2346
COL("orange", 0xffa500),
2347
COL("darkorange", 0xff8c00),
2348
COL("coral", 0xff7f50),
2349
COL("lightcoral", 0xf08080),
2350
COL("tomato", 0xff6347),
2351
COL("orangered", 0xff4500),
2352
COL("red", 0xff0000),
2353
COL("hotpink", 0xff69b4),
2354
COL("deeppink", 0xff1493),
2355
COL("pink", 0xffc0cb),
2356
COL("lightpink", 0xffb6c1),
2357
COL("palevioletred", 0xdb7093),
2358
COL("maroon", 0xb03060),
2359
COL("mediumvioletred", 0xc71585),
2360
COL("violetred", 0xd02090),
2361
COL("magenta", 0xff00ff),
2362
COL("violet", 0xee82ee),
2363
COL("plum", 0xdda0dd),
2364
COL("orchid", 0xda70d6),
2365
COL("mediumorchid", 0xba55d3),
2366
COL("darkorchid", 0x9932cc),
2367
COL("darkviolet", 0x9400d3),
2368
COL("blueviolet", 0x8a2be2),
2369
COL("purple", 0xa020f0),
2370
COL("mediumpurple", 0x9370db),
2371
COL("thistle", 0xd8bfd8),
2372
COL("snow1", 0xfffafa),
2373
COL("snow2", 0xeee9e9),
2374
COL("snow3", 0xcdc9c9),
2375
COL("snow4", 0x8b8989),
2376
COL("seashell1", 0xfff5ee),
2377
COL("seashell2", 0xeee5de),
2378
COL("seashell3", 0xcdc5bf),
2379
COL("seashell4", 0x8b8682),
2380
COL("antiquewhite1", 0xffefdb),
2381
COL("antiquewhite2", 0xeedfcc),
2382
COL("antiquewhite3", 0xcdc0b0),
2383
COL("antiquewhite4", 0x8b8378),
2384
COL("bisque1", 0xffe4c4),
2385
COL("bisque2", 0xeed5b7),
2386
COL("bisque3", 0xcdb79e),
2387
COL("bisque4", 0x8b7d6b),
2388
COL("peachpuff1", 0xffdab9),
2389
COL("peachpuff2", 0xeecbad),
2390
COL("peachpuff3", 0xcdaf95),
2391
COL("peachpuff4", 0x8b7765),
2392
COL("navajowhite1", 0xffdead),
2393
COL("navajowhite2", 0xeecfa1),
2394
COL("navajowhite3", 0xcdb38b),
2395
COL("navajowhite4", 0x8b795e),
2396
COL("lemonchiffon1", 0xfffacd),
2397
COL("lemonchiffon2", 0xeee9bf),
2398
COL("lemonchiffon3", 0xcdc9a5),
2399
COL("lemonchiffon4", 0x8b8970),
2400
COL("cornsilk1", 0xfff8dc),
2401
COL("cornsilk2", 0xeee8cd),
2402
COL("cornsilk3", 0xcdc8b1),
2403
COL("cornsilk4", 0x8b8878),
2404
COL("ivory1", 0xfffff0),
2405
COL("ivory2", 0xeeeee0),
2406
COL("ivory3", 0xcdcdc1),
2407
COL("ivory4", 0x8b8b83),
2408
COL("honeydew1", 0xf0fff0),
2409
COL("honeydew2", 0xe0eee0),
2410
COL("honeydew3", 0xc1cdc1),
2411
COL("honeydew4", 0x838b83),
2412
COL("lavenderblush1", 0xfff0f5),
2413
COL("lavenderblush2", 0xeee0e5),
2414
COL("lavenderblush3", 0xcdc1c5),
2415
COL("lavenderblush4", 0x8b8386),
2416
COL("mistyrose1", 0xffe4e1),
2417
COL("mistyrose2", 0xeed5d2),
2418
COL("mistyrose3", 0xcdb7b5),
2419
COL("mistyrose4", 0x8b7d7b),
2420
COL("azure1", 0xf0ffff),
2421
COL("azure2", 0xe0eeee),
2422
COL("azure3", 0xc1cdcd),
2423
COL("azure4", 0x838b8b),
2424
COL("slateblue1", 0x836fff),
2425
COL("slateblue2", 0x7a67ee),
2426
COL("slateblue3", 0x6959cd),
2427
COL("slateblue4", 0x473c8b),
2428
COL("royalblue1", 0x4876ff),
2429
COL("royalblue2", 0x436eee),
2430
COL("royalblue3", 0x3a5fcd),
2431
COL("royalblue4", 0x27408b),
2432
COL("blue1", 0x0000ff),
2433
COL("blue2", 0x0000ee),
2434
COL("blue3", 0x0000cd),
2435
COL("blue4", 0x00008b),
2436
COL("dodgerblue1", 0x1e90ff),
2437
COL("dodgerblue2", 0x1c86ee),
2438
COL("dodgerblue3", 0x1874cd),
2439
COL("dodgerblue4", 0x104e8b),
2440
COL("steelblue1", 0x63b8ff),
2441
COL("steelblue2", 0x5cacee),
2442
COL("steelblue3", 0x4f94cd),
2443
COL("steelblue4", 0x36648b),
2444
COL("deepskyblue1", 0x00bfff),
2445
COL("deepskyblue2", 0x00b2ee),
2446
COL("deepskyblue3", 0x009acd),
2447
COL("deepskyblue4", 0x00688b),
2448
COL("skyblue1", 0x87ceff),
2449
COL("skyblue2", 0x7ec0ee),
2450
COL("skyblue3", 0x6ca6cd),
2451
COL("skyblue4", 0x4a708b),
2452
COL("lightskyblue1", 0xb0e2ff),
2453
COL("lightskyblue2", 0xa4d3ee),
2454
COL("lightskyblue3", 0x8db6cd),
2455
COL("lightskyblue4", 0x607b8b),
2456
COL("slategray1", 0xc6e2ff),
2457
COL("slategray2", 0xb9d3ee),
2458
COL("slategray3", 0x9fb6cd),
2459
COL("slategray4", 0x6c7b8b),
2460
COL("lightsteelblue1", 0xcae1ff),
2461
COL("lightsteelblue2", 0xbcd2ee),
2462
COL("lightsteelblue3", 0xa2b5cd),
2463
COL("lightsteelblue4", 0x6e7b8b),
2464
COL("lightblue1", 0xbfefff),
2465
COL("lightblue2", 0xb2dfee),
2466
COL("lightblue3", 0x9ac0cd),
2467
COL("lightblue4", 0x68838b),
2468
COL("lightcyan1", 0xe0ffff),
2469
COL("lightcyan2", 0xd1eeee),
2470
COL("lightcyan3", 0xb4cdcd),
2471
COL("lightcyan4", 0x7a8b8b),
2472
COL("paleturquoise1", 0xbbffff),
2473
COL("paleturquoise2", 0xaeeeee),
2474
COL("paleturquoise3", 0x96cdcd),
2475
COL("paleturquoise4", 0x668b8b),
2476
COL("cadetblue1", 0x98f5ff),
2477
COL("cadetblue2", 0x8ee5ee),
2478
COL("cadetblue3", 0x7ac5cd),
2479
COL("cadetblue4", 0x53868b),
2480
COL("turquoise1", 0x00f5ff),
2481
COL("turquoise2", 0x00e5ee),
2482
COL("turquoise3", 0x00c5cd),
2483
COL("turquoise4", 0x00868b),
2484
COL("cyan1", 0x00ffff),
2485
COL("cyan2", 0x00eeee),
2486
COL("cyan3", 0x00cdcd),
2487
COL("cyan4", 0x008b8b),
2488
COL("darkslategray1", 0x97ffff),
2489
COL("darkslategray2", 0x8deeee),
2490
COL("darkslategray3", 0x79cdcd),
2491
COL("darkslategray4", 0x528b8b),
2492
COL("aquamarine1", 0x7fffd4),
2493
COL("aquamarine2", 0x76eec6),
2494
COL("aquamarine3", 0x66cdaa),
2495
COL("aquamarine4", 0x458b74),
2496
COL("darkseagreen1", 0xc1ffc1),
2497
COL("darkseagreen2", 0xb4eeb4),
2498
COL("darkseagreen3", 0x9bcd9b),
2499
COL("darkseagreen4", 0x698b69),
2500
COL("seagreen1", 0x54ff9f),
2501
COL("seagreen2", 0x4eee94),
2502
COL("seagreen3", 0x43cd80),
2503
COL("seagreen4", 0x2e8b57),
2504
COL("palegreen1", 0x9aff9a),
2505
COL("palegreen2", 0x90ee90),
2506
COL("palegreen3", 0x7ccd7c),
2507
COL("palegreen4", 0x548b54),
2508
COL("springgreen1", 0x00ff7f),
2509
COL("springgreen2", 0x00ee76),
2510
COL("springgreen3", 0x00cd66),
2511
COL("springgreen4", 0x008b45),
2512
COL("green1", 0x00ff00),
2513
COL("green2", 0x00ee00),
2514
COL("green3", 0x00cd00),
2515
COL("green4", 0x008b00),
2516
COL("chartreuse1", 0x7fff00),
2517
COL("chartreuse2", 0x76ee00),
2518
COL("chartreuse3", 0x66cd00),
2519
COL("chartreuse4", 0x458b00),
2520
COL("olivedrab1", 0xc0ff3e),
2521
COL("olivedrab2", 0xb3ee3a),
2522
COL("olivedrab3", 0x9acd32),
2523
COL("olivedrab4", 0x698b22),
2524
COL("darkolivegreen1", 0xcaff70),
2525
COL("darkolivegreen2", 0xbcee68),
2526
COL("darkolivegreen3", 0xa2cd5a),
2527
COL("darkolivegreen4", 0x6e8b3d),
2528
COL("khaki1", 0xfff68f),
2529
COL("khaki2", 0xeee685),
2530
COL("khaki3", 0xcdc673),
2531
COL("khaki4", 0x8b864e),
2532
COL("lightgoldenrod1", 0xffec8b),
2533
COL("lightgoldenrod2", 0xeedc82),
2534
COL("lightgoldenrod3", 0xcdbe70),
2535
COL("lightgoldenrod4", 0x8b814c),
2536
COL("lightyellow1", 0xffffe0),
2537
COL("lightyellow2", 0xeeeed1),
2538
COL("lightyellow3", 0xcdcdb4),
2539
COL("lightyellow4", 0x8b8b7a),
2540
COL("yellow1", 0xffff00),
2541
COL("yellow2", 0xeeee00),
2542
COL("yellow3", 0xcdcd00),
2543
COL("yellow4", 0x8b8b00),
2544
COL("gold1", 0xffd700),
2545
COL("gold2", 0xeec900),
2546
COL("gold3", 0xcdad00),
2547
COL("gold4", 0x8b7500),
2548
COL("goldenrod1", 0xffc125),
2549
COL("goldenrod2", 0xeeb422),
2550
COL("goldenrod3", 0xcd9b1d),
2551
COL("goldenrod4", 0x8b6914),
2552
COL("darkgoldenrod1", 0xffb90f),
2553
COL("darkgoldenrod2", 0xeead0e),
2554
COL("darkgoldenrod3", 0xcd950c),
2555
COL("darkgoldenrod4", 0x8b6508),
2556
COL("rosybrown1", 0xffc1c1),
2557
COL("rosybrown2", 0xeeb4b4),
2558
COL("rosybrown3", 0xcd9b9b),
2559
COL("rosybrown4", 0x8b6969),
2560
COL("indianred1", 0xff6a6a),
2561
COL("indianred2", 0xee6363),
2562
COL("indianred3", 0xcd5555),
2563
COL("indianred4", 0x8b3a3a),
2564
COL("sienna1", 0xff8247),
2565
COL("sienna2", 0xee7942),
2566
COL("sienna3", 0xcd6839),
2567
COL("sienna4", 0x8b4726),
2568
COL("burlywood1", 0xffd39b),
2569
COL("burlywood2", 0xeec591),
2570
COL("burlywood3", 0xcdaa7d),
2571
COL("burlywood4", 0x8b7355),
2572
COL("wheat1", 0xffe7ba),
2573
COL("wheat2", 0xeed8ae),
2574
COL("wheat3", 0xcdba96),
2575
COL("wheat4", 0x8b7e66),
2576
COL("tan1", 0xffa54f),
2577
COL("tan2", 0xee9a49),
2578
COL("tan3", 0xcd853f),
2579
COL("tan4", 0x8b5a2b),
2580
COL("chocolate1", 0xff7f24),
2581
COL("chocolate2", 0xee7621),
2582
COL("chocolate3", 0xcd661d),
2583
COL("chocolate4", 0x8b4513),
2584
COL("firebrick1", 0xff3030),
2585
COL("firebrick2", 0xee2c2c),
2586
COL("firebrick3", 0xcd2626),
2587
COL("firebrick4", 0x8b1a1a),
2588
COL("brown1", 0xff4040),
2589
COL("brown2", 0xee3b3b),
2590
COL("brown3", 0xcd3333),
2591
COL("brown4", 0x8b2323),
2592
COL("salmon1", 0xff8c69),
2593
COL("salmon2", 0xee8262),
2594
COL("salmon3", 0xcd7054),
2595
COL("salmon4", 0x8b4c39),
2596
COL("lightsalmon1", 0xffa07a),
2597
COL("lightsalmon2", 0xee9572),
2598
COL("lightsalmon3", 0xcd8162),
2599
COL("lightsalmon4", 0x8b5742),
2600
COL("orange1", 0xffa500),
2601
COL("orange2", 0xee9a00),
2602
COL("orange3", 0xcd8500),
2603
COL("orange4", 0x8b5a00),
2604
COL("darkorange1", 0xff7f00),
2605
COL("darkorange2", 0xee7600),
2606
COL("darkorange3", 0xcd6600),
2607
COL("darkorange4", 0x8b4500),
2608
COL("coral1", 0xff7256),
2609
COL("coral2", 0xee6a50),
2610
COL("coral3", 0xcd5b45),
2611
COL("coral4", 0x8b3e2f),
2612
COL("tomato1", 0xff6347),
2613
COL("tomato2", 0xee5c42),
2614
COL("tomato3", 0xcd4f39),
2615
COL("tomato4", 0x8b3626),
2616
COL("orangered1", 0xff4500),
2617
COL("orangered2", 0xee4000),
2618
COL("orangered3", 0xcd3700),
2619
COL("orangered4", 0x8b2500),
2620
COL("red1", 0xff0000),
2621
COL("red2", 0xee0000),
2622
COL("red3", 0xcd0000),
2623
COL("red4", 0x8b0000),
2624
COL("debianred", 0xd70751),
2625
COL("deeppink1", 0xff1493),
2626
COL("deeppink2", 0xee1289),
2627
COL("deeppink3", 0xcd1076),
2628
COL("deeppink4", 0x8b0a50),
2629
COL("hotpink1", 0xff6eb4),
2630
COL("hotpink2", 0xee6aa7),
2631
COL("hotpink3", 0xcd6090),
2632
COL("hotpink4", 0x8b3a62),
2633
COL("pink1", 0xffb5c5),
2634
COL("pink2", 0xeea9b8),
2635
COL("pink3", 0xcd919e),
2636
COL("pink4", 0x8b636c),
2637
COL("lightpink1", 0xffaeb9),
2638
COL("lightpink2", 0xeea2ad),
2639
COL("lightpink3", 0xcd8c95),
2640
COL("lightpink4", 0x8b5f65),
2641
COL("palevioletred1", 0xff82ab),
2642
COL("palevioletred2", 0xee799f),
2643
COL("palevioletred3", 0xcd6889),
2644
COL("palevioletred4", 0x8b475d),
2645
COL("maroon1", 0xff34b3),
2646
COL("maroon2", 0xee30a7),
2647
COL("maroon3", 0xcd2990),
2648
COL("maroon4", 0x8b1c62),
2649
COL("violetred1", 0xff3e96),
2650
COL("violetred2", 0xee3a8c),
2651
COL("violetred3", 0xcd3278),
2652
COL("violetred4", 0x8b2252),
2653
COL("magenta1", 0xff00ff),
2654
COL("magenta2", 0xee00ee),
2655
COL("magenta3", 0xcd00cd),
2656
COL("magenta4", 0x8b008b),
2657
COL("orchid1", 0xff83fa),
2658
COL("orchid2", 0xee7ae9),
2659
COL("orchid3", 0xcd69c9),
2660
COL("orchid4", 0x8b4789),
2661
COL("plum1", 0xffbbff),
2662
COL("plum2", 0xeeaeee),
2663
COL("plum3", 0xcd96cd),
2664
COL("plum4", 0x8b668b),
2665
COL("mediumorchid1", 0xe066ff),
2666
COL("mediumorchid2", 0xd15fee),
2667
COL("mediumorchid3", 0xb452cd),
2668
COL("mediumorchid4", 0x7a378b),
2669
COL("darkorchid1", 0xbf3eff),
2670
COL("darkorchid2", 0xb23aee),
2671
COL("darkorchid3", 0x9a32cd),
2672
COL("darkorchid4", 0x68228b),
2673
COL("purple1", 0x9b30ff),
2674
COL("purple2", 0x912cee),
2675
COL("purple3", 0x7d26cd),
2676
COL("purple4", 0x551a8b),
2677
COL("mediumpurple1", 0xab82ff),
2678
COL("mediumpurple2", 0x9f79ee),
2679
COL("mediumpurple3", 0x8968cd),
2680
COL("mediumpurple4", 0x5d478b),
2681
COL("thistle1", 0xffe1ff),
2682
COL("thistle2", 0xeed2ee),
2683
COL("thistle3", 0xcdb5cd),
2684
COL("thistle4", 0x8b7b8b),
2685
COL("gray0", 0x000000),
2686
COL("grey0", 0x000000),
2687
COL("gray1", 0x030303),
2688
COL("grey1", 0x030303),
2689
COL("gray2", 0x050505),
2690
COL("grey2", 0x050505),
2691
COL("gray3", 0x080808),
2692
COL("grey3", 0x080808),
2693
COL("gray4", 0x0a0a0a),
2694
COL("grey4", 0x0a0a0a),
2695
COL("gray5", 0x0d0d0d),
2696
COL("grey5", 0x0d0d0d),
2697
COL("gray6", 0x0f0f0f),
2698
COL("grey6", 0x0f0f0f),
2699
COL("gray7", 0x121212),
2700
COL("grey7", 0x121212),
2701
COL("gray8", 0x141414),
2702
COL("grey8", 0x141414),
2703
COL("gray9", 0x171717),
2704
COL("grey9", 0x171717),
2705
COL("gray10", 0x1a1a1a),
2706
COL("grey10", 0x1a1a1a),
2707
COL("gray11", 0x1c1c1c),
2708
COL("grey11", 0x1c1c1c),
2709
COL("gray12", 0x1f1f1f),
2710
COL("grey12", 0x1f1f1f),
2711
COL("gray13", 0x212121),
2712
COL("grey13", 0x212121),
2713
COL("gray14", 0x242424),
2714
COL("grey14", 0x242424),
2715
COL("gray15", 0x262626),
2716
COL("grey15", 0x262626),
2717
COL("gray16", 0x292929),
2718
COL("grey16", 0x292929),
2719
COL("gray17", 0x2b2b2b),
2720
COL("grey17", 0x2b2b2b),
2721
COL("gray18", 0x2e2e2e),
2722
COL("grey18", 0x2e2e2e),
2723
COL("gray19", 0x303030),
2724
COL("grey19", 0x303030),
2725
COL("gray20", 0x333333),
2726
COL("grey20", 0x333333),
2727
COL("gray21", 0x363636),
2728
COL("grey21", 0x363636),
2729
COL("gray22", 0x383838),
2730
COL("grey22", 0x383838),
2731
COL("gray23", 0x3b3b3b),
2732
COL("grey23", 0x3b3b3b),
2733
COL("gray24", 0x3d3d3d),
2734
COL("grey24", 0x3d3d3d),
2735
COL("gray25", 0x404040),
2736
COL("grey25", 0x404040),
2737
COL("gray26", 0x424242),
2738
COL("grey26", 0x424242),
2739
COL("gray27", 0x454545),
2740
COL("grey27", 0x454545),
2741
COL("gray28", 0x474747),
2742
COL("grey28", 0x474747),
2743
COL("gray29", 0x4a4a4a),
2744
COL("grey29", 0x4a4a4a),
2745
COL("gray30", 0x4d4d4d),
2746
COL("grey30", 0x4d4d4d),
2747
COL("gray31", 0x4f4f4f),
2748
COL("grey31", 0x4f4f4f),
2749
COL("gray32", 0x525252),
2750
COL("grey32", 0x525252),
2751
COL("gray33", 0x545454),
2752
COL("grey33", 0x545454),
2753
COL("gray34", 0x575757),
2754
COL("grey34", 0x575757),
2755
COL("gray35", 0x595959),
2756
COL("grey35", 0x595959),
2757
COL("gray36", 0x5c5c5c),
2758
COL("grey36", 0x5c5c5c),
2759
COL("gray37", 0x5e5e5e),
2760
COL("grey37", 0x5e5e5e),
2761
COL("gray38", 0x616161),
2762
COL("grey38", 0x616161),
2763
COL("gray39", 0x636363),
2764
COL("grey39", 0x636363),
2765
COL("gray40", 0x666666),
2766
COL("grey40", 0x666666),
2767
COL("gray41", 0x696969),
2768
COL("grey41", 0x696969),
2769
COL("gray42", 0x6b6b6b),
2770
COL("grey42", 0x6b6b6b),
2771
COL("gray43", 0x6e6e6e),
2772
COL("grey43", 0x6e6e6e),
2773
COL("gray44", 0x707070),
2774
COL("grey44", 0x707070),
2775
COL("gray45", 0x737373),
2776
COL("grey45", 0x737373),
2777
COL("gray46", 0x757575),
2778
COL("grey46", 0x757575),
2779
COL("gray47", 0x787878),
2780
COL("grey47", 0x787878),
2781
COL("gray48", 0x7a7a7a),
2782
COL("grey48", 0x7a7a7a),
2783
COL("gray49", 0x7d7d7d),
2784
COL("grey49", 0x7d7d7d),
2785
COL("gray50", 0x7f7f7f),
2786
COL("grey50", 0x7f7f7f),
2787
COL("gray51", 0x828282),
2788
COL("grey51", 0x828282),
2789
COL("gray52", 0x858585),
2790
COL("grey52", 0x858585),
2791
COL("gray53", 0x878787),
2792
COL("grey53", 0x878787),
2793
COL("gray54", 0x8a8a8a),
2794
COL("grey54", 0x8a8a8a),
2795
COL("gray55", 0x8c8c8c),
2796
COL("grey55", 0x8c8c8c),
2797
COL("gray56", 0x8f8f8f),
2798
COL("grey56", 0x8f8f8f),
2799
COL("gray57", 0x919191),
2800
COL("grey57", 0x919191),
2801
COL("gray58", 0x949494),
2802
COL("grey58", 0x949494),
2803
COL("gray59", 0x969696),
2804
COL("grey59", 0x969696),
2805
COL("gray60", 0x999999),
2806
COL("grey60", 0x999999),
2807
COL("gray61", 0x9c9c9c),
2808
COL("grey61", 0x9c9c9c),
2809
COL("gray62", 0x9e9e9e),
2810
COL("grey62", 0x9e9e9e),
2811
COL("gray63", 0xa1a1a1),
2812
COL("grey63", 0xa1a1a1),
2813
COL("gray64", 0xa3a3a3),
2814
COL("grey64", 0xa3a3a3),
2815
COL("gray65", 0xa6a6a6),
2816
COL("grey65", 0xa6a6a6),
2817
COL("gray66", 0xa8a8a8),
2818
COL("grey66", 0xa8a8a8),
2819
COL("gray67", 0xababab),
2820
COL("grey67", 0xababab),
2821
COL("gray68", 0xadadad),
2822
COL("grey68", 0xadadad),
2823
COL("gray69", 0xb0b0b0),
2824
COL("grey69", 0xb0b0b0),
2825
COL("gray70", 0xb3b3b3),
2826
COL("grey70", 0xb3b3b3),
2827
COL("gray71", 0xb5b5b5),
2828
COL("grey71", 0xb5b5b5),
2829
COL("gray72", 0xb8b8b8),
2830
COL("grey72", 0xb8b8b8),
2831
COL("gray73", 0xbababa),
2832
COL("grey73", 0xbababa),
2833
COL("gray74", 0xbdbdbd),
2834
COL("grey74", 0xbdbdbd),
2835
COL("gray75", 0xbfbfbf),
2836
COL("grey75", 0xbfbfbf),
2837
COL("gray76", 0xc2c2c2),
2838
COL("grey76", 0xc2c2c2),
2839
COL("gray77", 0xc4c4c4),
2840
COL("grey77", 0xc4c4c4),
2841
COL("gray78", 0xc7c7c7),
2842
COL("grey78", 0xc7c7c7),
2843
COL("gray79", 0xc9c9c9),
2844
COL("grey79", 0xc9c9c9),
2845
COL("gray80", 0xcccccc),
2846
COL("grey80", 0xcccccc),
2847
COL("gray81", 0xcfcfcf),
2848
COL("grey81", 0xcfcfcf),
2849
COL("gray82", 0xd1d1d1),
2850
COL("grey82", 0xd1d1d1),
2851
COL("gray83", 0xd4d4d4),
2852
COL("grey83", 0xd4d4d4),
2853
COL("gray84", 0xd6d6d6),
2854
COL("grey84", 0xd6d6d6),
2855
COL("gray85", 0xd9d9d9),
2856
COL("grey85", 0xd9d9d9),
2857
COL("gray86", 0xdbdbdb),
2858
COL("grey86", 0xdbdbdb),
2859
COL("gray87", 0xdedede),
2860
COL("grey87", 0xdedede),
2861
COL("gray88", 0xe0e0e0),
2862
COL("grey88", 0xe0e0e0),
2863
COL("gray89", 0xe3e3e3),
2864
COL("grey89", 0xe3e3e3),
2865
COL("gray90", 0xe5e5e5),
2866
COL("grey90", 0xe5e5e5),
2867
COL("gray91", 0xe8e8e8),
2868
COL("grey91", 0xe8e8e8),
2869
COL("gray92", 0xebebeb),
2870
COL("grey92", 0xebebeb),
2871
COL("gray93", 0xededed),
2872
COL("grey93", 0xededed),
2873
COL("gray94", 0xf0f0f0),
2874
COL("grey94", 0xf0f0f0),
2875
COL("gray95", 0xf2f2f2),
2876
COL("grey95", 0xf2f2f2),
2877
COL("gray96", 0xf5f5f5),
2878
COL("grey96", 0xf5f5f5),
2879
COL("gray97", 0xf7f7f7),
2880
COL("grey97", 0xf7f7f7),
2881
COL("gray98", 0xfafafa),
2882
COL("grey98", 0xfafafa),
2883
COL("gray99", 0xfcfcfc),
2884
COL("grey99", 0xfcfcfc),
2885
COL("gray100", 0xffffff),
2886
COL("grey100", 0xffffff),
2887
COL("darkgrey", 0xa9a9a9),
2888
COL("darkgray", 0xa9a9a9),
2889
COL("darkblue", 0x00008b),
2890
COL("darkcyan", 0x008b8b),
2891
COL("darkmagenta", 0x8b008b),
2892
COL("darkred", 0x8b0000),
2893
COL("lightgreen", 0x90ee90),
2894
COL(NULL,0) /* sentinel */
2895
};
2896
#undef COL
2897

2898
void
2899
long_to_rgb(long c, int *r, int *g, int *b)
2900
{
2901
  *b = c & 0xff; c >>= 8;
2902
  *g = c & 0xff; c >>= 8;
2903
  *r = c;
2904
}
2905
static int
2906
hex2(const char *s)
2907
{
2908
  int m = 0, c = 0, i;
2909
  for (i = 0; i < 2; i++, s++)
2910
  {
2911
    if (*s >= '0' && *s <= '9')
2912
      c = *s - '0';
2913
    else if (*s >= 'A' && *s <= 'F')
2914
      c = *s - 'A' + 10;
2915
    else if (*s >= 'a' && *s <= 'f')
2916
      c = *s - 'a' + 10;
2917
    else pari_err(e_MISC,"incorrect hexadecimal number: %s", s);
2918
    m = 16*m + c;
2919
  }
2920
  return m;
2921
}
2922
void
2923
colorname_to_rgb(const char *s, int *r, int *g, int *b)
2924
{
2925
  if (!rgb_colors) rgb_colors = hashstr_import_static(col_list, 1000);
2926
  if (*s == '#' && strlen(s) == 7)
2927
  {
2928
    *r = hex2(s+1);
2929
    *g = hex2(s+3);
2930
    *b = hex2(s+5);
2931
  }
2932
  else
2933
  {
2934
    hashentry *ep = hash_search(rgb_colors, (void*)s);
2935
    if (!ep) pari_err(e_MISC, "unknown color %s", s);
2936
    long_to_rgb((long)ep->val, r,g,b);
2937
  }
2938
}
2939

2940
static void
2941
chk_8bit(int v, GEN c)
2942
{ if (v & ~0xff) pari_err(e_MISC, "invalid RGB code: %Ps", c); }
2943
void
2944
color_to_rgb(GEN c, int *r, int *g, int *b)
2945
{
2946
  switch(typ(c))
2947
  {
2948
    case t_STR:
2949
      colorname_to_rgb(GSTR(c), r,g,b);
2950
      break;
2951
    default: /* t_VECSMALL: */
2952
      *r = c[1]; chk_8bit(*r, c);
2953
      *g = c[2]; chk_8bit(*g, c);
2954
      *b = c[3]; chk_8bit(*b, c);
2955
      break;
2956
  }
2957
}
2958

2959
Product

Resources

Company
