home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d3xx / d386 / xlispstat.lha / XLispStat / src2.lzh / XLisp-Stat / xsnewplots.c < prev    next >
Encoding:
C/C++ Source or Header  |  1990-10-03  |  6.8 KB  |  283 lines
  1. /* xsnewplots - XLISP interface to IVIEW dynamic graphics package.     */
  2. /* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney                  */
  3. /* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz    */
  4. /* You may give out copies of this software; for conditions see the    */
  5. /* file COPYING included with this distribution.                       */
  6.  
  7. #include "xlisp.h"
  8. #include "osdef.h"
  9. #ifdef ANSI
  10. #include "xlproto.h"
  11. #include "xlsproto.h"
  12. #include "iviewproto.h"
  13. #include "Stproto.h"
  14. #else
  15. #include "xlfun.h"
  16. #include "xlsfun.h"
  17. #include "iviewfun.h"
  18. #include "Stfun.h"
  19. #endif ANSI
  20. #include "xlsvar.h"
  21.  
  22. #ifdef ANSI
  23. void set_scale_shift(IVIEW_WINDOW,int,double,double),
  24.      add_data(int ,LVAL,LVAL,LVAL),
  25.      get_data(int,LVAL *,int *,LVAL *,int *),check_data(int,LVAL),
  26.      adjust_plot_to_data(LVAL,LVAL);
  27. LVAL make_iview_object(int,int,LVAL),newplot(int);
  28. #else
  29. void set_scale_shift(),
  30.      add_data()
  31.      get_data(),check_data(),
  32.      adjust_plot_to_data();
  33. LVAL make_iview_object(),newplot();
  34. #endif ANSI
  35.  
  36. static void set_scale_shift(w, var, scale, shift)
  37.      IVIEW_WINDOW w;
  38.      int var;
  39.      double scale, shift;
  40. {
  41.   double old_scale, old_shift;
  42.  
  43.   old_scale = IViewScale(w, var);
  44.   old_shift = IViewShift(w, var);
  45.   if (scale != 0.0 && old_scale != 0.0) {
  46.     scale = scale / old_scale;
  47.     shift = shift - scale * old_shift;
  48.     IViewApplyScaleShift(w, var, scale, shift);
  49.   }
  50. }
  51.  
  52. void StGrObAdjustToData(object, draw)
  53.      LVAL object;
  54.      int draw;
  55. {
  56.   IVIEW_WINDOW w;
  57.   double low, high, range, center;
  58.   int i, vars;
  59.   LVAL scale_type;
  60.   
  61.   w = GETIVIEWADDRESS(object);
  62.   if (w != nil) {
  63.     scale_type = slot_value(object, s_scale_type);
  64.     vars = IViewNumVariables(w);
  65.     high = 1.0; low = -high;
  66.     if (scale_type == s_variable) {
  67.       high = sqrt((double) vars); low = - high;
  68.       for (i = 0; i < vars; i++) {
  69.     IViewScaleToRange(w, i, -1.0, 1.0);
  70.     IViewSetScaledRange(w, i, low, high);
  71.       }
  72.     }
  73.     else if (scale_type == s_fixed) {
  74.       if (vars > 0) {
  75.     IViewGetVisibleRange(w, 0, &low, &high);
  76.     set_scale_shift(w, 0, 1.0, -(high + low) / 2.0);
  77.     range = high - low;
  78.     for (i = 1; i < vars; i++) {
  79.       IViewGetVisibleRange(w, i, &low, &high);
  80.       set_scale_shift(w, i, 1.0, -(high + low) / 2.0);
  81.       if (high - low > range) range = high - low;
  82.     }
  83.     range = sqrt((double) vars) * range / 2;
  84.     for (i = 0; i < vars; i++) {
  85.       center = -IViewShift(w, i);
  86.       IViewSetRange(w, i, center - range, center + range);
  87.     }
  88.       }
  89.     }
  90.     else {
  91.       for (i = 0; i < vars; i++) {
  92.     IViewApplyScaleShift(w, i, 1.0, 0.0);
  93.     IViewGetVisibleRange(w, i, &low, &high);
  94.     IViewSetRange(w, i, low, high);
  95.       }
  96.     }
  97.     if (draw) {
  98.       send_message(object, sk_resize);
  99.       send_message(object, sk_redraw);
  100.     }
  101.   }
  102. }
  103.  
  104. LVAL iview_adjust_to_data()
  105. {
  106.   LVAL object;
  107.   LVAL arg;
  108.   int draw;
  109.  
  110.   object = xlgaobject();
  111.   if (! xlgetkeyarg(sk_draw, &arg)) arg = s_true;
  112.   draw = (arg != NIL) ? TRUE : FALSE;
  113.   StGrObAdjustToData(object, draw);
  114.   return(NIL);
  115. }
  116.  
  117. static LVAL make_iview_object(which, vars, rest)
  118.     int which, vars;
  119.     LVAL rest;
  120. {
  121.   LVAL proto, object, args;
  122.   
  123.   switch (which) {
  124.   case 'H': proto = getvalue(s_histogram_proto); break;
  125.   case 'P': 
  126.   case 'L': proto = getvalue(s_scatterplot_proto); break;
  127.   case 'R': proto = getvalue(s_spin_proto); break;
  128.   case 'S': proto = getvalue(s_scatmat_proto); break;
  129.   case 'N': proto = getvalue(s_name_list_proto); break;
  130.   default:  xlfail("unknown iview proto");
  131.   }
  132.   
  133.   xlsave1(args);
  134.   args = cons(NIL, rest);
  135.   args = cons(sk_show, args);
  136.   /* cons protects its arguments, so the new fixnum should be safe */
  137.   args = cons(cvfixnum((FIXTYPE) vars), args);
  138.   object = apply_send(proto, sk_new, args);
  139.   xlpop();
  140.   return(object);
  141. }
  142.  
  143. static void get_data(which, data, vars, rest, show)
  144.     int which, *vars, *show;
  145.     LVAL *data, *rest;
  146. {
  147.   LVAL x, y;
  148.   int n;
  149.   
  150.   if (data == nil || vars == nil) return;
  151.   
  152.   switch (which) {
  153.   case 'H':
  154.     *data = xlgetarg();
  155.     *vars = (consp(*data) && sequencep(car(*data))) ? seqlen(*data) : 1;
  156.     *show = xsboolkey(sk_show, TRUE);
  157.     *rest = makearglist(xlargc, xlargv);
  158.     break;
  159.   case 'P':
  160.   case 'L':
  161.     x = xlgetarg();
  162.     if (consp(x) && sequencep(car(x))) *data = x;
  163.     else {
  164.       y = xlgetarg();
  165.       *data = list2(x, y);
  166.     }
  167.     *vars = (consp(*data) && sequencep(car(*data))) ? seqlen(*data) : 1;
  168.     *show = xsboolkey(sk_show, TRUE);
  169.     *rest = makearglist(xlargc, xlargv);
  170.     break;
  171.   case 'R':
  172.   case 'S':
  173.     *data = xlgalist();
  174.     *vars = seqlen(*data);
  175.     *show = xsboolkey(sk_show, TRUE);
  176.     *rest = makearglist(xlargc, xlargv);
  177.     break;
  178.   case 'N':
  179.     *vars = 0;
  180.     *data = xlgetarg();
  181.     *show = xsboolkey(sk_show, TRUE);
  182.     *rest = makearglist(xlargc, xlargv);
  183.     if (! numberp(*data)) {
  184.       n = seqlen(*data);
  185.       *rest = cons(*data, *rest);
  186.       *rest = cons(sk_point_labels, *rest);
  187.       *data = cvfixnum((FIXTYPE) n);
  188.     }
  189.     break;
  190.   default:  xlfail("unknown iview proto");
  191.   }    
  192. }
  193.  
  194. static void check_data(which, data)
  195.     int which;
  196.     LVAL data;
  197. {
  198.   switch (which) {
  199.   case 'H': break;
  200.   case 'P':
  201.   case 'L':
  202.   case 'R':
  203.   case 'S': 
  204.     if (! consp(data)) xlerror("not a list of sequences", data);
  205.     for (; consp(data); data = cdr(data)) 
  206.       if (! sequencep(car(data))) xlerror("not a sequence", car(data));
  207.     break;
  208.   case 'N': break;
  209.   default:  xlfail("unknown iview proto");
  210.   }
  211. }
  212.  
  213. static void add_data(which, object, data, rest)
  214.     int which;
  215.     LVAL object, data, rest;
  216. {
  217.   LVAL args, message;
  218.   
  219.   xlsave1(args);
  220.   args = cons(NIL, rest);
  221.   args = cons(sk_draw, args);
  222.   args = cons(data, args);
  223.  
  224.   switch (which) {
  225.   case 'H':
  226.   case 'P': 
  227.   case 'R': 
  228.   case 'S':
  229.   case 'N': message = sk_add_points; break;
  230.   case 'L': message = sk_add_lines;  break;
  231.   default:  xlfail("unknown iview proto");
  232.   }
  233.   
  234.   apply_send(object, message, args);
  235.   xlpop();
  236. }
  237.   
  238. static void adjust_plot_to_data(object, rest)
  239.     LVAL object, rest;
  240. {
  241.   LVAL args;
  242.   
  243.   xlsave1(args);
  244.   args = cons(NIL, rest);
  245.   args = cons(sk_draw, args);
  246.   apply_send(object, sk_adjust_to_data, args);
  247.   xlpop();
  248. }
  249.  
  250. static LVAL newplot(which)
  251.     int which;
  252. {
  253.   int vars, show;
  254.   LVAL object, data, rest, args;
  255.   
  256.   if (! StHasWindows()) xlfail("not available without windows");
  257.  
  258.   xlstkcheck(4);
  259.   xlsave(object);
  260.   xlsave(data);
  261.   xlsave(args);
  262.   xlsave(rest);
  263.   
  264.   get_data(which, &data, &vars, &rest, &show);
  265.   check_data(which, data);
  266.   object = make_iview_object(which, vars, rest);
  267.   add_data(which, object, data, rest);
  268.   adjust_plot_to_data(object, rest);
  269.   
  270.   xlpopn(4);
  271.   
  272.   if (show) send_message(object, sk_show_window);
  273.   
  274.   return(object);
  275. }
  276.  
  277. LVAL xshistogram()          { return(newplot('H')); }
  278. LVAL xsplot_points()        { return(newplot('P')); }
  279. LVAL xsplot_lines()         { return(newplot('L')); }
  280. LVAL xsspin_plot()          { return(newplot('R')); }
  281. LVAL xsscatterplot_matrix() { return(newplot('S')); }
  282. LVAL xsnamelist()           { return(newplot('N')); }
  283.