home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gnuplapi.zip / gnuplot-api-os2 / examples / Gnuplot.xs < prev    next >
Encoding:
Text File  |  1999-11-05  |  7.8 KB  |  454 lines
  1. #include "EXTERN.h"
  2. #include "perl.h"
  3. #include "XSUB.h"
  4.  
  5. #define GNUPLOT_OUTLINE_STDOUT
  6. #define DONT_POLLUTE_INIT
  7. #include "Gnuplot.h"
  8.  
  9. #define change_term_address() ((IV)&change_term)
  10. /* #define term_tbl_address() ((IV)term_tbl) */  /* Not used any more */
  11. #define term_tbl_address() 0
  12.  
  13. /* #define set_gnuplot_fh(file) (outfile = PerlIO_exportFILE(file,0)) */
  14.  
  15. #define int_change_term(s,l) (change_term(s,l) != 0)
  16. typedef PerlIO *OutputStream;
  17.  
  18. /* This sets the tokens for the options */
  19. static void
  20. set_tokens(SV **svp, int n, SV* acc)
  21. {
  22.     int tk = 0;
  23.  
  24.     c_token = 0;
  25.     num_tokens = n;
  26.     if (num_tokens > MAX_TOKENS) {
  27.     char buf[80];
  28.     sprintf(buf, "panic: more than %d tokens for options: %d",
  29.         MAX_TOKENS, num_tokens);
  30.     croak(buf);
  31.     }
  32.     while (num_tokens > tk) {
  33.     SV *elt = *svp++;
  34.     char buf[80];
  35.  
  36.     sv_catpvn(acc, " ", 1);
  37.         token[tk].start_index = SvCUR(acc);
  38.     if (SvIOKp(elt)) {
  39.         token[tk].is_token = 0;
  40.         token[tk].l_val.type = INTGR;
  41.         token[tk].l_val.v.int_val = SvIV(elt);
  42.         sprintf(buf, "%d", SvIV(elt));
  43.         sv_catpv(acc, buf);
  44.         token[tk].length = strlen(buf);
  45.     } else if (SvNOKp(elt)) {
  46.         token[tk].is_token = 0;
  47.         token[tk].l_val.type = CMPLX;
  48.         token[tk].l_val.v.cmplx_val.real = SvNV(elt);
  49.         token[tk].l_val.v.cmplx_val.imag = 0;
  50.         sprintf(buf, "%g", SvNV(elt));
  51.         sv_catpv(acc, buf);
  52.         token[tk].length = strlen(buf);
  53.     } else {
  54.         token[tk].is_token = 1;
  55.         token[tk].length = SvCUR(elt);
  56.         sv_catsv(acc, elt);
  57.     }
  58.     tk++;
  59.     }
  60. }
  61.  
  62. void
  63. set_options(SV **svp, int n)
  64. {
  65.     SV *sv = newSVpvn("", 0);    /* For error reporting in options() only */
  66.  
  67.     sv_2mortal(sv);
  68.     set_tokens(svp,n,sv);
  69.     input_line = SvPVX(sv);
  70.     options();
  71.     input_line = Nullch;
  72.     c_token = num_tokens = 0;
  73. }
  74.  
  75. long
  76. plot_outfile_set(char *s) { 
  77.     int normal = (strcmp(s,"-") == 0);
  78.  
  79.     /* Delegate all the hard work to term_set_output() */
  80.  
  81.     if (normal) 
  82.     term_set_output(NULL);
  83.     else {                /* term_set_output() needs
  84.                        a malloced string */
  85.     char *s1 = (char*) malloc(strlen(s) + 1);
  86.  
  87.     strcpy(s1,s);
  88.     term_set_output(s1);
  89.     }
  90.     return 1; 
  91. }
  92.  
  93. /* TK Canvas directdraw */
  94.  
  95. static SV *canvas;
  96. static int ptk_init = 0;
  97. static SV *fontsv;
  98.  
  99. static void
  100. do_init()
  101. {
  102.     if (!canvas)
  103.     croak("setcanvas should be set before a call to option()!");
  104.     ptk_init = 1;
  105.     fontsv = newSVpv("",0);
  106.     SvOK_off(fontsv);
  107. }
  108.  
  109. static void
  110. pTK_setcanvas( SV *sv )
  111. {
  112.     canvas = sv;
  113. }
  114.  
  115. void
  116. pTK_getsizes( int arr[3] )
  117. {
  118.     /*
  119.      * takes the actual width and height
  120.      * of the defined canvas
  121.      * => NOTE: this makes 'set size' useless !!!
  122.      * unless the original width and height is taken into account
  123.      * by some tcl or perl code, that's why the 'gnuplot_plotarea' and
  124.      * 'gnuplot_axisranges' procedures are supplied.
  125.      */
  126.     dSP ;
  127.     int count ;
  128.     SV *arg = sv_newmortal();
  129.     static char *types[] = { "width", "height", "border" };
  130.     int i;
  131.  
  132.     if (!ptk_init)
  133.     do_init();
  134.  
  135.     ENTER ;
  136.     SAVETMPS;
  137.  
  138.     EXTEND(SP,3);
  139.     for (i = 0; i < sizeof(types)/sizeof(char*); i++) {
  140.     PUSHMARK(SP) ;
  141.     PUSHs(canvas);
  142.     sv_setpv(arg, types[i]);
  143.     PUSHs(arg);
  144.     PUTBACK ;
  145.  
  146.     count = perl_call_method(i < 2 ? "winfo" : "cget", G_SCALAR);
  147.  
  148.     SPAGAIN ;
  149.  
  150.     if (count != 1)
  151.         croak("graphics: error in cget") ;
  152.  
  153.     arr[i] = POPi ;
  154.     PUTBACK ;
  155.     }
  156.     FREETMPS ;
  157.     LEAVE ;
  158. }
  159.  
  160. SV *
  161. pTK_putline( unsigned int px, unsigned int py, unsigned int x,
  162.          unsigned int y, char *color, double w )
  163. {
  164.     /*
  165.      * takes the actual width and height
  166.      * of the defined canvas
  167.      * => NOTE: this makes 'set size' useless !!!
  168.      * unless the original width and height is taken into account
  169.      * by some tcl or perl code, that's why the 'gnuplot_plotarea' and
  170.      * 'gnuplot_axisranges' procedures are supplied.
  171.      */
  172.     dSP ;
  173.     SV *ret;
  174.     I32 count;
  175.  
  176.     ENTER ;
  177.     SAVETMPS;
  178.  
  179.     EXTEND(SP,11);            /* 10 args */
  180.     PUSHMARK(SP) ;
  181.     PUSHs(canvas);
  182.     PUSHs(sv_2mortal(newSViv(px)));
  183.     PUSHs(sv_2mortal(newSViv(py)));
  184.     PUSHs(sv_2mortal(newSViv(x)));
  185.     PUSHs(sv_2mortal(newSViv(y)));
  186.     PUSHs(sv_2mortal(newSVpv("-fill", 5)));
  187.     PUSHs(sv_2mortal(newSVpv(color, 0)));
  188.     PUSHs(sv_2mortal(newSVpv("-width", 6)));
  189.     PUSHs(sv_2mortal(newSVnv(w)));
  190.     PUSHs(sv_2mortal(newSVpv("-capstyle", 9)));
  191.     PUSHs(sv_2mortal(newSVpv("round", 5)));
  192.     PUTBACK ;
  193.  
  194.     count = perl_call_method("createLine", G_SCALAR);
  195.  
  196.     SPAGAIN ;
  197.  
  198.     if (count != 1)
  199.     croak("vector: error in createLine") ;
  200.  
  201.     ret = SvREFCNT_inc(POPs) ;
  202.     PUTBACK ;
  203.     FREETMPS ;
  204.     LEAVE ;
  205.     SvREFCNT_dec(ret);
  206.     return ret;
  207. }
  208.  
  209. void
  210. pTK_puttext( unsigned int x, unsigned int y, char *s, char *color, char *anchor)
  211. {
  212.     dSP ;
  213.     ENTER ;
  214.     SAVETMPS;
  215.  
  216.     EXTEND(SP,11);            /* 10 args */
  217.     PUSHMARK(SP) ;
  218.     PUSHs(canvas);
  219.     PUSHs(sv_2mortal(newSViv(x)));
  220.     PUSHs(sv_2mortal(newSViv(y)));
  221.     PUSHs(sv_2mortal(newSVpv("-text", 5)));
  222.     PUSHs(sv_2mortal(newSVpv(s, 0)));
  223.     PUSHs(sv_2mortal(newSVpv("-fill", 5)));
  224.     PUSHs(sv_2mortal(newSVpv(color, 0)));
  225.     PUSHs(sv_2mortal(newSVpv("-anchor", 7)));
  226.     PUSHs(sv_2mortal(newSVpv(anchor, 0)));
  227.     if (SvOK(fontsv)) {
  228.     PUSHs(sv_2mortal(newSVpv("-font", 5)));
  229.     PUSHs(fontsv);
  230.     }
  231.     PUTBACK ;
  232.  
  233.     perl_call_method("createText", G_SCALAR | G_DISCARD);
  234.  
  235.     FREETMPS ;
  236.     LEAVE ;
  237. }
  238.  
  239. void
  240. pTK_setfont( char *font )
  241. {
  242.     if (font && *font)
  243.     sv_setpv(fontsv, font);
  244.     else
  245.     SvOK_off(fontsv);
  246. }
  247.  
  248. MODULE = Term::Gnuplot        PACKAGE = Term::Gnuplot        PREFIX = pTK_
  249.  
  250. void
  251. pTK_setcanvas( sv )
  252.     SV *sv
  253.  
  254. MODULE = Term::Gnuplot        PACKAGE = Term::Gnuplot        PREFIX = int_
  255.  
  256. long
  257. plot_outfile_set(s)
  258.     char *s
  259.  
  260. IV
  261. change_term_address()
  262.  
  263. IV
  264. term_tbl_address()
  265.  
  266. int
  267. test_term()
  268.  
  269. void
  270. list_terms()
  271.  
  272. void
  273. term_start_plot()
  274.  
  275. void
  276. term_end_plot()
  277.  
  278. void
  279. term_start_multiplot()
  280.  
  281. void
  282. term_end_multiplot()
  283.  
  284. void
  285. term_init()
  286.  
  287. int
  288. int_change_term(name,length=strlen(name))
  289. char *    name
  290. int    length
  291.  
  292. IV
  293. int_get_term_ftable()
  294.  
  295. void
  296. int_set_term_ftable(a)
  297.     IV a
  298.  
  299. int
  300. init_terminal()
  301.  
  302. # set_term is unsupported without junk
  303.  
  304. MODULE = Term::Gnuplot    PACKAGE = Term::Gnuplot  PREFIX=gptable_
  305.  
  306. void
  307. gptable_init()
  308.  
  309. MODULE = Term::Gnuplot    PACKAGE = Term::Gnuplot
  310.  
  311. void
  312. reset()
  313.  
  314. void
  315. text()
  316.  
  317. void
  318. graphics()
  319.  
  320. void
  321. set_options(...)
  322.     CODE:
  323.     {
  324.     set_options(&(ST(0)),items);
  325.     }
  326.  
  327. void
  328. linetype(lt)
  329.      int    lt
  330.  
  331. int
  332. justify_text(mode)
  333.      int    mode
  334.  
  335. int
  336. text_angle(ang)
  337.      int    ang
  338.  
  339. int
  340. scale(xs,ys)
  341.      double    xs
  342.      double    ys
  343.  
  344. void
  345. move(x,y)
  346.      unsigned int    x
  347.      unsigned int    y
  348.  
  349. void
  350. vector(x,y)
  351.      unsigned int    x
  352.      unsigned int    y
  353.  
  354. void
  355. put_text(x,y,str)
  356.      int    x
  357.      int    y
  358.      char *    str
  359.  
  360. void
  361. point(x,y,point)
  362.      unsigned int    x
  363.      unsigned int    y
  364.      int    point
  365.  
  366. void
  367. arrow(sx,sy,ex,ey,head)
  368.      int    sx
  369.      int    sy
  370.      int    ex
  371.      int    ey
  372.      int    head
  373.  
  374. void
  375. resume()
  376.  
  377. void
  378. suspend()
  379.  
  380. void
  381. linewidth(w)
  382.     double w
  383.  
  384. void
  385. setpointsize(w)
  386.     double w
  387.  
  388. int
  389. set_font(s)
  390.     char *s
  391.  
  392. void
  393. fillbox(sx,sy,ex,ey,head)
  394.      int    sx
  395.      unsigned int    sy
  396.      unsigned int    ex
  397.      unsigned int    ey
  398.      unsigned int    head
  399.  
  400. void
  401. getdata()
  402.    PPCODE:
  403.     {
  404.       if (!term) {
  405.     croak("No terminal specified");
  406.       }
  407.       EXTEND(SP, 8);
  408.       PUSHs(sv_2mortal(newSVpv(term->name,0)));
  409.       PUSHs(sv_2mortal(newSVpv(term->description,0)));
  410.       PUSHs(sv_2mortal(newSViv(term->xmax)));
  411.       PUSHs(sv_2mortal(newSViv(term->ymax)));
  412.       PUSHs(sv_2mortal(newSViv(term->v_char)));
  413.       PUSHs(sv_2mortal(newSViv(term->h_char)));
  414.       PUSHs(sv_2mortal(newSViv(term->v_tic)));
  415.       PUSHs(sv_2mortal(newSViv(term->h_tic)));
  416.     }
  417.  
  418. bool
  419. cannot_multiplot()
  420.  
  421. bool
  422. can_multiplot()
  423.  
  424. bool
  425. is_binary()
  426.  
  427. void
  428. plotsizes_scale(x,y)
  429.     double x
  430.     double y
  431.  
  432. double
  433. scaled_xmax()
  434.  
  435. double
  436. scaled_ymax()
  437.  
  438. SV*
  439. _term_descrs()
  440.     PPCODE:
  441.     {
  442.     int c = term_count(), i;
  443.     
  444.     EXTEND(SP, 2*c);
  445.     for (i = 0; i < c; i++) {
  446.         PUSHs(sv_2mortal(newSVpv(term_tbl[i].name,0)));
  447.         PUSHs(sv_2mortal(newSVpv(term_tbl[i].description,0)));
  448.     }
  449.     }
  450.  
  451. BOOT:
  452.     setup_gpshim();
  453.     plot_outfile_set("-");
  454.